Annotation of gforth/kernel/int.fs, revision 1.21
1.1 pazsan 1: \ definitions needed for interpreter only
2:
1.11 anton 3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
1.1 pazsan 21: \ \ Revision-Log
22:
23: \ put in seperate file 14sep97jaw
24:
25: \ \ input stream primitives 23feb93py
26:
27: : tib ( -- c-addr ) \ core-ext
28: \ obsolescent
29: >tib @ ;
30:
31: Defer source ( -- addr count ) \ core
32: \ used by dodefer:, must be defer
33:
34: : (source) ( -- addr count )
35: tib #tib @ ;
36: ' (source) IS source
37:
38: : (word) ( addr1 n1 char -- addr2 n2 )
39: dup >r skip 2dup r> scan nip - ;
40:
41: \ (word) should fold white spaces
42: \ this is what (parse-white) does
43:
44: \ word parse 23feb93py
45:
1.3 anton 46: : sword ( char -- addr len ) \ gforth
47: \G parses like @code{word}, but the output is like @code{parse} output
48: \ this word was called PARSE-WORD until 0.3.0, but Open Firmware and
49: \ dpANS6 A.6.2.2008 have a word with that name that behaves
50: \ differently (like NAME).
1.1 pazsan 51: source 2dup >r >r >in @ over min /string
52: rot dup bl = IF drop (parse-white) ELSE (word) THEN
53: 2dup + r> - 1+ r> min >in ! ;
54:
55: : word ( char -- addr ) \ core
1.3 anton 56: sword here place bl here count + c! here ;
1.1 pazsan 57:
58: : parse ( char -- addr len ) \ core-ext
59: >r source >in @ over min /string over swap r> scan >r
60: over - dup r> IF 1+ THEN >in +! ;
61:
62: \ name 13feb93py
63:
64: [IFUNDEF] (name) \ name might be a primitive
65:
66: : (name) ( -- c-addr count )
67: source 2dup >r >r >in @ /string (parse-white)
68: 2dup + r> - 1+ r> min >in ! ;
69: \ name count ;
70: [THEN]
71:
72: : name-too-short? ( c-addr u -- c-addr u )
73: dup 0= -&16 and throw ;
74:
75: : name-too-long? ( c-addr u -- c-addr u )
76: dup $1F u> -&19 and throw ;
77:
78: \ \ Number parsing 23feb93py
79:
80: \ number? number 23feb93py
81:
82: hex
83: const Create bases 10 , 2 , A , 100 ,
84: \ 16 2 10 character
85:
1.18 anton 86: \ !! protect BASE saving wrapper against exceptions
1.1 pazsan 87: : getbase ( addr u -- addr' u' )
88: over c@ [char] $ - dup 4 u<
89: IF
90: cells bases + @ base ! 1 /string
91: ELSE
92: drop
93: THEN ;
94:
1.20 pazsan 95: : sign? ( addr u -- addr u flag )
1.1 pazsan 96: over c@ '- = dup >r
97: IF
98: 1 /string
99: THEN
1.20 pazsan 100: r> ;
101:
102: : s>unumber? ( addr u -- ud flag )
1.21 ! pazsan 103: base @ >r dpl on getbase
1.20 pazsan 104: 0. 2swap
1.18 anton 105: BEGIN ( d addr len )
1.1 pazsan 106: dup >r >number dup
1.18 anton 107: WHILE \ there are characters left
1.1 pazsan 108: dup r> -
1.18 anton 109: WHILE \ the last >number parsed something
110: dup 1- dpl ! over c@ [char] . =
111: WHILE \ the current char is '.'
1.1 pazsan 112: 1 /string
1.18 anton 113: REPEAT THEN \ there are unparseable characters left
1.21 ! pazsan 114: 2drop false
1.20 pazsan 115: ELSE
116: rdrop 2drop true
1.21 ! pazsan 117: THEN
! 118: r> base ! ;
1.20 pazsan 119:
120: \ ouch, this is complicated; there must be a simpler way - anton
121: : s>number? ( addr len -- d f )
122: \ converts string addr len into d, flag indicates success
1.21 ! pazsan 123: sign? >r
1.20 pazsan 124: s>unumber?
125: 0= IF
1.21 ! pazsan 126: rdrop false
1.18 anton 127: ELSE \ no characters left, all ok
1.20 pazsan 128: r>
1.1 pazsan 129: IF
130: dnegate
131: THEN
1.18 anton 132: true
1.21 ! pazsan 133: THEN ;
1.1 pazsan 134:
1.18 anton 135: : s>number ( addr len -- d )
136: \ don't use this, there is no way to tell success
137: s>number? drop ;
138:
1.1 pazsan 139: : snumber? ( c-addr u -- 0 / n -1 / d 0> )
1.18 anton 140: s>number? 0=
1.1 pazsan 141: IF
142: 2drop false EXIT
143: THEN
1.18 anton 144: dpl @ dup 0< IF
1.1 pazsan 145: nip
1.18 anton 146: ELSE
147: 1+
1.1 pazsan 148: THEN ;
149:
150: : number? ( string -- string 0 / n -1 / d 0> )
151: dup >r count snumber? dup if
152: rdrop
153: else
154: r> swap
155: then ;
156:
157: : number ( string -- d )
158: number? ?dup 0= abort" ?" 0<
159: IF
160: s>d
161: THEN ;
162:
163: \ \ Comments ( \ \G
164:
165: : ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren
1.17 crook 166: \G ** this will not get annotated. The alias in glocals.fs will instead **
1.1 pazsan 167: [char] ) parse 2drop ; immediate
168:
1.17 crook 169: : \ ( -- ) \ core-ext,block-ext backslash
170: \G ** this will not get annotated. The alias in glocals.fs will instead **
1.12 pazsan 171: [ has? file [IF] ]
1.1 pazsan 172: blk @
173: IF
174: >in @ c/l / 1+ c/l * >in !
175: EXIT
176: THEN
1.12 pazsan 177: [ [THEN] ]
1.1 pazsan 178: source >in ! drop ; immediate
179:
1.19 crook 180: : \G ( -- ) \ gforth backslash-gee
181: \G Equivalent to @code{\} but used as a tag to annotate definition
182: \G comments into documentation.
1.1 pazsan 183: POSTPONE \ ; immediate
184:
185: \ \ object oriented search list 17mar93py
186:
187: \ word list structure:
188:
189: struct
190: cell% field find-method \ xt: ( c_addr u wid -- nt )
191: cell% field reveal-method \ xt: ( nt wid -- ) \ used by dofield:, must be field
192: cell% field rehash-method \ xt: ( wid -- ) \ re-initializes a "search-data" (hashtables)
193: cell% field hash-method \ xt: ( wid -- ) \ initializes ""
194: \ \ !! what else
195: end-struct wordlist-map-struct
196:
197: struct
1.6 pazsan 198: cell% field wordlist-map \ pointer to a wordlist-map-struct
1.13 anton 199: cell% field wordlist-id \ linked list of words (for WORDS etc.)
1.1 pazsan 200: cell% field wordlist-link \ link field to other wordlists
1.13 anton 201: cell% field wordlist-extend \ wordlist extensions (eg bucket offset)
1.1 pazsan 202: end-struct wordlist-struct
203:
204: : f83find ( addr len wordlist -- nt / false )
1.6 pazsan 205: wordlist-id @ (f83find) ;
1.1 pazsan 206:
207: : initvoc ( wid -- )
208: dup wordlist-map @ hash-method perform ;
209:
210: \ Search list table: find reveal
211: Create f83search ( -- wordlist-map )
212: ' f83find A, ' drop A, ' drop A, ' drop A,
213:
1.6 pazsan 214: here G f83search T A, NIL A, NIL A, NIL A,
1.1 pazsan 215: AValue forth-wordlist \ variable, will be redefined by search.fs
216:
217: AVariable lookup forth-wordlist lookup !
218: \ !! last is user and lookup?! jaw
219: AVariable current ( -- addr ) \ gforth
1.17 crook 220: \G VARIABLE: holds the wid of the current compilation word list.
1.1 pazsan 221: AVariable voclink forth-wordlist wordlist-link voclink !
1.17 crook 222: lookup AValue context ( -- addr ) \ gforth
223: \G VALUE: @code{context} @code{@@} is the wid of the word list at the
224: \G top of the search order stack.
1.1 pazsan 225:
226: forth-wordlist current !
227:
228: \ \ header, finding, ticks 17dec92py
229:
230: $80 constant alias-mask \ set when the word is not an alias!
231: $40 constant immediate-mask
232: $20 constant restrict-mask
233:
234: \ higher level parts of find
235:
236: : flag-sign ( f -- 1|-1 )
237: \ true becomes 1, false -1
238: 0= 2* 1+ ;
239:
240: : compile-only-error ( ... -- )
241: -&14 throw ;
242:
243: : (cfa>int) ( cfa -- xt )
244: [ has? compiler [IF] ]
245: dup interpret/compile?
246: if
247: interpret/compile-int @
248: then
249: [ [THEN] ] ;
250:
251: : (x>int) ( cfa b -- xt )
252: \ get interpretation semantics of name
253: restrict-mask and
254: if
255: drop ['] compile-only-error
256: else
257: (cfa>int)
258: then ;
259:
260: : name>string ( nt -- addr count ) \ gforth head-to-string
261: \g @var{addr count} is the name of the word represented by @var{nt}.
262: cell+ count $1F and ;
263:
264: : ((name>)) ( nfa -- cfa )
265: name>string + cfaligned ;
266:
267: : (name>x) ( nfa -- cfa b )
268: \ cfa is an intermediate cfa and b is the flags byte of nfa
269: dup ((name>))
270: swap cell+ c@ dup alias-mask and 0=
271: IF
272: swap @ swap
273: THEN ;
274:
275: : name>int ( nt -- xt ) \ gforth
276: \G @var{xt} represents the interpretation semantics of the word
277: \G @var{nt}. Produces @code{' compile-only-error} if
278: \G @var{nt} is compile-only.
279: (name>x) (x>int) ;
280:
281: : name?int ( nt -- xt ) \ gforth
282: \G Like name>int, but throws an error if compile-only.
283: (name>x) restrict-mask and
284: if
285: compile-only-error \ does not return
286: then
287: (cfa>int) ;
288:
289: : (name>comp) ( nt -- w +-1 ) \ gforth
290: \G @var{w xt} is the compilation token for the word @var{nt}.
291: (name>x) >r
292: [ has? compiler [IF] ]
293: dup interpret/compile?
294: if
295: interpret/compile-comp @
296: then
297: [ [THEN] ]
298: r> immediate-mask and flag-sign
299: ;
300:
301: : (name>intn) ( nfa -- xt +-1 )
302: (name>x) tuck (x>int) ( b xt )
303: swap immediate-mask and flag-sign ;
304:
1.14 anton 305: : head? ( addr -- f )
306: \G heuristic check whether addr is a name token; may deliver false
307: \G positives; addr must be a valid address
308: \ we follow the link fields and check for plausibility; two
309: \ iterations should catch most false addresses: on the first
310: \ iteration, we may get an xt, on the second a code address (or
311: \ some code), which is typically not in the dictionary.
312: 2 0 do
313: dup @ dup
314: if ( addr addr1 )
315: dup rot forthstart within
316: if \ addr1 is outside forthstart..addr, not a head
317: drop false unloop exit
318: then ( addr1 )
319: else \ 0 in the link field, no further checks
320: 2drop true unloop exit
321: then
322: loop
323: \ in dubio pro:
324: drop true ;
325:
1.1 pazsan 326: const Create ??? 0 , 3 c, char ? c, char ? c, char ? c,
327: \ ??? is used by dovar:, must be created/:dovar
328:
1.14 anton 329: : >head ( cfa -- nt ) \ gforth to-head
330: $21 cell do ( cfa )
331: dup i - count $9F and + cfaligned over alias-mask + =
332: if ( cfa )
333: dup i - cell - dup head?
334: if
335: nip unloop exit
336: then
337: drop
338: then
339: cell +loop
340: drop ??? ( wouldn't 0 be better? ) ;
1.1 pazsan 341:
342: ' >head ALIAS >name
343:
344: : body> 0 >body - ;
345:
346: : (search-wordlist) ( addr count wid -- nt / false )
347: dup wordlist-map @ find-method perform ;
348:
1.17 crook 349: : search-wordlist ( c-addr count wid -- 0 / xt +-1 ) \ search
350: \G Search the word list identified by wid
351: \G for the definition named by the string at c-addr count.
352: \G If the definition is not found, return 0. If the definition
353: \G is found return 1 (if the definition is immediate) or -1
354: \G (if the definition is not immediate) together with the xt.
355: \G The xt returned represents the interpretation semantics.
1.1 pazsan 356: (search-wordlist) dup if
357: (name>intn)
358: then ;
359:
360: : find-name ( c-addr u -- nt/0 ) \ gforth
361: \g Find the name @var{c-addr u} in the current search
362: \g order. Return its nt, if found, otherwise 0.
363: lookup @ (search-wordlist) ;
364:
365: : sfind ( c-addr u -- 0 / xt +-1 ) \ gforth-obsolete
366: find-name dup
367: if ( nt )
368: state @
369: if
370: (name>comp)
371: else
372: (name>intn)
373: then
374: then ;
375:
376: : find ( c-addr -- xt +-1 / c-addr 0 ) \ core,search
1.17 crook 377: \G Search all word lists in the current search order
378: \G for the definition named by the counted string at c-addr.
379: \G If the definition is not found, return 0. If the definition
380: \G is found return 1 (if the definition is immediate) or -1
381: \G (if the definition is not immediate) together with the xt.
1.1 pazsan 382: dup count sfind dup
383: if
384: rot drop
385: then ;
386:
387: \ ticks
388:
389: : (') ( "name" -- nt ) \ gforth
390: name find-name dup 0=
391: IF
392: drop -&13 bounce
393: THEN ;
394:
395: : ' ( "name" -- xt ) \ core tick
396: \g @var{xt} represents @var{name}'s interpretation
397: \g semantics. Performs @code{-14 throw} if the word has no
398: \g interpretation semantics.
399: (') name?int ;
400:
401: \ \ the interpreter loop mar92py
402:
403: \ interpret 10mar92py
404:
405: Defer parser
406: Defer name ( -- c-addr count ) \ gforth
407: \ get the next word from the input buffer
408: ' (name) IS name
409: Defer compiler-notfound ( c-addr count -- )
410: Defer interpreter-notfound ( c-addr count -- )
411:
412: : no.extensions ( addr u -- )
413: 2drop -&13 bounce ;
414: ' no.extensions IS compiler-notfound
415: ' no.extensions IS interpreter-notfound
416:
417: : interpret ( ?? -- ?? ) \ gforth
418: \ interpret/compile the (rest of the) input buffer
419: BEGIN
420: ?stack name dup
421: WHILE
422: parser
423: REPEAT
424: 2drop ;
425:
426: \ interpreter 30apr92py
427:
428: \ not the most efficient implementations of interpreter and compiler
1.12 pazsan 429: | : interpreter ( c-addr u -- )
1.1 pazsan 430: 2dup find-name dup
431: if
432: nip nip name>int execute
433: else
434: drop
435: 2dup 2>r snumber?
436: IF
437: 2rdrop
438: ELSE
439: 2r> interpreter-notfound
440: THEN
441: then ;
442:
443: ' interpreter IS parser
444:
445: \ \ Query Evaluate 07apr93py
446:
447: has? file 0= [IF]
1.12 pazsan 448: : sourceline# ( -- n ) 1 ;
1.1 pazsan 449: [THEN]
450:
451: : refill ( -- flag ) \ core-ext,block-ext,file-ext
1.12 pazsan 452: [ has? file [IF] ]
453: blk @ IF 1 blk +! true 0 >in ! EXIT THEN
454: [ [THEN] ]
455: tib /line
456: [ has? file [IF] ]
457: loadfile @ ?dup
458: IF read-line throw
459: ELSE
460: [ [THEN] ]
461: sourceline# 0< IF 2drop false EXIT THEN
462: accept true
463: [ has? file [IF] ]
464: THEN
465: 1 loadline +!
466: [ [THEN] ]
467: swap #tib ! 0 >in ! ;
1.1 pazsan 468:
469: : query ( -- ) \ core-ext
470: \G obsolescent
1.12 pazsan 471: [ has? file [IF] ]
472: blk off loadfile off
473: [ [THEN] ]
1.1 pazsan 474: tib /line accept #tib ! 0 >in ! ;
475:
476: \ save-mem extend-mem
477:
478: has? os [IF]
479: : save-mem ( addr1 u -- addr2 u ) \ gforth
480: \g copy a memory block into a newly allocated region in the heap
481: swap >r
482: dup allocate throw
483: swap 2dup r> -rot move ;
484:
485: : extend-mem ( addr1 u1 u -- addr addr2 u2 )
486: \ extend memory block allocated from the heap by u aus
487: \ the (possibly reallocated piece is addr2 u2, the extension is at addr
488: over >r + dup >r resize throw
489: r> over r> + -rot ;
490: [THEN]
491:
492: \ EVALUATE 17may93jaw
493:
494: has? file 0= [IF]
495: : push-file ( -- ) r>
1.12 pazsan 496: tibstack @ >r >tib @ >r #tib @ >r
1.1 pazsan 497: >tib @ tibstack @ = IF r@ tibstack +! THEN
498: tibstack @ >tib ! >in @ >r >r ;
499:
500: : pop-file ( throw-code -- throw-code )
501: r>
1.12 pazsan 502: r> >in ! r> #tib ! r> >tib ! r> tibstack ! >r ;
1.1 pazsan 503: [THEN]
504:
505: : evaluate ( c-addr len -- ) \ core,block
506: push-file #tib ! >tib !
1.12 pazsan 507: >in off
508: [ has? file [IF] ]
509: blk off loadfile off -1 loadline !
510: [ [THEN] ]
1.1 pazsan 511: ['] interpret catch
512: pop-file throw ;
513:
514: \ \ Quit 13feb93py
515:
516: Defer 'quit
517:
518: Defer .status
519:
520: : prompt state @ IF ." compiled" EXIT THEN ." ok" ;
521:
522: : (Query) ( -- )
1.12 pazsan 523: [ has? file [IF] ]
524: loadfile off blk off loadline off
525: [ [THEN] ]
526: refill drop ;
1.1 pazsan 527:
528: : (quit) BEGIN .status cr (query) interpret prompt AGAIN ;
529:
530: ' (quit) IS 'quit
531:
532: \ \ DOERROR (DOERROR) 13jun93jaw
533:
534: 8 Constant max-errors
535: Variable error-stack 0 error-stack !
536: max-errors 6 * cells allot
537: \ format of one cell:
538: \ source ( addr u )
539: \ >in
540: \ line-number
541: \ Loadfilename ( addr u )
542:
543: : dec. ( n -- ) \ gforth
1.17 crook 544: \G Display n as a signed decimal number, followed by a space.
1.1 pazsan 545: base @ decimal swap . base ! ;
546:
547: : hex. ( u -- ) \ gforth
1.17 crook 548: \G Display u as an unsigned hex number, prefixed with a "$" and
549: \G followed by a space.
1.1 pazsan 550: '$ emit base @ swap hex u. base ! ;
551:
552: : typewhite ( addr u -- ) \ gforth
553: \ like type, but white space is printed instead of the characters
554: bounds ?do
555: i c@ #tab = if \ check for tab
556: #tab
557: else
558: bl
559: then
560: emit
561: loop ;
562:
563: DEFER DOERROR
1.15 anton 564: Defer dobacktrace ( -- )
565: ' noop IS dobacktrace
1.1 pazsan 566:
567: : .error-frame ( addr1 u1 n1 n2 addr2 u2 -- )
568: cr error-stack @
569: IF
570: ." in file included from "
571: type ." :" dec. drop 2drop
572: ELSE
573: type ." :" dec.
574: cr dup 2over type cr drop
575: nip -trailing 1- ( line-start index2 )
576: 0 >r BEGIN
577: 2dup + c@ bl > WHILE
578: r> 1+ >r 1- dup 0< UNTIL THEN 1+
579: ( line-start index1 )
580: typewhite
581: r> 1 max 0 ?do \ we want at least one "^", even if the length is 0
582: [char] ^ emit
583: loop
584: THEN
585: ;
586:
587: : (DoError) ( throw-code -- )
588: [ has? os [IF] ]
1.8 pazsan 589: >stderr
1.1 pazsan 590: [ [THEN] ]
591: sourceline# IF
1.8 pazsan 592: source >in @ sourceline# 0 0 .error-frame
1.1 pazsan 593: THEN
594: error-stack @ 0 ?DO
595: -1 error-stack +!
596: error-stack dup @ 6 * cells + cell+
597: 6 cells bounds DO
598: I @
599: cell +LOOP
600: .error-frame
601: LOOP
602: dup -2 =
603: IF
604: "error @ ?dup
605: IF
606: cr count type
607: THEN
608: drop
609: ELSE
610: .error
611: THEN
1.15 anton 612: dobacktrace
1.8 pazsan 613: normal-dp dpp ! ;
1.1 pazsan 614:
615: ' (DoError) IS DoError
616:
617: : quit ( ?? -- ?? ) \ core
1.5 anton 618: rp0 @ rp! handler off clear-tibstack >tib @ >r
1.1 pazsan 619: BEGIN
620: [ has? compiler [IF] ]
621: postpone [
622: [ [THEN] ]
623: ['] 'quit CATCH dup
624: WHILE
625: DoError r@ >tib ! r@ tibstack !
626: REPEAT
627: drop r> >tib ! ;
628:
629: \ \ Cold Boot 13feb93py
630:
631: : (bootmessage)
632: ." GForth " version-string type
1.11 anton 633: ." , Copyright (C) 1998 Free Software Foundation, Inc." cr
1.1 pazsan 634: ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
635: [ has? os [IF] ]
636: cr ." Type `bye' to exit"
637: [ [THEN] ] ;
638:
639: defer bootmessage
640: defer process-args
641:
642: ' (bootmessage) IS bootmessage
643:
1.10 anton 644: Defer 'cold ( -- ) \ gforth tick-cold
1.1 pazsan 645: \ hook (deferred word) for things to do right before interpreting the
646: \ command-line arguments
647: ' noop IS 'cold
648:
1.2 anton 649: include ../chains.fs
1.1 pazsan 650:
651: Variable init8
652:
653: : cold ( -- ) \ gforth
654: [ has? file [IF] ]
655: pathstring 2@ fpath only-path
656: init-included-files
657: [ [THEN] ]
658: 'cold
659: init8 chainperform
660: [ has? file [IF] ]
1.8 pazsan 661: process-args
1.12 pazsan 662: loadline off
1.1 pazsan 663: [ [THEN] ]
664: bootmessage
1.12 pazsan 665: quit ;
1.1 pazsan 666:
1.5 anton 667: : clear-tibstack ( -- )
668: [ has? glocals [IF] ]
669: lp@ forthstart 7 cells + @ -
670: [ [ELSE] ]
671: [ has? os [IF] ]
1.8 pazsan 672: r0 @ forthstart 6 cells + @ -
1.5 anton 673: [ [ELSE] ]
1.16 pazsan 674: sp@ $10 cells +
1.5 anton 675: [ [THEN] ]
676: [ [THEN] ]
677: dup >tib ! tibstack ! #tib off >in off ;
678:
1.1 pazsan 679: : boot ( path **argv argc -- )
680: main-task up!
681: [ has? os [IF] ]
682: stdout TO outfile-id
1.7 pazsan 683: stdin TO infile-id
1.1 pazsan 684: \ !! [ [THEN] ]
685: \ !! [ has? file [IF] ]
686: argc ! argv ! pathstring 2!
687: [ [THEN] ]
688: sp@ sp0 !
1.5 anton 689: clear-tibstack
1.1 pazsan 690: rp@ rp0 !
691: [ has? floating [IF] ]
692: fp@ fp0 !
693: [ [THEN] ]
1.8 pazsan 694: ['] cold catch DoError cr
1.1 pazsan 695: [ has? os [IF] ]
696: bye
697: [ [THEN] ]
698: ;
699:
700: has? os [IF]
701: : bye ( -- ) \ tools-ext
702: [ has? file [IF] ]
703: script? 0= IF cr THEN
704: [ [ELSE] ]
705: cr
706: [ [THEN] ]
707: 0 (bye) ;
708: [THEN]
709:
710: \ **argv may be scanned by the C starter to get some important
711: \ information, as -display and -geometry for an X client FORTH
712: \ or space and stackspace overrides
713:
714: \ 0 arg contains, however, the name of the program.
715:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>