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

Diff for /gforth/kernel/comp.fs between versions 1.14 and 1.15

version 1.14, 1999/05/05 18:12:15 version 1.15, 1999/05/06 21:33:36
Line 27 Line 27
 [IFUNDEF] allot  [IFUNDEF] allot
 [IFUNDEF] forthstart  [IFUNDEF] forthstart
 : allot ( n -- ) \ core  : allot ( n -- ) \ core
     \G Reserve or release @var{n} address units of data space; @var{n}      \G Reserve or release @i{n} address units of data space; @i{n}
     \G is a signed number. There are restrictions on releasing data      \G is a signed number. There are restrictions on releasing data
     \G space.      \G space.
     dup unused u> -8 and throw      dup unused u> -8 and throw
Line 38 Line 38
 \ we default to this version if we have nothing else 05May99jaw  \ we default to this version if we have nothing else 05May99jaw
 [IFUNDEF] allot  [IFUNDEF] allot
 : allot ( n -- ) \ core  : allot ( n -- ) \ core
     \G Reserve or release @var{n} address units of data space; @var{n}      \G Reserve or release @i{n} address units of data space; @i{n}
     \G is a signed number. There are restrictions on releasing data      \G is a signed number. There are restrictions on releasing data
     \G space.      \G space.
     here +      here +
