Skip to content

Commit

Permalink
turbo: fpc changes and code formatting
Browse files Browse the repository at this point in the history
  • Loading branch information
@tangentstorm
tangentstorm committed Nov 26, 2015
1 parent 94cd279 commit 9a0f56f
Show file tree
Hide file tree
Showing 4 changed files with 59 additions and 66 deletions.
23 changes: 13 additions & 10 deletions turbo/b4.pas
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,13 @@
{$mode delphi}{$i xpc.inc}{$H+}
{$mode delphi}{$i xpc}
{ this is the main entry point for b4 }
program b4;
uses xpc, cli, ub4, ub4asm, ub4ops, kvm, cw, kbd;

const pgsz = 8 * 9; { should be multiple of 8 to come out even }

procedure dump;
{ this displays the visual debugger }
var x,y, oldattr :byte; i, r : value; literal, target : boolean;
const pgsz = 56; { should be multiple of 8 to come out even }
var x,y, oldattr :word; i, r : value; literal, target : boolean;
begin
x := wherex; y := wherey; oldattr := textattr; clrscr;

Expand All @@ -21,26 +22,27 @@ procedure dump;
{ draw ram }
for i := r to r + pgsz-1 do
begin
if (i=ram[ip]) and (i=ram[ep]) then begin bg('m'); fg('M') end
if (i=ram[ip]) and (i=ram[ep]) then begin bg('m'); fg('M') end
else if i=ram[ip] then begin bg('c'); fg('m') end
else if i=ram[ep] then begin bg('r'); fg('M') end
else begin bg('k'); fg('m') end;
if i mod 8 = 0 then writeln;
else begin bg('k'); fg('m') end;
if i mod 8 = 0 then writeln;
write(i:5);
if literal or (i < 64) { 0..63 is a register } then
begin fg('y'); write(ram[i]:5); literal := false end
else if target then
begin if i = ram[ep] then fg('k') else fg('r');
write(ram[i]:5); target := false
end
else if (ram[i] in [1..pgsz-1]) then
else if i > high(ram) then begin fg('K'); write('xxxxx') end
else if (ram[i] in [1..high(optbl)]) then
begin
fg('W');
write(optbl[ram[i]]:5);
if ram[i] = 1 then literal := true;
if ram[i] in [2..3] then target := true;
end
else begin fg('b'); write(ram[i]:5) end;
else begin fg('b'); write(ram[i]:5) end;
end;

{ draw the data stack }
Expand All @@ -58,7 +60,7 @@ procedure dump;
gotoxy(x,y); textattr:=oldattr;
end;

var ch : char; debug, pause : boolean;
var ch : ansichar; debug, pause : boolean;
begin
open('disk.b4'); boot; clrscr;
assign(input, 'bios.b4a');
Expand All @@ -76,13 +78,14 @@ procedure dump;
^P : if ram[ep] >= 8 then dec(ram[ep],8);
^F : inc(ram[ep]);
^B : dec(ram[ep]);
^V : inc(ram[ep], pgsz);
'I': ram[ep] := ram[ip];
'S',
' ': pause := false;
'G': debug := false;
'Q': halt;
'0'..'9' : fillchar(ram[minbuff],
(maxbuff-minbuff)*sizeof(value), ch);
(maxbuff-minbuff)*sizeof(value), ch);
end;
if ram[ep] < 0 then ram[ep] := maxcell;
if ram[ep] > maxcell then ram[ep] := 0;
Expand Down
72 changes: 35 additions & 37 deletions turbo/ub4.pas
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{$mode tp}
{$mode delphi}{$i xpc}
unit ub4;
interface uses kvm, kbd;
interface uses xpc, kvm, kbd;
{
this contains the virtual machine
and the code to load and save blocks.
Expand Down Expand Up @@ -33,13 +33,13 @@ interface uses kvm, kbd;
bytes: array[0..maxcell*sizeof(value)] of byte;
disk : file of block;
const {-- these are all offsets into the ram array --}
ip = 0; { instruction pointer }
dp = 1; { data stack pointer }
rp = 2; { retn stack pointer }
hp = 3; { heap pointer }
last = 4; { last dictionary entry }
ap = 5; { the 'a' register }
ep = 6; { the editor pointer }
ip = 0; { instruction pointer }
dp = 1; { data stack pointer }
rp = 2; { retn stack pointer }
hp = 3; { heap pointer }
last = 4; { last dictionary entry }
ap = 5; { the 'a' register }
ep = 6; { the editor pointer }
ml = 64; { main loop }


Expand Down Expand Up @@ -110,8 +110,7 @@ function nos : value;
end;

procedure zap( v : value );
begin
{ discards a value }
begin { discards a value (for turbo pascal) }
end;

{ the stacks are really rings, so no over/underflows }
Expand Down Expand Up @@ -206,25 +205,24 @@ function step : value;
00 : {nop } begin end;
01 : {lit } begin inc(ram[ip]); dput(ram[ram[ip]]) end;
02 : {jmp } ram[ip] := ram[ram[ip]+1];
03 : {jwz } if tos = 0 then
03 : {jw0 } if tos = 0 then
begin
zap(dpop);
ram[ip] := ram[ram[ip]+1];
end
else
inc(ram[ip]) { skip over the addres };
else inc(ram[ip]) { skip over the addres };
04 : {ret } ram[ip] := rpop;
05 : {rwz } if tos = 0 then
begin
zap(dpop);
ram[ip] := rpop
end;
05 : {rw0 } if tos = 0 then
begin
zap(dpop);
ram[ip] := rpop
end;
06 : {eq } if dpop = dpop then dput(-1) else dput(0);
07 : {ne } if dpop <> dpop then dput(-1) else dput(0);
08 : {gt } if dpop > dpop then dput(-1) else dput(0);
09 : {lt } if dpop < dpop then dput(-1) else dput(0);
10 : {lte } if dpop <= dpop then dput(-1) else dput(0);
11 : {gte } if dpop >= dpop then dput(-1) else dput(0);
10 : {le } if dpop <= dpop then dput(-1) else dput(0);
11 : {gt } if dpop >= dpop then dput(-1) else dput(0);
12 : {and } dput(dpop and dpop);
13 : {or } dput(dpop or dpop);
14 : {xor } dput(dpop xor dpop);
Expand All @@ -235,7 +233,7 @@ function step : value;
rput(tos mod nos);
dput(dpop div dpop);
dput(rpop);
end;
end;
19 : {shl } begin swap; dput(dpop shl dpop) end;
20 : {shr } begin swap; dput(dpop shr dpop) end;
21 : {push} rput(dpop);
Expand All @@ -249,23 +247,23 @@ function step : value;
29 : {swap} swap;
30 : {over} dput(nos);
31 : {goxy} begin
swap;
kvm.gotoxy(dpop mod (xMax + 1),
dpop mod (yMax + 1))
end;
swap;
kvm.gotoxy(dpop mod (xMax + 1),
dpop mod (yMax + 1))
end;
32 : {attr} kvm.textattr := dpop;
33 : {putc} write(chr(dpop));
34 : {getc} begin
dput(value(kbd.readkey));
{ we have 32 bits and only need 16,
so we can store extended keys in
one cell }
if tos = 0 then
begin
zap(dpop);
dput(value(kbd.readkey) shl 8)
end
end;
dput(value(kbd.readkey));
{ we have 32 bits and only need 16,
so we can store extended keys in
one cell }
if tos = 0 then
begin
zap(dpop);
dput(value(kbd.readkey) shl 8)
end
end;
35 : {halt} halt;
36 : {boot} boot;
37 : {load} load;
Expand All @@ -284,4 +282,4 @@ function step : value;
end;

begin
end.
end.
29 changes: 10 additions & 19 deletions turbo/ub4asm.pas
View file
Original file line number Diff line number Diff line change
@@ -1,17 +1,17 @@
{$mode tp}
{$mode delphi}{$i xpc}
unit ub4asm;
interface uses ub4ops, ub4;
interface uses xpc, ub4ops, ub4;

type chargen = function( var ch : char ) : char;

var nextchar : chargen;
function b4op(code : opstring; var op:byte) : boolean;
function b4op(code : opstring; out op:byte) : boolean;
function readnext( var ch : char ) : char;
procedure b4as;

implementation

function b4op(code : opstring; var op:byte) : boolean;
function b4op(code : opstring; out op:byte) : boolean;
var found : boolean;
begin
op := 0; found := false;
Expand All @@ -24,9 +24,8 @@ function b4op(code : opstring; var op:byte) : boolean;
end;

function b4opc(code:opstring) : byte;
var result : byte;
begin
if b4op(code, result) then b4opc := result
if b4op(code, result) then ok
else begin writeln('invalid op: ', code); halt end;
end;

Expand All @@ -47,7 +46,6 @@ function readnext( var ch : char ) : char;
read(ch); readnext := ch;
end;


function next( var tok : token; var ch : char ) : boolean;
procedure keep;
begin
Expand Down Expand Up @@ -122,7 +120,7 @@ procedure b4as;
end
end;
def : if ents > 31 then err := -12345
else
else
begin
dict[ents].key := tok.str;
dict[ents].val := here-1 ;
Expand All @@ -134,12 +132,10 @@ procedure b4as;
op := 0;
while op < ents do
begin
if dict[op].key = tok.str then
emit(dict[op].val);
if dict[op].key = tok.str then emit(dict[op].val);
inc(op);
end

end;
end;
_wh : dput(here-1);
_do : begin
emit(b4opc('jwz'));
Expand All @@ -163,13 +159,8 @@ procedure b4as;
begin
err := 0; ents := 0; here := ram[hp];
read(ch);
while (err = 0) and not eof do
if next(tok, ch) then
compile;

if err <> 0
then dput(err)
else begin ram[hp] := here end
while (err = 0) and not eof do if next(tok, ch) then compile;
if err <> 0 then dput(err) else ram[hp] := here;
end;

begin
Expand Down
1 change: 1 addition & 0 deletions turbo/ub4ops.pas
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{$mode delphi}{$i xpc}
{-- do not edit! regenerate with mkoptbl.pas --}
unit ub4ops;
interface
Expand Down

0 comments on commit 9a0f56f

Please sign in to comment.