version 1.23, 1994/11/11 16:10:12
|
version 1.26, 1994/11/17 15:53:14
|
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 1385 Variable argc
|
Line 1385 Variable argc
|
2drop |
2drop |
here r> tuck - 2 cells / ; |
here r> tuck - 2 cells / ; |
|
|
: ">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 |
2dup s" -e" compare 0= >r |
2dup s" -e" compare 0= >r |
2dup s" -evaluate" compare 0= r> or |
2dup s" -evaluate" compare 0= r> or |
IF 2drop ">tib interpret 2 EXIT THEN |
IF 2drop dup >r ['] evaluate catch |
|
?dup IF dup >r DoError r> negate (bye) THEN |
|
r> >tib +! 2 EXIT THEN |
." Unknown option: " type cr 2drop 1 ; |
." Unknown option: " type cr 2drop 1 ; |
|
|
: process-args ( -- ) |
: process-args ( -- ) >tib @ >r |
argc @ 1 |
argc @ 1 |
?DO |
?DO |
I arg over c@ [char] - <> |
I arg over c@ [char] - <> |
Line 1402 Variable argc
|
Line 1402 Variable argc
|
ELSE |
ELSE |
I 1+ arg do-option |
I 1+ arg do-option |
THEN |
THEN |
+LOOP ; |
+LOOP |
|
r> >tib ! ; |
|
|
|
Defer 'cold ' noop IS 'cold |
|
|
: cold ( -- ) |
: cold ( -- ) |
pathstring 2@ process-path pathdirs 2! |
pathstring 2@ process-path pathdirs 2! |
|
'cold |
argc @ 1 > |
argc @ 1 > |
IF |
IF |
['] process-args catch ?dup |
['] process-args catch ?dup |
Line 1417 Variable argc
|
Line 1421 Variable argc
|
." GNU Forth 0.0alpha, Copyright (C) 1994 Free Software Foundation, Inc." cr |
." GNU Forth 0.0alpha, 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" |
quit ; |
loadline off quit ; |
|
|
: license ( -- ) cr |
: license ( -- ) cr |
." This program is free software; you can redistribute it and/or modify" cr |
." This program is free software; you can redistribute it and/or modify" cr |
Line 1436 Variable argc
|
Line 1440 Variable argc
|
|
|
: boot ( path **argv argc -- ) |
: boot ( path **argv argc -- ) |
argc ! argv ! cstring>sstring pathstring 2! 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 ! #tib off >in off |
|
rp@ r0 ! fp@ f0 ! cold ; |
|
|
: bye script? 0= IF cr THEN 0 (bye) ; |
: bye script? 0= IF cr THEN 0 (bye) ; |
|
|