commit b792b226d8e6a14562b23aa7a540b0564e576d36
parent 0338cd91589ffa991b193f283047226ecfb0125c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 7 Jan 2023 19:02:05 -0500
Change how aliases work
See doc/usage. It's problematic for aliases to obey "to" semantics. It creates
a whole class of possible bugs with "to" applying to an alias when it was meant
to a variable. Moreover, there's no real case for using the other "fancy" to
words. So, we scap that.
Also, I have the upcoming accelerator feature in mind, which will require to
"hijack" words. "realias" can do that. So, we're good.
Also, remove ivalue and ialias, which are not used outside of bootlo.
Diffstat:
16 files changed, 142 insertions(+), 129 deletions(-)
diff --git a/Makefile b/Makefile
@@ -51,23 +51,23 @@ run: dusk
.PHONY: test
test: dusk
- echo "' byefail to abort f<< tests/all.fs bye" | ./dusk || (echo; exit 1)
+ echo "' byefail ' abort realias f<< tests/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: testlib
testlib: dusk
- echo "' byefail to abort f<< tests/lib/all.fs bye" | ./dusk || (echo; exit 1)
+ echo "' byefail ' abort realias f<< tests/lib/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: testcc
testcc: dusk
- echo "' byefail to abort f<< tests/comp/c/all.fs bye" | ./dusk || (echo; exit 1)
+ echo "' byefail ' abort realias f<< tests/comp/c/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: testemul
testemul: dusk
- echo "' byefail to abort f<< tests/emul/all.fs bye" | ./dusk || (echo; exit 1)
+ echo "' byefail ' abort realias f<< tests/emul/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: testgr
testgr: dusk
- echo "' byefail to abort f<< tests/gr/all.fs bye" | ./dusk || (echo; exit 1)
+ echo "' byefail ' abort realias f<< tests/gr/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: clean
clean:
diff --git a/fs/comp/c/pgen.fs b/fs/comp/c/pgen.fs
@@ -168,7 +168,7 @@ alias noop parseExpression ( tok -- ) \ forward declaration
_post tuck CType type ( ctype lvl type )
_addlvl ( ctype type )
over to CType type ( ctype ) then ;
-current to parseDeclarator
+current ' parseDeclarator realias
: _parseStruct ( -- ctype )
nextt dup isIdent? if nextt else NULLSTR swap then
@@ -196,7 +196,7 @@ current to parseDeclarator
dup typenames sfind dup 0>= if ( type tok idx )
nip << << or 1
else drop nip findTypedef ( type-or-0 ) ?dup bool then then ;
-current to parseType
+current ' parseType realias
alias noop parseFactor ( tok -- ) \ forward declaration
@@ -299,7 +299,7 @@ MAXLITSZ Stack :new structbind Stack _list
r@ findIdent ?dup _assert ctype>op parsePostfixOp endof
r@ parse if const>op else _err then
endcase ;
-current to parseFactor
+current ' parseFactor realias
\ Parse the "right" part of an expression with the leftmost factor and leftmost
\ binary operator already parsed. We expect vmop to already contain the left
@@ -331,7 +331,7 @@ current to parseFactor
nip vmop^ :push swap parseRExpr vmop^ :pop
else to nexttputback then ;
-current to parseExpression
+current ' parseExpression realias
$40 const MAXSWITCHCASES
\ breaks are a list of forward jumps addr that need to be resolved at the end
@@ -433,7 +433,7 @@ MAXSWITCHCASES << Stack :new structbind Stack _cases
dup statementnames sfind dup >r dup 0< if ( tok -1 ) \ V1=stmtidx
drop parseExpression read; else nip statementhandler swap wexec then
ops$ r> to _laststmtid ;
-current to parseStatement
+current ' parseStatement realias
\ When there's variable initialization code, it has to come before the prelude
\ and we jump to it after we've created the stack frame.
diff --git a/fs/comp/c/type.fs b/fs/comp/c/type.fs
@@ -173,14 +173,14 @@ create _ssymbols 0 , 0 c, \ static
dup typeunsigned? if ." unsigned " then
dup >> >> 3 and typenames slistiter stype then
type*lvl begin ?dup while '*' emit 1- repeat ;
-current to _printtype
+current ' _printtype realias
: typesize ( type -- size-in-bytes )
dup type*lvl if drop 4 else
dup ctype? if
ctype' CType :size
else >> >> 3 and _ + c@ then then ;
-current to _typesize
+current ' _typesize realias
: inttypeofsize ( size -- type ) case
0 of = TYPE_VOID endof
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -323,6 +323,7 @@ which can then be executed to have the desired effect.
; -- *I* Compile a return from call and then stop compiling.
litn n -- Compile a literal with value n.
execute, a -- Compile a call to address a.
+alias, a -- Compile a jump to address a.
exit, -- Compile a return from call.
compile "x" -- *I* Find word x and compile a compilation of a call to it.
[compile] "x" -- *I* Find immediate word x and instead of executing it
@@ -337,12 +338,9 @@ does> -- Begin compiling the runtime behavior of a doer word.
does' w -- a Yields the address of the "data" part of a doer word w.
value n "x" -- Create a new entry of type "value" with n as its initial
value
-ivalue a "x" -- Create a new entry of type "indirect value" with a being the
- address holding the pointer to the value.
alias "x y" -- Find word "x" in system dictionary and create entry "y" of
type "alias" pointing to it.
-ialias a "x" -- Create a new entry of type "indirect alias" with a being the
- address holding the pointer to the word to execute.
+realias w t -- Make target word "t" into an alias to word "w".
S" x" -- *IC* Yield string literal with contents "x".
## "to" words
diff --git a/fs/doc/usage.txt b/fs/doc/usage.txt
@@ -125,7 +125,7 @@ useful.
[if]..[then] work like comments and simply drop words until "[then]". There is
no "[else]".
-## Values, cells, constants, aliases
+## Values, cells, constants
A "cell" is a word that refers to an area in memory. Calling this word yields
the address directly following it:
@@ -145,28 +145,21 @@ A constant is a read-only value that doesn't obey "to" semantics:
42 const myconst
-An alias is a shortcut to another word:
-
-alias noop myalias
-
-Calling "myalias" is the same as calling "noop". Aliases obey "to" semantics and
-can thus be changed.
-
## "to" semantics
-Values and aliases are very similar to cells: they're a piece of memory attached
-to a "handling" routine. With the cell, the routine is a noop, it returns the
-address of the piece of memory.
+Values are very similar to cells: they're a piece of memory attached to a
+"handling" routine. With the cell, the routine is a noop, it returns the address
+of the piece of memory.
-With value and aliases, it's not a noop. The first fetches the value in memory,
-the second jumps to the address contained by that memory.
+With values it's not a noop. The first fetches the value in memory, the second
+jumps to the address contained by that memory.
-These routines come with... side effects. How can you modify a value or an
-alias? You need a "to" word.
+These routines come with... side effects. How can you modify a value? You need a
+"to" word.
The "to" words ("to", "to+", etc.) set a global variable with a pointer to an
-alternate routine for value or alias words to execute. For example, the "to"
-word makes that global variable point to "!".
+alternate routine for value words to execute. For example, the "to" word makes
+that global variable point to "!".
This means that when you do "42 to myvalue", instead of "myvalue" executing the
equivalent of "addr-of-myvalue @", it executes "addr-of-myvalue !".
@@ -176,8 +169,28 @@ As soon as a "to" override is used, the global "to" pointer is reset to 0.
Refer to doc/dict for a complete list of "to" words.
Warning: this variable is global. any usage of "to" will affect the next value
-or alias that pops up. To avoid problems, always put your "to" call very, very
-close to your value/alias call.
+that pops up. To avoid problems, always put your "to" call very, very close to
+your value call.
+
+## Aliases
+
+An alias is a shortcut to another word:
+
+ alias noop myalias
+
+Calling "myalias" is the same as calling "noop". An alias is a native jump to
+its target, so there's almost no runtime overhead to using aliases.
+
+You can change the target of an alias, you can use the word
+"realias ( w tgt -- )" which makes target word "tgt" alias to word "w". Example:
+
+ ' anotherword ' myalias realias
+
+Note that while "tgt" is usually an alias, it doesn't have to be. You can make
+a "hostile takeover" of a word with realias and brutally make it point
+elsewhere. If you do, make sure that the word is big enough for a native jump.
+For example, using realias on the word "noop", which only contains a "return"
+op, would likely corrupt the dictionary entry of the following word.
## Linked lists
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -48,11 +48,11 @@ struct[ Path
: _ ( id fs -- )
2dup Filesystem :info dup FSInfo dir? if ( id fs info )
_w else 2drop drop then ;
- : :iterdirs ( w self -- ) swap to _w ['] _ swap :iter ;
+ : :iterdirs ( w self -- ) swap ['] _w realias ['] _ swap :iter ;
: _ ( id fs -- )
2dup Filesystem :info dup FSInfo dir? not if ( id fs info )
_w else 2drop drop then ;
- : :iterfiles ( w self -- ) swap to _w ['] _ swap :iter ;
+ : :iterfiles ( w self -- ) swap ['] _w realias ['] _ swap :iter ;
: :remove ( self -- ) dup id swap fs Filesystem :remove ;
: :root ( self -- path ) fs 0 :new ;
diff --git a/fs/sys/io.fs b/fs/sys/io.fs
@@ -35,7 +35,7 @@ struct+[ IO
]struct
: _consoleemit ConsoleOut IO :putc ;
-' _consoleemit to emit
+' _consoleemit ' emit realias
: stdin StdIn IO :getc ;
: stdout StdOut IO :putc ;
: stdio$ ConsoleIn to StdIn ConsoleOut to StdOut ;
diff --git a/fs/sys/loop.fs b/fs/sys/loop.fs
@@ -13,7 +13,7 @@
_current ?dup not if _loop then
?dup if
dup _word@ execute llnext to _current then ;
-' _idle to idle
+current ' idle realias
: loopadd ( w -- ) _loop ?dup not if to' _loop then lladd drop , ;
diff --git a/fs/sys/rdln.fs b/fs/sys/rdln.fs
@@ -28,5 +28,6 @@ create RdlnIn 0 , ' _readbuf , ' _ioerr , ' _ioerr ,
: rdlnreset RdlnIn to ConsoleIn in) to in> ;
: rdlnmain rdlnreset begin word runword again ;
: rdln$
- ['] (abort) to abort \ we have a read loop, we can have regular abort.
- rdlnreset ['] rdlnmain to main ;
+ \ we have a read loop, we can have regular abort.
+ ['] (abort) ['] abort realias
+ rdlnreset ['] rdlnmain ['] main realias ;
diff --git a/fs/tests/harness.fs b/fs/tests/harness.fs
@@ -21,17 +21,17 @@ _buf 1+ MemIO :new const _memio
: #s= ( s1 s2 -- ) 2dup s= if 2drop else swap stype ." != " stype abort then ;
0 value _aborted
-0 value _oldabort
+create _oldabort 5 allot
0 value _oldrcnt
+: _restore _oldabort ['] abort 5 move ;
: _
." \naborted as expected!\n"
- 1 to _aborted _oldabort to abort
- begin rcnt _oldrcnt > while rdrop repeat ;
+ 1 to _aborted _restore begin rcnt _oldrcnt > while rdrop repeat ;
: expectabort
- 0 to _aborted to@ abort to _oldabort ['] _ to abort
+ 0 to _aborted ['] abort _oldabort 5 move ['] _ ['] abort realias
rcnt 1+ to _oldrcnt
word runword
- _oldabort to abort _aborted not if abort" abort expected" then
+ _restore _aborted not if abort" abort expected" then
\ After an abort, PS is in an unpredictable state. Let's always empty it.
begin scnt while drop repeat ;
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -29,7 +29,7 @@ code : ] code ] ;
: next compile (next) , 4 [rcnt] +! ; immediate
: leave 1 litn 0 r', compile ! ; immediate
: = - not ;
-: \ begin IN< @ execute $0a = until ; immediate
+: \ begin in< $0a = until ; immediate
\ hello, this is a comment!
: exit exit, ; immediate
code drop 4 p+, exit,
@@ -105,14 +105,9 @@ create _ 0 ,
swap litn 0 toptr @! ?dup if nip then execute, else
0 toptr @! ?dup if nip then execute then ;
: value doer , immediate does> ['] @ toexec ;
-: ivalue doer , immediate does> @ ['] @ toexec ;
-HERE ivalue here
-: _ @ execute ;
-: alias ' doer , immediate does> ['] _ toexec ;
-: ialias doer , immediate does> @ ['] _ toexec ;
-EMIT ialias emit
-ABORT ialias abort
-MAIN ialias main
+: here HERE ['] @ toexec ; immediate
+: alias ' code alias, ;
+: realias ( 'new 'tgt -- ) to@! here swap alias, to here ;
alias noop idle
: &+ ( n -- ) doer , does> @ + ;
@@ -173,7 +168,7 @@ alias noop [then]
\ Entry metadata
1 const EMETA_DOCLINE \ a doc strings that ends with LF
\ a \\ comment goes before the creation of the word it comments
-: \\ nextmeta lladd drop EMETA_DOCLINE , begin IN< @ execute dup c, LF = until ;
+: \\ nextmeta lladd drop EMETA_DOCLINE , begin in< dup c, LF = until ;
\ Structures
@@ -289,7 +284,7 @@ BootIn value ConsoleIn
IONullOut value ConsoleOut
0 value consoleecho
: _ ConsoleIn IO :getc consoleecho if dup emit then ;
-current IN< !
+current ' in< realias
ConsoleIn value StdIn
IONullOut value StdOut
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -25,10 +25,10 @@
\ Constants and labels
0 to realmode
: values ( n -- ) >r begin 0 value next ;
-24 values lblmainalias lblbootptr lblin< lblabort lblnextword
- lblcurword lblnextmeta lblret lblsysdict lblemit lblparsec lblparseh
- lblparseud lblerrmsg lblrtype lblhere lbl[rcnt] lblmovewrite lblwrite
- lblcwrite lblfind lblcompiling lblidt lblwoff
+21 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
+ lblsysdict lblparsec lblparseh lblparseud lblerrmsg lblrtype lblhere
+ lbl[rcnt] lblmovewrite lblwrite lblcwrite lblfind lblcompiling lblidt
+ lblwoff
$8000 const HERESTART
$500 to binstart
$2000 const STACKSZ
@@ -94,11 +94,6 @@ xcode (next)
ax CELLSZ i) add,
ax jmp,
-pc to lblmainalias 0 ,
-xcode MAIN
- lblmainalias pspushN,
- ret,
-
xcode herestart
HERESTART pspushN,
ret,
@@ -128,7 +123,7 @@ xcode quit
cld,
lblwoff m) 0 i) mov,
sp RSTOP i) mov,
- lblmainalias m) jmp,
+ forward jmp, to lblmainalias
xcode (abort)
L1 forward!
@@ -645,10 +640,7 @@ xcode ?b
xwordlbl 16b abs>rel jz,
ret,
-pc to lblemit xwordlbl drop ,
-xcode EMIT
- lblemit pspushN,
- ret,
+xcode emit xwordlbl drop abs>rel jmp,
xcode rtype ( a u -- )
CX SI pspop2,
@@ -658,7 +650,7 @@ pc to lblrtype
al [esi] movclr,
AX pspush,
si push, cx push,
- lblemit m) call,
+ wcall, emit
cx pop, si pop,
si inc,
lblrtype abs>rel loop,
@@ -668,17 +660,12 @@ pc to lblrtype
\ mainloop because the mainloop likely sends us to an infinite error loop
\ through boot<.
pc ," boot failure"
-pc
+xcode abort
cx 12 i) mov,
- si swap ( msg ) i) mov,
+ si ( msg ) i) mov,
lblrtype abs>rel call,
0 jmp,
-pc to lblabort ( pc ) ,
-xcode ABORT
- lblabort pspushN,
- ret,
-
0 align4 pc to lblbootptr 0 ,
xcode boot<
si lblbootptr m) mov,
@@ -688,10 +675,8 @@ xcode boot<
ret,
\ where "word" feeds itself
-pc to lblin< xwordlbl boot< ,
-xcode IN< ( -- c )
- lblin< pspushN,
- ret,
+xcode in< xwordlbl boot< abs>rel jmp,
+3 allot \ that last jump is a rel8, we need more space.
pc to lblnextword 0 ,
xcode NEXTWORD
@@ -730,7 +715,7 @@ xcode maybeword ( -- str-or-0 )
ax push,
lblwoff m) 0 i) mov,
pc ( loop1 )
- lblin< m) call,
+ wcall, in<
AX pspop,
ax ax test,
L1 ( word_eof ) abs>rel js,
@@ -741,7 +726,7 @@ pc ( loop2 )
bx 0 d) al mov,
bx inc,
bx push,
- lblin< m) call,
+ wcall, in<
bx pop,
AX pspop,
ax ax test,
@@ -765,7 +750,7 @@ xcode word
si ( pc ) i) mov,
pc to lblerrmsg \ exc=sl esi=sa
lblrtype abs>rel call,
- lblabort m) jmp,
+ xwordlbl abort abs>rel jmp,
xcode find ( str 'dict -- word-or-0 )
DX pspop,
@@ -897,7 +882,7 @@ xcode parse ( str -- n? f )
pc 7 nc, 'n' LF 'r' CR '0' 0 0
xcode "<
- lblin< m) call,
+ wcall, in<
[ebp] '"' i) cmp,
forward jnz,
[ebp] -1 i) mov,
@@ -906,7 +891,7 @@ xcode "<
[ebp] '\' i) cmp,
lblret abs>rel jnz,
ps-,
- lblin< m) call,
+ wcall, in<
si ( pc ) i) mov,
pc
lodsb,
@@ -941,8 +926,7 @@ xcode litn
lblcwrite abs>rel call,
xwordlbl , abs>rel jmp,
-xcode execute,
- al $e8 ( call ) i) mov,
+pc
lblcwrite abs>rel call,
AX pspop, \ abs addr
ax lblhere m) sub, \ displacement
@@ -951,6 +935,14 @@ xcode execute,
lblwoff m) 0 i) mov,
lblwrite abs>rel jmp,
+xcode execute,
+ al $e8 ( call ) i) mov,
+ dup ( pc ) abs>rel jmp,
+
+xcode alias,
+ al $e9 ( call ) i) mov,
+ ( pc ) abs>rel jmp,
+
xcode exit,
al $c3 ( ret ) i) mov,
lblcwrite abs>rel jmp,
@@ -1012,7 +1004,8 @@ xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
ax call,
xwordlbl stack? abs>rel jmp,
-pc lblmainalias pc>addr !
+xcode main
+lblmainalias forward!
pc ( loop )
wcall, word
wcall, runword
diff --git a/fs/xcomp/i386/pc/init.fs b/fs/xcomp/i386/pc/init.fs
@@ -38,8 +38,8 @@ f<< /drv/pc/ps28042.fs
f<< /sys/ps2.fs
8042ps2$
-' 8042kbd@? to (ps2@?)
-' ps2keyset1? to key?
+' 8042kbd@? ' (ps2@?) realias
+' ps2keyset1? ' key? realias
8042mouse$
PS2Mouse :new ' mouse rebind
diff --git a/fs/xcomp/i386/pc/inittest.fs b/fs/xcomp/i386/pc/inittest.fs
@@ -5,6 +5,6 @@ com$
f<< sys/scratch.fs
f<< lib/fmt.fs
f<< lib/diag.fs
-' bye to abort
+' bye ' abort realias
f<< tests/all.fs
: init bye ;
diff --git a/posix/init.fs b/posix/init.fs
@@ -4,4 +4,4 @@
: _:emit ( c self -- ) drop (emit) ;
' _:emit ByteWriter :new dup to ConsoleOut to StdOut
f<< /sys/kbd.fs
-' (key?) to key?
+' (key?) ' key? realias
diff --git a/posix/vm.c b/posix/vm.c
@@ -29,12 +29,8 @@ The VM is little endian.
#define SYSDICT (HEREMAX+4)
#define NEXTMETA (SYSDICT+8) // +8 to leave space for sysdict's 0 len. doc/impl
#define _RCNT_ (NEXTMETA+4)
-#define INRD (_RCNT_+4)
-#define EMIT (INRD+4)
-#define ABORT (EMIT+4)
-#define NEXTWORD (ABORT+4)
-#define MAINLOOP (NEXTWORD+4)
-#define CURWORD (MAINLOOP+4)
+#define NEXTWORD (_RCNT_+4)
+#define CURWORD (NEXTWORD+4)
#define IOBUFSZ 0x200
#define IOBUF (SYSVARS-IOBUFSZ)
@@ -56,6 +52,12 @@ struct VM {
static struct VM vm = {0};
static FILE *fp;
+// Addresses of sysaliases
+static dword abortaddr;
+static dword emitaddr;
+static dword inrdaddr;
+static dword mainaddr;
+
// Utilities
static void vmabort() { vm.PC = MEMSZ + 1; }
static dword memchk(dword a) {
@@ -135,6 +137,10 @@ static void callwr(dword a) {
cwrite(0x01); // CALL
dwrite(a);
}
+static void jumpwr(dword a) {
+ cwrite(0x00); // JUMP
+ dwrite(a);
+}
static void callword(dword addr); // forward declaration
static void _entry(byte *name, byte slen) {
memcpy(&vm.mem[here()], name, slen);
@@ -190,7 +196,7 @@ static void QUIT() { // op: 06
vm.bwidth = 0;
vm.woff = 0;
vm.RSP = RSTOP;
- vm.PC = gd(MAINLOOP);
+ vm.PC = mainaddr;
}
static void ABORT_() { // op: 07
@@ -423,12 +429,12 @@ static void WRITE() { // op: 30
static char escapes[ESCAPECNT][2] = {{'n', '\n'}, {'r', '\r'}, {'0', 0}};
static void SRD() { // op: 31
dword c;
- callword(gd(INRD));
+ callword(inrdaddr);
c = ppop();
if (c == '"') {
c = 0xffffffff;
} else if (c == '\\') {
- callword(gd(INRD));
+ callword(inrdaddr);
c = ppop();
for (int i=0; i<ESCAPECNT; i++) {
if ((dword)escapes[i][0] == c) {
@@ -604,7 +610,7 @@ static void RTYPE() { // op: 4e
if (memchk(a+u)) {
for (int i=0; i<u; i++) {
ppush(vm.mem[a+i]);
- callword(gd(EMIT));
+ callword(emitaddr);
}
}
}
@@ -612,13 +618,13 @@ static void RTYPE() { // op: 4e
static void WNF() { // op: 4f
write(STDOUT_FILENO, &vm.mem[CURWORD+1], vm.mem[CURWORD]);
write(STDOUT_FILENO, " word not found", 15);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
}
static void STACKCHK() { // op: 50
if (vm.PSP > PSTOP) {
write(STDOUT_FILENO, "stack underflow", 15);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
}
}
@@ -635,7 +641,7 @@ static void MAYBEWORD() { // op: 51
}
vm.woff = 0;
do {
- callword(gd(INRD));
+ callword(inrdaddr);
c = ppop();
if (c >> 31) { // EOF
vm.woff = woff;
@@ -646,7 +652,7 @@ static void MAYBEWORD() { // op: 51
a = CURWORD+1;
do {
sb(a++, c);
- callword(gd(INRD));
+ callword(inrdaddr);
c = ppop();
} while (!(c >> 31) && (c > ' '));
vm.woff = woff;
@@ -658,7 +664,7 @@ static void WORD() { // op: 52
MAYBEWORD();
if (!ppeek()) {
write(STDOUT_FILENO, "word expected", 13);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
}
}
@@ -737,6 +743,9 @@ static void COMPILING() { // op: 57
ppush(vm.compiling);
}
+static void ALIASWR() { // op: 58
+ jumpwr(ppop());
+}
static void STARTCOMP() { // op: 59
vm.compiling = 1;
}
@@ -826,7 +835,7 @@ static int getfiledesc(dword hdl) {
static char* getpathfromid(dword fsid) {
if ((fsid >= FSIDCNT) || !fsids[fsid][0]) {
printf("Out of bounds FSID %x\n", fsid);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return NULL;
}
return fsids[fsid];
@@ -877,7 +886,7 @@ static void FOPEN () { // op: 61
fd = open(path, O_RDONLY);
if (fd < 0) {
printf("Can't open %s\n", path);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return;
}
filesize = lseek(fd, 0, SEEK_END);
@@ -908,7 +917,7 @@ static void FREADBUF() { // op: 62
res = read(fd, &vm.mem[IOBUF], n);
if (res < 0) {
printf("I/O readbuf error\n");
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return;
}
sd(hdl+FILEPOSOFF, lseek(fd, 0, SEEK_CUR));
@@ -935,7 +944,7 @@ static void FINFO() { // op: 64
struct stat s;
if (stat(path, &s) != 0) { // does not exist
printf("Can't stat %s\n", path);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return;
}
ppush(dst);
@@ -979,7 +988,7 @@ static void FITER() { // op: 65
closedir(dirp);
} else {
printf("Couldn't open dir %s\n", path);
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
}
}
@@ -989,13 +998,13 @@ static void FSEEK() { // op: 66
int res;
int fd = getfiledesc(hdl);
if (!fd) {
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return;
}
res = lseek(fd, pos, SEEK_SET);
if (res < 0) {
printf("I/O lseek error\n");
- vm.PC = gd(ABORT);
+ vm.PC = abortaddr;
return;
}
sd(hdl+FILEPOSOFF, res);
@@ -1057,7 +1066,7 @@ static void (*ops[OPCNT])() = {
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
RSHIFT, LITN, EXECUTEWR, EXITWR, MOVE, MOVEWR, RTYPE, WNF,
STACKCHK, MAYBEWORD, WORD, PARSE, REQ, FIND, APOS, COMPILING,
- NULL, STARTCOMP, STOPCOMP, COMPWORD, RUNWORD, NULL, NULL, NULL,
+ ALIASWR, STARTCOMP, STOPCOMP, COMPWORD, RUNWORD, NULL, NULL, NULL,
FCHILD, FOPEN, FREADBUF, FCLOSE, FINFO, FITER, FSEEK, NULL,
MOUNTDRV, UNMOUNTDRV, DRVRD, DRVWR};
@@ -1073,7 +1082,7 @@ static char *opnames[OPCNT] = {
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "rtype", "(wnf)",
"stack?", "maybeword", "word", "parse", "[]=", "find", "'", "compiling",
- NULL, "]", "[", "compword", "runword", NULL, NULL, NULL,
+ "alias,", "]", "[", "compword", "runword", NULL, NULL, NULL,
"_fchild", "_fopen", "_freadbuf", "_fclose", "_finfo", "_fiter", "_fseek", NULL,
"_mountdrv", "_unmountdrv", "_drv@", "_drv!"};
@@ -1135,6 +1144,11 @@ static void sysconst(char *name, dword val) {
retwr();
}
+static void sysalias(char *name, char *target) {
+ entry(name);
+ jumpwr(find(target));
+}
+
static void buildsysdict() {
sd(HERE, 0);
sd(HEREMAX, IOBUF);
@@ -1152,13 +1166,12 @@ static void buildsysdict() {
makeimm("[");
makeimm("16b");
makeimm("8b");
- sd(INRD, find("boot<"));
- sd(EMIT, find("(emit)"));
- sd(ABORT, find("byefail"));
- sysconst("IN<", INRD);
- sysconst("EMIT", EMIT);
- sysconst("ABORT", ABORT);
- sysconst("MAIN", MAINLOOP);
+ sysalias("abort", "byefail");
+ abortaddr = find("abort");
+ sysalias("emit", "(emit)");
+ emitaddr = find("emit");
+ sysalias("in<", "boot<");
+ inrdaddr = find("in<");
sysconst("HERE", HERE);
sysconst("NEXTWORD", NEXTWORD);
sysconst("HEREMAX", HEREMAX);
@@ -1167,12 +1180,12 @@ static void buildsysdict() {
sysconst("nextmeta", NEXTMETA);
sysconst("[rcnt]", _RCNT_);
entry("_fsinfobuf"); allot(0x112); // used in FINFO
- entry("mainloop");
- sd(MAINLOOP, here());
+ entry("main");
+ mainaddr = here();
callwr(find("word"));
callwr(find("runword"));
cwrite(0x00); // JUMP
- dwrite(gd(MAINLOOP));
+ dwrite(mainaddr);
}
// Interpret loop
