Annotation of gforth/kernel/int.fs, revision 1.26
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
1.24 anton 419: rp@ backtrace-rp0 !
1.1 pazsan 420: BEGIN
421: ?stack name dup
422: WHILE
423: parser
424: REPEAT
425: 2drop ;
426:
427: \ interpreter 30apr92py
428:
429: \ not the most efficient implementations of interpreter and compiler
1.12 pazsan 430: | : interpreter ( c-addr u -- )
1.1 pazsan 431: 2dup find-name dup
432: if
433: nip nip name>int execute
434: else
435: drop
436: 2dup 2>r snumber?
437: IF
438: 2rdrop
439: ELSE
440: 2r> interpreter-notfound
441: THEN
442: then ;
443:
444: ' interpreter IS parser
445:
446: \ \ Query Evaluate 07apr93py
447:
448: has? file 0= [IF]
1.12 pazsan 449: : sourceline# ( -- n ) 1 ;
1.1 pazsan 450: [THEN]
451:
452: : refill ( -- flag ) \ core-ext,block-ext,file-ext
1.12 pazsan 453: [ has? file [IF] ]
454: blk @ IF 1 blk +! true 0 >in ! EXIT THEN
455: [ [THEN] ]
456: tib /line
457: [ has? file [IF] ]
458: loadfile @ ?dup
459: IF read-line throw
460: ELSE
461: [ [THEN] ]
462: sourceline# 0< IF 2drop false EXIT THEN
463: accept true
464: [ has? file [IF] ]
465: THEN
466: 1 loadline +!
467: [ [THEN] ]
468: swap #tib ! 0 >in ! ;
1.1 pazsan 469:
470: : query ( -- ) \ core-ext
471: \G obsolescent
1.12 pazsan 472: [ has? file [IF] ]
473: blk off loadfile off
474: [ [THEN] ]
1.1 pazsan 475: tib /line accept #tib ! 0 >in ! ;
476:
477: \ save-mem extend-mem
478:
479: has? os [IF]
480: : save-mem ( addr1 u -- addr2 u ) \ gforth
481: \g copy a memory block into a newly allocated region in the heap
482: swap >r
483: dup allocate throw
484: swap 2dup r> -rot move ;
485:
486: : extend-mem ( addr1 u1 u -- addr addr2 u2 )
487: \ extend memory block allocated from the heap by u aus
488: \ the (possibly reallocated piece is addr2 u2, the extension is at addr
489: over >r + dup >r resize throw
490: r> over r> + -rot ;
491: [THEN]
492:
493: \ EVALUATE 17may93jaw
494:
495: has? file 0= [IF]
496: : push-file ( -- ) r>
1.12 pazsan 497: tibstack @ >r >tib @ >r #tib @ >r
1.1 pazsan 498: >tib @ tibstack @ = IF r@ tibstack +! THEN
499: tibstack @ >tib ! >in @ >r >r ;
500:
501: : pop-file ( throw-code -- throw-code )
502: r>
1.12 pazsan 503: r> >in ! r> #tib ! r> >tib ! r> tibstack ! >r ;
1.1 pazsan 504: [THEN]
505:
506: : evaluate ( c-addr len -- ) \ core,block
507: push-file #tib ! >tib !
1.12 pazsan 508: >in off
509: [ has? file [IF] ]
510: blk off loadfile off -1 loadline !
511: [ [THEN] ]
1.1 pazsan 512: ['] interpret catch
513: pop-file throw ;
514:
515: \ \ Quit 13feb93py
516:
517: Defer 'quit
518:
519: Defer .status
520:
521: : prompt state @ IF ." compiled" EXIT THEN ." ok" ;
522:
523: : (Query) ( -- )
1.12 pazsan 524: [ has? file [IF] ]
525: loadfile off blk off loadline off
526: [ [THEN] ]
527: refill drop ;
1.1 pazsan 528:
529: : (quit) BEGIN .status cr (query) interpret prompt AGAIN ;
530:
531: ' (quit) IS 'quit
532:
533: \ \ DOERROR (DOERROR) 13jun93jaw
534:
535: 8 Constant max-errors
536: Variable error-stack 0 error-stack !
537: max-errors 6 * cells allot
538: \ format of one cell:
539: \ source ( addr u )
540: \ >in
541: \ line-number
542: \ Loadfilename ( addr u )
543:
544: : dec. ( n -- ) \ gforth
1.17 crook 545: \G Display n as a signed decimal number, followed by a space.
1.23 jwilke 546: \G !! not used...
1.1 pazsan 547: base @ decimal swap . base ! ;
548:
1.23 jwilke 549: : dec.r ( u -- ) \ gforth
550: \G Display u as a unsigned decimal number
551: base @ decimal swap 0 .r base ! ;
552:
1.1 pazsan 553: : hex. ( u -- ) \ gforth
1.17 crook 554: \G Display u as an unsigned hex number, prefixed with a "$" and
555: \G followed by a space.
1.23 jwilke 556: \G !! not used...
1.1 pazsan 557: '$ emit base @ swap hex u. base ! ;
558:
559: : typewhite ( addr u -- ) \ gforth
560: \ like type, but white space is printed instead of the characters
561: bounds ?do
562: i c@ #tab = if \ check for tab
563: #tab
564: else
565: bl
566: then
567: emit
568: loop ;
569:
570: DEFER DOERROR
1.15 anton 571: Defer dobacktrace ( -- )
572: ' noop IS dobacktrace
1.1 pazsan 573:
1.23 jwilke 574: : .error-string ( throw-code -- )
575: dup -2 =
576: IF "error @ ?dup IF count type THEN drop
577: ELSE .error
578: THEN ;
579:
580: : .error-frame ( throwcode addr1 u1 n1 n2 addr2 u2 -- throwcode )
581: \ addr2 u2: filename of included file
582: \ n2: line number
583: \ n1: error position in input line
584: \ addr1 u1: input line
585:
1.1 pazsan 586: cr error-stack @
587: IF
588: ." in file included from "
1.23 jwilke 589: type ." :" dec.r drop 2drop
1.1 pazsan 590: ELSE
1.23 jwilke 591: type ." :" dec.r ." : " 3 pick .error-string cr
592: dup 2over type cr drop
1.1 pazsan 593: nip -trailing 1- ( line-start index2 )
594: 0 >r BEGIN
595: 2dup + c@ bl > WHILE
596: r> 1+ >r 1- dup 0< UNTIL THEN 1+
597: ( line-start index1 )
598: typewhite
599: r> 1 max 0 ?do \ we want at least one "^", even if the length is 0
600: [char] ^ emit
601: loop
1.23 jwilke 602: THEN ;
1.1 pazsan 603:
604: : (DoError) ( throw-code -- )
605: [ has? os [IF] ]
1.8 pazsan 606: >stderr
1.1 pazsan 607: [ [THEN] ]
608: sourceline# IF
1.8 pazsan 609: source >in @ sourceline# 0 0 .error-frame
1.1 pazsan 610: THEN
611: error-stack @ 0 ?DO
612: -1 error-stack +!
613: error-stack dup @ 6 * cells + cell+
614: 6 cells bounds DO
615: I @
616: cell +LOOP
617: .error-frame
618: LOOP
1.26 ! anton 619: drop dobacktrace
1.8 pazsan 620: normal-dp dpp ! ;
1.1 pazsan 621:
622: ' (DoError) IS DoError
623:
624: : quit ( ?? -- ?? ) \ core
1.5 anton 625: rp0 @ rp! handler off clear-tibstack >tib @ >r
1.1 pazsan 626: BEGIN
627: [ has? compiler [IF] ]
628: postpone [
629: [ [THEN] ]
630: ['] 'quit CATCH dup
631: WHILE
1.22 anton 632: <# \ reset hold area, or we may get another error
1.1 pazsan 633: DoError r@ >tib ! r@ tibstack !
634: REPEAT
635: drop r> >tib ! ;
636:
637: \ \ Cold Boot 13feb93py
638:
639: : (bootmessage)
640: ." GForth " version-string type
1.11 anton 641: ." , Copyright (C) 1998 Free Software Foundation, Inc." cr
1.1 pazsan 642: ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
643: [ has? os [IF] ]
644: cr ." Type `bye' to exit"
645: [ [THEN] ] ;
646:
647: defer bootmessage
648: defer process-args
649:
650: ' (bootmessage) IS bootmessage
651:
1.10 anton 652: Defer 'cold ( -- ) \ gforth tick-cold
1.1 pazsan 653: \ hook (deferred word) for things to do right before interpreting the
654: \ command-line arguments
655: ' noop IS 'cold
656:
1.2 anton 657: include ../chains.fs
1.1 pazsan 658:
659: Variable init8
660:
661: : cold ( -- ) \ gforth
662: [ has? file [IF] ]
663: pathstring 2@ fpath only-path
664: init-included-files
665: [ [THEN] ]
666: 'cold
667: init8 chainperform
668: [ has? file [IF] ]
1.8 pazsan 669: process-args
1.12 pazsan 670: loadline off
1.1 pazsan 671: [ [THEN] ]
672: bootmessage
1.12 pazsan 673: quit ;
1.1 pazsan 674:
1.5 anton 675: : clear-tibstack ( -- )
676: [ has? glocals [IF] ]
677: lp@ forthstart 7 cells + @ -
678: [ [ELSE] ]
679: [ has? os [IF] ]
1.8 pazsan 680: r0 @ forthstart 6 cells + @ -
1.5 anton 681: [ [ELSE] ]
1.16 pazsan 682: sp@ $10 cells +
1.5 anton 683: [ [THEN] ]
684: [ [THEN] ]
685: dup >tib ! tibstack ! #tib off >in off ;
686:
1.1 pazsan 687: : boot ( path **argv argc -- )
688: main-task up!
689: [ has? os [IF] ]
690: stdout TO outfile-id
1.7 pazsan 691: stdin TO infile-id
1.1 pazsan 692: \ !! [ [THEN] ]
693: \ !! [ has? file [IF] ]
694: argc ! argv ! pathstring 2!
695: [ [THEN] ]
696: sp@ sp0 !
1.5 anton 697: clear-tibstack
1.1 pazsan 698: rp@ rp0 !
699: [ has? floating [IF] ]
700: fp@ fp0 !
701: [ [THEN] ]
1.8 pazsan 702: ['] cold catch DoError cr
1.1 pazsan 703: [ has? os [IF] ]
704: bye
705: [ [THEN] ]
706: ;
707:
708: has? os [IF]
709: : bye ( -- ) \ tools-ext
710: [ has? file [IF] ]
711: script? 0= IF cr THEN
712: [ [ELSE] ]
713: cr
714: [ [THEN] ]
715: 0 (bye) ;
716: [THEN]
717:
718: \ **argv may be scanned by the C starter to get some important
719: \ information, as -display and -geometry for an X client FORTH
720: \ or space and stackspace overrides
721:
722: \ 0 arg contains, however, the name of the program.
723:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to int.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / kernel