Commit def5edb3 authored by jwilke's avatar jwilke

If abranch option is on we compiler abranch, a?branch, a(do), ...

(instead of branch, ...) and use absolute addresses for branch
targets.
parent eb93add9
......@@ -1174,6 +1174,7 @@ false DefaultValue header
false DefaultValue backtrace
false DefaultValue new-input
false DefaultValue peephole
false DefaultValue abranch
[THEN]
true DefaultValue interpreter
......@@ -2927,12 +2928,6 @@ compile: does-resolved ;compile
: branchoffset ( src dest -- ) - tchar / ; \ ?? jaw
: >resolve ( sys -- )
X here ( dup ." >" hex. ) over branchoffset swap X ! ;
: <resolve ( sys -- )
X here ( dup ." <" hex. ) branchoffset X , ;
:noname compile branch X here branchoffset X , ;
IS branch, ( target-addr -- )
:noname compile ?branch X here branchoffset X , ;
......@@ -2959,7 +2954,10 @@ compile: does-resolved ;compile
Variable tleavings 0 tleavings !
: (done) ( addr -- )
: (done) ( do-addr -- )
\G resolve branches of leave and ?leave and ?do
\G do-addr is the address of the beginning of our
\G loop so we can take care of nested loops
tleavings @
BEGIN dup
WHILE
......@@ -3009,7 +3007,10 @@ Cond: ?LEAVE ?leave, ;Cond
0 DO dup @ swap 1 cells - LOOP
free throw ;
: loop] branchto, dup <resolve tcell - (done) ;
: loop] ( target-addr -- )
branchto,
dup X here branchoffset X ,
tcell - (done) ;
: skiploop] ?dup IF branchto, branchtoresolve, THEN ;
......@@ -3113,6 +3114,55 @@ Cond: LOOP 1 ncontrols? loop, ;Cond
Cond: +LOOP 1 ncontrols? +loop, ;Cond
Cond: NEXT 1 ncontrols? next, ;Cond
\ Absoulte branches 26sep02jaw
\ This section defined different semantics for
\ conditionals, using and compiling absolute branches
X has? abranch [IF]
Ghost abranch drop
Ghost a?branch drop
Ghost a(?do) drop
Ghost a(do) drop
Ghost a(next) drop
Ghost a(+loop) drop
Ghost a(loop) drop
:noname compile abranch X a, ; plugin-of branch,
:noname compile a?branch X a, ; plugin-of ?branch,
:noname compile abranch T here 0 a, H ; plugin-of branchmark,
:noname compile a?branch T here 0 a, H ; plugin-of ?branchmark,
:noname
dup X @ ABORT" CROSS: branch already resolved"
X here swap X a! ; plugin-of branchtoresolve,
:noname
0 compile a(?do) ?domark, (leave)
branchtomark, 2 to1 ; plugin-of ?do,
: aloop] ( target-addr -- )
branchto,
dup X a,
tcell - (done) ;
:noname
1to compile a(loop) aloop]
compile unloop skiploop] ; plugin-of loop,
:noname
1to compile a(+loop) aloop]
compile unloop skiploop] ; plugin-of +loop,
:noname
compile a(next) aloop] compile unloop ; plugin-of next,
[THEN]
\ String words 23feb93py
: ," [char] " parse ht-string, X align ;
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment