[gforth] / gforth / kernel / comp.fs  

gforth: gforth/kernel/comp.fs

Diff for /gforth/kernel/comp.fs between version 1.83 and 1.84

version 1.83, Sat Mar 4 22:45:08 2006 UTC version 1.84, Sun Mar 5 14:10:52 2006 UTC
Line 48 
Line 48 
   
 : c,    ( c -- ) \ core c-comma  : c,    ( c -- ) \ core c-comma
     \G Reserve data space for one char and store @i{c} in the space.      \G Reserve data space for one char and store @i{c} in the space.
     here 1 chars allot c! ;      here 1 chars allot [ has? flash [IF] ] flashc! [ [ELSE] ] c! [ [THEN] ] ;
   
 : ,     ( w -- ) \ core comma  : ,     ( w -- ) \ core comma
     \G Reserve data space for one cell and store @i{w} in the space.      \G Reserve data space for one cell and store @i{w} in the space.
     here cell allot  ! ;      here cell allot [ has? flash [IF] ] flash! [ [ELSE] ] ! [ [THEN] ] ;
   
 : 2,    ( w1 w2 -- ) \ gforth  : 2,    ( w1 w2 -- ) \ gforth
     \G Reserve data space for two cells and store the double @i{w1      \G Reserve data space for two cells and store the double @i{w1
     \G w2} there, @i{w2} first (lower address).      \G w2} there, @i{w2} first (lower address).
     here 2 cells allot 2! ;      here 2 cells allot  [ has? flash [IF] ] tuck flash! cell+ flash!
           [ [ELSE] ] 2! [ [THEN] ] ;
   
 \ : aligned ( addr -- addr' ) \ core  \ : aligned ( addr -- addr' ) \ core
 \     [ cell 1- ] Literal + [ -1 cells ] Literal and ;  \     [ cell 1- ] Literal + [ -1 cells ] Literal and ;
Line 106 
Line 107 
 : string, ( c-addr u -- ) \ gforth  : string, ( c-addr u -- ) \ gforth
     \G puts down string as cstring      \G puts down string as cstring
     dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c,      dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c,
     here swap chars dup allot move ;  [ has? flash [IF] ]
       bounds ?DO  I c@ c,  LOOP
   [ [ELSE] ]
       here swap chars dup allot move
   [ [THEN] ] ;
   
 : longstring, ( c-addr u -- ) \ gforth  : longstring, ( c-addr u -- ) \ gforth
     \G puts down string as longcstring      \G puts down string as longcstring
Line 116 
Line 121 
     name-too-long?      name-too-long?
     dup max-name-length @ max max-name-length !      dup max-name-length @ max max-name-length !
     align here last !      align here last !
 [ has? ec [IF] ]  [ has? flash [IF] ]
     -1 A,      -1 A,
 [ [ELSE] ]  [ [ELSE] ]
     current @ 1 or A,   \ link field; before revealing, it contains the      current @ 1 or A,   \ link field; before revealing, it contains the
Line 226 
Line 231 
 : cfa,     ( code-address -- )  \ gforth        cfa-comma  : cfa,     ( code-address -- )  \ gforth        cfa-comma
     here      here
     dup lastcfa !      dup lastcfa !
     0 A, 0 ,  code-address! ;      [ has? rom [IF] ] 2 cells allot [ [ELSE] ] 0 A, 0 , [ [THEN] ]
       code-address! ;
   
 [IFUNDEF] compile,  [IFUNDEF] compile,
 defer compile, ( xt -- )        \ core-ext      compile-comma  defer compile, ( xt -- )        \ core-ext      compile-comma
Line 377 
Line 383 
   
 : S, ( addr u -- )  : S, ( addr u -- )
     \ allot string as counted string      \ allot string as counted string
     here over char+ allot  place align ;  [ has? flash [IF] ]
       dup c, bounds ?DO  I c@ c,  LOOP
   [ [ELSE] ]
       here over char+ allot  place align
   [ [THEN] ] ;
   
 : mem, ( addr u -- )  : mem, ( addr u -- )
     \ allot the memory block HERE (do alignment yourself)      \ allot the memory block HERE (do alignment yourself)
     here over allot swap move ;  [ has? flash [IF] ]
       bounds ?DO  I c@ c,  LOOP
   [ [ELSE] ]
       here over allot swap move
   [ [THEN] ] ;
   
 : ," ( "string"<"> -- )  : ," ( "string"<"> -- )
     [char] " parse s, ;      [char] " parse s, ;
Line 497 
Line 511 
 : AConstant ( addr "name" -- ) \ gforth  : AConstant ( addr "name" -- ) \ gforth
     (Constant) A, ;      (Constant) A, ;
   
   has? flash [IF]
   : Value ( w "name" -- ) \ core-ext
       (Value) dpp @ >r here cell allot >r
       ram here >r , r> r> flash! r> dpp ! ;
   
   ' Value alias AValue
   [ELSE]
 : Value ( w "name" -- ) \ core-ext  : Value ( w "name" -- ) \ core-ext
     (Value) , ;      (Value) , ;
   
 : AValue ( w "name" -- ) \ core-ext  : AValue ( w "name" -- ) \ core-ext
     (Value) A, ;      (Value) A, ;
   [THEN]
   
 : 2Constant ( w1 w2 "name" -- ) \ double two-constant  : 2Constant ( w1 w2 "name" -- ) \ double two-constant
     Create ( w1 w2 "name" -- )      Create ( w1 w2 "name" -- )
Line 574 
Line 596 
 :noname  :noname
     ;-hook ?struc      ;-hook ?struc
     [ has? xconds [IF] ] exit-like [ [THEN] ]      [ has? xconds [IF] ] exit-like [ [THEN] ]
     here 5 cells + postpone aliteral postpone (does>2) [compile] exit      here [ has? peephole [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] cells +
       postpone aliteral postpone (does>2) [compile] exit
     [ has? peephole [IF] ] finish-code [ [THEN] ] dodoes,      [ has? peephole [IF] ] finish-code [ [THEN] ] dodoes,
     defstart :-hook ;      defstart :-hook ;
 interpret/compile: DOES>  ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core        does  interpret/compile: DOES>  ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core        does
Line 655 
Line 678 
     if \ the last word has a header      if \ the last word has a header
         dup ( name>link ) @ -1 =          dup ( name>link ) @ -1 =
         if \ it is still hidden          if \ it is still hidden
             current @ dup >r @ over ! r> !              current @ dup >r @ over
               [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] r> !
         else          else
             drop              drop
         then          then

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help