commit be090135d4ffeadc250faa2e104a97ea524ca28d
parent b6be887df7461771def1cbcdedab2134a255c7fb
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 29 Jun 2023 07:41:01 -0400
hal: rename "execute," to "branchR,"
No change in semantics. I'm puzzled as to why I chose that name initially, its
semantics is different than "execute" (compiles a call to hardcoded address
rather than calling a PS pop) and this causes confusion.
I've also cleared up the docs on the subject.
I've specifically avoided the name "call," to avoid clashes with assemblers
mnemonics.
Diffstat:
10 files changed, 86 insertions(+), 88 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -128,8 +128,8 @@ code _callA branchA,
psoff V2 - ?dup if dup ps+, neg to+ psoff then CELLSZ to+ V2
',' readChar? while nextt repeat ')' expectChar then ( funcres )
dup ExprOp cdecl dup CDecl :constfuncsig? if ( funcres cdecl )
- nip dup CDecl offset execute,
- else swap ExprOp :hal$ A>) @, ['] _callA execute, then ( cdecl )
+ nip dup CDecl offset branchR,
+ else swap ExprOp :hal$ A>) @, ['] _callA branchR, then ( cdecl )
rdrop r> ( psinitlvl ) to psoff
ExprOp currentW ?dup if PS- ExprOp :release then
\ TODO: arilvl of fun rettype isn't properly preserved here
diff --git a/fs/doc/code.txt b/fs/doc/code.txt
@@ -109,7 +109,7 @@ Here's a walkthrough to that code.
First, the context. When we begin running bootlo, all we have is the kernel and
that's quite limited. We have literal parsing and memory (@ ! , etc.) words and
constants to important memory areas (HERE and sysdict), we have the very
-important and arch-specific exit, and execute, and we have the extremely
+important and arch-specific exit, and branchR, and we have the extremely
important flow words [ and ] , but we don't have : or ; yet!
The first task of bootlo is thus to implement those 2 very important words.
@@ -127,7 +127,7 @@ duplication.
Alright, our entry is set up and "here" points to the word-to-be. Now we need to
compile the code for "5 - ;". We *could* be hardcore and go with something like
-"5 litn, ' - execute, ret," but the kernel already contains the mechanism to
+"5 litn, ' - branchR, ret," but the kernel already contains the mechanism to
compile words, so let's just us it and switch to compile mode with ].
The following "5 -" have the exact same effect as if they were in a regular
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -332,7 +332,9 @@ runword s -- Execute string s according to our general logic: if
## Compiling
Compiling words operate on a higher plane: they write native code to "here",
-which can then be executed to have the desired effect.
+which can then be executed to have the desired effect. Words from the HAL
+(doc/hal) are omitted from the list below but are of course very useful on the
+subject of compiling.
[ -- *I* Stop compiling. The following words will be interpreted.
] -- Begin compiling. The following words will be compiled.
@@ -343,14 +345,6 @@ which can then be executed to have the desired effect.
it shadows to this new word.
; -- *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.
-branch, a -- a Compile a jump to address a and yield an address for branch!
- if it's a forward jump.
-?branch, a -- a Like branch, but compiles a conditional jump, that is, code
- that consumes PS top and jumps if it's zero.
-branch! n a -- With "a" being the output of branch, or ?branch, make that
- branching target address "n".
-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
immediately as we would normally do, compile it as if it
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -209,21 +209,25 @@ A=0>Z, --
C>W, cond --
If cond is met, W=1. Otherwise, W=0.
-execute, a --
- Call address a
branch, a -- a
- Branch to address a
+ Branch to address a, yielding a "forward" address for "branch!"
branchC, a cond -- a
- Branch to address a if condition is met
+ Branch to address a if condition is met, yielding "a" for "branch!"
branch! tgtaddr braddr --
Given "braddr" yielded by a previous "branch" instruction, change the
reference at the address so that it targets "tgtaddr". Used for forward
branching.
+branchR, a --
+ Compile a branch to address a while at the same time setting the "return
+ address" (commonly, that means pushing to RSP, but not always) to the
+ instruction directly following this one. This is commonly called a "call".
branchA, --
Branch to the address held in the A register.
+exit, --
+ Compile a return from a call.
pushret, --
Push the current return address to RSP (on relevant CPUs)
-popret, --
+popret, --
Pop RSP in return address register (on relevant CPUs)
Instructions:
diff --git a/fs/lib/wordtbl.fs b/fs/lib/wordtbl.fs
@@ -5,4 +5,4 @@
: 'w ( a -- a+4? ) ' over ! w+ ;
: wtbl@ ( tbl idx -- w ) CELLSZ * + @ ;
: wexec ( tbl idx -- ) wtbl@ execute ;
-: wexec, ( tbl idx -- ) wtbl@ execute, ;
+: wexec, ( tbl idx -- ) wtbl@ branchR, ;
diff --git a/fs/tests/hal.fs b/fs/tests/hal.fs
@@ -91,7 +91,7 @@ code test9 ( n -- n ) \ returns 42 if arg >= 10, 54 otherwise
code test10 ( n -- n-42 )
dup,
42 i) @,
- pushret, ' test1 execute, popret,
+ pushret, ' test1 branchR, popret,
exit,
54 test10 12 #eq
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -24,9 +24,9 @@
: xdup, rTOP ppush, ;
: pushret, rLR push, ;
: popret, rLR pop, ;
-: exit, rLR bx) ,) ;
-: execute, abs>rel bl) ,) ;
-: wcall, xwordlbl execute, ;
+: ret, rLR bx) ,) ;
+: absbl, abs>rel bl) ,) ;
+: wcall, xwordlbl absbl, ;
: wjmp, xwordlbl abs>rel b) ,) ; \ only for leaf words!
: pc>reg, ( pc r -- )
@@ -42,7 +42,7 @@
rot mov) over rd) rot imm) ,) ( n1 r )
add) swap rdn) swap imm) ,) ;
-: xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, exit, ;
+: xconst ( n -- ) pc swap le, xcode xdup, rTOP pc@>reg, ret, ;
: return) ( -- operand ) mov) rPC rd) rLR rm) ;
: setrd0) ( -- operand ) bic) $f000 imm) ;
@@ -115,7 +115,7 @@ xcode bye 0 b) ,)
pc to L1 \ fail
mov) rTOP rd) 0 imm) ,)
- exit,
+ ret,
\ parse char
pc to L2 \ rTOP=a-with-'-skipped r0=u
@@ -128,7 +128,7 @@ pc to L2 \ rTOP=a-with-'-skipped r0=u
and) r0 rdn) $ff imm) ,)
r0 ppush,
mov) rTOP rd) 1 imm) ,)
- exit,
+ ret,
\ parse hexadecimal
pc to L3 \ rTOP=a-with-$-skipped r0=u
@@ -154,7 +154,7 @@ L4 forward! \ parse ok
( loop ) abs>rel b) nz) ,)
r2 ppush,
mov) rTOP rd) 1 imm) ,)
- exit,
+ ret,
\ parse unsigned decimal
pc to L4 \ rTOP=a+1 r1=first-char r0=u
@@ -178,7 +178,7 @@ pc \ loop
rsb) z) r2 rdn) 0 imm) ,) \ negate
r2 ppush,
mov) rTOP rd) 1 imm) ,)
- exit,
+ ret,
xcode parse ( str -- n? f )
ldr) r0 rd) rTOP rn) 8b) 1 +i) post) ,) \ rTOP=a r0=u
@@ -190,24 +190,24 @@ xcode parse ( str -- n? f )
mov) r2 rd) r1 rm) ,)
L4 abs>rel b) ,)
-xcode rtype exit, \ placeholder
+xcode rtype ret, \ placeholder
xcode compiling
xdup, rTOP binstart COMPILING movi2,
ldr) rTOP rdn) ,)
- exit,
+ ret,
xcode [ ximm
mov) r0 rd) 0 imm) ,)
r1 binstart COMPILING movi2,
str) r0 rd) r1 rn) ,)
- exit,
+ ret,
pc to L1 \ set MOD to 0
mov) r0 rd) 0 imm) ,)
r1 binstart MOD movi2,
str) r0 rd) r1 rn) ,)
- exit,
+ ret,
xcode quit
mov) rSP rd) RSTOP imm) ,)
L1 abs>rel bl) ,)
@@ -253,7 +253,7 @@ xcode findmod ( w -- w )
return) z) ,) \ no mod
pushret, L1 abs>rel bl) ,) popret,
add) rTOP rdn) 8 imm) ,)
- exit,
+ ret,
pc to lblerrmsg \ r0=sa r1=sl
r0 ppush,
@@ -266,7 +266,7 @@ xcode boot<
ldr) r1 rd) r0 rn) ,)
xdup, ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
str) r1 rd) r0 rn) ,)
- exit,
+ ret,
xcode in< wjmp, boot<
@@ -275,7 +275,7 @@ pc to lblmoverange \ r0=src r1=len r2=dst. out: r0=src+len r2=dst+len Saves r3
str) r4 rd) r2 rn) 8b) 1 +i) post) ,)
sub) r1 rdn) 1 imm) f) ,)
lblmoverange abs>rel b) ne) ,)
- exit,
+ ret,
pc \ we have a nonzero lblnextword. r0=src
r1 binstart NEXTWORD movi2,
@@ -289,7 +289,7 @@ pc \ we have a nonzero lblnextword. r0=src
pc to L1 \ EOF
mov) rTOP rd) 0 imm) ,)
- popret, exit,
+ popret, ret,
xcode maybeword ( -- str-or-0 )
xdup,
@@ -315,7 +315,7 @@ xcode maybeword ( -- str-or-0 )
( pc ) abs>rel b) gt) ,)
rTOP binstart CURWORD movi2,
str) r6 rd) rTOP rn) 8b) ,)
- popret, exit,
+ popret, ret,
pc ," word expected" alignhere
xcode word
@@ -324,7 +324,7 @@ xcode word
mov) r1 rd) 13 imm) ,)
cmp) rTOP rn) 0 imm) ,)
lblerrmsg abs>rel b) z) ,)
- exit,
+ ret,
pc ," word not found" alignhere
xcode (wnf)
@@ -363,34 +363,34 @@ pc \ loop2
( loop2 ) abs>rel b) ne) ,)
\ same contents
add) rTOP rdn) 4 imm) ,) \ e>w
- exit,
+ ret,
L2 forward! L1 forward! \ not matching, try next
ldr) rTOP rdn) 0 +i) ,)
cmp) rTOP rn) 0 imm) ,)
( loop1 ) abs>rel b) ne) ,)
\ not found
- exit,
+ ret,
pc to lblcwrite \ r0=char
r2 binstart HERE movi2,
ldr) r1 rd) r2 rn) ,)
str) r0 rd) r1 rn) 8b) 1 +i) post) ,)
str) r1 rd) r2 rn) ,)
- exit,
+ ret,
pc to lbldwrite \ r0=n. Destroys r1 and r2, preserves rest and flags
r2 binstart HERE movi2,
ldr) r1 rd) r2 rn) ,)
str) r0 rd) r1 rn) 4 +i) post) ,)
str) r1 rd) r2 rn) ,)
- exit,
+ ret,
pc to lblwriterange \ r0=addr r1=len
r3 binstart HERE movi2,
ldr) r2 rd) r3 rn) ,)
pushret, lblmoverange abs>rel bl) ,) popret,
str) r2 rd) r3 rn) ,)
- exit,
+ ret,
xcode entry pushret, ( 'dict s -- )
r0 binstart RCNT movi2,
@@ -409,12 +409,12 @@ xcode entry pushret, ( 'dict s -- )
xdrop, \ rTOP='dict
mov) r0 rd) r6 rm) ,)
mov) r1 rd) r5 rm) ,)
- lblwriterange execute,
+ lblwriterange absbl,
mov) r0 rd) r5 rm) ,)
- lblcwrite execute,
+ lblcwrite absbl,
r0 binstart NEXTMETA movi2,
ldr) r0 rdn) ,)
- lbldwrite execute,
+ lbldwrite absbl,
ldr) r0 rd) rTOP rn) ,) \ r0=dict
r1 binstart HERE movi2, ldr) r1 rdn) ,)
str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
@@ -460,21 +460,21 @@ xcode i) ( a -- operand )
r0 binstart HBANK movi2,
str) rTOP rd) r0 rn) ,)
( pc ) rTOP pc@>reg,
- exit,
+ ret,
pc HALBASE $20 or le, \ b5 is set
xcode m) ( a -- operand )
r0 binstart HBANK movi2,
str) rTOP rd) r0 rn) ,)
( pc ) rTOP pc@>reg,
- exit,
+ ret,
pc HALBASE HALIMM or le,
xcode i) ( n -- operand )
r0 binstart HBANK movi2,
str) rTOP rd) r0 rn) ,)
( pc ) rTOP pc@>reg,
- exit,
+ ret,
\ TODO: support negative offsets
xcode +) ( operand n -- operand )
@@ -482,29 +482,29 @@ xcode +) ( operand n -- operand )
str) rTOP rd) r0 rn) ,)
xdrop,
orr) rTOP rdn) $10 imm) ,)
- exit,
+ ret,
xcode 8b) ( operand -- operand )
orr) rTOP rdn) $00400000 imm) ,)
- exit,
+ ret,
xcode 16b) ( operand -- operand )
bic) rTOP rdn) $04000000 imm) ,)
- exit,
+ ret,
xcode 32b) ( operand -- operand )
bic) rTOP rdn) $00400000 imm) ,)
orr) rTOP rdn) $04000000 imm) ,)
- exit,
+ ret,
xcode A>) ( operand -- operand )
setrd0) rTOP rdn) ,)
orr) rTOP rdn) rA 12 lshift imm) ,)
- exit,
+ ret,
xcode &) ( operand -- operand )
orr) rTOP rdn) HALDEREF imm) ,)
- exit,
+ ret,
\ HAL operations
\ r0 is used as the immediate accumulator
@@ -534,7 +534,7 @@ pc
rsb) r2 rdn) 0 imm) ,) \ rotate is to the *right*
and) r2 rdn) $1e imm) ,) \ 0-32, even numbers
orr) rTOP rd) r3 rn) r2 rm) 7 lsl) ,) \ rTOP=rotate+imm
- exit,
+ ret,
\ Compile a add) of immediate "n" with target register selected in r1
pc add) 0 imm) f) ,)
@@ -558,7 +558,7 @@ pc
r0 pop,
cmp) rTOP rn) 0 imm) ,)
( pc ) abs>rel b) nz) ,)
- xdrop, popret, exit,
+ xdrop, popret, ret,
xcode rs+, ( n -- )
r0 binstart RCNT movi2,
@@ -598,7 +598,7 @@ pc to lblimmwr ( operand -- operand ) \ preserves r0
orr) rTOP rdn) $10000 imm) ,) \ Rn=r1
bic) rTOP rdn) $3f imm) ,) \ clear offset+imm flags
r0 pop,
- exit,
+ ret,
\ Move Rn to Rm in operand
pc to lblrn>rm \ rTOP=operand
@@ -608,14 +608,14 @@ pc to lblrn>rm \ rTOP=operand
and) r0 rdn) $f imm) ,)
orr) rTOP rdn) r0 rm) ,)
bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
- exit,
+ ret,
\ Copy Rd to Rn in operand.
pc to lblrdn \ rTOP=operand
bic) rTOP rdn) $f0000 imm) ,) \ clear Rn
and) r0 rd) rTOP rn) $f000 imm) ,)
orr) rTOP rdn) r0 rm) 4 lsl) ,)
- exit,
+ ret,
\ Swap Rd and Rn in operand
pc to lblrd<>rn \ rTOP=operand
@@ -624,7 +624,7 @@ pc to lblrd<>rn \ rTOP=operand
bic) rTOP rdn) $ff000 imm) ,)
orr) rTOP rdn) r0 rm) 4 lsl) ,)
orr) rTOP rdn) r1 rm) 4 lsr) ,)
- exit,
+ ret,
\ Write a mov) from operand's src to operand *dereferenced* dst. Offsets are
\ ignored.
@@ -806,7 +806,7 @@ pc popret,
xcode popret,
( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
-pc exit,
+pc ret,
xcode exit,
( pc ) r0 pc@>reg, lbldwrite abs>rel b) ,)
@@ -820,7 +820,7 @@ pc to L1 ( w -- ) \ r2=base instr
xdrop,
lbldwrite abs>rel b) ,)
-xcode execute, ( w -- )
+xcode branchR, ( w -- )
mov) r2 rd) $eb000000 imm) ,)
L1 abs>rel b) ,)
@@ -830,7 +830,7 @@ pc to L2 ( a -- a ) \ r2=base instr
pushret, L1 abs>rel bl) ,) popret,
xdup, rTOP binstart HERE movi2, ldr) rTOP rdn) ,)
sub) rTOP rdn) 4 imm) ,)
- exit,
+ ret,
xcode branchC, ( a cond -- a )
mov) r2 rd) $0a000000 imm) ,)
@@ -852,7 +852,7 @@ xcode branch! ( tgt a -- )
and) r1 rdn) $ff000000 imm) ,)
orr) r0 rdn) r1 rm) ,)
str) r0 rd) rTOP rn) ,)
- xdrop, exit,
+ xdrop, ret,
\ a simple SWP pc, [sp] would be nice, right? but we can't...
\ In this sequence below, remember that PC is 8 bytes ahead.
@@ -891,38 +891,38 @@ xcode litn
\ Arithmetics
xcode and ( n n -- n )
r0 ppop, and) rTOP rdn) r0 rm) ,)
- exit,
+ ret,
xcode or ( n n -- n )
r0 ppop, orr) rTOP rdn) r0 rm) ,)
- exit,
+ ret,
xcode xor ( n n -- n )
r0 ppop, eor) rTOP rdn) r0 rm) ,)
- exit,
+ ret,
xcode << ( n -- n )
mov) rTOP rd) rTOP rm) 1 lsl) ,)
- exit,
+ ret,
xcode >> ( n -- n )
mov) rTOP rd) rTOP rm) 1 lsr) ,)
- exit,
+ ret,
xcode lshift ( n u -- n )
r0 ppop,
mov) rTOP rd) r0 rm) rTOP rlsl) ,)
- exit,
+ ret,
xcode rshift ( n u -- n )
r0 ppop,
mov) rTOP rd) r0 rm) rTOP rlsr) ,)
- exit,
+ ret,
xcode * ( a b -- n )
r0 ppop,
mul) rTOP rd) rTOP rs) r0 rm) ,)
- exit,
+ ret,
pc ," divide by zero" alignhere
xcode /mod ( a b -- r q )
@@ -948,14 +948,14 @@ pc
( pc ) abs>rel b) hs) ,)
str) r0 rd) rPSP rn) ,) \ remainder
mov) rTOP rd) r1 rm) ,) \ quotient
- exit,
+ ret,
xcode move ( src dst u -- )
r2 ppop, r0 ppop, \ r0=src r2=dst
mov) r1 rd) rTOP rm) ,) xdrop, \ r1=u
cmp) r2 rn) 0 imm) ,)
lblmoverange abs>rel b) nz) ,)
- exit,
+ ret,
xcode []= ( src dst u -- f )
r2 ppop, r0 ppop, \ r0=src r2=dst
@@ -972,7 +972,7 @@ pc
sub) r1 rdn) 1 imm) f) ,)
( pc ) abs>rel b) ne) ,)
mov) rTOP rd) 1 imm) ,)
- exit,
+ ret,
xcode cidx ( c a u -- ?idx f )
r0 ppop, \ r0=a rTOP=u
@@ -989,7 +989,7 @@ pc
( pc ) abs>rel b) nz) ,)
xnip,
mov) rTOP rd) 0 imm) ,)
- exit,
+ ret,
\ Interpret loop
xcode ; ximm pushret,
@@ -1012,7 +1012,7 @@ pc to L1 pushret, ( str -- w ) \ find in sys dict
wcall, find
teq) rTOP rn) 0 imm) ,)
xwordlbl (wnf) abs>rel b) eq) ,)
- popret, exit,
+ popret, ret,
pc to L2 ( w -- ) \ findmod+execute
pushret,
@@ -1026,13 +1026,13 @@ xcode compword ( str -- )
cmp) rTOP rn) 0 imm) ,)
xdrop,
xwordlbl litn abs>rel b) ne) ,) \ literal: jump to litn
- pushret, L1 execute, popret,
+ pushret, L1 absbl, popret,
ldr) r0 rd) rTOP rn) 8b) 9 -i) ,)
tst) r0 rn) $80 imm) ,)
L2 abs>rel b) ne) ,) \ immediate? execute
\ compile word
pushret, wcall, findmod popret,
- wjmp, execute,
+ wjmp, branchR,
xcode ]
pushret,
@@ -1046,7 +1046,7 @@ pc
cmp) rTOP rn) 0 imm) ,)
xdrop,
( pc ) abs>rel b) nz) ,)
- popret, exit,
+ popret, ret,
xcode runword ( str -- )
r0 binstart COMPILING movi2,
@@ -1057,7 +1057,7 @@ xcode runword ( str -- )
cmp) rTOP rn) 0 imm) ,)
xdrop,
return) ne) ,) \ literal: nothing to do
- pushret, L1 execute, popret,
+ pushret, L1 absbl, popret,
L2 abs>rel b) ,)
xcode main pc w>e org SYSDICT + le!
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -79,8 +79,8 @@ code bool W=0>Z, NZ) C>W, exit,
code ?dup W=0>Z, 0 Z) branchC, dup, then exit,
: ' word sysdict @ find dup not if (wnf) then ;
: ['] ' litn ; immediate
-: compile ' litn ['] execute, execute, ; immediate
-: [compile] ' execute, ; immediate
+: compile ' litn ['] branchR, branchR, ; immediate
+: [compile] ' branchR, ; immediate
: allot HERE +! ;
: else [compile] ahead HERE @ rot branch! ; immediate
: begin HERE @ ; immediate
@@ -306,7 +306,7 @@ alias noop [then]
does> ( 'struct )
_structfind
dup w>e e>wlen c@ $80 and not compiling and \ compile only if not immediate
- if execute, else execute then ;
+ if branchR, else execute then ;
: ]struct
\ break the chain at the root of the struct
0 _curroot !
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -316,7 +316,7 @@ pc 3 nc, $5f $ff $d7 \ di pop, di call,
xcode yield ximm
( pc ) 3 movewrite, ret,
-xcode execute,
+xcode branchR,
di ax mov, xdrop,
lblcallwr absjmp,
@@ -718,7 +718,7 @@ xcode compword ( str -- )
L1 abs>rel jnz, \ immediate? execute
\ compile word
wcall, findmod
- wjmp, execute,
+ wjmp, branchR,
xcode [ ximm
lblcompiling m) 0 i) mov,
diff --git a/posix/vm.c b/posix/vm.c
@@ -1015,7 +1015,7 @@ static void buildsysdict() {
entry("C>W,"); compileop(0x5e); cwritewr(); retwr();
entry("A=0>Z,"); compileop(0x5f); retwr();
entry("exit,"); compileop(0x02); retwr();
- entry("execute,"); compileop(0x01); writewr(); retwr();
+ entry("branchR,"); compileop(0x01); writewr(); retwr();
entry("branchA,"); compileop(0x04); retwr();
entry("branch,"); litwr(0x00); cwritewr(); cwrite(0x03); retwr();
entry("branchC,"); litwr(0x05); cwritewr(); cwritewr(); cwrite(0x03); retwr();