[BACK]Return to int.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / kernel

Diff for /gforth/kernel/int.fs between versions 1.22 and 1.23

version 1.22, 1999/02/21 14:55:44 version 1.23, 1999/02/24 11:54:39
Line 542  max-errors 6 * cells allot Line 542  max-errors 6 * cells allot
   
 : dec. ( n -- ) \ gforth  : dec. ( n -- ) \ gforth
     \G Display n as a signed decimal number, followed by a space.      \G Display n as a signed decimal number, followed by a space.
       \G !! not used...
     base @ decimal swap . base ! ;      base @ decimal swap . base ! ;
   
   : dec.r ( u -- ) \ gforth
       \G Display u as a unsigned decimal number
       base @ decimal swap 0 .r base ! ;
   
 : hex. ( u -- ) \ gforth  : hex. ( u -- ) \ gforth
     \G Display u as an unsigned hex number, prefixed with a "$" and      \G Display u as an unsigned hex number, prefixed with a "$" and
     \G followed by a space.      \G followed by a space.
       \G !! not used...
     '$ emit base @ swap hex u. base ! ;      '$ emit base @ swap hex u. base ! ;
   
 : typewhite ( addr u -- ) \ gforth  : typewhite ( addr u -- ) \ gforth
Line 564  DEFER DOERROR Line 570  DEFER DOERROR
 Defer dobacktrace ( -- )  Defer dobacktrace ( -- )
 ' noop IS dobacktrace  ' noop IS dobacktrace
   
 : .error-frame ( addr1 u1 n1 n2 addr2 u2 -- )  : .error-string ( throw-code -- )
     dup -2 = 
     IF    "error @ ?dup IF count type  THEN drop
     ELSE  .error
     THEN ;
   
   : .error-frame ( throwcode addr1 u1 n1 n2 addr2 u2 -- throwcode )
   \ addr2 u2:     filename of included file
   \ n2:           line number
   \ n1:           error position in input line
   \ addr1 u1:     input line
   
   cr error-stack @    cr error-stack @
   IF    IF
      ." in file included from "       ." in file included from "
      type ." :" dec.  drop 2drop       type ." :" dec.r  drop 2drop
   ELSE    ELSE
      type ." :" dec.       type ." :" dec.r ." : " 3 pick .error-string cr
      cr dup 2over type cr drop       dup 2over type cr drop
      nip -trailing 1- ( line-start index2 )       nip -trailing 1- ( line-start index2 )
      0 >r  BEGIN       0 >r  BEGIN
                   2dup + c@ bl >  WHILE                    2dup + c@ bl >  WHILE
Line 581  Defer dobacktrace ( -- ) Line 598  Defer dobacktrace ( -- )
      r> 1 max 0 ?do \ we want at least one "^", even if the length is 0       r> 1 max 0 ?do \ we want at least one "^", even if the length is 0
                   [char] ^ emit                    [char] ^ emit
      loop       loop
   THEN    THEN ;
 ;  
   
 : (DoError) ( throw-code -- )  : (DoError) ( throw-code -- )
   [ has? os [IF] ]    [ has? os [IF] ]
Line 599  Defer dobacktrace ( -- ) Line 615  Defer dobacktrace ( -- )
     cell +LOOP      cell +LOOP
     .error-frame      .error-frame
   LOOP    LOOP
   dup -2 =    cr ." Error: " .error-string
   IF   
      "error @ ?dup  
      IF  
         cr count type   
      THEN  
      drop  
   ELSE  
      .error  
   THEN  
   dobacktrace    dobacktrace
   normal-dp dpp ! ;    normal-dp dpp ! ;
   
Removed from v.1.22  
changed lines
  Added in v.1.23

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