version 1.14, 1994/08/19 17:47:23
|
version 1.15, 1994/08/25 15:25:28
|
Line 142 Defer source
|
Line 142 Defer source
|
dup count chars bounds |
dup count chars bounds |
?DO I c@ toupper I c! 1 chars +LOOP ; |
?DO I c@ toupper I c! 1 chars +LOOP ; |
: (name) ( -- addr ) bl word ; |
: (name) ( -- addr ) bl word ; |
\ : (cname) ( -- addr ) bl word capitalize ; |
: sname ( -- c-addr count ) |
|
source 2dup >r >r >in @ /string (parse-white) |
|
2dup + r> - 1+ r> min >in ! ; |
|
\ name count ; |
|
|
\ Literal 17dec92py |
\ Literal 17dec92py |
|
|
Line 203 Create bases 10 , 2 , A , 100 ,
|
Line 206 Create bases 10 , 2 , A , 100 ,
|
REPEAT THEN 2drop rdrop dpl off ELSE |
REPEAT THEN 2drop rdrop dpl off ELSE |
2drop rdrop r> IF dnegate THEN |
2drop rdrop r> IF dnegate THEN |
THEN r> base ! ; |
THEN r> base ! ; |
|
: snumber? ( c-addr u -- 0 / n -1 / d 0> ) |
|
s>number dpl @ 0= |
|
IF |
|
2drop false EXIT |
|
THEN |
|
dpl @ dup 0> 0= IF |
|
nip |
|
THEN ; |
: number? ( string -- string 0 / n -1 / d 0> ) |
: number? ( string -- string 0 / n -1 / d 0> ) |
dup count s>number dpl @ 0= IF 2drop false EXIT THEN |
dup >r count snumber? dup if |
rot drop dpl @ dup 0> 0= IF nip THEN ; |
rdrop |
|
else |
|
r> swap |
|
then ; |
: s>d ( n -- d ) dup 0< ; |
: s>d ( n -- d ) dup 0< ; |
: number ( string -- d ) |
: number ( string -- d ) |
number? ?dup 0= abort" ?" 0< IF s>d THEN ; |
number? ?dup 0= abort" ?" 0< IF s>d THEN ; |
Line 304 hex
|
Line 318 hex
|
|
|
Defer parser |
Defer parser |
Defer name ' (name) IS name |
Defer name ' (name) IS name |
Defer notfound |
Defer notfound ( c-addr count -- ) |
|
|
: no.extensions ( string -- ) IF -&13 bounce THEN ; |
: no.extensions ( addr u -- ) 2drop -&13 bounce ; |
|
|
' no.extensions IS notfound |
' no.extensions IS notfound |
|
|
: interpret |
: interpret |
BEGIN ?stack name dup c@ WHILE parser REPEAT drop ; |
BEGIN |
|
?stack sname dup |
\ interpreter compiler 30apr92py |
WHILE |
|
parser |
: interpreter ( name -- ) find ?dup |
REPEAT |
IF 1 and IF execute EXIT THEN -&14 throw THEN |
2drop ; |
number? 0= IF notfound THEN ; |
|
|
\ sinterpreter scompiler 30apr92py |
|
|
|
: sinterpreter ( c-addr u -- ) |
|
\ interpretation semantics for the name/number c-addr u |
|
2dup sfind dup |
|
IF |
|
1 and |
|
IF \ not restricted to compile state? |
|
nip nip execute EXIT |
|
THEN |
|
-&14 throw |
|
THEN |
|
drop |
|
2dup 2>r snumber? |
|
IF |
|
2rdrop |
|
ELSE |
|
2r> notfound |
|
THEN ; |
|
|
' interpreter IS parser |
' sinterpreter IS parser |
|
|
: compiler ( name -- ) find ?dup |
: scompiler ( c-addr u -- ) |
IF 0> IF execute EXIT THEN compile, EXIT THEN number? dup |
\ compilation semantics for the name/number c-addr u |
IF 0> IF swap postpone Literal THEN postpone Literal |
2dup sfind dup |
ELSE drop notfound THEN ; |
IF |
|
0> |
|
IF |
|
nip nip execute EXIT |
|
THEN |
|
compile, 2drop EXIT |
|
THEN |
|
drop |
|
2dup snumber? dup |
|
IF |
|
0> |
|
IF |
|
swap postpone Literal |
|
THEN |
|
postpone Literal |
|
2drop |
|
ELSE |
|
drop notfound |
|
THEN ; |
|
|
: [ ['] interpreter IS parser state off ; immediate |
: [ ['] sinterpreter IS parser state off ; immediate |
: ] ['] compiler IS parser state on ; |
: ] ['] scompiler IS parser state on ; |
|
|
\ locals stuff needed for control structures |
\ locals stuff needed for control structures |
|
|
Line 839 Create ??? 0 , 3 c, char ? c, char ? c,
|
Line 890 Create ??? 0 , 3 c, char ? c, char ? c,
|
|
|
\ IS Defer What's Defers TO 24feb93py |
\ IS Defer What's Defers TO 24feb93py |
|
|
: Defer |
: Defer ( -- ) |
Create ( -- ) |
\ !! shouldn't it be initialized with abort or something similar? |
['] noop A, |
Header Reveal [ :dodefer ] Literal cfa, |
DOES> ( ??? ) |
['] noop A, ; |
@ execute ; |
\ Create ( -- ) |
|
\ ['] noop A, |
|
\ DOES> ( ??? ) |
|
\ @ execute ; |
|
|
: IS ( addr "name" -- ) |
: IS ( addr "name" -- ) |
' >body |
' >body |
Line 936 Variable warnings G -1 warnings T !
|
Line 990 Variable warnings G -1 warnings T !
|
then |
then |
2drop 2drop ; |
2drop 2drop ; |
|
|
: find ( addr -- cfa +-1 / string false ) dup |
: sfind ( c-addr u -- xt n / 0 ) |
count search @ search-wordlist dup IF rot drop THEN ; |
search @ search-wordlist ; |
|
|
|
: find ( addr -- cfa +-1 / string false ) |
|
\ !! not ANS conformant: returns +-2 for restricted words |
|
dup count sfind dup if |
|
rot drop |
|
then ; |
|
|
: reveal ( -- ) |
: reveal ( -- ) |
last? if |
last? if |
Line 947 Variable warnings G -1 warnings T !
|
Line 1007 Variable warnings G -1 warnings T !
|
|
|
: rehash ( wid -- ) dup cell+ @ cell+ cell+ @ execute ; |
: rehash ( wid -- ) dup cell+ @ cell+ cell+ @ execute ; |
|
|
: ' ( "name" -- addr ) name find 0= no.extensions ; |
: ' ( "name" -- addr ) name find 0= if drop -&13 bounce then ; |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
\ Input 13feb93py |
\ Input 13feb93py |
|
|