gforth/kernel/int.fs - diff

Return to int.fs CVS log

Up to [gforth] / gforth / kernel

Diff for /gforth/kernel/int.fs between versions 1.63 and 1.64

version 1.63, 2000/09/23 15:47:10	version 1.64, 2000/10/29 20:27:03
Line 31 require ./errore.fs \ .error ...	Line 31 require ./errore.fs \ .error ...
require kernel/version.fs \ version-string	require kernel/version.fs \ version-string
require ./../chains.fs	require ./../chains.fs

	has? new-input 0= [IF]
: tib ( -- c-addr ) \ core-ext t-i-b	: tib ( -- c-addr ) \ core-ext t-i-b
\G @i{c-addr} is the address of the Terminal Input Buffer.	\G @i{c-addr} is the address of the Terminal Input Buffer.
\G OBSOLESCENT: @code{source} superceeds the function of this word.	\G OBSOLESCENT: @code{source} superceeds the function of this word.
Line 44 Defer source ( -- c-addr u ) \ core	Line 45 Defer source ( -- c-addr u ) \ core
: (source) ( -- c-addr u )	: (source) ( -- c-addr u )
tib #tib @ ;	tib #tib @ ;
' (source) IS source	' (source) IS source
	[THEN]

: (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 518 Defer interpreter-notfound ( c-addr coun	Line 520 Defer interpreter-notfound ( c-addr coun
has? file 0= [IF]	has? file 0= [IF]
: sourceline# ( -- n ) 1 ;	: sourceline# ( -- n ) 1 ;
[ELSE]	[ELSE]
	has? new-input 0= [IF]
Variable #fill-bytes	Variable #fill-bytes
\G number of bytes read via (read-line) by the last refill	\G number of bytes read via (read-line) by the last refill
[THEN]	[THEN]
	[THEN]

	has? new-input 0= [IF]
: refill ( -- flag ) \ core-ext,block-ext,file-ext	: refill ( -- flag ) \ core-ext,block-ext,file-ext
\G Attempt to fill the input buffer from the input source. When	\G Attempt to fill the input buffer from the input source. When
\G the input source is the user input device, attempt to receive	\G the input source is the user input device, attempt to receive
Line 560 Variable #fill-bytes	Line 565 Variable #fill-bytes
[ has? file [IF] ]	[ has? file [IF] ]
blk off loadfile off	blk off loadfile off
[ [THEN] ]	[ [THEN] ]
tib /line accept #tib ! 0 >in ! ;	refill drop ;
	[THEN]

\ save-mem extend-mem	\ save-mem extend-mem

Line 580 has? os [IF]	Line 586 has? os [IF]

\ EVALUATE 17may93jaw	\ EVALUATE 17may93jaw

has? file 0= [IF]	has? file 0= has? new-input 0= and [IF]
: push-file ( -- ) r>	: push-file ( -- ) r>
tibstack @ >r >tib @ >r #tib @ >r	tibstack @ >r >tib @ >r #tib @ >r
>tib @ tibstack @ = IF r@ tibstack +! THEN	>tib @ tibstack @ = IF r@ tibstack +! THEN
Line 591 has? file 0= [IF]	Line 597 has? file 0= [IF]
r> >in ! r> #tib ! r> >tib ! r> tibstack ! >r ;	r> >in ! r> #tib ! r> >tib ! r> tibstack ! >r ;
[THEN]	[THEN]

	has? new-input 0= [IF]
: evaluate ( c-addr u -- ) \ core,block	: evaluate ( c-addr u -- ) \ core,block
\G Save the current input source specification. Store @code{-1} in	\G Save the current input source specification. Store @code{-1} in
\G @code{source-id} and @code{0} in @code{blk}. Set @code{>IN} to	\G @code{source-id} and @code{0} in @code{blk}. Set @code{>IN} to
\G @code{0} and make the string @i{c-addr u} the input source	\G @code{0} and make the string @i{c-addr u} the input source
\G and input buffer. Interpret. When the parse area is empty,	\G and input buffer. Interpret. When the parse area is empty,
\G restore the input source specification.	\G restore the input source specification.
	[ has? file [IF] ]
loadfilename# @ >r	loadfilename# @ >r
1 loadfilename# ! \ "evaluated string"	1 loadfilename# ! \ "evaluated string"
	[ [THEN] ]
push-file #tib ! >tib !	push-file #tib ! >tib !
>in off	>in off
[ has? file [IF] ]	[ has? file [IF] ]
Line 606 has? file 0= [IF]	Line 615 has? file 0= [IF]
[ [THEN] ]	[ [THEN] ]
['] interpret catch	['] interpret catch
pop-file	pop-file
	[ has? file [IF] ]
r> loadfilename# !	r> loadfilename# !
	[ [THEN] ]
throw ;	throw ;
	[THEN]

\ \ Quit 13feb93py	\ \ Quit 13feb93py

Line 617 Defer .status	Line 629 Defer .status

: prompt state @ IF ." compiled" EXIT THEN ." ok" ;	: prompt state @ IF ." compiled" EXIT THEN ." ok" ;

: (Query) ( -- )
[ has? file [IF] ]
loadfile off blk off loadline off
[ [THEN] ]
refill drop ;

: (quit) ( -- )	: (quit) ( -- )
\ exits only through THROW etc.	\ exits only through THROW etc.
\ sp0 @ cell - handler @ &12 + ! \ !! kludge: fix the stack pointer	\ sp0 @ cell - handler @ &12 + ! \ !! kludge: fix the stack pointer
Line 630 Defer .status	Line 636 Defer .status
\ after the next THROW it catches (it may be off due to BOUNCEs or	\ after the next THROW it catches (it may be off due to BOUNCEs or
\ because process-args left something on the stack)	\ because process-args left something on the stack)
BEGIN	BEGIN
.status cr (query) interpret prompt	.status cr query interpret prompt
AGAIN ;	AGAIN ;

' (quit) IS 'quit	' (quit) IS 'quit
Line 639 Defer .status	Line 645 Defer .status

8 Constant max-errors	8 Constant max-errors
Variable error-stack 0 error-stack !	Variable error-stack 0 error-stack !
max-errors 6 * cells allot	max-errors has? file [IF] 6 [ELSE] 4 [THEN] * cells allot
\ format of one cell:	\ format of one cell:
\ source ( addr u )	\ source ( addr u )
\ >in	\ >in
\ line-number	\ line-number
\ Loadfilename ( addr u )	\ Loadfilename ( addr u )

	: error> ( -- addr u >in line# [addr u] )
	-1 error-stack +!
	error-stack dup @
	[ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal * cells + cell+
	[ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal cells bounds DO
	I @
	cell +LOOP ;
	: >error ( addr u >in line# [addr u] -- )
	error-stack dup @ dup 1+
	max-errors 1- min error-stack !
	[ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal * cells + cell+
	[ has? file [IF] 6 [ELSE] 4 [THEN] 1- ] Literal cells bounds swap DO
	I !
	-1 cells +LOOP ;

: dec. ( n -- ) \ gforth	: dec. ( n -- ) \ gforth
\G Display @i{n} as a signed decimal number, followed by a space.	\G Display @i{n} as a signed decimal number, followed by a space.
\ !! not used...	\ !! not used...
Line 685 Defer dobacktrace ( -- )	Line 706 Defer dobacktrace ( -- )
ELSE .error	ELSE .error
THEN ;	THEN ;

: .error-frame ( throwcode addr1 u1 n1 n2 addr2 u2 -- throwcode )	: .error-frame ( throwcode addr1 u1 n1 n2 [addr2 u2] -- throwcode )
\ addr2 u2: filename of included file	\ addr2 u2: filename of included file - optional
\ n2: line number	\ n2: line number
\ n1: error position in input line	\ n1: error position in input line
\ addr1 u1: input line	\ addr1 u1: input line
cr error-stack @	cr error-stack @
IF	IF
." in file included from "	[ has? file [IF] ]
type ." :" dec.r drop 2drop	." in file included from "
	type ." :"
	[ [THEN] ]
	dec.r drop 2drop
ELSE	ELSE
type ." :" dup >r dec.r ." : " 3 pick .error-string	[ has? file [IF] ]
	type ." :"
	[ [THEN] ]
	dup >r dec.r ." : " 3 pick .error-string
r> IF \ if line# non-zero, there is a line	r> IF \ if line# non-zero, there is a line
cr dup 2over type cr drop	cr dup 2over type cr drop
nip -trailing 1- ( line-start index2 )	nip -trailing 1- ( line-start index2 )
Line 716 Defer dobacktrace ( -- )	Line 743 Defer dobacktrace ( -- )
[ has? os [IF] ]	[ has? os [IF] ]
>stderr	>stderr
[ [THEN] ]	[ [THEN] ]
source >in @ sourceline# sourcefilename .error-frame	source >in @ sourceline# [ has? file [IF] ]
	sourcefilename
	[ [THEN] ] .error-frame
error-stack @ 0 ?DO	error-stack @ 0 ?DO
-1 error-stack +!	error>
error-stack dup @ 6 * cells + cell+
6 cells bounds DO
I @
cell +LOOP
.error-frame	.error-frame
LOOP	LOOP
drop	drop
Line 737 Defer dobacktrace ( -- )	Line 762 Defer dobacktrace ( -- )
\G Empty the return stack, make the user input device	\G Empty the return stack, make the user input device
\G the input source, enter interpret state and start	\G the input source, enter interpret state and start
\G the text interpreter.	\G the text interpreter.
rp0 @ rp! handler off clear-tibstack >tib @ >r	rp0 @ rp! handler off clear-tibstack
	[ has? new-input 0= [IF] ] >tib @ >r [ [THEN] ]
BEGIN	BEGIN
[ has? compiler [IF] ]	[ has? compiler [IF] ]
postpone [	postpone [
Line 745 Defer dobacktrace ( -- )	Line 771 Defer dobacktrace ( -- )
['] 'quit CATCH dup	['] 'quit CATCH dup
WHILE	WHILE
<# \ reset hold area, or we may get another error	<# \ reset hold area, or we may get another error
DoError r@ >tib ! r@ tibstack !	DoError
	[ has? new-input [IF] ] clear-tibstack
	[ [ELSE] ] r@ >tib ! r@ tibstack !
	[ [THEN] ]
REPEAT	REPEAT
drop r> >tib ! ;	drop [ has? new-input [IF] ] clear-tibstack
	[ [ELSE] ] r> >tib !
	[ [THEN] ] ;

\ \ Cold Boot 13feb93py	\ \ Cold Boot 13feb93py

Line 790 Variable init8	Line 821 Variable init8
bootmessage	bootmessage
quit ;	quit ;

	has? new-input 0= [IF]
: clear-tibstack ( -- )	: clear-tibstack ( -- )
[ has? glocals [IF] ]	[ has? glocals [IF] ]
lp@ forthstart 7 cells + @ -	lp@ forthstart 7 cells + @ -
Line 801 Variable init8	Line 833 Variable init8
[ [THEN] ]	[ [THEN] ]
[ [THEN] ]	[ [THEN] ]
dup >tib ! tibstack ! #tib off >in off ;	dup >tib ! tibstack ! #tib off >in off ;
	[THEN]

: boot ( path **argv argc -- )	: boot ( path n **argv argc -- )
main-task up!	main-task up!
[ has? os [IF] ]	[ has? os [IF] ]
stdout TO outfile-id	stdout TO outfile-id
Line 812 Variable init8	Line 845 Variable init8
argc ! argv ! pathstring 2!	argc ! argv ! pathstring 2!
[ [THEN] ]	[ [THEN] ]
sp@ sp0 !	sp@ sp0 !
	[ has? new-input [IF] ]
	current-input off
	[ [THEN] ]
clear-tibstack	clear-tibstack
rp@ rp0 !	rp@ rp0 !
[ has? floating [IF] ]	[ has? floating [IF] ]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.63
changed lines
	Added in v.1.64