--- gforth/kernel/vars.fs 2003/03/09 15:17:07 1.34 +++ gforth/kernel/vars.fs 2012/05/26 10:20:01 1.53 @@ -1,12 +1,12 @@ \ VARS.FS Kernal variables -\ Copyright (C) 1995,1996,1997,1998,2000,2003 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. \ Gforth is free software; you can redistribute it and/or \ 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. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. hex \ everything now hex! 11may93jaw @@ -46,17 +45,15 @@ has? floating [IF] \G @i{c-char} is the character value for a space. \ used by docon:, must be constant -FF Constant /line +has? EC [IF] 20 cells [ELSE] FF [THEN] Constant /line -40 Constant c/l -10 Constant l/s -400 Constant chars/block +has? file [IF] +40 Value c/l +10 Value l/s +400 Value chars/block +[THEN] 20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u ) -create holdbuf word-pno-size chars allot -holdbuf word-pno-size chars + aconstant holdbuf-end -avariable holdptr holdbuf-end holdptr a! -avariable holdend holdbuf-end holdend a! 84 constant pad-minsize ( -- u ) @@ -69,11 +66,12 @@ $400 Value def#tib \ 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 main-task -UNLOCK tup ! LOCK +UNLOCK swap region user-region user-region setup-region LOCK Variable udp ( -- a-addr ) \ gforth \G user area size @@ -81,15 +79,16 @@ Variable udp ( -- a-addr ) \ gforth AUser next-task main-task next-task ! AUser prev-task main-task prev-task ! AUser save-task 0 save-task ! +[THEN] AUser sp0 ( -- a-addr ) \ gforth \G @code{User} variable -- initial value of the data stack pointer. \ 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} AUser rp0 ( -- a-addr ) \ gforth \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} has? floating [IF] @@ -101,13 +100,14 @@ AUser fp0 ( -- a-addr ) \ gforth has? glocals [IF] AUser lp0 ( -- a-addr ) \ gforth \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} [THEN] +AUser throw-entry \ pointer to task-specific signal handler + AUser handler \ pointer to last throw frame has? backtrace [IF] -User backtrace-empty \ true if the next THROW should store a backtrace AUser backtrace-rp0 \ rp at last call of interpret [THEN] \ AUser output @@ -117,6 +117,16 @@ AUser errorhandler AUser "error 0 "error ! +has? EC 0= [IF] + auser holdbufptr + here word-pno-size chars allot dup holdbufptr ! + word-pno-size chars + + : holdbuf ( -- addr ) holdbufptr @ ; + : holdbuf-end holdbuf word-pno-size chars + ; + auser holdptr dup holdptr a! + auser holdend holdend a! +[THEN] + has? new-input [IF] User current-input [ELSE] @@ -146,7 +156,7 @@ has? file [IF] User loadfile 0 loadfile ! 2user loadfilename 0 0 loadfilename 2! \ addr u for sourcefilename - + User loadline \ number of the currently interpreted \ (in TIB) line if the interpretation \ is in a textfile @@ -157,18 +167,33 @@ has? file [IF] [THEN] [THEN] + 2user includefilename 0 0 includefilename 2! \ innermost included file + + User base ( -- a-addr ) \ core -\G @code{User} variable -- @i{a-addr} is the address of a cell that stores the -\G number base used by default for number conversion during input and output. +\G @code{User} variable -- @i{a-addr} is the address of a cell that +\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 ! User dpl ( -- a-addr ) \ gforth \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 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. -1 dpl ! +User dp-char ( -- a-addr ) \ VFX +\G @code{User} variable -- @i{a-addr} is the address of a cell that stores the +\G decimal point character for double number conversion +'.' dp-char ! + +User fp-char ( -- a-addr ) \ VFX +\G @code{User} variable -- @i{a-addr} is the address of a cell that stores the +\G decimal point character for floating point number conversion +'.' fp-char ! + User state ( -- a-addr ) \ core,tools-ext \G @code{User} variable -- @i{a-addr} is the address of a cell \G containing the compilation state flag. 0 => interpreting, -1 => @@ -189,13 +214,16 @@ AUser dpp normal-dp dpp ! \ the pointer to the current dictionary pointer \ ist reset to normal-dp on (doerror) \ (i.e. any throw caught by quit) -AUser LastCFA +has? ec [IF] + AUser LastCFA +[THEN] AUser Last -AUser last-compiled \ last compile,d xt - \ 0 if last xt was dyn-compiled already (basic-block-end) -0 last-compiled ! -AUser last-compiled-here \ where LAST-COMPILED should be stored +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 !