Commit 0f194b67 authored by Anton Ertl's avatar Anton Ertl
Browse files

gforth-ditc is now installed with "make install" 

bugfix in print-backtrace
rewrote number output: now uses a fixed buffer HOLDBUF; added <<# and
	#>> to deal with nested number output (e.g., AT-XY), and fixed
	ud.r and d.r (and thus all the "." words) and DUMP to use
	them.  Other words using <# still have to be fixed.
removed COMPACT// and its use; it did not work, and anyway, it's a bad
	idea for Cygwin, Domain/OS (Apollo's OS), and possibly other OSs.
parent abc0df93

Makefile.in

+2 −1
Original line number Diff line number Diff line
@@ -436,12 +436,13 @@ binonlydist: Makedist FORCE 
install:	gforth$(EXE) $(FORTH_SRC) $(kernel_fi) gforth.fi gforthmi doc/gforth.1 prim install.TAGS installdirs

		touch $(siteforthdir)/siteinit.fs

		-$(RM) $(bindir)/gforth$(EXE) $(bindir)/gforth-$(VERSION)$(EXE) $(bindir)/gforthmi

		-$(RM) $(bindir)/gforth-fast$(EXE) $(bindir)/gforth-fast-$(VERSION)$(EXE) $(bindir)/gforthmi

		-$(RM) $(bindir)/gforth-fast$(EXE) $(bindir)/gforth-fast-$(VERSION)$(EXE)

		$(INSTALL_PROGRAM) -s gforth$(EXE) $(bindir)/gforth-$(VERSION)$(EXE)

		$(LN_S) $(bindir)/gforth-$(VERSION)$(EXE) $(bindir)/gforth$(EXE)

		$(INSTALL_PROGRAM) -s gforth-fast$(EXE) $(bindir)/gforth-fast-$(VERSION)$(EXE)

		$(LN_S) $(bindir)/gforth-fast-$(VERSION)$(EXE) $(bindir)/gforth-fast$(EXE)

		$(INSTALL_PROGRAM) gforthmi $(bindir)/gforthmi-$(VERSION)

		$(INSTALL_PROGRAM) gforth-ditc $(libdir)/gforth/$(VERSION)

		$(LN_S) $(bindir)/gforthmi-$(VERSION) $(bindir)/gforthmi

		-$(INSTALL_DATA) $(srcdir)/doc/gforth.1 $(man1dir)

		-for i in $(srcdir)/doc/gforth.info*; do $(INSTALL_DATA) $$i $(infodir); done

backtrace.fs

+8 −2
Original line number Diff line number Diff line
@@ -83,8 +83,14 @@ IS store-backtrace 
    swap u+do

	cr

	i @ dup hex. ( return-addr? )

	cell - dup in-dictionary? if

	    @ look drop .name

	cell - dup in-dictionary? over dup aligned = and

	if

	    @ look

	    if

		.name

	    else

		drop

	    then

	else

	    drop

	then

kernel/int.fs

+1 −0
Original line number Diff line number Diff line
@@ -622,6 +622,7 @@ Defer dobacktrace ( -- ) 
	[ [THEN] ]

	['] 'quit CATCH dup

    WHILE

	<# \ reset hold area, or we may get another error

	DoError r@ >tib ! r@ tibstack !

    REPEAT

    drop r> >tib ! ;

kernel/nio.fs

+25 −5
Original line number Diff line number Diff line
@@ -26,18 +26,38 @@ 
: hold    ( char -- ) \ core

    \G Used within @code{<#} and @code{#>}. Append the character char

    \G to the pictured numeric output string.

    pad cell - -1 chars over +! @ c! ;

    -1 chars holdptr +!

    holdptr @ dup holdbuf u< -&17 and throw

    c! ;



: <# ( -- ) \ core	less-number-sign

    \G Initialise/clear the pictured numeric output string.

    pad cell - dup ! ;

    holdbuf-end holdptr ! ;



: #>      ( xd -- addr u ) \ core	number-sign-greater

    \G Complete the pictured numeric output string by

    \G discarding xd and returning addr u; the address and length

    \G of the formatted string. A Standard program may modify characters

    \G within the string.

    2drop pad cell - dup @ tuck - ;

    2drop holdptr @ holdbuf-end over - ;



: <<# ( -- addr ) \ gforth	less-less-number-sign

    \G starts a hold area that ends with @code{#>>}. Can be nested in

    \G each other and in @code{<#}.  Note: if you do not match up the

    \G @code{<<#}s with @code{#>>}s, you will eventually run out of

    \G hold area; you can reset the hold area to empty with @code{<#}.

    holdptr @ ;



: #>> ( xd addr1 -- addr u ) \ gforth	number-sign-greater-greater

    \G Completes a numeric output string started with

    \G @code{<<#}. @var{xd} is discarded, @var{addr1} is the value

    \G produced by @code{<<#}, @var{addr u} represents the output

    \G string.

    \ this stack effect has been chosen to make it conventient to

    \ replace @code{<# ... #>} with @code{<<# >r ... r> #>>}

    >r 2drop

    holdptr @ r@ over -

    r> holdptr ! ;



: sign    ( n -- ) \ core

    \G Used within @code{<#} and @code{#>}. If n (a @var{single} number)
@@ -75,13 +95,13 @@ 
    \G Display d right-aligned in a field n characters wide. If more than

    \G n characters are needed to display the number, all digits are displayed.

    \G If appropriate, n must include a character for a leading "-".

    >r tuck  dabs  <# #s  rot sign #>

    >r tuck  dabs  <<# >r #s  rot sign r> #>>

    r> over - spaces  type ;



: ud.r ( ud n -- ) \ gforth	u-d-dot-r

    \G Display ud right-aligned in a field n characters wide. If more than

    \G n characters are needed to display the number, all digits are displayed.

    >r <# #s #> r> over - spaces type ;

    >r <<# >r #s r> #>> r> over - spaces type ;



: .r ( n1 n2 -- ) \ core-ext	dot-r

    \G Display n1 right-aligned in a field n2 characters wide. If more than

kernel/paths.fs

+1 −14
Original line number Diff line number Diff line
@@ -157,19 +157,6 @@ Create tfile 0 c, 255 chars allot 
	ofile +place

    THEN ;



: compact// ( adr len -- adr2 len2 )

\ deletes phrases like "//" out of our directory name 2dec97jaw

  over >r

  BEGIN	dup WHILE

	over c@ pathsep? over 1- 0<> and

	IF over 1+ c@ pathsep?

	   IF 	1- over 1+ swap move

	   THEN

	THEN

	1 /string

   REPEAT 

   drop r> tuck - ;



: compact.. ( adr len -- adr2 len2 )

\ deletes phrases like "xy/.." out of our directory name 2dec97jaw

  over >r -1 >r
@@ -195,7 +182,7 @@ Create tfile 0 c, 255 chars allot 


: reworkdir ( -- )

  remove~+

  ofile count compact// compact..

  ofile count compact..

  nip ofile c! ;



: open-ofile ( -- fid ior )