[OpenBIOS] r641 - in trunk/openbios-devel/forth: bootstrap device
svn at openbios.org
svn at openbios.org
Wed Dec 9 02:09:49 CET 2009
Author: mcayland
Date: 2009-12-09 02:09:48 +0100 (Wed, 09 Dec 2009)
New Revision: 641
Modified:
trunk/openbios-devel/forth/bootstrap/bootstrap.fs
trunk/openbios-devel/forth/device/fcode.fs
Log:
Revert r638, apply previous patch to extend control flow stack items to 2 data stack items, and fix the Fcode evaluator to use
this new information to correctly resolve destination (b<mark) references. See the email archives for further discussion on why
this is required.
Hopefully this should finally resolve the Fcode backward branch problem; at least all previous incorrect resolutions now appear
correct and the Fcode evaluator no longer crashes or gets stuck in a loop while attempting to boot Milax.
Modified: trunk/openbios-devel/forth/bootstrap/bootstrap.fs
===================================================================
--- trunk/openbios-devel/forth/bootstrap/bootstrap.fs 2009-12-05 10:13:17 UTC (rev 640)
+++ trunk/openbios-devel/forth/bootstrap/bootstrap.fs 2009-12-09 01:09:48 UTC (rev 641)
@@ -159,15 +159,20 @@
\ 7.3.8.1 Conditional branches
\
-: resolve-orig here over /n + - swap ! ;
-: (if) ['] do?branch , here 0 , ; compile-only
+\ A control stack entry is implemented using 2 data stack items
+\ of the form ( addr type ). type can be one of the
+\ following:
+\ 0 - orig
+\ 1 - dest
+\ 2 - do-sys
+
+: resolve-orig here nip over /n + - swap ! ;
+: (if) ['] do?branch , here 0 0 , ; compile-only
: (then) resolve-orig ; compile-only
variable tmp-comp-depth -1 tmp-comp-depth !
variable tmp-comp-buf 0 tmp-comp-buf !
-variable cstack-startdepth -1 cstack-startdepth ! \ start depth of the cstack
-
: setup-tmp-comp ( -- )
state @ 0 = (if)
here tmp-comp-buf @ here! , \ save here and switch to tmp directory
@@ -175,20 +180,9 @@
depth tmp-comp-depth ! \ save control depth
]
(then)
-
- \ If start of new execution context, record the location of the bottom
- \ of the new cstack (required for backwards Fcode branches)
- cstack-startdepth @ -1 = (if)
- depth cstack-startdepth !
- (then)
;
: execute-tmp-comp ( -- )
- \ If at the end of this execution context, reset cstack location
- depth cstack-startdepth @ = (if)
- -1 cstack-startdepth !
- (then)
-
depth tmp-comp-depth @ =
(if)
-1 tmp-comp-depth !
@@ -200,9 +194,9 @@
(then)
;
-: if setup-tmp-comp ['] do?branch , here 0 , ; immediate
+: if setup-tmp-comp ['] do?branch , here 0 0 , ; immediate
: then resolve-orig execute-tmp-comp ; compile-only
-: else ['] dobranch , here 0 , swap resolve-orig ; compile-only
+: else ['] dobranch , here 0 0 , 2swap resolve-orig ; compile-only
\
\ 7.3.8.3 Conditional loops
@@ -215,42 +209,66 @@
: (while) ;
: (repeat) ;
-: resolve-dest here /n + - , ;
+\ resolve-dest requires a loop...
+: (resolve-dest) here /n + nip - , ;
+: (resolve-begin) setup-tmp-comp ['] (begin) , here 1 ; immediate
+: (resolve-until) ['] (until) , ['] do?branch , (resolve-dest) execute-tmp-comp ; compile-only
-: begin
+: resolve-dest ( dest origN ... orig )
+ 2 >r
+ (resolve-begin)
+ \ Find topmost control stack entry with a type of 1 (dest)
+ r> dup dup pick 1 = if
+ \ Move it to the top
+ roll
+ swap 1 - roll
+ \ Resolve it
+ (resolve-dest)
+ 1 \ force exit
+ else
+ drop
+ 2 + >r
+ 0
+ then
+ (resolve-until)
+;
+
+: begin
setup-tmp-comp
['] (begin) ,
- here
+ here
+ 1
; immediate
-
-: again
+
+: again
['] (again) ,
['] dobranch ,
resolve-dest
execute-tmp-comp
; compile-only
-
-: until
+
+: until
['] (until) ,
['] do?branch ,
- resolve-dest
+ resolve-dest
execute-tmp-comp
; compile-only
-
+
: while
setup-tmp-comp
['] (while) ,
['] do?branch ,
- here 0 , swap
+ here 0 0 , 2swap
; immediate
-
-: repeat
+
+: repeat
['] (repeat) ,
['] dobranch ,
resolve-dest resolve-orig
execute-tmp-comp
; compile-only
+
\
\ 7.3.8.4 Counted loops
\
@@ -267,13 +285,14 @@
here over - \ -- *leaves leaves here-leaves
swap ! \ -- *leaves
repeat
- here - ,
+ here nip - ,
leaves !
;
-: do
+: do
setup-tmp-comp
- leaves @ here
+ leaves @
+ here 2
['] (do) ,
0 leaves !
; immediate
@@ -282,7 +301,7 @@
setup-tmp-comp
leaves @
['] (?do) ,
- here
+ here 2
here leaves !
0 ,
; immediate
@@ -299,6 +318,7 @@
execute-tmp-comp
; immediate
+
\ Using primitive versions of i and j
\ speeds up loops by 300%
\ : i r> r@ swap >r ;
@@ -325,15 +345,15 @@
0
; immediate
-: endcase
+: endcase
['] drop ,
- 0 ?do
+ 0 ?do
['] then execute
loop
execute-tmp-comp
; immediate
-: of
+: of
1 + >r
['] over ,
['] = ,
@@ -342,13 +362,12 @@
r>
; immediate
-: endof
+: endof
>r
['] else execute
r>
; immediate
-
\
\ 7.3.8.5 Other control flow commands
\
Modified: trunk/openbios-devel/forth/device/fcode.fs
===================================================================
--- trunk/openbios-devel/forth/device/fcode.fs 2009-12-05 10:13:17 UTC (rev 640)
+++ trunk/openbios-devel/forth/device/fcode.fs 2009-12-09 01:09:48 UTC (rev 641)
@@ -451,15 +451,13 @@
: bbranch
fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
['] dobranch ,
- \ Backwards branches are resolved from the bottom of the cstack
- depth cstack-startdepth @ 1+ - roll
resolve-dest
execute-tmp-comp
else
setup-tmp-comp ['] dobranch ,
- here
+ here 0
0 ,
- swap
+ 2swap
then
; immediate
@@ -470,13 +468,11 @@
: b?branch
fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
['] do?branch ,
- \ Backwards branches are resolved from the bottom of the cstack
- depth cstack-startdepth @ 1+ - roll
resolve-dest
execute-tmp-comp
else
setup-tmp-comp ['] do?branch ,
- here
+ here 0
0 ,
then
; immediate
@@ -487,7 +483,7 @@
: b(<mark)
setup-tmp-comp
- here
+ here 1
; immediate
More information about the OpenBIOS
mailing list