Line 47 Line 47
 [THEN]  [THEN]
   
 : c,    ( c -- ) \ core  : c,    ( c -- ) \ core
     \G Reserve data space for one char and store @var{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 c! ;
   
 : ,     ( w -- ) \ core  : ,     ( w -- ) \ core
     \G Reserve data space for one cell and store @var{w} in the space.      \G Reserve data space for one cell and store @i{w} in the space.
     here cell allot  ! ;      here cell allot  ! ;
   
 : 2,    ( w1 w2 -- ) \ gforth  : 2,    ( w1 w2 -- ) \ gforth
     \G Reserve data space for two cells and store the double @var{w1      \G Reserve data space for two cells and store the double @i{w1
     \G w2} in the space.      \G w2} in the space.
     here 2 cells allot 2! ;      here 2 cells allot 2! ;
   
Line 63 Line 63
 \     [ cell 1- ] Literal + [ -1 cells ] Literal and ;  \     [ cell 1- ] Literal + [ -1 cells ] Literal and ;
   
 : align ( -- ) \ core  : align ( -- ) \ core
       \G If the data-space pointer is not aligned, reserve enough space to align it.
     here dup aligned swap ?DO  bl c,  LOOP ;      here dup aligned swap ?DO  bl c,  LOOP ;
   
 \ : faligned ( addr -- f-addr ) \ float  \ : faligned ( addr -- f-addr ) \ float
 \     [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ;   \     [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ; 
   
 : falign ( -- ) \ float  : falign ( -- ) \ float
       \G If the data-space pointer is not float-aligned, reserve
       \G enough space to align it.
     here dup faligned swap      here dup faligned swap
     ?DO      ?DO
         bl c,          bl c,
Line 142  create nextname-buffer 32 chars allot Line 145  create nextname-buffer 32 chars allot
     ['] noname-header IS (header) ;      ['] noname-header IS (header) ;
   
 : lastxt ( -- xt ) \ gforth  : lastxt ( -- xt ) \ gforth
     \G @var{xt} is the execution token of the last word defined.      \G @i{xt} is the execution token of the last word defined.
     \ The main purpose of this word is to get the xt of words defined using noname      \ The main purpose of this word is to get the xt of words defined using noname
     lastcfa @ ;      lastcfa @ ;
   
 \ \ literals                                                    17dec92py  \ \ literals                                                    17dec92py
   
 : Literal  ( compilation n -- ; run-time -- n ) \ core  : Literal  ( compilation n -- ; run-time -- n ) \ core
     \G Compile appropriate code such that, at run-time, @var{n} is placed      \G Compile appropriate code such that, at run-time, @i{n} is placed
     \G on the stack. Interpretation semantics are undefined.      \G on the stack. Interpretation semantics are undefined.
 [ [IFDEF] lit, ]  [ [IFDEF] lit, ]
     lit,      lit,
Line 165  create nextname-buffer 32 chars allot Line 168  create nextname-buffer 32 chars allot
 [ [THEN] ] ; immediate restrict  [ [THEN] ] ; immediate restrict
   
 : char   ( '<spaces>ccc' -- c ) \ core  : char   ( '<spaces>ccc' -- c ) \ core
     \G Skip leading spaces. Parse the string @var{ccc} and return @var{c}, the      \G Skip leading spaces. Parse the string @i{ccc} and return @i{c}, the
     \G display code representing the first character of @var{ccc}.      \G display code representing the first character of @i{ccc}.
     bl word char+ c@ ;      bl word char+ c@ ;
   
 : [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char  : [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char
     \G Compilation: skip leading spaces. Parse the string      \G Compilation: skip leading spaces. Parse the string
     \G @var{ccc}. Run-time: return @var{c}, the display code      \G @i{ccc}. Run-time: return @i{c}, the display code
     \G representing the first character of @var{ccc}.  Interpretation      \G representing the first character of @i{ccc}.  Interpretation
     \G semantics for this word are undefined.      \G semantics for this word are undefined.
     char postpone Literal ; immediate restrict      char postpone Literal ; immediate restrict
   
Line 185  create nextname-buffer 32 chars allot Line 188  create nextname-buffer 32 chars allot
   
 [IFUNDEF] compile,  [IFUNDEF] compile,
 : compile, ( xt -- )    \ core-ext      compile-comma  : compile, ( xt -- )    \ core-ext      compile-comma
     \G  Compile the word represented by the execution token, @var{xt}.      \G  Compile the word represented by the execution token, @i{xt},
       \G  into the current definition.
     A, ;      A, ;
 [THEN]  [THEN]
   
Line 202  create nextname-buffer 32 chars allot Line 206  create nextname-buffer 32 chars allot
     r> dup cell+ >r @ compile, ;      r> dup cell+ >r @ compile, ;
   
 : postpone, ( w xt -- ) \ gforth        postpone-comma  : postpone, ( w xt -- ) \ gforth        postpone-comma
     \g Compile the compilation semantics represented by @var{w xt}.      \g Compile the compilation semantics represented by @i{w xt}.
     dup ['] execute =      dup ['] execute =
     if      if
         drop compile,          drop compile,
Line 216  create nextname-buffer 32 chars allot Line 220  create nextname-buffer 32 chars allot
     then ;      then ;
   
 : POSTPONE ( "name" -- ) \ core  : POSTPONE ( "name" -- ) \ core
     \g Compiles the compilation semantics of @var{name}.      \g Compiles the compilation semantics of @i{name}.
     COMP' postpone, ; immediate restrict      COMP' postpone, ; immediate restrict
   
 struct  struct
Line 234  DOES> Line 238  DOES>
 \ \ ticks  \ \ ticks
   
 : name>comp ( nt -- w xt ) \ gforth  : name>comp ( nt -- w xt ) \ gforth
     \G @var{w xt} is the compilation token for the word @var{nt}.      \G @i{w xt} is the compilation token for the word @i{nt}.
     (name>comp)      (name>comp)
     1 = if      1 = if
         ['] execute          ['] execute
Line 246  DOES> Line 250  DOES>
     (') postpone ALiteral ; immediate restrict      (') postpone ALiteral ; immediate restrict
   
 : [']  ( compilation. "name" -- ; run-time. -- xt ) \ core      bracket-tick  : [']  ( compilation. "name" -- ; run-time. -- xt ) \ core      bracket-tick
     \g @var{xt} represents @var{name}'s interpretation      \g @i{xt} represents @i{name}'s interpretation
     \g semantics. Performs @code{-14 throw} if the word has no      \g semantics. Perform @code{-14 throw} if the word has no
     \g interpretation semantics.      \g interpretation semantics.
     ' postpone ALiteral ; immediate restrict      ' postpone ALiteral ; immediate restrict
   
 : COMP'    ( "name" -- w xt ) \ gforth  comp-tick  : COMP'    ( "name" -- w xt ) \ gforth  comp-tick
     \g @var{w xt} represents @var{name}'s compilation semantics.      \g Compilation token @i{w xt} represents @i{name}'s compilation semantics.
     (') name>comp ;      (') name>comp ;
   
 : [COMP']  ( compilation "name" -- ; run-time -- w xt ) \ gforth bracket-comp-tick  : [COMP']  ( compilation "name" -- ; run-time -- w xt ) \ gforth bracket-comp-tick
     \g @var{w xt} represents @var{name}'s compilation semantics.      \g Compilation token @i{w xt} represents @i{name}'s compilation semantics.
     COMP' swap POSTPONE Aliteral POSTPONE ALiteral ; immediate restrict      COMP' swap POSTPONE Aliteral POSTPONE ALiteral ; immediate restrict
   
 \ \ recurse                                                     17may93jaw  \ \ recurse                                                     17may93jaw
Line 300  DOES> Line 304  DOES>
   here over char+ allot  place align ;    here over char+ allot  place align ;
   
 : SLiteral ( Compilation c-addr1 u ; run-time -- c-addr2 u ) \ string  : SLiteral ( Compilation c-addr1 u ; run-time -- c-addr2 u ) \ string
     \G Compilation: compile the string specified by @var{c-addr1},      \G Compilation: compile the string specified by @i{c-addr1},
     \G @var{u} into the current definition. Run-time: return      \G @i{u} into the current definition. Run-time: return
     \G @var{c-addr2 u} describing the address and length of the      \G @i{c-addr2 u} describing the address and length of the
     \G string.      \G string.
     postpone (S") here over char+ allot  place align ;      postpone (S") here over char+ allot  place align ;
                                              immediate restrict                                               immediate restrict
Line 310  DOES> Line 314  DOES>
 \ \ abort"                                                      22feb93py  \ \ abort"                                                      22feb93py
   
 : abort" ( compilation 'ccc"' -- ; run-time f -- ) \ core,exception-ext abort-quote  : abort" ( compilation 'ccc"' -- ; run-time f -- ) \ core,exception-ext abort-quote
     \G If any bit of @var{f} is non-zero, perform the function of @code{-2 throw},      \G If any bit of @i{f} is non-zero, perform the function of @code{-2 throw},
     \G displaying the string @var{ccc} if there is no exception frame on the      \G displaying the string @i{ccc} if there is no exception frame on the
     \G exception stack.      \G exception stack.
     postpone (abort") ," ;        immediate restrict      postpone (abort") ," ;        immediate restrict
   
Line 344  DOES> Line 348  DOES>
   
 \ \ Create Variable User Constant                               17mar93py  \ \ Create Variable User Constant                               17mar93py
   
 : Alias    ( cfa "name" -- ) \ gforth  : Alias    ( xt "name" -- ) \ gforth
       \ 29Apr1999nac The stack comment for this was cfa -- I changed it to xt because
       \ they are the same thing in Gforth, and xt is a more appropriate thing to
       \ document.
     Header reveal      Header reveal
     alias-mask lastflags creset      alias-mask lastflags creset
     dup A, lastcfa ! ;      dup A, lastcfa ! ;
Line 391  doer? :docon [IF] Line 398  doer? :docon [IF]
 [THEN]  [THEN]
   
 : Constant ( w "name" -- ) \ core  : Constant ( w "name" -- ) \ core
     \G Defines constant @var{name}      \G Define a constant @i{name} with value @i{w}.
     \G        \G  
     \G @var{name} execution: @var{-- w}      \G @i{name} execution: @i{-- w}
     (Constant) , ;      (Constant) , ;
   
 : AConstant ( addr "name" -- ) \ gforth  : AConstant ( addr "name" -- ) \ gforth
Removed from v.1.14  
changed lines
  Added in v.1.15

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