version 1.18, 1994/09/02 15:23:36
|
version 1.24, 1994/11/15 15:55:39
|
Line 1
|
Line 1
|
\ KERNAL.FS ANS figFORTH kernal 17dec92py |
\ KERNAL.FS GNU FORTH kernal 17dec92py |
\ $ID: |
\ $ID: |
\ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
\ Copyright 1992 by the ANSI figForth Development Group |
\ Copyright 1992 by the ANSI figForth Development Group |
Line 66 DOES> ( n -- ) + c@ ;
|
Line 66 DOES> ( n -- ) + c@ ;
|
bl c, |
bl c, |
LOOP ; |
LOOP ; |
|
|
|
: chars ; immediate |
|
|
: A! ( addr1 addr2 -- ) dup relon ! ; |
: A! ( addr1 addr2 -- ) dup relon ! ; |
: A, ( addr -- ) here cell allot A! ; |
: A, ( addr -- ) here cell allot A! ; |
Line 110 Defer source
|
Line 110 Defer source
|
|
|
\ (word) 22feb93py |
\ (word) 22feb93py |
|
|
: scan ( addr1 n1 char -- addr2 n2 ) >r |
: scan ( addr1 n1 char -- addr2 n2 ) |
BEGIN dup WHILE over c@ r@ <> WHILE 1 /string |
\ skip all characters not equal to char |
REPEAT THEN rdrop ; |
>r |
: skip ( addr1 n1 char -- addr2 n2 ) >r |
BEGIN |
BEGIN dup WHILE over c@ r@ = WHILE 1 /string |
dup |
REPEAT THEN rdrop ; |
WHILE |
|
over c@ r@ <> |
|
WHILE |
|
1 /string |
|
REPEAT THEN |
|
rdrop ; |
|
: skip ( addr1 n1 char -- addr2 n2 ) |
|
\ skip all characters equal to char |
|
>r |
|
BEGIN |
|
dup |
|
WHILE |
|
over c@ r@ = |
|
WHILE |
|
1 /string |
|
REPEAT THEN |
|
rdrop ; |
|
|
: (word) ( addr1 n1 char -- addr2 n2 ) |
: (word) ( addr1 n1 char -- addr2 n2 ) |
dup >r skip 2dup r> scan nip - ; |
dup >r skip 2dup r> scan nip - ; |
Line 138 Defer source
|
Line 154 Defer source
|
|
|
\ name 13feb93py |
\ name 13feb93py |
|
|
: capitalize ( addr -- addr ) |
: capitalize ( addr len -- addr len ) |
dup count chars bounds |
2dup chars 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) ( -- c-addr count ) |
: sname ( -- c-addr count ) |
|
source 2dup >r >r >in @ /string (parse-white) |
source 2dup >r >r >in @ /string (parse-white) |
2dup + r> - 1+ r> min >in ! ; |
2dup + r> - 1+ r> min >in ! ; |
\ name count ; |
\ name count ; |
Line 158 Defer source
|
Line 173 Defer source
|
: [char] ( 'char' -- n ) char postpone Literal ; immediate |
: [char] ( 'char' -- n ) char postpone Literal ; immediate |
' [char] Alias Ascii immediate |
' [char] Alias Ascii immediate |
|
|
: (compile) ( -- ) r> dup cell+ >r @ A, ; |
: (compile) ( -- ) r> dup cell+ >r @ compile, ; |
: postpone ( "name" -- ) |
: postpone ( "name" -- ) |
name find dup 0= abort" Can't compile " |
name sfind dup 0= abort" Can't compile " |
0> IF A, ELSE postpone (compile) A, THEN ; |
0> IF compile, ELSE postpone (compile) A, THEN ; |
immediate restrict |
immediate restrict |
|
|
\ Use (compile) for the old behavior of compile! |
\ Use (compile) for the old behavior of compile! |
Line 229 decimal
|
Line 244 decimal
|
Create spaces bl 80 times \ times from target compiler! 11may93jaw |
Create spaces bl 80 times \ times from target compiler! 11may93jaw |
DOES> ( u -- ) swap |
DOES> ( u -- ) swap |
0 max 0 ?DO I' I - &80 min 2dup type +LOOP drop ; |
0 max 0 ?DO I' I - &80 min 2dup type +LOOP drop ; |
|
Create backspaces 08 80 times \ times from target compiler! 11may93jaw |
|
DOES> ( u -- ) swap |
|
0 max 0 ?DO I' I - &80 min 2dup type +LOOP drop ; |
hex |
hex |
: space 1 spaces ; |
: space 1 spaces ; |
|
|
Line 326 Defer notfound ( c-addr count -- )
|
Line 344 Defer notfound ( c-addr count -- )
|
|
|
: interpret |
: interpret |
BEGIN |
BEGIN |
?stack sname dup |
?stack name dup |
WHILE |
WHILE |
parser |
parser |
REPEAT |
REPEAT |
2drop ; |
2drop ; |
|
|
\ sinterpreter scompiler 30apr92py |
\ interpreter compiler 30apr92py |
|
|
: sinterpreter ( c-addr u -- ) |
: interpreter ( c-addr u -- ) |
\ interpretation semantics for the name/number c-addr u |
\ interpretation semantics for the name/number c-addr u |
2dup sfind dup |
2dup sfind dup |
IF |
IF |
Line 352 Defer notfound ( c-addr count -- )
|
Line 370 Defer notfound ( c-addr count -- )
|
2r> notfound |
2r> notfound |
THEN ; |
THEN ; |
|
|
' sinterpreter IS parser |
' interpreter IS parser |
|
|
: scompiler ( c-addr u -- ) |
: compiler ( c-addr u -- ) |
\ compilation semantics for the name/number c-addr u |
\ compilation semantics for the name/number c-addr u |
2dup sfind dup |
2dup sfind dup |
IF |
IF |
Line 377 Defer notfound ( c-addr count -- )
|
Line 395 Defer notfound ( c-addr count -- )
|
drop notfound |
drop notfound |
THEN ; |
THEN ; |
|
|
: [ ['] sinterpreter IS parser state off ; immediate |
: [ ['] interpreter IS parser state off ; immediate |
: ] ['] scompiler IS parser state on ; |
: ] ['] compiler IS parser state on ; |
|
|
\ locals stuff needed for control structures |
\ locals stuff needed for control structures |
|
|
: compile-lp+! ( n -- ) |
: compile-lp+! ( n -- ) |
dup negate locals-size +! |
dup negate locals-size +! |
0 over = if |
0 over = if |
else -4 over = if postpone -4lp+! |
else -1 cells over = if postpone lp- |
else 8 over = if postpone 8lp+! |
else 1 floats over = if postpone lp+ |
else 16 over = if postpone 16lp+! |
else 2 floats over = if postpone lp+2 |
else postpone lp+!# dup , |
else postpone lp+!# dup , |
then then then then drop ; |
then then then then drop ; |
|
|
Line 402 AConstant locals-list \ acts like a vari
|
Line 420 AConstant locals-list \ acts like a vari
|
|
|
|
|
variable dead-code \ true if normal code at "here" would be dead |
variable dead-code \ true if normal code at "here" would be dead |
|
variable backedge-locals |
: unreachable ( -- ) |
\ contains the locals list that BEGIN will assume to be live on |
\ declares the current point of execution as unreachable |
\ the back edge if the BEGIN is unreachable from above. Set by |
dead-code on ; |
\ ASSUME-LIVE, reset by UNREACHABLE. |
|
|
|
: UNREACHABLE ( -- ) |
|
\ declares the current point of execution as unreachable |
|
dead-code on |
|
0 backedge-locals ! ; immediate |
|
|
|
: ASSUME-LIVE ( orig -- orig ) |
|
\ used immediateliy before a BEGIN that is not reachable from |
|
\ above. causes the BEGIN to assume that the same locals are live |
|
\ as at the orig point |
|
dup orig? |
|
2 pick backedge-locals ! ; immediate |
|
|
\ locals list operations |
\ locals list operations |
|
|
: common-list ( list1 list2 -- list3 ) |
: common-list ( list1 list2 -- list3 ) |
Line 531 variable dead-code \ true if normal code
|
Line 561 variable dead-code \ true if normal code
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
: AHEAD ( -- orig ) |
: AHEAD ( -- orig ) |
POSTPONE branch >mark unreachable ; immediate restrict |
POSTPONE branch >mark POSTPONE unreachable ; immediate restrict |
|
|
: IF ( -- orig ) |
: IF ( -- orig ) |
POSTPONE ?branch >mark ; immediate restrict |
POSTPONE ?branch >mark ; immediate restrict |
Line 545 variable dead-code \ true if normal code
|
Line 575 variable dead-code \ true if normal code
|
|
|
: THEN ( orig -- ) |
: THEN ( orig -- ) |
dup orig? |
dup orig? |
dead-code @ |
dead-orig = |
if |
if |
dead-orig = |
>resolve drop |
if |
|
>resolve drop |
|
else |
|
>resolve set-locals-size-list dead-code off |
|
then |
|
else |
else |
dead-orig = |
dead-code @ |
if |
if |
>resolve drop |
>resolve set-locals-size-list dead-code off |
else \ both live |
else \ both live |
over list-size adjust-locals-size |
over list-size adjust-locals-size |
>resolve |
>resolve |
Line 578 variable dead-code \ true if normal code
|
Line 603 variable dead-code \ true if normal code
|
|
|
: BEGIN ( -- dest ) |
: BEGIN ( -- dest ) |
dead-code @ if |
dead-code @ if |
\ set up an assumption of the locals visible here |
\ set up an assumption of the locals visible here. if the |
\ currently we just take the top cs-item |
\ users want something to be visible, they have to declare |
\ it would be more intelligent to take the top orig |
\ that using ASSUME-LIVE |
\ but that can be arranged by the user |
backedge-locals @ set-locals-size-list |
dup defstart <> if |
|
dup cs-item? |
|
2 pick |
|
else |
|
0 |
|
then |
|
set-locals-size-list |
|
then |
then |
cs-push-part dest |
cs-push-part dest |
dead-code off ; immediate restrict |
dead-code off ; immediate restrict |
Line 604 variable dead-code \ true if normal code
|
Line 622 variable dead-code \ true if normal code
|
POSTPONE branch |
POSTPONE branch |
<resolve |
<resolve |
check-begin |
check-begin |
unreachable ; immediate restrict |
POSTPONE unreachable ; immediate restrict |
|
|
\ UNTIL (the current control flow may join an earlier one or continue): |
\ UNTIL (the current control flow may join an earlier one or continue): |
\ Similar to AGAIN. The new locals-list and locals-size are the current |
\ Similar to AGAIN. The new locals-list and locals-size are the current |
Line 736 Avariable leave-sp leave-stack 3 cells
|
Line 754 Avariable leave-sp leave-stack 3 cells
|
: EXIT ( -- ) |
: EXIT ( -- ) |
0 adjust-locals-size |
0 adjust-locals-size |
POSTPONE ;s |
POSTPONE ;s |
unreachable ; immediate restrict |
POSTPONE unreachable ; immediate restrict |
|
|
: ?EXIT ( -- ) |
: ?EXIT ( -- ) |
POSTPONE if POSTPONE exit POSTPONE then ; immediate restrict |
POSTPONE if POSTPONE exit POSTPONE then ; immediate restrict |
Line 781 Avariable leave-sp leave-stack 3 cells
|
Line 799 Avariable leave-sp leave-stack 3 cells
|
\ information through global variables), but they are useful for dealing |
\ information through global variables), but they are useful for dealing |
\ with existing/independent defining words |
\ with existing/independent defining words |
|
|
defer header |
defer (header) |
|
defer header ' (header) IS header |
|
|
: name, ( "name" -- ) |
: name, ( "name" -- ) |
name c@ |
name |
dup $1F u> -&19 and throw ( is name too long? ) |
dup $1F u> -&19 and throw ( is name too long? ) |
1+ chars allot align ; |
dup c, here swap chars dup allot move align ; |
: input-stream-header ( "name" -- ) |
: input-stream-header ( "name" -- ) |
\ !! this is f83-implementation-dependent |
\ !! this is f83-implementation-dependent |
align here last ! -1 A, |
align here last ! -1 A, |
Line 794 defer header
|
Line 813 defer header
|
|
|
: input-stream ( -- ) \ general |
: input-stream ( -- ) \ general |
\ switches back to getting the name from the input stream ; |
\ switches back to getting the name from the input stream ; |
['] input-stream-header IS header ; |
['] input-stream-header IS (header) ; |
|
|
' input-stream-header IS header |
' input-stream-header IS (header) |
|
|
\ !! make that a 2variable |
\ !! make that a 2variable |
create nextname-buffer 32 chars allot |
create nextname-buffer 32 chars allot |
Line 814 create nextname-buffer 32 chars allot
|
Line 833 create nextname-buffer 32 chars allot
|
dup $1F u> -&19 and throw ( is name too long? ) |
dup $1F u> -&19 and throw ( is name too long? ) |
nextname-buffer c! ( c-addr ) |
nextname-buffer c! ( c-addr ) |
nextname-buffer count move |
nextname-buffer count move |
['] nextname-header IS header ; |
['] nextname-header IS (header) ; |
|
|
: noname-header ( -- ) |
: noname-header ( -- ) |
0 last ! |
0 last ! |
Line 822 create nextname-buffer 32 chars allot
|
Line 841 create nextname-buffer 32 chars allot
|
|
|
: noname ( -- ) \ general |
: noname ( -- ) \ general |
\ the next defined word remains anonymous. The xt of that word is given by lastxt |
\ the next defined word remains anonymous. The xt of that word is given by lastxt |
['] noname-header IS header ; |
['] noname-header IS (header) ; |
|
|
: lastxt ( -- xt ) \ general |
: lastxt ( -- xt ) \ general |
\ xt is the execution token of the last word defined. The main purpose of this word is to get the xt of words defined using noname |
\ xt is the execution token of the last word defined. The main purpose of this word is to get the xt of words defined using noname |
Line 1008 Variable warnings G -1 warnings T !
|
Line 1027 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= if drop -&13 bounce then ; |
: ' ( "name" -- addr ) name sfind 0= if -&13 bounce then ; |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
\ Input 13feb93py |
\ Input 13feb93py |
|
|
Line 1022 Variable warnings G -1 warnings T !
|
Line 1041 Variable warnings G -1 warnings T !
|
|
|
: bell #bell emit ; |
: bell #bell emit ; |
|
|
: backspaces 0 ?DO #bs emit LOOP ; |
\ : backspaces 0 ?DO #bs emit LOOP ; |
: >string ( span addr pos1 -- span addr pos1 addr2 len ) |
: >string ( span addr pos1 -- span addr pos1 addr2 len ) |
over 3 pick 2 pick chars /string ; |
over 3 pick 2 pick chars /string ; |
: type-rest ( span addr pos1 -- span addr pos1 back ) |
: type-rest ( span addr pos1 -- span addr pos1 back ) |
Line 1039 Variable warnings G -1 warnings T !
|
Line 1058 Variable warnings G -1 warnings T !
|
: 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 ; |
|
|
Create crtlkeys |
Create ctrlkeys |
] false false back false false false forw false |
] false false back false false 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 [ |
|
|
|
defer everychar |
|
' noop IS everychar |
|
|
: decode ( max span addr pos1 key -- max span addr pos2 flag ) |
: decode ( max span addr pos1 key -- max span addr pos2 flag ) |
|
everychar |
dup #del = IF drop #bs THEN \ del is rubout |
dup #del = IF drop #bs THEN \ del is rubout |
dup bl < IF cells crtlkeys + @ execute EXIT THEN |
dup bl < IF cells ctrlkeys + @ execute EXIT THEN |
>r 2over = IF rdrop bell 0 EXIT THEN |
>r 2over = IF rdrop bell 0 EXIT THEN |
r> (ins) 0 ; |
r> (ins) 0 ; |
|
|
Line 1148 create nl$ 1 c, A c, 0 c, \ gnu includes
|
Line 1171 create nl$ 1 c, A c, 0 c, \ gnu includes
|
: include-file ( i*x fid -- j*x ) |
: include-file ( i*x fid -- j*x ) |
push-file loadfile ! |
push-file loadfile ! |
0 loadline ! blk off ['] read-loop catch |
0 loadline ! blk off ['] read-loop catch |
loadfile @ close-file swap |
loadfile @ close-file swap 2dup or |
pop-file throw throw ; |
pop-file drop throw throw ; |
|
|
|
create pathfilenamebuf 256 chars allot \ !! make this grow on demand |
|
|
|
: open-path-file ( c-addr1 u1 -- file-id c-addr2 u2 ) |
|
\ opens a file for reading, searching in the path for it; c-addr2 |
|
\ u2 is the full filename (valid until the next call); if the file |
|
\ is not found (or in case of other errors for each try), -38 |
|
\ (non-existant file) is thrown. Opening for other access modes |
|
\ makes little sense, as the path will usually contain dirs that |
|
\ are only readable for the user |
|
\ !! check for "/", "./", "../" in original filename; check for "~/"? |
|
pathdirs 2@ 0 |
|
?DO ( c-addr1 u1 dirnamep ) |
|
dup >r 2@ dup >r pathfilenamebuf swap cmove ( addr u ) |
|
2dup pathfilenamebuf r@ chars + swap cmove ( addr u ) |
|
pathfilenamebuf over r> + dup >r r/o open-file 0= |
|
if ( addr u file-id ) |
|
nip nip r> rdrop 0 leave |
|
then |
|
rdrop drop r> cell+ cell+ |
|
LOOP |
|
0<> -&38 and throw ( file-id u2 ) |
|
pathfilenamebuf swap ; |
|
|
: included ( i*x addr u -- j*x ) |
: included ( i*x addr u -- j*x ) |
loadfilename 2@ >r >r |
loadfilename 2@ >r >r |
dup allocate throw over loadfilename 2! |
open-path-file ( file-id c-addr2 u2 ) |
over loadfilename 2@ move |
dup allocate throw over loadfilename 2! ( file-id c-addr2 u2 ) |
r/o open-file throw include-file |
drop loadfilename 2@ move |
|
['] include-file catch |
\ don't free filenames; they don't take much space |
\ don't free filenames; they don't take much space |
\ and are used for debugging |
\ and are used for debugging |
r> r> loadfilename 2! ; |
r> r> loadfilename 2! throw ; |
|
|
\ HEX DECIMAL 2may93jaw |
\ HEX DECIMAL 2may93jaw |
|
|
Line 1168 create nl$ 1 c, A c, 0 c, \ gnu includes
|
Line 1215 create nl$ 1 c, A c, 0 c, \ gnu includes
|
\ DEPTH 9may93jaw |
\ DEPTH 9may93jaw |
|
|
: depth ( -- +n ) sp@ s0 @ swap - cell / ; |
: depth ( -- +n ) sp@ s0 @ swap - cell / ; |
|
: clearstack ( ... -- ) s0 @ sp! ; |
|
|
\ INCLUDE 9may93jaw |
\ INCLUDE 9may93jaw |
|
|
: include ( "file" -- ) |
: include ( "file" -- ) |
bl word count included ; |
name included ; |
|
|
\ RECURSE 17may93jaw |
\ RECURSE 17may93jaw |
|
|
Line 1249 DEFER DOERROR
|
Line 1297 DEFER DOERROR
|
ELSE |
ELSE |
type ." :" dec. |
type ." :" dec. |
cr dup 2over type cr drop |
cr dup 2over type cr drop |
nip -trailing ( line-start index2 ) |
nip -trailing 1- ( line-start index2 ) |
0 >r BEGIN |
0 >r BEGIN |
1- 2dup + c@ bl > WHILE |
2dup + c@ bl > WHILE |
r> 1+ >r dup 0< UNTIL THEN 1+ |
r> 1+ >r 1- dup 0< UNTIL THEN 1+ |
( line-start index1 ) |
( line-start index1 ) |
typewhite |
typewhite |
r> 1 max 0 ?do \ we want at least one "^", even if the length is 0 |
r> 1 max 0 ?do \ we want at least one "^", even if the length is 0 |
Line 1302 DEFER DOERROR
|
Line 1350 DEFER DOERROR
|
\ : words listwords @ |
\ : words listwords @ |
\ BEGIN @ dup WHILE dup .name REPEAT drop ; |
\ BEGIN @ dup WHILE dup .name REPEAT drop ; |
|
|
: >len ( cstring -- addr n ) 100 0 scan 0 swap 100 - /string ; |
: cstring>sstring ( cstring -- addr n ) -1 0 scan 0 swap 1+ /string ; |
: arg ( n -- addr count ) cells argv @ + @ >len ; |
: arg ( n -- addr count ) cells argv @ + @ cstring>sstring ; |
: #! postpone \ ; immediate |
: #! postpone \ ; immediate |
|
|
Variable env |
Create pathstring 2 cells allot \ string |
|
Create pathdirs 2 cells allot \ dir string array, pointer and count |
Variable argv |
Variable argv |
Variable argc |
Variable argc |
|
|
0 Value script? ( -- flag ) |
0 Value script? ( -- flag ) |
|
|
|
: process-path ( addr1 u1 -- addr2 u2 ) |
|
\ addr1 u1 is a path string, addr2 u2 is an array of dir strings |
|
here >r |
|
BEGIN |
|
over >r [char] : scan |
|
over r> tuck - ( rest-str this-str ) |
|
dup |
|
IF |
|
2dup 1- chars + c@ [char] / <> |
|
IF |
|
2dup chars + [char] / swap c! |
|
1+ |
|
THEN |
|
2, |
|
ELSE |
|
2drop |
|
THEN |
|
dup |
|
WHILE |
|
1 /string |
|
REPEAT |
|
2drop |
|
here r> tuck - 2 cells / ; |
|
|
: ">tib ( addr len -- ) dup #tib ! >in off tib swap move ; |
: ">tib ( addr len -- ) dup #tib ! >in off tib swap move ; |
|
|
: do-option ( addr1 len1 addr2 len2 -- n ) 2swap |
: do-option ( addr1 len1 addr2 len2 -- n ) 2swap |
Line 1320 Variable argc
|
Line 1393 Variable argc
|
IF 2drop ">tib interpret 2 EXIT THEN |
IF 2drop ">tib interpret 2 EXIT THEN |
." Unknown option: " type cr 2drop 1 ; |
." Unknown option: " type cr 2drop 1 ; |
|
|
: process-args ( -- ) argc @ 1 |
: process-args ( -- ) |
?DO I arg over c@ [char] - <> |
argc @ 1 |
IF true to script? included false to script? 1 |
?DO |
ELSE I 1+ arg do-option |
I arg over c@ [char] - <> |
THEN |
IF |
+LOOP ; |
true to script? included false to script? 1 |
|
ELSE |
|
I 1+ arg do-option |
|
THEN |
|
+LOOP ; |
|
|
|
Defer 'cold ' noop IS 'cold |
|
|
: cold ( -- ) |
: cold ( -- ) |
|
'cold |
|
pathstring 2@ process-path pathdirs 2! |
argc @ 1 > |
argc @ 1 > |
IF |
IF |
['] process-args catch ?dup |
['] process-args catch ?dup |
Line 1356 Variable argc
|
Line 1437 Variable argc
|
." along with this program; if not, write to the Free Software" cr |
." along with this program; if not, write to the Free Software" cr |
." Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA." cr ; |
." Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA." cr ; |
|
|
: boot ( **env **argv argc -- ) |
: boot ( path **argv argc -- ) |
argc ! argv ! env ! main-task up! |
argc ! argv ! cstring>sstring pathstring 2! main-task up! |
sp@ dup s0 ! $10 + >tib ! rp@ r0 ! fp@ f0 ! cold ; |
sp@ dup s0 ! $10 + >tib ! rp@ r0 ! fp@ f0 ! cold ; |
|
|
: bye script? 0= IF cr THEN 0 (bye) ; |
: bye script? 0= IF cr THEN 0 (bye) ; |