duskos

commit 93b16b9002c1df2d204e4d6942c8340d3de669d4
parent 163c297217268ac1a89831fbf263c19ef3c5bbdc
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon, 29 Aug 2022 14:05:30 -0400

Remove system aliases from kernel and replace them with mem consts

Patience, you'll see where I'm going...

Diffstat:
M
fs/xcomp/bootlo.fs
 | 
8
+++++++-
M
fs/xcomp/i386.fs
 | 
39
++++++++++++++++++++++-----------------
M
posix/vm.c
 | 
26
+++++---------------------

3 files changed, 34 insertions(+), 39 deletions(-)
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -35,7 +35,7 @@ code : ] code ] ;
 : next compile (next) , 4 [rcnt] +! ; immediate
 : leave 1 litn 0 r', compile ! ; immediate
 : = - not ;
-: \ begin in< $0a = until ; immediate
+: \ begin IN< @ execute $0a = until ; immediate
 \ hello, this is a comment!
 : ( begin
     word dup c@ 1 = if
@@ -96,6 +96,12 @@ code : ] code ] ;
 : does' ( w -- 'data ) CALLSZ + CELLSZ + ;
 : ivalue doer , does> @ to? ?dup if execute else @ then ;
 HERE ivalue here
+: ialias doer , does> @ to? ?dup if execute else @ execute then ;
+IN< ialias in<
+EMIT ialias emit
+ABORT ialias abort
+MAIN ialias main
+
 : &+ ( n -- ) doer , does> @ + ;
 : &@ ( n -- ) doer , does> @ @ ;
 : &w@ ( n -- ) doer , does> @ w@ ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -24,7 +24,7 @@
 \ Constants and labels
 0 to realmode
 : values ( n -- ) >r begin 0 value next ;
-26 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin<
+27 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblabort
           lblcurword lblnextmeta lblret lblsysdict lblemit lblparsec lblparseh
           lblparseud lblerrmsg lblrtype lblhere lbl[rcnt] lblmovewrite lblwrite
           lblcwrite lblfind lblcompiling lblareg lblidt
@@ -121,9 +121,10 @@ xcode to?
   lbltoptr m) 0 i) mov,
   ret,
 
-xcode main
-  wcall, (alias)
-  pc to lblmainalias 0 ,
+pc to lblmainalias 0 ,
+xcode MAIN
+  lblmainalias pspushN,
+  ret,
 
 xcode herestart
   HERESTART pspushN,
@@ -153,7 +154,7 @@ xcode quit
   cld,
   lbltoptr m) 0 i) mov,
   sp RSTOP i) mov,
-  xwordlbl main abs>rel jmp,
+  lblmainalias m) jmp,
 
 xcode (abort)
   L1 forward!
@@ -521,8 +522,10 @@ xcode r>A
   lblareg m) bx mov,
   ax jmp,
 
-xcode emit
-  wcall, (alias) xwordlbl drop ,
+pc to lblemit xwordlbl drop ,
+xcode EMIT
+  lblemit pspushN,
+  ret,
 
 xcode rtype ( a u -- )
   CX SI pspop2,
@@ -531,7 +534,7 @@ pc to lblrtype
   al [esi] mov,
   AX pspush,
   si push, cx push,
-  wcall, emit
+  lblemit m) call,
   cx pop, si pop,
   si inc,
   cx dec,
@@ -548,11 +551,13 @@ pc
   lblrtype abs>rel call,
   0 jmp,
 
-xcode abort
-  wcall, (alias) ( pc ) ,
+pc to lblabort ( pc ) ,
+xcode ABORT
+  lblabort pspushN,
+  ret,
 
 xcode key
-  wcall, (alias) xwordlbl abort ,
+  wcall, (alias) xwordlbl (abort) ,
 
 align4 pc to lblbootptr 0 ,
 xcode boot<
@@ -564,10 +569,10 @@ xcode boot<
   ret,
 
 \ where "word" feeds itself
-xcode in< ( -- c )
-  wcall, (alias)
-pc to lblin<
-  xwordlbl boot< ,
+pc to lblin< xwordlbl boot< ,
+xcode IN< ( -- c )
+  lblin< pspushN,
+  ret,
 
 pc to lblcurword $20 allot0
 xcode curword
@@ -623,7 +628,7 @@ xcode word
   si ( pc ) i) mov,
 pc to lblerrmsg \ exc=sl esi=sa
   lblrtype abs>rel call,
-  xwordlbl abort abs>rel jmp,
+  lblabort m) jmp,
 
 xcode find ( str 'dict -- word-or-0 )
   DX pspop,
@@ -760,7 +765,7 @@ xcode parse ( str -- n? f )
   ret,
 
 xcode ,"
-  wcall, in<
+  lblin< m) call,
   AX pspop,
   al '"' i) cmp,
   lblret abs>rel jz,
diff --git a/posix/vm.c b/posix/vm.c
@@ -238,15 +238,6 @@ static void NEXT() { // op: 10
     }
 }
 
-static void SYSALIAS() { // op: 11
-    dword a = gpc();
-    if (vm.toptr) {
-        toexec(a);
-    } else {
-        vm.PC = gd(a);
-    }
-}
-
 static void BOOTRD() { // op: 13
     ppush(fgetc(fp));
 }
@@ -929,7 +920,7 @@ static void DRVWR() { // op: 6a
 static void (*ops[OPCNT])() = {
     JUMP, CALL, RET, LIT, BYE, BYEFAIL, QUIT, ABORT_,
     EXECUTE, CELL, VAL, ALIAS, DOES, SLIT, BR, CBR,
-    NEXT, SYSALIAS, NULL, BOOTRD, STDOUT, STDERR, KEY, DROP,
+    NEXT, NULL, NULL, BOOTRD, STDOUT, STDERR, KEY, DROP,
     DUP, CDUP, SWAP, OVER, ROT, ROTR, NIP, TUCK,
     RSADD, RSADDWR, RSADDR, RSADDRWR, SCNT, RCNT, ASET, AGET,
     ACFETCH, ACSTORE, AINC, ADEC, A2RS, RS2A, TOSET, TOGET,
@@ -993,13 +984,6 @@ static void makeimm(char *name) {
     sb(a, gb(a)|0x80);
 }
 
-static void sysalias(char *name, dword addr) {
-    entry(name);
-    cwrite(0x11); // SYSALIAS
-    dwrite(addr);
-    retwr();
-}
-
 static void sysconst(char *name, dword val) {
     entry(name);
     litwr(val);
@@ -1017,10 +1001,10 @@ static void buildsysdict() {
     sd(INRD, find("boot<"));
     sd(EMIT, find("(emit)"));
     sd(ABORT, find("byefail"));
-    sysalias("in<", INRD);
-    sysalias("emit", EMIT);
-    sysalias("abort", ABORT);
-    sysalias("main", MAINLOOP);
+    sysconst("IN<", INRD);
+    sysconst("EMIT", EMIT);
+    sysconst("ABORT", ABORT);
+    sysconst("MAIN", MAINLOOP);
     sysconst("HERE", HERE);
     sysconst("heremax", HEREMAX);
     sysconst("curword", CURWORD);