[gforth] / gforth / kernel / vars.fs  

gforth: gforth/kernel/vars.fs

Diff for /gforth/kernel/vars.fs between version 1.19 and 1.50

version 1.19, Mon Nov 8 22:01:12 1999 UTC version 1.50, Sat Dec 31 15:29:26 2011 UTC
Line 1 
Line 1 
 \ VARS.FS      Kernal variables  \ VARS.FS      Kernal variables
   
 \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007,2011 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 
Line 15 
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  
   
 hex \ everything now hex!                               11may93jaw  hex \ everything now hex!                               11may93jaw
   
Line 34 
Line 33 
   
 [IFUNDEF] cell  [IFUNDEF] cell
 1 cells Constant cell ( -- u ) \ gforth  1 cells Constant cell ( -- u ) \ gforth
 \G @code{Constant} -- the number of address units corresponding to 1 cell.  \G @code{Constant} -- @code{1 cells}
 [THEN]  [THEN]
   
   has? floating [IF]
 1 floats Constant float ( -- u ) \ gforth  1 floats Constant float ( -- u ) \ gforth
 \G @code{Constant} -- the number of address units corresponding to a floating-point number.  \G @code{Constant} -- the number of address units corresponding to a floating-point number.
   [THEN]
   
 20 Constant bl ( -- c-char ) \ core  20 Constant bl ( -- c-char ) \ core b-l
 \G @i{c-char} is the character value for a space.  \G @i{c-char} is the character value for a space.
 \ used by docon:, must be constant  \ used by docon:, must be constant
   
 FF Constant /line  has? EC [IF] 20 cells [ELSE] FF [THEN] Constant /line
   
   has? file [IF]
 40 Constant c/l  40 Constant c/l
 10 Constant l/s  10 Constant l/s
 400 Constant chars/block  400 Constant chars/block
   [THEN]
   
 20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u )  20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u )
   
   has? EC 0= [IF]
 create holdbuf word-pno-size chars allot  create holdbuf word-pno-size chars allot
 holdbuf word-pno-size chars + aconstant holdbuf-end  holdbuf word-pno-size chars + aconstant holdbuf-end
 avariable holdptr holdbuf-end holdptr a!  avariable holdptr holdbuf-end holdptr a!
 avariable holdend holdbuf-end holdend a!  avariable holdend holdbuf-end holdend a!
   [THEN]
   
 84 constant pad-minsize ( -- u )  84 constant pad-minsize ( -- u )
   
   $400 Value def#tib
   \G default size of terminal input buffer. Default size is 1K
   
 \ that's enough so long  \ that's enough so long
   
