Commit de4d1689 authored by Bernd Paysan's avatar Bernd Paysan

Rewriting of recognizer stack tool

parent af5ef0a4
......@@ -766,6 +766,8 @@ Plugin endcase, ( x1 .. xn n -- )
Plugin do, ( -- do-token )
Plugin ?do, ( -- ?do-token )
Plugin +do, ( -- ?do-token )
Plugin -do, ( -- ?do-token )
Plugin for, ( -- for-token )
Plugin loop, ( do-token / ?do-token -- )
Plugin +loop, ( do-token / ?do-token -- )
......@@ -1749,6 +1751,7 @@ T has? relocate H
>CROSS
Ghost (do) Ghost (?do) 2drop
Ghost (+do) Ghost (-do) 2drop
Ghost (for) drop
Ghost (loop) Ghost (+loop) Ghost (-loop) 2drop drop
Ghost (next) drop
......@@ -3613,6 +3616,14 @@ Cond: ENDCASE endcase, ;Cond
0 compile (?do) ?domark, (leave)
branchtomark, 2 to1 ; ' (?do,) plugin-of ?do,
: (+do,) ( -- target-addr )
0 compile (+do) ?domark, (leave)
branchtomark, 2 to1 ; ' (+do,) plugin-of +do,
: (-do,) ( -- target-addr )
0 compile (-do) ?domark, (leave)
branchtomark, 2 to1 ; ' (-do,) plugin-of -do,
: (for,) ( -- target-addr )
compile (for) branchtomark, ; ' (for,) plugin-of for,
......@@ -3633,6 +3644,8 @@ Cond: ENDCASE endcase, ;Cond
Cond: DO do, ;Cond
Cond: ?DO ?do, ;Cond
Cond: +DO +do, ;Cond
Cond: -DO -do, ;Cond
Cond: FOR for, ;Cond
Cond: LOOP 1 ncontrols? loop, ;Cond
......
......@@ -905,7 +905,7 @@ Defer 'cold ( -- ) \ gforth tick-cold
\G Hook (deferred word) for things to do right before interpreting the
\G OS command-line arguments. Normally does some initializations that
\G you also want to perform.
' noop IS 'cold
:noname default-recognizer $boot ; IS 'cold
[THEN]
: cold ( -- ) \ gforth
......
......@@ -71,40 +71,40 @@ AConstant r:dnum
THEN
drop r:fail ;
\ generic stack get/set
\ generic deque get/set
$10 Constant max-stack#
: deque@ ( deque -- x1 .. xn n )
\G fetch everything from the generic deque to the data stack
$@ dup cell/ >r bounds cell- swap cell- -DO I @ cell -LOOP r> ;
: deque! ( x1 .. xn n deque -- )
\G set the generic deque with values from the data stack
>r cells r@ $!len
r> $@ bounds DO I ! cell +LOOP ;
: get-stack ( rec-addr -- xt1 .. xtn n )
dup @ dup >r cells bounds swap ?DO
I @
cell -LOOP r> ;
: deque: ( n "name" -- )
\G create a named deque with n cells space
drop Variable ;
: set-stack ( xt1 .. xtn n rec-addr -- )
over max-stack# u>= abort" Too many items"
2dup ! cell+ swap cells bounds ?DO
I !
cell +LOOP ;
Variable forth-recognizer
AVariable default-recognizer
\G The system recognizer
' rec:word A, ' rec:num A, max-stack# 2 - cells allot
2 forth-recognizer !
\ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers
here default-recognizer !
2 cells , ' rec:word A, ' rec:num A,
default-recognizer AValue forth-recognizer
: get-recognizers ( -- xt1 .. xtn n )
\G push the content on the recognizer stack
forth-recognizer get-stack ;
forth-recognizer deque@ ;
: set-recognizers ( xt1 .. xtn n )
\G set the recognizer stack from content on the stack
forth-recognizer set-stack ;
forth-recognizer deque! ;
\ recognizer loop
: map-recognizer ( addr u rec-addr -- tokens table )
\G apply a recognizer stack to a string, delivering a token
dup cell+ swap @ cells bounds ?DO
$@ bounds ?DO
2dup I -rot 2>r
perform dup r:fail <> IF 2rdrop UNLOOP EXIT THEN drop
2r>
......
......@@ -71,6 +71,13 @@
\G initializes a string to empty (doesn't look at what was there before).
>r r@ off s" " r> $! ;
: $boot ( addr -- )
\G take string from dictionary to allocated memory
dup >r $@ r@ off r> $! ;
: $save ( addr -- )
\G push string to dictionary for savesys
dup >r $@ here r> ! dup , here swap dup aligned allot move ;
\ dynamic string handling 12dec99py
: $split ( addr u char -- addr1 u1 addr2 u2 ) \ gforth-string string-split
......
......@@ -47,6 +47,7 @@
w/o bin create-file throw >r
update-image-included-files
update-image-order
default-recognizer $save
update-maintask
here forthstart - forthstart 2 cells + !
forthstart
......
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