commit cbfcc97e0ebc9cf71d871a28c2323bf1fd9b5a1e
parent ffea12a28d6bf818b727361e155f841c0e0c2a19
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 10 Mar 2023 21:51:34 -0500
hal: making good progress on CC
Diffstat:
5 files changed, 148 insertions(+), 153 deletions(-)
diff --git a/fs/comp/c/vm/commonhi.fs b/fs/comp/c/vm/commonhi.fs
@@ -66,7 +66,7 @@ ARIOPCNT wordtbl constops ( n n -- n )
: _movarray, \ special case, we have a {1, 2, 3} assign
vmop loc VM_STACKFRAME = _assert
vmop^ arg vmop^ :init @+ ( a sz )
- swap litn RSP>A, vmop arg A+, A>, litn \ on compiled PS: src dst len
+ swap litn dup, RSP) vmop arg +) lea, litn \ on compiled PS: src dst len
compile move ;
: _assignop, ( opid -- )
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -17,9 +17,9 @@ struct+[ VMOp
: _compile ( arg loc -- ) \ compile "straight" operands, errors on * ops.
case ( arg )
VM_CONSTANT of = litn PS+ endof
- VM_STACKFRAME of = RSP>A, A+, A>, PS+ endof
- VM_ARGSFRAME of = PSP>A, psoff + A+, A>, PS+ endof
- VM_REGISTER of = PSP>A, psoff + A+, A@, PS+ endof
+ VM_STACKFRAME of = dup, PS+ RSP) swap +) lea, endof
+ VM_ARGSFRAME of = dup, PS+ PSP) swap psoff CELLSZ - + +) lea, endof
+ VM_REGISTER of = dup, PS+ PSP) swap psoff CELLSZ - + +) @, endof
_err endcase ;
: :compile& dup :locptr? _assert bi arg | :loclo _compile ;
: :typesz! type typesize sz! ;
@@ -47,24 +47,21 @@ struct+[ VMOp
]struct
\ Free elements leaked to PS during the execution of the function
-: neutral# 0 to@! psoff ?dup if p+, then ;
+: neutral# 0 to@! psoff ?dup if ps+, then ;
\ generate function prelude code by allocating "locsz" bytes on RS.
: vmprelude, ( argsz locsz -- )
to locsz to argsz 0 to psoff
- locsz if locsz neg r+, then ;
+ locsz if locsz neg rs+, then ;
\ deallocate locsz and argsz. If result is set, keep a 4b in here and push the
\ result there.
: vmret,
- argsz >r \ V1=argsz
vmop^ :noop# \ returning with a second operand? something's wrong
- vmop loc if
- vmop :compile$ PS- psoff argsz + ?dup if
- PSP>A, A+, A!, -4 to+ V1 then then
- r> ( argsz ) 0 to@! psoff + ?dup if p+, then
- locsz ?dup if r+, then
- exit, ;
+ vmop loc dup >r if vmop :compile$ PS- then
+ 0 to@! psoff argsz + ps+,
+ r> ( vmop loc ) not if drop, then
+ locsz ?dup if rs+, then exit, ;
: vmcall, ( ?argN .. ?arg0 nargs -- ) dup >r \ V1=nargs
vmop :push >r
@@ -90,8 +87,8 @@ struct+[ VMOp
\ on PS *has* to be right after the last argument of the args frame.
\ The same logic applies to vmswitch,.
: _compileFinal
- vmop^ :noop# vmop :compile$ PS- 0 to@! psoff ?dup if
- dup PSP>A, A+, A!, CELLSZ - ?dup if p+, then then ;
+ vmop^ :noop# vmop :compile$ PS-
+ 0 to@! psoff ?dup if ps+, then ;
: vmjz, ( a -- ) _compileFinal [compile] until ;
: vmjz[, ( -- a ) _compileFinal [compile] if ;
: vmjnz, ( a -- ) _compileFinal compile not [compile] until ;
@@ -101,24 +98,24 @@ UNOPCNT wordtbl unop
'w neg 'w ^ 'w bool 'w not
: unop, ( opid -- ) vmop :compile$ unop swap wexec, vmop :>reg ;
-\ Signature: incsz -- n
+\ Comptime sig: incsz -- Runtime sig: -- n
UNOPMUTCNT >> wordtbl _tbl32
-:w ( ++op/--op ) A+!, A@, ;
-:w ( op++/op-- ) A@, compile swap A+!, ;
+:w ( ++op/--op ) W) [+n], W) @, ;
+:w ( op++/op-- ) W>A, W) @, A) [+n], ;
UNOPMUTCNT >> wordtbl _tbl16
-:w ( ++op/--op ) 16b A+!, 16b A@, ;
-:w ( op++/op-- ) 16b A@, compile swap 16b A+!, ;
+:w ( ++op/--op ) W) 16b [+n], W) 16b @, ;
+:w ( op++/op-- ) W>A, W) 16b @, A) 16b [+n], ;
UNOPMUTCNT >> wordtbl _tbl8
-:w ( ++op/--op ) 8b A+!, 8b A@, ;
-:w ( op++/op-- ) 8b A@, compile swap 8b A+!, ;
+:w ( ++op/--op ) W) 8b [+n], W) 8b @, ;
+:w ( op++/op-- ) W>A, W) 8b @, A) 8b [+n], ;
: unopmut, ( opid -- )
vmop type typesize
case 1 of = _tbl8 endof 2 of = _tbl16 endof _tbl32 endcase ( opid tbl )
- over >> wtbl@ ( opid w ) vmop :compile& >A,
- vmop :*arisz rot 1 and if ( -- ) neg then litn ( w ) execute vmop :>reg ;
+ over >> wtbl@ ( opid w ) vmop :compile&
+ vmop :*arisz rot 1 and if neg then swap ( incsz w ) execute vmop :>reg ;
ARIOPCNT 1+ ( for = ) wordtbl _tbl
'w + 'w - 'w * 'w /
diff --git a/fs/tests/all.fs b/fs/tests/all.fs
@@ -3,8 +3,8 @@ f<< /tests/kernel.fs
f<< /tests/lib/all.fs
f<< /tests/sys/all.fs
f<< /tests/fs/all.fs
+f<< /tests/comp/c/all.fs
f<< /tests/asm/all.fs
-\ f<< /tests/comp/c/all.fs
\ f<< /tests/ar/all.fs
\ f<< /tests/emul/all.fs
f<< /tests/gr/all.fs
diff --git a/fs/tests/comp/c/all.fs b/fs/tests/comp/c/all.fs
@@ -1,5 +1,5 @@
\ Run all CC test suites
f<< tests/comp/c/type.fs
f<< tests/comp/c/vm.fs
-f<< tests/comp/c/cc.fs
-f<< tests/comp/c/lib.fs
+\ f<< tests/comp/c/cc.fs
+\ f<< tests/comp/c/lib.fs
diff --git a/posix/dis.c b/posix/dis.c
@@ -11,117 +11,133 @@ as the ones compiled by the Forth backend of CC.
#define ARGNONE 0
#define ARGBYTE 1
#define ARGINT 2
-#define ARGSTR 3
-#define ARGERR 4 // can't continue, arg size unknown
+#define ARGFIVE 3 // byte + int
+#define ARGEIGHT 4 // 2x int
+#define ARGERR 5 // can't continue, arg size unknown
struct op {
char *name; // NULL= no op
int arg;
};
-#define OPCNT 0x6c
+#define OPCNT 0x78
static struct op ops[OPCNT] = {
- {"JUMP", ARGINT},
+ {"BR", ARGINT},
{"CALL", ARGINT},
{"RET", ARGNONE},
- {"LIT", ARGINT},
- {"BYE", ARGNONE},
- {"BYEFAIL", ARGNONE},
- {"QUIT", ARGNONE},
- {"ABORT", ARGNONE},
- {"EXECUTE", ARGNONE},
- {"CELL", ARGERR},
- {"DOES", ARGERR},
- {"SLIT", ARGSTR},
- {"BR", ARGINT},
- {"CBR", ARGINT},
- {NULL, ARGERR},
+ {"BRWR", ARGNONE},
+ {"BRA", ARGNONE},
+ {"BRC", ARGFIVE},
+ {"BRCDROP", ARGFIVE},
{"YIELD", ARGNONE},
- {"PSADD", ARGBYTE},
- {"PSADDWR", ARGNONE},
- {NULL, ARGERR},
- {NULL, ARGERR},
+ {"PSADD", ARGINT},
+ {"RSADD", ARGINT},
+ {"WLIT", ARGINT},
+ {"ALIT", ARGINT},
+ {"WADDN", ARGINT},
+ {"AADDN", ARGINT},
+ {"W2A", ARGNONE},
+ {"WSWAPA", ARGNONE},
+
+ {"WFETCH", ARGINT},
+ {"WSTORE", ARGINT},
+ {"WSWAP", ARGINT},
+ {"MADDN", ARGEIGHT},
+ {"WCMP", ARGINT},
+ {"WIFETCH", ARGINT},
+ {"WISTORE", ARGINT},
+ {"WADD", ARGINT},
+
+ {"WFETCH16", ARGINT},
+ {"WSTORE16", ARGINT},
+ {"WSWAP16", ARGINT},
+ {"MADDN16", ARGEIGHT},
+ {"WCMP16", ARGINT},
+ {"WIFETCH16", ARGINT},
+ {"WISTORE16", ARGINT},
+ {"WADD16", ARGINT},
+
+ {"WFETCH8", ARGINT},
+ {"WSTORE8", ARGINT},
+ {"WSWAP8", ARGINT},
+ {"MADDN8", ARGEIGHT},
+ {"WCMP8", ARGINT},
+ {"WIFETCH8", ARGINT},
+ {"WISTORE8", ARGINT},
+ {"WADD8", ARGINT},
+
+ {"WLEA", ARGINT},
{"BOOTRD", ARGNONE},
{"STDOUT", ARGNONE},
{"MAYBEKEY", ARGNONE},
- {"FINDMETA", ARGNONE},
- {"DUP", ARGNONE},
- {"CDUP", ARGNONE},
- {"SWAP", ARGNONE},
- {"OVER", ARGNONE},
- {"ROT", ARGNONE},
- {"ROTR", ARGNONE},
- {"NIP", ARGNONE},
- {"TUCK", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
- {"RSADD", ARGINT},
+ {"MAYBEWORD", ARGNONE},
+ {"WORD", ARGNONE},
+ {"PARSE", ARGNONE},
+ {"FIND", ARGNONE},
+ {"WNF", ARGNONE},
+ {"FINDMOD", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+
+ {"STACKCHK", ARGNONE},
+ {"COMPWORD", ARGNONE},
+ {"RUNWORD", ARGNONE},
+ {"COMPILING", ARGNONE},
+ {"STARTCOMP", ARGNONE},
+ {"STOPCOMP", ARGNONE},
{"RSADDWR", ARGNONE},
- {NULL, ARGERR},
- {NULL, ARGERR},
- {"SCNT", ARGNONE},
- {"RCNT", ARGNONE},
- {"RSP2A", ARGNONE},
- {"PSP2A", ARGNONE},
- {"AFETCH", ARGNONE},
- {"ASTORE", ARGNONE},
- {"AADDSTORE", ARGNONE},
- {NULL, ARGERR},
- {"AINC", ARGINT},
- {"AIINC", ARGINT},
- {"AIFETCH", ARGNONE},
- {"AISTORE", ARGNONE},
-
- {"WRITE", ARGNONE},
- {"SRD", ARGNONE},
- {"SWR", ARGNONE},
- {"SETBW", ARGNONE},
- {"SETA", ARGNONE},
- {"PUSHA", ARGNONE},
- {"GETBW", ARGNONE},
- {"LITA", ARGNONE},
- {"INC", ARGNONE},
- {"DEC", ARGNONE},
- {"ADD", ARGNONE},
+ {NULL, ARGERR},
+
+ {"ALIGN4", ARGNONE},
+ {"ENTRY", ARGNONE},
+ {"CODE", ARGNONE},
+ {"CODE16", ARGNONE},
+ {"CODE8", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+
{"SUB", ARGNONE},
{"MUL", ARGNONE},
{"DIVMOD", ARGNONE},
- {"AND", ARGNONE},
- {"ALIGN4", ARGNONE},
+ {"LSHIFT", ARGNONE},
+ {"RSHIFT", ARGNONE},
+ {"LT", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {"AND", ARGNONE},
{"OR", ARGNONE},
{"XOR", ARGNONE},
- {"BOOL", ARGNONE},
- {"NOT", ARGNONE},
- {"LT", ARGNONE},
- {"SHLC", ARGNONE},
- {"SHRC", ARGNONE},
- {"LSHIFT", ARGNONE},
- {"RSHIFT", ARGNONE},
- {NULL, ARGERR},
- {NULL, ARGERR},
- {NULL, ARGERR},
- {"MOVE", ARGNONE},
- {"MOVEWR", ARGNONE},
- {"FINDMOD", ARGNONE},
- {"WNF", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
- {"STACKCHK", ARGNONE},
- {"MAYBEWORD", ARGNONE},
- {"WORD", ARGNONE},
- {"PARSE", ARGNONE},
- {"REQ", ARGNONE},
- {"FIND", ARGNONE},
- {"APOS", ARGNONE},
- {"COMPILING", ARGNONE},
- {"ALIASWR", ARGNONE},
- {"STARTCOMP", ARGNONE},
- {"STOPCOMP", ARGNONE},
- {"COMPWORD", ARGNONE},
- {"RUNWORD", ARGNONE},
+ {"BYE", ARGNONE},
+ {"BYEFAIL", ARGNONE},
+ {"QUIT", ARGNONE},
+ {"ABORT_", ARGNONE},
+ {"DBG", ARGNONE},
{"USLEEP", ARGNONE},
- {NULL, ARGERR},
- {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+
+ {"SHLN", ARGBYTE},
+ {"SHRN", ARGBYTE},
+ {"ANDN", ARGINT},
+ {"ORN", ARGINT},
+ {"XORN", ARGINT},
+ {"CHECKZ", ARGNONE},
+ {"STOREZ", ARGNONE},
+ {NULL, ARGERR},
{"FCHILD", ARGNONE},
{"FOPEN", ARGNONE},
@@ -131,49 +147,31 @@ static struct op ops[OPCNT] = {
{"FITER", ARGNONE},
{NULL, ARGERR},
{"FSEEK", ARGNONE},
+
{"MOUNTDRV", ARGNONE},
{"UNMOUNTDRV", ARGNONE},
{"DRVRD", ARGNONE},
- {"DRVWR", ARGNONE}};
+ {"DRVWR", ARGNONE},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+ {NULL, ARGERR},
+};
/* Now this systen below is really fragile. Offsets will change often, and those
have to be maintained. But oh well... */
struct call {
int addr;
char *name;
- int arg;
};
-#define CALLCNT 28
+#define CALLCNT 5
struct call calls[CALLCNT] = {
- {0x5f, "execute", ARGNONE},
- {0x9e, "(br)", ARGINT},
- {0xae, "(?br)", ARGINT},
- {0x11a, "dup", ARGNONE},
- {0x138, "swap", ARGNONE},
- {0x147, "over", ARGNONE},
- {0x155, "rot", ARGNONE},
- {0x172, "nip", ARGNONE},
- {0x1c7, "@", ARGNONE},
- {0x1cf, "16b @", ARGNONE},
- {0x1d7, "8b @", ARGNONE},
- {0x1e9, "!", ARGNONE},
- {0x1f1, "16b !", ARGNONE},
- {0x1f9, "8b !", ARGNONE},
- {0x275, "!+", ARGNONE},
- {0x27d, "16b !+", ARGNONE},
- {0x285, "8b !+", ARGNONE},
- {0x355, "1+", ARGNONE},
- {0x36e, "+", ARGNONE},
- {0x37a, "-", ARGNONE},
- {0x386, "*", ARGNONE},
- {0x3a3, "and", ARGNONE},
- {0x3ec, "not", ARGNONE},
- {0x3f8, "<", ARGNONE},
- {0x436, "rshift", ARGNONE},
- {0xc18, "drop", ARGNONE},
- {0xd38, ">", ARGNONE},
- {0xde0, "/", ARGNONE}
+ {0x2e8, "-"},
+ {0x1760, "dup"},
+ {0x1b18, "@"},
+ {0x1e54, "execute"},
+ {0x1e94, "not"},
};
static int offset = 0;
@@ -200,13 +198,13 @@ int printarg(int arg) { // returns 1 on success, 0 on error
n = getint();
printf("\t%x", n);
break;
- case ARGSTR:
- n = getchar() & 0xff;
- offset++;
- for (int i=0; i<n; i++) {
- putchar(getchar());
- offset++;
- }
+ case ARGFIVE:
+ printarg(ARGBYTE);
+ printarg(ARGINT);
+ break;
+ case ARGEIGHT:
+ printarg(ARGINT);
+ printarg(ARGINT);
break;
case ARGERR:
fprintf(stderr, "Can't parse this op's arg\n");
@@ -223,7 +221,7 @@ int printcall() {
for (int i=0; i<CALLCNT; i++) {
if (calls[i].addr == addr) {
printf("\t%s", calls[i].name);
- return printarg(calls[i].arg);
+ return 1;
}
}
printf("\t%x", addr);
