Commit 5db7fd0b authored by jwilke's avatar jwilke

Fixes to tasker.fs, environ.fs

Changed has-xy flags to environmental queries!!
parent 6d81e2f4
...@@ -128,9 +128,12 @@ false DefaultValue create-forward-warn \ warn on forward declaration of create ...@@ -128,9 +128,12 @@ false DefaultValue create-forward-warn \ warn on forward declaration of create
previous >CROSS previous >CROSS
: .dec
base @ decimal swap . base ! ;
: .sourcepos : .sourcepos
cr sourcefilename type ." :" cr sourcefilename type ." :"
base @ decimal sourceline# . base ! ; sourceline# .dec ;
: warnhead : warnhead
\G display error-message head \G display error-message head
...@@ -274,21 +277,33 @@ VARIABLE env-current \ save information of current dictionary to restore with en ...@@ -274,21 +277,33 @@ VARIABLE env-current \ save information of current dictionary to restore with en
: e? name T environment? H 0= ABORT" environment variable not defined!" ; : e? name T environment? H 0= ABORT" environment variable not defined!" ;
: has? name T environment? H IF ELSE false THEN ; : has? name T environment? H
IF \ environment variable is present, return its value
ELSE \ environment variable is not present, return false
\ !! JAW abort is just for testing
false true ABORT" arg"
THEN ;
: $has? T environment? H IF ELSE false THEN ; : $has? T environment? H IF ELSE false THEN ;
>ENVIRON >ENVIRON
true Value cross false SetValue ionly
true SetValue cross
>TARGET >TARGET
mach-file count included hex mach-file count included hex
>TARGET >ENVIRON
[IFUNDEF] has-interpreter true Value has-interpreter [THEN] s" interpreter" T environment? H 0= ?dup nip [IF] true Value interpreter [THEN]
[IFUNDEF] itc true Value itc [THEN] s" ITC" T environment? H 0= ?dup nip [IF] true SetValue ITC [THEN]
[IFUNDEF] has-rom false Value has-rom [THEN] s" rom" T environment? H 0= ?dup nip [IF] false Value rom [THEN]
>TARGET
s" relocate" T environment? H
[IF] SetValue NIL
[ELSE] >ENVIRON T NIL H SetValue relocate
[THEN]
>CROSS >CROSS
...@@ -406,7 +421,7 @@ Variable mirrored-link \ linked list for mirrored regions ...@@ -406,7 +421,7 @@ Variable mirrored-link \ linked list for mirrored regions
." End: " r@ 1 cells + @ + .addr space ." End: " r@ 1 cells + @ + .addr space
." DP: " r> 2 cells + @ .addr ." DP: " r> 2 cells + @ .addr
REPEAT drop REPEAT drop
s" rom" $has? 0= ?EXIT s" rom" T $has? H 0= ?EXIT
cr ." Mirrored:" cr ." Mirrored:"
mirrored-link @ mirrored-link @
BEGIN dup BEGIN dup
...@@ -422,7 +437,7 @@ Variable mirrored-link \ linked list for mirrored regions ...@@ -422,7 +437,7 @@ Variable mirrored-link \ linked list for mirrored regions
0 0 region dictionary 0 0 region dictionary
\ rom area for the compiler \ rom area for the compiler
has? rom T has? rom H
[IF] [IF]
0 0 region ram-dictionary mirrored 0 0 region ram-dictionary mirrored
\ ram area for the compiler \ ram area for the compiler
...@@ -440,7 +455,7 @@ has? rom ...@@ -440,7 +455,7 @@ has? rom
: setup-target ( -- ) \G initialize targets memory space : setup-target ( -- ) \G initialize targets memory space
s" rom" $has? s" rom" T $has? H
IF \ check for ram and rom... IF \ check for ram and rom...
address-space area nip address-space area nip
ram-dictionary area nip ram-dictionary area nip
...@@ -493,7 +508,7 @@ variable fixed \ flag: true: no automatic switching ...@@ -493,7 +508,7 @@ variable fixed \ flag: true: no automatic switching
variable constflag constflag off variable constflag constflag off
: (switchram) : (switchram)
fixed @ ?EXIT has-rom 0= ?EXIT fixed @ ?EXIT s" rom" T $has? H 0= ?EXIT
ram-dictionary >rdp to tdp ; ram-dictionary >rdp to tdp ;
: switchram : switchram
...@@ -674,18 +689,53 @@ DEFER comp[ \ ends compilation ...@@ -674,18 +689,53 @@ DEFER comp[ \ ends compilation
: compile, colon, ; : compile, colon, ;
>CROSS >CROSS
\ file loading
Variable filelist 0 filelist !
0 Value loadfile
0 [IF] \ !! JAW WIP
: add-included-file ( adr len -- )
dup 2 cells + allocate throw >r
r@ 1 cells + dup TO loadfile place
filelist @ r@ !
r> filelist ! ;
: included? ( c-addr u -- f )
filelist
BEGIN @ dup
WHILE >r r@ 1 cells + count compare 0=
IF rdrop 2drop true EXIT THEN
r>
REPEAT
2drop drop false ;
: included
cr ." Including: " 2dup type ." ..."
2dup add-included-file included ;
: include bl word count included ;
: require bl word count included ;
[THEN]
\ resolve structure \ resolve structure
: >next ; \ link to next field : >next ; \ link to next field
: >tag cell+ ; \ indecates type of reference: 0: call, 1: address : >tag cell+ ; \ indecates type of reference: 0: call, 1: address
: >taddr cell+ cell+ ; : >taddr cell+ cell+ ;
: >ghost 3 cells + ; : >ghost 3 cells + ;
: >file 4 cells + ;
: >line 5 cells + ;
: refered ( ghost tag -- ) : refered ( ghost tag -- )
\G creates a resolve structure
swap >r here r@ >link @ , r@ >link ! ( tag ) , swap >r here r@ >link @ , r@ >link ! ( tag ) ,
T here aligned H , r> drop last-header-ghost @ , ; T here aligned H , r> drop last-header-ghost @ ,
loadfile , sourceline# ,
;
Defer resolve-warning Defer resolve-warning
...@@ -768,9 +818,24 @@ variable ResolveFlag ...@@ -768,9 +818,24 @@ variable ResolveFlag
: ?touched ( ghost -- flag ) dup forward? swap >link @ : ?touched ( ghost -- flag ) dup forward? swap >link @
0 <> and ; 0 <> and ;
: .forwarddefs ( ghost -- )
." appeared in:"
>link
BEGIN @ dup
WHILE cr 5 spaces
dup >ghost @ >ghostname type
." file " dup >file @ ?dup IF count type ELSE ." CON" THEN
." line " dup >line @ .dec
REPEAT
drop ;
: ?resolved ( ghostname -- ) : ?resolved ( ghostname -- )
dup cell+ @ ?touched dup cell+ @ ?touched
IF cell+ cell+ count cr type ResolveFlag on ELSE drop THEN ; IF dup
cell+ cell+ count cr type ResolveFlag on
cell+ @ .forwarddefs
ELSE drop
THEN ;
>MINIMAL >MINIMAL
: .unresolved ( -- ) : .unresolved ( -- )
...@@ -789,8 +854,6 @@ variable ResolveFlag ...@@ -789,8 +854,6 @@ variable ResolveFlag
: .stats : .stats
base @ >r decimal base @ >r decimal
cr ." named Headers: " headers-named @ . cr ." named Headers: " headers-named @ .
\ cr ." MaxRam*" ramdp @ .
\ cr ." MaxRom*" romdp @ .
r> base ! ; r> base ! ;
>CROSS >CROSS
...@@ -958,16 +1021,16 @@ VARIABLE ;Resolve 1 cells allot ...@@ -958,16 +1021,16 @@ VARIABLE ;Resolve 1 cells allot
>TARGET >TARGET
: Alias ( cfa -- ) \ name : Alias ( cfa -- ) \ name
>in @ skip? IF 2drop EXIT THEN >in ! >in @ skip? IF 2drop EXIT THEN >in !
dup 0< has-prims 0= and dup 0< s" prims" T $has? H 0= and
IF IF
." needs prim: " >in @ bl word count type >in ! cr .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
THEN THEN
(THeader over resolve T A, H 80 flag! ; (THeader over resolve T A, H 80 flag! ;
: Alias: ( cfa -- ) \ name : Alias: ( cfa -- ) \ name
>in @ skip? IF 2drop EXIT THEN >in ! >in @ skip? IF 2drop EXIT THEN >in !
dup 0< has-prims 0= and dup 0< s" prims" T $has? H 0= and
IF IF
." needs doer: " >in @ bl word count type >in ! cr .sourcepos ." needs doer: " >in @ bl word count type >in ! cr
THEN THEN
ghost tuck swap resolve <do:> swap >magic ! ; ghost tuck swap resolve <do:> swap >magic ! ;
>CROSS >CROSS
...@@ -1066,7 +1129,7 @@ Defer (end-code) ...@@ -1066,7 +1129,7 @@ Defer (end-code)
: Code : Code
defempty? defempty?
(THeader there resolve (THeader there resolve
[ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF] [ T e? prims H 0= [IF] T e? ITC H [ELSE] true [THEN] ] [IF]
doprim, doprim,
[THEN] [THEN]
depth (code) ; depth (code) ;
...@@ -1268,7 +1331,7 @@ Cond: DOES> restrict? ...@@ -1268,7 +1331,7 @@ Cond: DOES> restrict?
: BuildSmart: ( -- [xt] [colon-sys] ) : BuildSmart: ( -- [xt] [colon-sys] )
:noname :noname
[ has-rom [IF] ] [ T has? rom H [IF] ]
postpone RTCreate postpone RTCreate
[ [ELSE] ] [ [ELSE] ]
postpone TCreate postpone TCreate
...@@ -1320,7 +1383,7 @@ BuildSmart: ; ...@@ -1320,7 +1383,7 @@ BuildSmart: ;
by: :dovar ( ghost -- addr ) ;DO by: :dovar ( ghost -- addr ) ;DO
Builder Create Builder Create
has-rom [IF] T has? rom H [IF]
Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ; Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;
by (Constant) by (Constant)
Builder Variable Builder Variable
...@@ -1330,7 +1393,7 @@ by Create ...@@ -1330,7 +1393,7 @@ by Create
Builder Variable Builder Variable
[THEN] [THEN]
has-rom [IF] T has? rom H [IF]
Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ; Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;
by (Constant) by (Constant)
Builder AVariable Builder AVariable
...@@ -1504,6 +1567,7 @@ Cond: NEXT restrict? sys? compile (next) loop] ;Cond ...@@ -1504,6 +1567,7 @@ Cond: NEXT restrict? sys? compile (next) loop] ;Cond
Cond: BUT restrict? sys? swap ;Cond Cond: BUT restrict? sys? swap ;Cond
Cond: YET restrict? sys? dup ;Cond Cond: YET restrict? sys? dup ;Cond
1 [IF]
>CROSS >CROSS
Variable tleavings Variable tleavings
>TARGET >TARGET
...@@ -1519,8 +1583,44 @@ Cond: DONE ( addr -- ) restrict? tleavings @ ...@@ -1519,8 +1583,44 @@ Cond: DONE ( addr -- ) restrict? tleavings @
Cond: LEAVE restrict? compile branch (leave ;Cond Cond: LEAVE restrict? compile branch (leave ;Cond
Cond: ?LEAVE restrict? compile 0= compile ?branch (leave ;Cond Cond: ?LEAVE restrict? compile 0= compile ?branch (leave ;Cond
[ELSE]
\ !! This is WIP
\ The problem is (?DO)!
\ perhaps we need a plug-in for (?DO)
>CROSS
Variable tleavings 0 tleavings !
>TARGET
Cond: DONE ( addr -- )
restrict? tleavings @
BEGIN dup
WHILE >r dup r@ cell+ @ \ address of branch
u> 0= \ lower than DO?
WHILE r@ 2 cells + @ \ branch token
branchtoresolve,
r@ @ r> free throw
REPEAT drop r>
THEN
tleavings ! drop ;Cond
>CROSS
: (leave ( branchtoken -- )
3 cells allocate throw >r
T here H r@ cell+ !
r@ 2 cells + !
tleavings @ r@ !
r> tleavings ! ;
>TARGET
Cond: LEAVE restrict? branchmark, (leave ;Cond
Cond: ?LEAVE restrict? compile 0= ?branchmark, (leave ;Cond
[THEN]
\ Structural Conditionals 12dec92py \ Structural Conditionals 12dec92py
>TARGET
Cond: AHEAD restrict? branchmark, ;Cond Cond: AHEAD restrict? branchmark, ;Cond
Cond: IF restrict? ?branchmark, ;Cond Cond: IF restrict? ?branchmark, ;Cond
Cond: THEN restrict? sys? branchto, branchtoresolve, ;Cond Cond: THEN restrict? sys? branchto, branchtoresolve, ;Cond
...@@ -1545,7 +1645,7 @@ Cond: ?DO restrict? compile (?do) T (leave here H ;Cond ...@@ -1545,7 +1645,7 @@ Cond: ?DO restrict? compile (?do) T (leave here H ;Cond
Cond: FOR restrict? compile (for) T here H ;Cond Cond: FOR restrict? compile (for) T here H ;Cond
>CROSS >CROSS
: loop] dup <resolve tcell - compile DONE compile unloop ; : loop] branchto, dup <resolve tcell - compile DONE compile unloop ;
>TARGET >TARGET
Cond: LOOP restrict? sys? compile (loop) loop] ;Cond Cond: LOOP restrict? sys? compile (loop) loop] ;Cond
......
...@@ -29,7 +29,7 @@ Create environment-wordlist wordlist drop ...@@ -29,7 +29,7 @@ Create environment-wordlist wordlist drop
false false
endif ; endif ;
: e? name environment? ; immediate : e? name environment? 0= ABORT" environmental dependency not existing" ;
: has? name environment? IF ELSE false THEN ; : has? name environment? IF ELSE false THEN ;
......
...@@ -18,19 +18,15 @@ ...@@ -18,19 +18,15 @@
\ along with this program; if not, write to the Free Software \ along with this program; if not, write to the Free Software
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
[IFUNDEF] e? : e? name 2drop false ; [THEN] [IFUNDEF] allocate
e? ec
[IF]
: reserve-mem here swap allot ; : reserve-mem here swap allot ;
\ ToDo: check memory space with unused
\ move to a kernel/memory.fs \ move to a kernel/memory.fs
[ELSE] [ELSE]
: reserve-mem allocate throw ; : reserve-mem allocate throw ;
[THEN] [THEN]
[IFUNDEF] hashbits [IFUNDEF] hashbits
11 value hashbits 11 Value hashbits
[THEN] [THEN]
1 hashbits lshift Value Hashlen 1 hashbits lshift Value Hashlen
...@@ -140,7 +136,7 @@ to hashsearch-map ...@@ -140,7 +136,7 @@ to hashsearch-map
HashTable Hashlen cells erase THEN HashTable Hashlen cells erase THEN
HashIndex @ over ! 1 HashIndex +! HashIndex @ over ! 1 HashIndex +!
HashIndex @ Hashlen >= HashIndex @ Hashlen >=
[ e? ec [IF] ] [ [IFUNDEF] allocate ]
ABORT" no more space in hashtable" ABORT" no more space in hashtable"
[ [ELSE] ] [ [ELSE] ]
IF HashTable >r clearhash IF HashTable >r clearhash
...@@ -151,7 +147,7 @@ to hashsearch-map ...@@ -151,7 +147,7 @@ to hashsearch-map
[ [THEN] ] ; is hash-alloc [ [THEN] ] ; is hash-alloc
\ Hash-Find 01jan93py \ Hash-Find 01jan93py
e? cross 0= has? cross 0=
[IF] [IF]
: make-hash : make-hash
hashsearch-map forth-wordlist cell+ ! hashsearch-map forth-wordlist cell+ !
...@@ -164,14 +160,14 @@ e? cross 0= ...@@ -164,14 +160,14 @@ e? cross 0=
\ for ec version display that vocabulary goes hashed \ for ec version display that vocabulary goes hashed
: hash-cold ( -- ) : hash-cold ( -- )
[ e? ec [IF] ] ." Hashing..." [ [THEN] ] [ has? ec [IF] ] ." Hashing..." [ [THEN] ]
HashPointer off 0 TO HashTable HashIndex off HashPointer off 0 TO HashTable HashIndex off
addall addall
\ voclink \ voclink
\ BEGIN @ dup WHILE \ BEGIN @ dup WHILE
\ dup 0 wordlist-link - initvoc \ dup 0 wordlist-link - initvoc
\ REPEAT drop \ REPEAT drop
[ e? ec [IF] ] ." Done" cr [ [THEN] ] ; [ has? ec [IF] ] ." Done" cr [ [THEN] ] ;
' hash-cold INIT8 chained ' hash-cold INIT8 chained
......
...@@ -46,7 +46,7 @@ decimal ...@@ -46,7 +46,7 @@ decimal
[IFUNDEF] look [IFUNDEF] look
has? ec [IF] has? ec [IF]
has-rom has? rom
[IF] [IF]
: look : look
dup [ unlock rom-dictionary area lock ] dup [ unlock rom-dictionary area lock ]
......
...@@ -29,14 +29,4 @@ ...@@ -29,14 +29,4 @@
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -29,14 +29,4 @@ false Constant bigendian ...@@ -29,14 +29,4 @@ false Constant bigendian
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -29,14 +29,4 @@ ...@@ -29,14 +29,4 @@
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -29,14 +29,4 @@ false Constant bigendian ...@@ -29,14 +29,4 @@ false Constant bigendian
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -29,14 +29,4 @@ ...@@ -29,14 +29,4 @@
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -29,14 +29,4 @@ false Constant bigendian ...@@ -29,14 +29,4 @@ false Constant bigendian
\ feature list \ feature list
true Constant NIL \ relocating include machpc.fs
true Constant has-files
true Constant has-OS
true Constant has-prims
true Constant has-floats
true Constant has-locals
true Constant has-dcomps
true Constant has-hash
true Constant has-xconds
true Constant has-header
...@@ -128,7 +128,7 @@ EXEC(*(Xt *)a_addr); ...@@ -128,7 +128,7 @@ EXEC(*(Xt *)a_addr);
: :
@ execute ; @ execute ;
\+has-locals [IF] \+has? glocals [IF]
branch-lp+!# -- gforth branch_lp_plus_store_number branch-lp+!# -- gforth branch_lp_plus_store_number
/* this will probably not be used */ /* this will probably not be used */
...@@ -157,7 +157,7 @@ else ...@@ -157,7 +157,7 @@ else
INC_IP(1); INC_IP(1);
$4 $4
\+has-locals [IF] \+has? glocals [IF]
$1-lp+!# $2_lp_plus_store_number $1-lp+!# $2_lp_plus_store_number
$3 goto branch_adjust_lp; $3 goto branch_adjust_lp;
...@@ -181,7 +181,7 @@ if (f==0) { ...@@ -181,7 +181,7 @@ if (f==0) {
\ we don't need an lp_plus_store version of the ?dup-stuff, because it \ we don't need an lp_plus_store version of the ?dup-stuff, because it
\ is only used in if's (yet) \ is only used in if's (yet)
\+has-xconds [IF] \+has? xconds [IF]
?dup-?branch f -- f new question_dupe_question_branch ?dup-?branch f -- f new question_dupe_question_branch
""The run-time procedure compiled by @code{?DUP-IF}."" ""The run-time procedure compiled by @code{?DUP-IF}.""
...@@ -250,7 +250,7 @@ if ((olddiff^(olddiff+n))>=0 /* the limit is not crossed */ ...@@ -250,7 +250,7 @@ if ((olddiff^(olddiff+n))>=0 /* the limit is not crossed */
IF >r + >r dup @ + >r IF >r + >r dup @ + >r
ELSE >r >r drop cell+ >r THEN ;) ELSE >r >r drop cell+ >r THEN ;)
\+has-xconds [IF] \+has? xconds [IF]
condbranch((-loop),u -- gforth paren_minus_loop, condbranch((-loop),u -- gforth paren_minus_loop,
/* !! check this thoroughly */ /* !! check this thoroughly */
...@@ -325,7 +325,7 @@ else { ...@@ -325,7 +325,7 @@ else {
cell+ >r cell+ >r
THEN ; \ --> CORE-EXT THEN ; \ --> CORE-EXT
\+has-xconds [IF] \+has? xconds [IF]
(+do) nlimit nstart -- gforth paren_plus_do (+do) nlimit nstart -- gforth paren_plus_do
*--rp = nlimit; *--rp = nlimit;
...@@ -905,7 +905,7 @@ f = FLAG($4>=$5); ...@@ -905,7 +905,7 @@ f = FLAG($4>=$5);
) )
\+has-dcomps [IF] \+has? dcomps [IF]
dcomparisons(d, d1 d2, d_, d1, d2, double, gforth, double, gforth) dcomparisons(d, d1 d2, d_, d1, d2, double, gforth, double, gforth)
dcomparisons(d0, d, d_zero_, d, DZERO, double, gforth, double, gforth) dcomparisons(d0, d, d_zero_, d, DZERO, double, gforth, double, gforth)
...@@ -931,7 +931,7 @@ a_addr = rp; ...@@ -931,7 +931,7 @@ a_addr = rp;
rp! a_addr -- gforth rpstore rp! a_addr -- gforth rpstore
rp = a_addr; rp = a_addr;
\+has-floats [IF] \+has? floating [IF]
fp@ -- f_addr gforth fp_fetch fp@ -- f_addr gforth fp_fetch
f_addr = fp; f_addr = fp;
...@@ -1017,7 +1017,7 @@ Variable (rot) ...@@ -1017,7 +1017,7 @@ Variable (rot)
nip w1 w2 -- w2 core-ext nip w1 w2 -- w2 core-ext
: :
>r drop r> ; swap drop ;
tuck w1 w2 -- w2 w1 w2 core-ext tuck w1 w2 -- w2 w1 w2 core-ext
: :
...@@ -1191,7 +1191,7 @@ f83name2=f83name1; ...@@ -1191,7 +1191,7 @@ f83name2=f83name1;
: (find-samelen) ( u f83name1 -- u f83name2/0 ) : (find-samelen) ( u f83name1 -- u f83name2/0 )
BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ; BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ;
\+has-hash [IF] \+has? hash [IF]
(hashfind) c_addr u a_addr -- f83name2 new paren_hashfind (hashfind) c_addr u a_addr -- f83name2 new paren_hashfind
F83Name *f83name1; F83Name *f83name1;
...@@ -1369,7 +1369,7 @@ n=1; ...@@ -1369,7 +1369,7 @@ n=1;
: :
1 ; 1 ;
\+has-os [IF] \+has? os [IF]
(key) -- n gforth paren_key (key) -- n gforth paren_key
fflush(stdout); fflush(stdout);
...@@ -1493,7 +1493,7 @@ fp=FP; ...@@ -1493,7 +1493,7 @@ fp=FP;
IF_TOS(TOS=sp[0]); IF_TOS(TOS=sp[0]);
IF_FTOS(FTOS=fp[0]); IF_FTOS(FTOS=fp[0]);
\+[THEN] ( has-os ) has-files [IF] \+[THEN] ( has? os ) has? file [IF]
close-file wfileid -- wior file close_file close-file wfileid -- wior file close_file
wior = IOR(fclose((FILE *)wfileid)==EOF); wior = IOR(fclose((FILE *)wfileid)==EOF);
...@@ -1574,7 +1574,7 @@ else { ...@@ -1574,7 +1574,7 @@ else {
u2=0; u2=0;
} }