Commit ca81eeb5 authored by pazsan's avatar pazsan

Recognizer included

parent b76ea60e
......@@ -181,6 +181,7 @@ KERN_SRC = \
kernel/basics.fs \
kernel/int.fs \
kernel/comp.fs \
kernel/recognizer.fs \
kernel/io.fs \
kernel/input.fs \
kernel/license.fs \
......
......@@ -765,6 +765,7 @@ Plugin ?do, ( -- ?do-token )
Plugin for, ( -- for-token )
Plugin loop, ( do-token / ?do-token -- )
Plugin +loop, ( do-token / ?do-token -- )
Plugin -loop, ( do-token / ?do-token -- )
Plugin next, ( for-token )
Plugin leave, ( -- )
Plugin ?leave, ( -- )
......@@ -1726,7 +1727,7 @@ T has? relocate H
Ghost (do) Ghost (?do) 2drop
Ghost (for) drop
Ghost (loop) Ghost (+loop) 2drop
Ghost (loop) Ghost (+loop) Ghost (-loop) 2drop drop
Ghost (next) drop
Ghost !does drop
Ghost compile, drop
......@@ -3233,6 +3234,10 @@ Cond: ENDCASE endcase, ;Cond
1to compile (+loop) loop]
compile unloop skiploop] ; ' (+loop,) plugin-of +loop,
: (-loop,) ( target-addr -- )
1to compile (-loop) loop]
compile unloop skiploop] ; ' (-loop,) plugin-of -loop,
: (next,)
compile (next) loop] compile unloop ; ' (next,) plugin-of next,
......@@ -3242,6 +3247,7 @@ Cond: FOR for, ;Cond
Cond: LOOP 1 ncontrols? loop, ;Cond
Cond: +LOOP 1 ncontrols? +loop, ;Cond
Cond: -LOOP 1 ncontrols? -loop, ;Cond
Cond: NEXT 1 ncontrols? next, ;Cond
\ String words 23feb93py
......
......@@ -141,6 +141,22 @@ DOES> ( -- r )
2drop false
THEN ;
[ifdef] recognizer:
' noop
:noname postpone Fliteral ;
dup
recognizer: r:fnumber
:noname ( addr u -- nt int-table true | addr u false )
2dup sfnumber dup
IF
drop 2drop r:fnumber true
THEN ; Constant fnum-recognizer
fnum-recognizer
forth-recognizer get-recognizers
1+ forth-recognizer set-recognizers
[else]
[ifundef] compiler-notfound1
defer compiler-notfound1
' no.extensions IS compiler-notfound1
......@@ -170,6 +186,7 @@ IS compiler-notfound1
defers interpreter-notfound1
ENDIF ;
IS interpreter-notfound1
[then]
: fvariable ( "name" -- ) \ float f-variable
Create 0.0E0 f, ;
......
......@@ -364,9 +364,13 @@ has? primcentric [IF]
swap POSTPONE aliteral compile,
then ;
has? recognizer [IF]
include ./recognizer.fs
[ELSE]
: POSTPONE ( "name" -- ) \ core
\g Compiles the compilation semantics of @i{name}.
COMP' postpone, ; immediate
[THEN]
\ \ recurse 17may93jaw
......@@ -376,6 +380,7 @@ has? primcentric [IF]
\ \ compiler loop
has? recognizer 0= [IF]
: compiler1 ( c-addr u -- ... xt )
2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
if ( c-addr u nt )
......@@ -403,6 +408,7 @@ has? primcentric [IF]
: ] ( -- ) \ core right-bracket
\G Enter compilation state.
['] compiler1 IS parser1 state on ;
[THEN]
\ \ Strings 22feb93py
......
......@@ -693,6 +693,7 @@ has? backtrace [IF]
then ;
[THEN]
has? recognizer 0= [IF]
\ not the most efficient implementations of interpreter and compiler
: interpreter1 ( c-addr u -- ... xt )
2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
......@@ -709,6 +710,7 @@ has? backtrace [IF]
then ;
' interpreter1 IS parser1
[THEN]
\ \ Query Evaluate 07apr93py
......
......@@ -22,7 +22,7 @@
has? interpreter [IF]
include ./int.fs
has? compiler [IF]
include ./comp.fs
include ./comp.fs
[THEN]
[THEN]
has? new-input [IF]
......
......@@ -15,18 +15,16 @@
\ interpret it, compile interpretation semantics
\ compile it, compile it as literal.
: recognizer: ( xt1 xt2 xt3 xt4 -- ) Create 2swap swap 2, swap 2, ;
: recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
(field) r>int ( r-addr -- addr ) 0 cells ,
(field) r>compint ( r-addr -- ) 1 cells ,
(field) r>comp ( r-addr -- ) 2 cells ,
(field) r>lit ( r-addr -- ) 3 cells ,
(field) r>int ( r-addr -- addr ) 0 cells ,
(field) r>comp ( r-addr -- ) 1 cells ,
(field) r>lit ( r-addr -- ) 2 cells ,
:noname ( ... nt -- ) name>int execute ;
:noname ( ... nt -- ) name>int compile, ;
:noname ( ... nt -- ) name>comp execute ;
:noname ( ... nt -- ) postpone Literal ;
recognizer: r:interpreter
Create r:interpreter rot A, swap A, A,
:noname ( addr u -- nt int-table true | addr u false )
2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
......@@ -37,14 +35,14 @@ recognizer: r:interpreter
' noop
:noname postpone Literal ;
dup
dup
recognizer: r:number
Create r:number rot A, swap A, A,
' noop
:noname postpone 2Literal ;
dup
dup
recognizer: r:2number
Create r:2number rot A, swap A, A,
\ snumber? should be implemented as recognizer stack
:noname ( addr u -- nt int-table true | addr u false )
2dup 2>r snumber? dup
......@@ -53,12 +51,11 @@ recognizer: r:2number
THEN
drop 2r> false ; Constant num-recognizer
' no.extensions dup 2dup recognizer: r:fail
' no.extensions dup dup Create r:fail A, A, A,
\ recognizer stack
$10 Constant max-rec#
Variable forth-recognizer max-rec# cells allot
: get-recognizers ( rec-addr -- xt1 .. xtn n )
dup cell+ swap @ dup >r cells bounds ?DO
......@@ -71,7 +68,11 @@ Variable forth-recognizer max-rec# cells allot
I !
cell -LOOP ;
num-recognizer int-recognizer 2 forth-recognizer set-recognizers
Variable forth-recognizer
int-recognizer A, num-recognizer A, max-rec# 2 - cells allot
2 forth-recognizer !
\ num-recognizer int-recognizer 2 forth-recognizer set-recognizers
\ recognizer loop
......@@ -92,6 +93,8 @@ num-recognizer int-recognizer 2 forth-recognizer set-recognizers
: interpreter-r ( addr u -- ... xt )
forth-recognizer do-recognizer r>int @ ;
' interpreter-r IS parser1
: compiler-r ( addr u -- ... xt )
forth-recognizer do-recognizer r>comp @ ;
......@@ -103,8 +106,11 @@ num-recognizer int-recognizer 2 forth-recognizer set-recognizers
\G Enter compilation state.
['] compiler-r IS parser1 state on ;
: >postpone ( token table -- )
dup r:fail = IF no.extensions THEN
>r r@ r>lit perform r> r>comp @ compile, ;
: postpone ( "name" -- ) \ core
\g Compiles the compilation semantics of @i{name}.
parse-name forth-recognizer do-recognizer >r
r@ r>lit perform r> r>comp @ compile, ; immediate
parse-name forth-recognizer do-recognizer >postpone ; immediate
......@@ -58,6 +58,8 @@ false DefaultValue control-rack \ disable return stack use for control flow
false DefaultValue crlf
true DefaultValue recognizer
$100 DefaultValue kernel-start
cell 2 = [IF] &32 KB [ELSE] $100000 cells [THEN] DefaultValue kernel-size
......@@ -109,6 +111,8 @@ true DefaultValue control-rack \ disable return stack use for control flow
false DefaultValue crlf
false DefaultValue recognizer
false DefaultValue flash
$10 DefaultValue kernel-start \ no artificial offset
......
......@@ -181,6 +181,18 @@ AUser CSP
: ]] ( -- ) \ gforth right-bracket-bracket
\G switch into postpone state
['] postponer1 is parser1 state on ; immediate restrict
[then]
[ifdef] compiler-r
: postponer-r ( addr u -- ... xt )
forth-recognizer do-recognizer
over [ s" [[" find-name ] Literal =
IF 2drop [comp'] ] drop ELSE ['] >postpone THEN ;
: ]] ( -- ) \ gforth right-bracket-bracket
\G switch into postpone state
['] postponer-r is parser1 state on ; immediate restrict
[then]
comp' literal drop alias postpone-literal
comp' 2literal drop alias postpone-2literal
......@@ -204,8 +216,6 @@ comp' sliteral drop alias postpone-sliteral
\G allocated permanently, you can use @code{]]2L} instead.
]] postpone-sliteral ]] [[ ; immediate
[then]
\ f.rdp
: push-right ( c-addr u1 u2 cfill -- )
......
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