--- gforth/kernel/vars.fs 2007/12/31 17:34:59 1.46 +++ gforth/kernel/vars.fs 2012/12/31 15:25:19 1.54 @@ -1,12 +1,12 @@ \ VARS.FS Kernal variables -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007,2011,2012 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,23 +45,16 @@ has? floating [IF] \G @i{c-char} is the character value for a space. \ used by docon:, must be constant -has? EC [IF] 40 [ELSE] FF [THEN] Constant /line +has? EC [IF] 20 cells [ELSE] FF [THEN] Constant /line has? file [IF] -40 Constant c/l -10 Constant l/s -400 Constant chars/block +40 Value c/l +10 Value l/s +400 Value chars/block [THEN] 20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u ) -has? EC 0= [IF] -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! -[THEN] - 84 constant pad-minsize ( -- u ) $400 Value def#tib @@ -112,6 +104,8 @@ AUser lp0 ( -- 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] AUser backtrace-rp0 \ rp at last call of interpret @@ -123,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] @@ -180,6 +184,16 @@ User dpl ( -- a-addr ) \ gforth \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 => @@ -200,7 +214,9 @@ 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 has? flash [IF]