version 1.39, 1995/08/29 21:07:35
|
version 1.40, 1995/09/06 21:00:21
|
Line 346 hex
|
Line 346 hex
|
|
|
\ ?stack 23feb93py |
\ ?stack 23feb93py |
|
|
: ?stack ( ?? -- ?? ) sp@ s0 @ > IF -4 throw THEN ; |
: ?stack ( ?? -- ?? ) |
|
sp@ s0 @ > IF -4 throw THEN |
|
fp@ f0 @ > IF -&45 throw THEN ; |
\ ?stack should be code -- it touches an empty stack! |
\ ?stack should be code -- it touches an empty stack! |
|
|
\ interpret 10mar92py |
\ interpret 10mar92py |
Line 990 AVariable current
|
Line 992 AVariable current
|
|
|
: last? ( -- false / nfa nfa ) last @ ?dup ; |
: last? ( -- false / nfa nfa ) last @ ?dup ; |
: (reveal) ( -- ) |
: (reveal) ( -- ) |
last? |
last? |
IF |
IF |
dup @ 0< |
dup @ 0< |
IF |
IF |
current @ @ over ! current @ ! |
current @ @ over ! current @ ! |
ELSE |
ELSE |
drop |
drop |
THEN |
THEN |
THEN ; |
THEN ; |
|
|
\ object oriented search list 17mar93py |
\ object oriented search list 17mar93py |
|
|
Line 1096 Variable warnings G -1 warnings T !
|
Line 1098 Variable warnings G -1 warnings T !
|
: (ret) type-rest drop true space ; |
: (ret) type-rest drop true space ; |
: back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; |
: back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; |
: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; |
: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; |
|
: eof 2 pick 0= IF bye ELSE (ret) THEN ; |
|
|
Create ctrlkeys |
Create ctrlkeys |
] false false back false false false forw false |
] false false back false eof false forw false |
?del false (ret) false false (ret) false false |
?del false (ret) false false (ret) false false |
false false false false false false false false |
false false false false false false false false |
false false false false false false false false [ |
false false false false false false false false [ |
Line 1334 create included-files 0 , 0 , ( pointer
|
Line 1337 create included-files 0 , 0 , ( pointer
|
: recurse ( -- ) |
: recurse ( -- ) |
lastxt compile, ; immediate restrict |
lastxt compile, ; immediate restrict |
: recursive ( -- ) |
: recursive ( -- ) |
reveal ; immediate |
reveal last off ; immediate |
|
|
\ */MOD */ 17may93jaw |
\ */MOD */ 17may93jaw |
|
|
Line 1503 Variable argc
|
Line 1506 Variable argc
|
|
|
: process-args ( -- ) |
: process-args ( -- ) |
>tib @ >r |
>tib @ >r |
true to script? |
|
argc @ 1 |
argc @ 1 |
?DO |
?DO |
I arg over c@ [char] - <> |
I arg over c@ [char] - <> |
IF |
IF |
required 1 |
required 1 |
ELSE |
ELSE |
I 1+ arg do-option |
I 1+ argc @ = IF s" " ELSE I 1+ arg THEN |
|
do-option |
THEN |
THEN |
+LOOP |
+LOOP |
false to script? |
|
r> >tib ! ; |
r> >tib ! ; |
|
|
Defer 'cold ' noop IS 'cold |
Defer 'cold ' noop IS 'cold |
Line 1524 Defer 'cold ' noop IS 'cold
|
Line 1526 Defer 'cold ' noop IS 'cold
|
'cold |
'cold |
argc @ 1 > |
argc @ 1 > |
IF |
IF |
|
true to script? |
['] process-args catch ?dup |
['] process-args catch ?dup |
IF |
IF |
dup >r DoError cr r> negate (bye) |
dup >r DoError cr r> negate (bye) |
THEN |
THEN |
|
cr |
THEN |
THEN |
cr |
false to script? |
." GNU Forth " version-string type ." , Copyright (C) 1994 Free Software Foundation, Inc." cr |
." GNU Forth " version-string type ." , Copyright (C) 1994 Free Software Foundation, Inc." cr |
." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr |
." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr |
." Type `bye' to exit" |
." Type `bye' to exit" |