[gforth] / gforth / kernel / int.fs  

gforth: gforth/kernel/int.fs

Diff for /gforth/kernel/int.fs between version 1.111 and 1.112

version 1.111, Tue Dec 28 19:51:44 2004 UTC version 1.112, Tue Dec 28 21:09:47 2004 UTC
Line 790 
Line 790 
 \ \ DOERROR (DOERROR)                                   13jun93jaw  \ \ DOERROR (DOERROR)                                   13jun93jaw
   
 8 Constant max-errors  8 Constant max-errors
   4 has? file 2 and + Constant /error
 Variable error-stack  0 error-stack !  Variable error-stack  0 error-stack !
 max-errors has? file [IF] 6 [ELSE] 4 [THEN] * cells allot  max-errors /error * cells allot
 \ format of one cell:  \ format of one cell:
 \ source ( addr u )  \ source ( addr u )
 \ >in  \ >in
Line 801 
Line 802 
 : error> ( -- addr u >in line# [addr u] )  : error> ( -- addr u >in line# [addr u] )
     -1 error-stack +!      -1 error-stack +!
     error-stack dup @      error-stack dup @
     [ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal * cells + cell+      /error * cells + cell+
     [ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal cells bounds DO      /error cells bounds DO
         I @          I @
         cell +LOOP ;          cell +LOOP ;
 : >error ( addr u >in line# [addr u] -- )  : >error ( addr u >in line# [addr u] -- )
     error-stack dup @ dup 1+      error-stack dup @ dup 1+
     max-errors 1- min error-stack !      max-errors 1- min error-stack !
     [ has? file [IF] 6 [ELSE] 4 [THEN] ] Literal * cells + cell+      /error * cells + cell+
     [ has? file [IF] 6 [ELSE] 4 [THEN] 1- ] Literal cells bounds swap DO      /error 1- cells bounds swap DO
         I !          I !
         -1 cells +LOOP ;          -1 cells +LOOP ;
   
Line 870 
Line 871 
     then      then
     drop ;      drop ;
   
   Defer mark-start
   Defer mark-end
   
   :noname ." >>>" ; IS mark-start
   :noname ." <<<" ; IS mark-end
   
 : .error-line ( addr1 u1 n1 -- )  : .error-line ( addr1 u1 n1 -- )
     \ print error ending at char n1 in line addr1 u1      \ print error ending at char n1 in line addr1 u1
     \ should work with UTF-8 (whitespace check looks ok)      \ should work with UTF-8 (whitespace check looks ok)
Line 880 
Line 887 
         2dup + c@ bl >  WHILE          2dup + c@ bl >  WHILE
         r> 1+ >r  1- dup 0<  UNTIL  THEN  1+          r> 1+ >r  1- dup 0<  UNTIL  THEN  1+
     ( addr1 n2 r: u1 namelen )      ( addr1 n2 r: u1 namelen )
     2dup type ." >>>"      2dup type mark-start
     r> -rot r> swap /string ( namelen addr2 u2 )      r> -rot r> swap /string ( namelen addr2 u2 )
     >r swap 2dup type ." <<<" ( addr2 namelen r: u2 )      >r swap 2dup type mark-end ( addr2 namelen r: u2 )
     r> swap /string type ;      r> swap /string type ;
   
 : .error-frame ( throwcode addr1 u1 n1 n2 [addr2 u2] -- throwcode )  : .error-frame ( throwcode addr1 u1 n1 n2 [addr2 u2] -- throwcode )

Generate output suitable for use with a patch program
Legend:
Removed from v.1.111  
changed lines
  Added in v.1.112
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help