Line 65 
Line 73 
   
 \ initialized by COLD  \ initialized by COLD
   
 Create main-task  has? OS [IF] 100 [ELSE] 40 [THEN] cells allot  has? no-userspace 0= [IF]
   Create main-task  has? OS [IF] 100 [ELSE] 40 [THEN] cells dup allot
   
 \ set user-pointer from cross-compiler right  \ set user-pointer from cross-compiler right
 main-task  main-task
 UNLOCK tup ! LOCK  UNLOCK swap region user-region user-region setup-region LOCK
   
 Variable udp ( -- a-addr ) \ gforth  Variable udp ( -- a-addr ) \ gforth
 \ user area size? -anton  \G user area size
   
 AUser next-task        main-task next-task !  AUser next-task        main-task next-task !
 AUser prev-task        main-task prev-task !  AUser prev-task        main-task prev-task !
 AUser save-task        0 save-task !  AUser save-task        0 save-task !
   [THEN]
 AUser sp0 ( -- a-addr ) \ gforth  AUser sp0 ( -- a-addr ) \ gforth
 \G @code{User} variable -- initial value of the data stack pointer.  \G @code{User} variable -- initial value of the data stack pointer.
 \ sp0 is used by douser:, must be user  \ sp0 is used by douser:, must be user
     ' sp0 Alias s0 ( -- a-addr ) \ gforth  \    ' sp0 Alias s0 ( -- a-addr ) \ gforth
 \G OBSOLETE alias of @code{sp0}  \G OBSOLETE alias of @code{sp0}
   
 AUser rp0 ( -- a-addr ) \ gforth  AUser rp0 ( -- a-addr ) \ gforth
 \G @code{User} variable -- initial value of the return stack pointer.  \G @code{User} variable -- initial value of the return stack pointer.
     ' rp0 Alias r0 ( -- a-addr ) \ gforth  \    ' rp0 Alias r0 ( -- a-addr ) \ gforth
 \G OBSOLETE alias of @code{rp0}  \G OBSOLETE alias of @code{rp0}
   
   has? floating [IF]
 AUser fp0 ( -- a-addr ) \ gforth  AUser fp0 ( -- a-addr ) \ gforth
 \G @code{User} variable -- initial value of the floating-point stack pointer.  \G @code{User} variable -- initial value of the floating-point stack pointer.
 \ no f0, because this leads to unexpected results when using hex  \ no f0, because this leads to unexpected results when using hex
   [THEN]
   
   has? glocals [IF]
 AUser lp0 ( -- a-addr ) \ gforth  AUser lp0 ( -- a-addr ) \ gforth
 \G @code{User} variable -- initial value of the locals stack pointer.  \G @code{User} variable -- initial value of the locals stack pointer.
     ' lp0 Alias l0 ( -- a-addr ) \ gforth  \    ' lp0 Alias l0 ( -- a-addr ) \ gforth
 \G OBSOLETE alias of @code{lp0}  \G OBSOLETE alias of @code{lp0}
   [THEN]
   
 AUser handler   \ pointer to last throw frame  AUser handler   \ pointer to last throw frame
 has? backtrace [IF]  has? backtrace [IF]
 User backtrace-empty \ true if the next THROW should store a backtrace  
 AUser backtrace-rp0 \ rp at last call of interpret  AUser backtrace-rp0 \ rp at last call of interpret
 [THEN]  [THEN]
 \ AUser output  \ AUser output
Line 109 
Line 122 
   
 AUser "error            0 "error !  AUser "error            0 "error !
   
   has? new-input [IF]
       User current-input
   [ELSE]
 [IFUNDEF] #tib          \ in ec-Version we may define this ourself  [IFUNDEF] #tib          \ in ec-Version we may define this ourself
  User tibstack          \ saves >tib in execute   User tibstack          \ saves >tib in execute
  User >tib              \ pointer to terminal input buffer   User >tib              \ pointer to terminal input buffer
  User #tib ( -- a-addr ) \ core-ext          User #tib ( -- a-addr ) \ core-ext number-t-i-b
  \G @code{User} variable -- @i{a-addr} is the address of a cell containing   \G @code{User} variable -- @i{a-addr} is the address of a cell containing
  \G the number of characters in the terminal input buffer.   \G the number of characters in the terminal input buffer.
  \G OBSOLESCENT: @code{source} superceeds the function of this word.   \G OBSOLESCENT: @code{source} superceeds the function of this word.
   
  User >in ( -- a-addr ) \ core          User >in ( -- a-addr ) \ core to-in
  \G @code{User} variable -- @i{a-addr} is the address of a cell containing the   \G @code{User} variable -- @i{a-addr} is the address of a cell containing the
  \G char offset from the start of the input buffer to the start of the   \G char offset from the start of the input buffer to the start of the
  \G parse area.   \G parse area.
                         0 >in ! \ char number currently processed in tib                          0 >in ! \ char number currently processed in tib
 [THEN]  [THEN]
   
 has? file [IF]  has? file [IF]
  User blk ( -- a-addr ) \ block   User blk ( -- a-addr ) \ block b-l-k
  \G @code{User} variable -- @i{a-addr} is the address of a cell containing zero   \G @code{User} variable -- @i{a-addr} is the address of a cell containing zero
  \G (in which case the input source is not a block and can be identified   \G (in which case the input source is not a block and can be identified
  \G by @code{source-id}) or the number of the block currently being   \G by @code{source-id}) or the number of the block currently being
Line 133 
Line 150 
   
  User loadfile          0 loadfile !   User loadfile          0 loadfile !
   
  User loadfilename#     0 loadfilename# !   2user loadfilename     0 0 loadfilename 2! \ addr u for sourcefilename
   
  User loadline          \ number of the currently interpreted   User loadline          \ number of the currently interpreted
                         \ (in TIB) line if the interpretation                          \ (in TIB) line if the interpretation
