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

Diff for /gforth/prims2x.fs between versions 1.64 and 1.66

version 1.64, 2001/01/17 09:35:12 version 1.66, 2001/01/18 16:44:15
Line 68  variable rawinput \ pointer to next char Line 68  variable rawinput \ pointer to next char
 variable endrawinput \ pointer to the end of the input (the char after the last)  variable endrawinput \ pointer to the end of the input (the char after the last)
 variable cookedinput \ pointer to the next char to be parsed  variable cookedinput \ pointer to the next char to be parsed
 variable line \ line number of char pointed to by input  variable line \ line number of char pointed to by input
 1 line !  variable line-start \ pointer to start of current line (for error messages)
   0 line !
 2variable filename \ filename of original input file  2variable filename \ filename of original input file
 0 0 filename 2!  0 0 filename 2!
 2variable f-comment  2variable f-comment
Line 103  struct% Line 104  struct%
  cell%    field item-stack  \ descriptor for the stack used, 0 is default   cell%    field item-stack  \ descriptor for the stack used, 0 is default
  cell%    field item-type   \ descriptor for the item type   cell%    field item-type   \ descriptor for the item type
  cell%    field item-offset \ offset in stack items, 0 for the deepest element   cell%    field item-offset \ offset in stack items, 0 for the deepest element
    cell%    field item-first  \ true if this is the first occurence of the item
 end-struct item%  end-struct item%
   
 struct%  struct%
Line 225  print-token ! Line 227  print-token !
     endif      endif
     drop ;      drop ;
   
   : print-error-line ( -- )
       \ print the current line and position
       line-start @ endrawinput @ over - 2dup nl-char scan drop nip ( start end )
       over - type cr
       line-start @ rawinput @ over - typewhite ." ^" cr ;
       
 : ?nextchar ( f -- )  : ?nextchar ( f -- )
     ?not? if      ?not? if
         filename 2@ type ." :" line @ 0 .r ." : syntax error, wrong char:"          outfile-id >r try
         getinput . cr              stderr to outfile-id
         rawinput @ endrawinput @ over - 100 min type cr              filename 2@ type ." :" line @ 0 .r ." : syntax error, wrong char:"
               getinput . cr
               print-error-line
               0
           recover endtry
           r> to outfile-id throw
         abort          abort
     endif      endif
     rawinput @ endrawinput @ <> if      rawinput @ endrawinput @ <> if
Line 238  print-token ! Line 251  print-token !
         1 chars cookedinput +!          1 chars cookedinput +!
         nl-char = if          nl-char = if
             checksyncline              checksyncline
               rawinput @ line-start !
         endif          endif
         rawinput @ c@ cookedinput @ c!          rawinput @ c@ cookedinput @ c!
     endif ;      endif ;
Line 349  warnings @ [IF] Line 363  warnings @ [IF]
 : primfilter ( file-id xt -- )  : primfilter ( file-id xt -- )
 \ fileid is for the input file, xt ( -- ) is for the output word  \ fileid is for the input file, xt ( -- ) is for the output word
  output !   output !
  here dup rawinput ! cookedinput !   here dup rawinput ! dup line-start ! cookedinput !
  here unused rot read-file throw   here unused rot read-file throw
  dup here + endrawinput !   dup here + endrawinput !
  allot   allot
Line 489  does> ( item -- ) Line 503  does> ( item -- )
     typ item item-type !      typ item item-type !
     typ type-stack @ item item-stack !default      typ type-stack @ item item-stack !default
     item item-name 2@ items @ search-wordlist 0= if \ new name      item item-name 2@ items @ search-wordlist 0= if \ new name
         item item-name 2@ 2dup nextname item declare          item item-name 2@ nextname item declare
         typ type-c-name 2@ type space type  ." ;" cr          item item-first on
           \ typ type-c-name 2@ type space type  ." ;" cr
     else      else
         drop          drop
           item item-first off
     endif ;      endif ;
   
 : execute-prefix ( item addr1 u1 -- )  : execute-prefix ( item addr1 u1 -- )
Line 519  does> ( item -- ) Line 535  does> ( item -- )
  effect-in effect-in-end @ declaration-list   effect-in effect-in-end @ declaration-list
  effect-out effect-out-end @ declaration-list ;   effect-out effect-out-end @ declaration-list ;
   
   : print-declaration { item -- }
       item item-first @ if
           item item-type @ type-c-name 2@ type space
           item item-name 2@ type ." ;" cr
       endif ;
   
   : print-declarations ( -- )
       effect-in  effect-in-end  @ ['] print-declaration map-items
       effect-out effect-out-end @ ['] print-declaration map-items ;
       
 : stack-prefix ( stack "prefix" -- )  : stack-prefix ( stack "prefix" -- )
     name tuck nextname create ( stack length ) 2,      name tuck nextname create ( stack length ) 2,
 does> ( item -- )  does> ( item -- )
Line 653  does> ( item -- ) Line 679  does> ( item -- )
  ." DEF_CA" cr   ." DEF_CA" cr
  declarations   declarations
  compute-offsets \ for everything else   compute-offsets \ for everything else
    print-declarations
  ." NEXT_P0;" cr   ." NEXT_P0;" cr
  flush-tos   flush-tos
  fetches   fetches
Line 740  does> ( item -- ) Line 767  does> ( item -- )
     ." {" cr      ." {" cr
     declarations      declarations
     compute-offsets \ for everything else      compute-offsets \ for everything else
       print-declarations
     inst-stream  stack-used? IF ." Cell *ip=IP;" cr THEN      inst-stream  stack-used? IF ." Cell *ip=IP;" cr THEN
     data-stack   stack-used? IF ." Cell *sp=SP;" cr THEN      data-stack   stack-used? IF ." Cell *sp=SP;" cr THEN
     fp-stack     stack-used? IF ." Cell *fp=*FP;" cr THEN      fp-stack     stack-used? IF ." Cell *fp=*FP;" cr THEN
Removed from v.1.64  
changed lines
  Added in v.1.66

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