BBC Micro: More Progress on P65Pas Units
After making the last post, I continued working on the Pascal unit files for P65Pas to target the BBC Micro, and discussed with another Pascal enthusiast about the prospect of having a 6502 target added to FreePascal. The FreePascal compiler does have targets for both AVR and the Z-80 CPU, the latter here is another popular CPU from the 8-bit micros of the 80s.
The main bcc unit file now has basic file handling in the Pascal way, with supporting procedures of Assign, Rewrite, and Reset all using BBC Micro APIs. Although currently reading and writing to files is done is via new procedures, fputbyte and fgetbyte. Future versions will support methods such as BlockRead, and BlockWrite. I will also be adding support for the BBC Micro's OSFILE API which allows an entire file to either be loaded or saved at once via a single API call.
I also began work on a crt compatible unit, although I ran into an issue getting the Pascal Window procedure to work correctly. While I am sending the appropriate VDU commands, and even tested it using the VDU command from BBC BASIC, it does not seem to be working when called from machine code, so I'll need to look into this more to find out if it's a documentation error, or an error with my implementation, but I double-checked and triple-checked, so I am a bit confused on why it is not working.
And finally, the initial parts of a Turbo Pascal compatible graph unit is also underway. Currently, it supports only some basic graphical primitives such as PutPixel, and the various Line* and MoveTo calls. There is a low-level BBC Micro call Plot available that works just as the BBC BASIC one does, which will allow a Pascal program to perform any of those more advanced routines, and my current graphical calls go through this API as well.
The first crt unit demo program
Here is the initial creation of a CRT demo program, although note that the Window procedure is not currently working. This program will be created and used throughout development to ensure that all the crt unit calls are working as expected:
////////////////////////////////////////////
// New program created in 13-4-26}
////////////////////////////////////////////
program crtdemo;
{$OUTPUTHEX 'CRTDEMO,2000-2000'}
uses bbc, crt;
procedure AnyKey;
var
c: char;
begin
c:=ReadKey;
end;
procedure Center80(row: byte; s: pointer);
var
x: byte;
begin
x:=41 - Length(s) div 2;
GotoXY(x, row);
Write(s);
end;
procedure ColourTest;
var
i: byte;
begin
TextMode(2);
for i:=0 to 7 do
TextColour(i);
WriteLn(@'Colour!');
end;
AnyKey;
end;
procedure ModeTest;
var
buf: array[40] of char;
i: byte;
begin
TextMode(BW80);
Center80(10, @'This is Mode BW80, BBC Micro Mode 3!');
Center80(12, @'It only supports 2 colours, but is 80x25!');
Center80(20, @'Press your ANY key please...');
AnyKey;
Window(4,4,30,13); { The VDU commands for this don't seem to be working from Machine Code. :( }
ClrScr;
WriteLn(@'This is an example of a typical Window.');
Write(@'Please enter some text: ');
ReadLn(@buf);
for i:= 0 to 20 do
Write(@buf);
end;
AnyKey;
end;
begin
WriteLn(@'This is a basic CRT unit test program.');
Write(@'Please hit your ANY key to begin...');
AnyKey;
ModeTest;
ColourTest;
TextMode(7); { Default BBC Micro Mode. }
Exit;
end.
As you can see, it's all rather simple as this stage of development, but does support all the major features such as text cursor positions, and of course colour!
The New Version of the bbc Unit
Here is the latest version of the bbc unit, which I will also add comments to this version to explain what is going on in various places:
////////////////////////////////////////////
// New unit created in 04-12-26}
////////////////////////////////////////////
unit bbc;
{$BOOTLOADER JMP}
{$STRING NULL_TERMINATED}
{$ORG $2000}
{$SET_DATA_ADDR '3000-30FF'}
interface
type
pointer = word; { Here we define a pointer type which on the 6502 is a 16-bit word. }
string = array[] of char; { Formality for programs that need it. }
var
{ ReadError stores the error from ReadKey.}
{ IOResult works similar as in TP and will store the result from a file I/O operation. }
ReadError, IOResult: byte;
procedure Write(s: pointer);
procedure WriteLn(s: pointer);
procedure ReadKey: char;
procedure ReadLn(s: pointer);
procedure Length(s: pointer): byte;
{ This are used to interoperate with some BBC Micro MOS API calls. }
procedure Null2CR(s: pointer); { Converts a null-terminated string to a CR-terminated string. }
procedure CR2Null(s: pointer); { Does opposite of above. }
procedure Assign(f, fna: pointer);
procedure Reset(f: pointer);
procedure Rewrite(f: pointer);
procedure Close(f: pointer);
procedure fputbyte(f: pointer; b: byte registerA);
procedure fgetbyte(f: pointer): byte;
procedure FilePos(f: pointer): word;
procedure Seek(f: pointer; n: word);
procedure FileSize(f: pointer): word;
procedure Flush(f: pointer);
implementation
var
fptr: pointer; { Stores the file channel. }
{ OSFile Control Block }
OF_ADDR: pointer;
OF_LOAD1: pointer;
OF_LOAD2: pointer;
OF_EXEC1: pointer;
OF_EXEC2: pointer;
OF_START1: pointer;
OF_START2: pointer;
OF_END1: pointer;
OF_END2: pointer;
const
{ Various constants from the BBC Micro MOS OS API calls. }
OSFIND = $FFCE;
OSGBPB = $FFD1;
OSBPUT = $FFD4;
OSBGET = $FFD7;
OSARGS = $FFDA;
OSFILE = $FFDD;
OSRDCH = $FFE0;
OSASCI = $FFE3;
OSWORD = $FFF1;
OSBYTE = $FFF4;
OSCLI = $FFF7;
{ Constants related to File I/O. }
F_INPUT = $40;
F_OUTPUT =$80;
F_RANDOM =$C0;
procedure Write(s: pointer);
begin
asm
LDA s { Loads the string pointer into $70-$71 }
STA $70
LDA s+1
STA $71
LDY #0 { Sets our string index to 0 }
wloop:
LDA ($70), Y { Load character from string pointer into A }
BEQ wdone { Is it a null? We're done! }
JSR OSASCI { Call MOS API to output character in A }
INY { Increment Y index register }
BNE wloop { Loop back, routine will only support strings up to 255.}
wdone:
end;
end;
procedure WriteLn(s: pointer);
begin
Write(s);
asm
LDA #$0D { Loads CR into A }
JMP OSASCI { Calls MOS API to output character }
end;
end;
procedure ReadKey: char;
begin
asm
JSR OSRDCH { MOS API to read a character into A }
BCS nochar { Is CARRY bit is set, then we might have an error. }
RTS { CARRY is 0? We got character in A, return. }
nochar:
STA ReadError { Store potential error code in ReadError }
LDA #0 { Return 0 back as the character to signal error. }
end;
end;
procedure ReadLn(s: pointer);
begin
asm
LDA s { Loads up our string buffer pointer into $70,$71 }
STA $70
LDA s+1
STA $71
LDY #0 { Sets out index Y register to 0 }
rloop:
JSR OSRDCH { Read character from Keyboard into A }
BCS rloop { No character, loop until we have one }
JSR OSASCI { Echo character back to the screen }
CMP #$0D { Did user hit Enter? }
BEQ rdone { If user hit Enter, we're done. }
STA ($70),Y { Store character into string buffer. }
INY { Increment our Y index register. }
BNE rloop { Loop for another character. }
rdone:
LDA #0 { Null-terminate our string. }
STA ($70),Y { Write null to end of string buffer. }
end;
end;
procedure Length(s: pointer): byte;
begin
asm
LDA s { Load up our string buffer pointer into $70,$71 }
STA $70
LDA s+1
STA $71
LDY #0 { Set our pointer index to 0 }
lloop:
LDA ($70), Y { Load character from buffer into A }
BEQ ldone { Is it a null character? We're done. }
INY { Increment Y index register }
BNE lloop { Loop }
ldone:
TYA { Transfer the string size we counted into A }
end;
end;
procedure Null2CR(s: pointer);
begin
asm
LDA s { Transfer string pointer into $70,$71 }
STA $70
LDA s+1
STA $71
LDY #0 { Set our pointer index to 0 }
ncloop:
LDA ($70), Y { Load character from buffer into A }
BEQ ncdone { Have we found our null? }
INY { Increment Y register. }
BNE ncloop { Loop it. }
ncdone:
LDA #$0D { Load a CR into A }
STA ($70), Y { Replace the null with the CR. }
end;
end;
procedure CR2Null(s: pointer);
begin
asm
LDA s { Load string pointer into $70,$71 }
STA $70
LDA s+1
STA $71
LDY #0 { Start reading string at 0 }
ncloop:
LDA ($70), Y { Load character from string into A }
CMP #$0D { Have we found a CR? }
BEQ ncdone { Branch if we got CR }
INY { Increment Y register }
BNE ncloop { Loop it }
ncdone:
LDA #0 { Place null into A }
STA ($70), Y { Replace the CR with the null. }
end;
end;
procedure Assign(f, fna: pointer);
begin
{ Currently the Reset/Rewrite need to come right after Assign for simplicity. }
fptr:=fna; { Store the file name pointer buffer for later use. }
Null2CR(fptr); { Ensure filename is CR-terminated for MOS API Call. }
end;
{ Internal procedure to aid with file operations. }
procedure FileOp(f: pointer; op: byte);
begin
asm
LDX fptr { Load the location of the filename pointer into X,Y )
LDY fptr+1
LDA op; { Load our file operation into A }
JSR OSFIND { Perform MOS API Call OSFIND }
CMP #0 { Check returning A to see if it's 0. }
BEQ foperr { If it's 0, then we got an error. }
STA f { Store the channel number for the user program. }
LDA #0 { Load 0 into A }
STA IOResult { Store the result as success. }
RTS { Return }
foperr:
LDA #1 { We got an error, so let the user know. }
STA IOResult { Store the IOResult so the pascal program can check.}
end;
end;
procedure Reset(f: pointer);
begin
FileOp(f, F_RANDOM); { Currently using Reset with use MOS Random open. }
end;
procedure Rewrite(f: pointer);
begin
FileOp(f, F_OUTPUT); { Call FileOp to request new output file. }
end;
procedure Close(f: pointer);
begin
asm
LDY f { Load the file channel into Y. }
LDA #0 { API for file close is 0 }
JSR OSFIND { Call MOS API to close the file. }
STA f { Store the result into f, which should set it to 0. }
end;
end;
procedure fputbyte(f: pointer; b: byte registerA);
begin
asm
LDY f { Place the file channel into Y. }
JMP OSBPUT { Call MOS API to put a byte from A into the channel. }
end;
end;
procedure fgetbyte(f: pointer): byte;
begin
asm
LDY f { Load file channel into Y. }
JSR OSBGET { MOS API call to get a byte from the channel. }
BCS bgeterr { If CARRY is set, we got an error. }
RTS { Return if we have no error, result is in A }
bgeterr:
STA IOResult { We got an error, let the Pascal code know. }
LDA #0 { Return back a 0 to signal an issue. }
end;
end;
procedure FilePos(f: pointer): word;
begin
asm
LDX #$70 { X must point to 4 bytes on zero page. }
LDY f { Set our file channel in the Y register }
LDA #0 { The API to request a file position is 0 }
JSR OSARGS { Call the MOS API }
LDA $71 { Upon return $70,$71 will contain the position. }
STA __H
LDA $70
end;
end;
procedure Seek(f: pointer; n: word);
begin
asm
LDX #$70 { X must point to zero-page structure. }
LDY f { Load file channel into Y register }
LDA n { Copy our word of the seek location into $70,$71 }
STA $70
LDA n+1
STA $71
LDA #1 { API call for file seek is 1 }
JMP OSARGS { Perform MOS API call }
end;
end;
procedure FileSize(f: pointer): word;
begin
asm
LDX #$70 { X must point to zero-page location. }
LDY f { Load our file channel into the Y register. }
LDA #2 { API to request file size is 2 }
JSR OSARGS { Perform MOS API call }
LDA $71 { The file size will be in $70,$71 }
STA __H
LDA $70
end;
end;
procedure Flush(f: pointer);
begin
asm
LDA #$70 { X must always be set for this MOS API }
LDY f { Load file channel to flush to disk into Y }
LDA #$FF { API to flush channel to disk is $FF }
JMP OSARGS { Call the MOS API. }
end;
end;
end.
Okay, there is the latest version of the bbc unit full with comments. Hopefully this one is much easier to understand than the one from the post yesterday.
The Current crt Unit
Here is the current version of the crt unit I've been developing, and so far it mostly works except for the Window routine.
////////////////////////////////////////////
// New unit created in 12-4-26}
////////////////////////////////////////////
unit crt;
interface
uses bbc;
const
Black = 0;
Red = 1;
Green = 2;
Yellow = 3;
Blue = 4;
Magenta = 5;
Cyan = 6;
White = 7;
M80x32 = 0;
M40x32 = 1;
BW20x32 = 2;
M80x25 = 3;
BW40x32 = 4;
M20x32 = 5;
M40x25 = 6;
BW40 = M40x25;
CO40 = M40x32;
BW80 = M80x25;
procedure ClrScr;
procedure GotoXY(x, y: byte);
procedure Window(x1, y1, x2, y2: byte);
procedure WhereX: byte;
procedure WhereY: byte;
procedure TextMode(m: byte);
procedure TextColour(c: byte);
procedure TextBackground(c: byte);
procedure ResetWindow;
implementation
const
OSASCI = $FFE3;
OSBYTE = $FFF4;
procedure ClrScr;
begin
asm
LDA #$0C { VDU call to clear the screen. }
JMP OSASCI
end;
end;
procedure GotoXY(x, y: byte);
begin
asm
LDA #$1F { VDU call to set the cursor position }
JSR OSASCI
LDA x
JSR OSASCI
LDA y
JMP OSASCI
end;
end;
procedure Window(x1, y1, x2, y2: byte);
begin
asm
LDA #$1C { VDU call to set the text window. }
JSR OSASCI
LDA x1
JSR OSASCI
LDA y2
JSR OSASCI
LDA x2
JSR OSASCI
LDA y1
JMP OSASCI
end;
end;
procedure WhereX: byte;
begin
asm
LDA #$86 { OSBYTE call to obtain the text cursor position. }
JSR OSBYTE
TXA { Position for X is returned in the X register. }
end;
end;
procedure WhereY: byte;
begin
asm
LDA #$86 { OSBYTE call to obtain the text cursor position. }
JSR OSBYTE
TYA { Position for Y is returned in the Y register. }
end;
end;
procedure TextMode(m: byte);
begin
asm
LDA #$16 { VDU call to set the current screen mode. }
JSR OSASCI
LDA m
JMP OSASCI
end;
end;
procedure TextColour(c: byte);
begin
asm
LDA #$11 { VDU call to set the text colour }
JSR OSASCI
LDA c
JMP OSASCI
end;
end;
procedure TextBackground(c: byte);
begin
asm
LDA #$11 { VDU call to set the text colour. }
JSR OSASCI
LDA c
CLC
ADC #$80 { Add 128 to tell the VDU we want to set the background colour. }
JMP OSASCI
end;
end;
procedure ResetWindow;
begin
asm
LDA #$1A { VDU call to reset the text window. }
JMP OSASCI
end;
end;
end.
It has a decent amount of the functionality from crt, although there is still some missing which will be added later.
The Current graph Unit, Untested
Here is the current work on the Turbo Pascal compatible graph unit, and this one might take awhile longer, as it is much more complicated.
////////////////////////////////////////////
// New unit created in 13-4-26}
////////////////////////////////////////////
unit graph;
interface
uses bbc;
const
{ Constants for various graphical modes. }
GM640x256x2 = 0;
GM320x256x4 = 1;
GM160x256x16 = 2;
GM320x256x2 = 4;
GM160x256x4 = 5;
procedure InitGraph(m: byte);
procedure CloseGraph;
procedure SetViewPort(x1,y1,x2,y2: word);
procedure SetColour(c: byte);
procedure Plot(k: byte; x,y: word);
procedure Line(x1,y1,x2,y2: word);
procedure LineTo(x,y: word);
procedure LineRel(x,y: word);
procedure MoveTo(x,y: word);
procedure MoveRel(x,y: word);
implementation
const
OSASCI = $FFE3;
OSBYTE = $FFF4;
procedure InitGraph(m: byte);
begin
asm
LDA #$16 { VDU call to set the screen mode. }
JSR OSASCI
LDA m
JSR OSASCI
LDA #$05 { VDU call which will set the text position. }
JMP OSASCI
end;
end;
procedure CloseGraph;
begin
asm
LDA #$04 { VDU call to reset the text position. }
JSR OSASCI
LDA #$0C { Clear the screen. }
JMP OSASCI
end;
end;
procedure SetViewPort(x1,y1,x2,y2: word);
begin
asm
LDA #$18 { VDU call to set the graphics area window. }
JSR OSASCI
LDA x1
JSR OSASCI
LDA x1+1
JSR OSASCI
LDA y2
JSR OSASCI
LDA y2+1
JSR OSASCI
LDA x2
JSR OSASCI
LDA x2+1
JSR OSASCI
LDA y1
JSR OSASCI
LDA y1+1
JMP OSASCI
end;
end;
procedure SetColour(c: byte);
begin
asm
LDA #$12 { VDU call to set the graphics colour. }
JSR OSASCI
LDA c
JMP OSASCI
end;
end;
procedure Plot(k: byte; x,y: word);
begin
asm
LDA #$19 { VDU Call for generic PLOT commands. }
JSR OSASCI
LDA k { This is the PLOT API of such. }
JSR OSASCI
LDA x
JSR OSASCI
LDA x+1
JSR OSASCI
LDA y
JSR OSASCI
LDA y+1
JMP OSASCI
end;
end;
procedure Line(x1,y1,x2,y2: word);
begin
Plot(4, x1, y1); { Set the absolute start position via Plot. }
Plot(5, x2, y2); { Draw our actual line via Plot. }
end;
procedure LineTo(x,y: word);
begin
Plot(5, x, y); { Absolute line draw from current position. }
end;
procedure LineRel(x,y: word);
begin
Plot(1, x, y); { Relative Line draw from current position. }
end;
procedure MoveTo(x,y: word);
begin
Plot(4, x, y); { Move the graphics cursor. }
end;
procedure MoveRel(x,y: word);
begin
Plot(0, x, y); { Move graphics cursor relative to current pos. }
end;
end.
This unit has not been tested yet, although all the APIs do match, so in theory, it should work. Although be warned that this uses the graphical system of the BBC Micro, which has it's graphical origin at the bottom left of the display, and does not use pixels for the X, and Y, but rather uses it's own system which is a static size of 1280x1024. This is why I haven't written a test for this yet, as it's graphics system can be a tad confusing at first, especially for someone used to pixels and an origin of the top-left...
In Conclusion
I am hoping to eventually use these units to build and compile a native version of my Adventure Kernel for the BBC Micro, among other fun demo programs. I hope that this project can also be a nice middle ground for those people who want to experiment with the BBC Micro and create programs in machine code, but don't want to use pure assembly, and couldn't find an existing compiler that suites their needs. This project should be a good starting off point for various BBC Micro demo-scene projects, as once you understand the APIs and such, and then know how P65Pas works by looking at this project, it should be fairly easy from that point to start writing your own custom assembly routines using the P65Pas compiler to create some amazing demo-scene software one day.
Happy RISCing!