Line 143 
Line 160 
 2User linestart         \ starting file postition of  2User linestart         \ starting file postition of
                         \ the current interpreted line (in TIB)                          \ the current interpreted line (in TIB)
 [THEN]  [THEN]
   [THEN]
   
    2user includefilename  0 0 includefilename 2! \ innermost included file
   
   
  User base ( -- a-addr ) \ core   User base ( -- a-addr ) \ core
  \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the  \G @code{User} variable -- @i{a-addr} is the address of a cell that
  \G number base used by default for number conversion during input and output.  \G stores the number base used by default for number conversion during
   \G input and output.  Don't store to @code{base}, use
   \G @code{base-execute} instead.
                         A base !                          A base !
  User dpl ( -- a-addr ) \ gforth   User dpl ( -- a-addr ) \ gforth
  \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the   \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
  \G position of the decimal point in the most recent numeric conversion.   \G position of the decimal point in the most recent numeric conversion.
  \G Initialised to -1. After the conversion of a number containing no   \G Initialised to -1. After the conversion of a number containing no
  \G decimal point, @code{@ dpl} is -1. After the conversion of @code{2.} it holds  \G decimal point, @code{dpl} is -1. After the conversion of @code{2.} it holds
  \G 0. After the conversion of 234123.9 it contains 1, and so forth.   \G 0. After the conversion of 234123.9 it contains 1, and so forth.
  -1 dpl !   -1 dpl !
   
  User state ( -- a-addr ) \ core,tools-ext   User state ( -- a-addr ) \ core,tools-ext
  \G @code{User} variable -- @i{a-addr} is the address of a cell containing the  \G @code{User} variable -- @i{a-addr} is the address of a cell
  \G compilation state flag. 0 => interpreting, -1 => compiling.  A  \G containing the compilation state flag. 0 => interpreting, -1 =>
  \G program shall not directly alter the value of @code{state}. The  \G compiling.  A program shall not directly alter the value of
  \G following Standard words alter the value in @code{state}: @code{:}  \G @code{state}. The following Standard words alter the value in
  \G (colon) @code{;} (semicolon) @code{abort} @code{quit}  \G @code{state}: @code{:} (colon) @code{;} (semicolon) @code{abort}
  \G @code{:noname} @code{[} (left-bracket) @code{]} (right-bracket)  \G @code{quit} @code{:noname} @code{[} (left-bracket) @code{]}
  \G @code{;code}. Don't use @code{state}! @xref{Interpretation and  \G (right-bracket) @code{;code}. Don't use @code{state}! For an
  \G Compilation Semantics} for an alternative.  \G alternative see @ref{Interpretation and Compilation Semantics}.
  \  Recommended reading: @cite{@code{State}-smartness--Why it is evil   \  Recommended reading: @cite{@code{State}-smartness--Why it is evil
  \  and how to exorcise it},   \  and how to exorcise it},
  \  @url{http://www.complang.tuwien.ac.at/papers/ertl98.ps.gz}; short   \  @url{http://www.complang.tuwien.ac.at/papers/ertl98.ps.gz}; short
Line 176 
Line 199 
                         \ the pointer to the current dictionary pointer                          \ the pointer to the current dictionary pointer
                         \ ist reset to normal-dp on (doerror)                          \ ist reset to normal-dp on (doerror)
                         \  (i.e. any throw caught by quit)                          \  (i.e. any throw caught by quit)
   has? ec [IF]
 AUser LastCFA  AUser LastCFA
   [THEN]
 AUser Last  AUser Last
   
   has? flash [IF]
       AUser flash-dp
       : rom  flash-dp dpp ! ;
       : ram  normal-dp dpp ! ;
   [THEN]
   
   User max-name-length \ maximum length of all names defined yet
   32 max-name-length !
   
   \  has? peephole  [IF]
   \  0 value peeptable \ initialized in boot
   \  [THEN]
   
 has? glocals [IF]  has? glocals [IF]
 User locals-size \ this is the current size of the locals stack  User locals-size \ this is the current size of the locals stack
                  \ frame of the current word                   \ frame of the current word

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help