commit 33fa1be1e8cb51e3935483746427b30f1dfa39f8
parent 93b16b9002c1df2d204e4d6942c8340d3de669d4
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 29 Aug 2022 14:13:23 -0400
Remove (val) and (alias)
Right now, the system is much much slower than it was, but it's going to get
better, I promise.
Diffstat:
4 files changed, 10 insertions(+), 48 deletions(-)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -84,23 +84,24 @@ code : ] code ] ;
\ Compiling words
: create code compile (cell) ;
-: value code compile (val) , ;
: const code litn exit, ;
4 const CELLSZ
\ TODO: 5 is hardcoded, might not work on all arches
5 const CALLSZ
-: alias ' code compile (alias) , ;
-0 value _
-: doer code compile (does) HERE @ to _ CELLSZ allot ;
-: does> r> ( exit current definition ) _ ! ;
+create _ 0 ,
+: doer code compile (does) HERE @ _ ! CELLSZ allot ;
+: does> r> ( exit current definition ) _ @ ! ;
: does' ( w -- 'data ) CALLSZ + CELLSZ + ;
+: value doer , does> to? ?dup if execute else @ then ;
: ivalue doer , does> @ to? ?dup if execute else @ then ;
HERE ivalue here
+: alias ' doer , does> to? ?dup if execute else @ execute then ;
: ialias doer , does> @ to? ?dup if execute else @ execute then ;
IN< ialias in<
EMIT ialias emit
ABORT ialias abort
MAIN ialias main
+alias abort key
: &+ ( n -- ) doer , does> @ + ;
: &@ ( n -- ) doer , does> @ @ ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -61,20 +61,6 @@ xcode (cell)
AX pspush,
ret,
-xcode (val)
- ax pop,
- lbltoptr m) -1 i) test,
- lbltoexec abs>rel jnz,
- bx ax 0 d) mov,
- BX pspush,
- ret,
-
-xcode (alias)
- ax pop,
- lbltoptr m) -1 i) test,
- lbltoexec abs>rel jnz,
- ax 0 d) jmp,
-
xcode (does)
ax pop,
bx ax mov,
@@ -556,9 +542,6 @@ xcode ABORT
lblabort pspushN,
ret,
-xcode key
- wcall, (alias) xwordlbl (abort) ,
-
align4 pc to lblbootptr 0 ,
xcode boot<
si lblbootptr m) mov,
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -1,3 +1,4 @@
+' (key) to key
: _ doer ' , does> nip @ execute ;
_ _:child _fchild _ _:open _fopen _ _:info _finfo
create _POSIXFS
diff --git a/posix/vm.c b/posix/vm.c
@@ -126,11 +126,6 @@ static void _entry(byte *name, byte slen) {
static void entry(char *name) {
_entry((byte*)name, strlen(name));
}
-static void toexec(dword a) {
- ppush(a);
- vm.PC = vm.toptr;
- vm.toptr = 0;
-}
// Operations
/* The VM works in a simple manner. The VM reads the byte where PC points to in
@@ -185,24 +180,6 @@ static void CELL() { // op: 09
ppush(rpop());
}
-static void VAL() { // op: 0a
- dword a = rpop();
- if (vm.toptr) {
- toexec(a);
- } else {
- ppush(gd(a));
- }
-}
-
-static void ALIAS() { // op: 0b
- dword a = rpop();
- if (vm.toptr) {
- toexec(a);
- } else {
- vm.PC = gd(a);
- }
-}
-
static void DOES() { // op: 0c
dword a = rpop();
ppush(a+4);
@@ -919,7 +896,7 @@ static void DRVWR() { // op: 6a
#define OPCNT 0x6b
static void (*ops[OPCNT])() = {
JUMP, CALL, RET, LIT, BYE, BYEFAIL, QUIT, ABORT_,
- EXECUTE, CELL, VAL, ALIAS, DOES, SLIT, BR, CBR,
+ EXECUTE, CELL, NULL, NULL, DOES, SLIT, BR, CBR,
NEXT, NULL, NULL, BOOTRD, STDOUT, STDERR, KEY, DROP,
DUP, CDUP, SWAP, OVER, ROT, ROTR, NIP, TUCK,
RSADD, RSADDWR, RSADDR, RSADDRWR, SCNT, RCNT, ASET, AGET,
@@ -935,8 +912,8 @@ static void (*ops[OPCNT])() = {
static char *opnames[OPCNT] = {
NULL, NULL, NULL, NULL, "bye", "byefail", "quit", "(abort)",
- "execute", "(cell)", "(val)", "(alias)", "(does)", "(s)", "(br)", "(?br)",
- "(next)", NULL, NULL, "boot<", "(emit)", "stderr", "key", "drop",
+ "execute", "(cell)", NULL, NULL, "(does)", "(s)", "(br)", "(?br)",
+ "(next)", NULL, NULL, "boot<", "(emit)", "stderr", "(key)", "drop",
"dup", "?dup", "swap", "over", "rot", "rot>", "nip", "tuck",
NULL, "r+,", NULL, "r',", "scnt", "rcnt", ">A", "A>",
"Ac@", "Ac!", "A+", "A-", "A>r", "r>A", "[to]", "to?",
