crc/retroforth
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

update the pascal implementation to support new instructions

Browse source 
FossilOrigin-Name: 96de198c5eb91ba70cba3e7e9b9bcb99374cefe2b54e3f44e2bef8af1ac96c4a
This commit is contained in:
crc 2018-11-22 02:01:52 +00:00
parent 1236b51664
commit c8347b515a
2 changed files with 27 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
interfaces/pascal/nga.inc
View file

@ -1,5 +1,6 @@
// ********************************************************
// Copyright (c) 2016 Rob Judd <judd@ob-wan.com>
// Copyright (c) 2018 Charles Childers <crc@forthworks.com>
// Based on C version by Charles Childers et al
// ISC License - see included file LICENSE
// ********************************************************
@ -11,7 +12,7 @@ const
STACK_DEPTH = 32;
ADDRESSES = 128;
IMAGE_SIZE = 524288;
NUM_OPS = 27;
NUM_OPS = 30;
{$define TOS := data[sp]}
{$define NOS := data[sp-1]}

25
interfaces/pascal/nga.pas
View file

@ -1,5 +1,6 @@
// ********************************************************
// Copyright (c) 2016 Rob Judd <judd@ob-wan.com>
// Copyright (c) 2018 Charles Childers <crc@forthworks.com>
// Based on C version by Charles Childers et al
// ISC License - see included file LICENSE
// ********************************************************
@ -284,6 +285,27 @@ begin
ip := IMAGE_SIZE - 1;
end;
procedure inst_in();
begin
inc(sp);
TOS := 1;
end;
procedure inst_iq();
begin
TOS := 0;
inc(sp);
TOS := 0;
end;
procedure inst_ii();
begin
inst_drop();
write(Char(data[sp]));
dec(sp);
end;
procedure ngaProcessOpcode(opcode : Cell);
begin
case opcode of
@ -314,6 +336,9 @@ begin
24 : inst_shift();
25 : inst_zret();
26 : inst_end();
27 : inst_in();
28 : inst_iq();
29 : inst_ii();
end;
end;