[gforth] / gforth / kernel / vars.fs  

gforth: gforth/kernel/vars.fs

1 : anton 1.1 \ VARS.FS Kernal variables
2 :    
3 : anton 1.50 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007,2011 Free Software Foundation, Inc.
4 : anton 1.1
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 : anton 1.47 \ as published by the Free Software Foundation, either version 3
10 : anton 1.1 \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 : anton 1.47 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : anton 1.1
20 :     hex \ everything now hex! 11may93jaw
21 :    
22 :     \ important constants 17dec92py
23 :    
24 :     \ dpANS6 (sect 3.1.3.1) says
25 :     \ "a true flag ... [is] a single-cell value with all bits set"
26 :     \ better definition: 0 0= constant true ( no dependence on 2's compl)
27 : crook 1.10 -1 Constant true ( -- f ) \ core-ext
28 : crook 1.19 \G @code{Constant} -- @i{f} is a cell with all bits set.
29 : crook 1.10 \ see starts looking for primitives after this word!
30 :    
31 :     0 Constant false ( -- f ) \ core-ext
32 : crook 1.19 \G @code{Constant} -- @i{f} is a cell with all bits clear.
33 : anton 1.1
34 : jwilke 1.16 [IFUNDEF] cell
35 : anton 1.1 1 cells Constant cell ( -- u ) \ gforth
36 : anton 1.22 \G @code{Constant} -- @code{1 cells}
37 : jwilke 1.16 [THEN]
38 : crook 1.17
39 : pazsan 1.25 has? floating [IF]
40 : anton 1.1 1 floats Constant float ( -- u ) \ gforth
41 : crook 1.19 \G @code{Constant} -- the number of address units corresponding to a floating-point number.
42 : pazsan 1.25 [THEN]
43 : anton 1.1
44 : crook 1.20 20 Constant bl ( -- c-char ) \ core b-l
45 : crook 1.17 \G @i{c-char} is the character value for a space.
46 : crook 1.10 \ used by docon:, must be constant
47 : anton 1.1
48 : pazsan 1.48 has? EC [IF] 20 cells [ELSE] FF [THEN] Constant /line
49 : anton 1.1
50 : pazsan 1.39 has? file [IF]
51 : pazsan 1.53 40 Value c/l
52 :     10 Value l/s
53 :     400 Value chars/block
54 : pazsan 1.38 [THEN]
55 : anton 1.1
56 : jwilke 1.18 20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u )
57 : pazsan 1.40
58 : anton 1.2 84 constant pad-minsize ( -- u )
59 : anton 1.11
60 : pazsan 1.25 $400 Value def#tib
61 :     \G default size of terminal input buffer. Default size is 1K
62 : anton 1.2
63 : anton 1.1 \ that's enough so long
64 :    
65 :     \ User variables 13feb93py
66 :    
67 :     \ initialized by COLD
68 :    
69 : pazsan 1.38 has? no-userspace 0= [IF]
70 : jwilke 1.35 Create main-task has? OS [IF] 100 [ELSE] 40 [THEN] cells dup allot
71 : jwilke 1.3
72 :     \ set user-pointer from cross-compiler right
73 :     main-task
74 : jwilke 1.35 UNLOCK swap region user-region user-region setup-region LOCK
75 : anton 1.1
76 : crook 1.19 Variable udp ( -- a-addr ) \ gforth
77 : pazsan 1.28 \G user area size
78 : anton 1.1
79 :     AUser next-task main-task next-task !
80 :     AUser prev-task main-task prev-task !
81 :     AUser save-task 0 save-task !
82 : pazsan 1.38 [THEN]
83 : crook 1.10 AUser sp0 ( -- a-addr ) \ gforth
84 : crook 1.19 \G @code{User} variable -- initial value of the data stack pointer.
85 : crook 1.10 \ sp0 is used by douser:, must be user
86 : pazsan 1.38 \ ' sp0 Alias s0 ( -- a-addr ) \ gforth
87 : crook 1.10 \G OBSOLETE alias of @code{sp0}
88 :    
89 :     AUser rp0 ( -- a-addr ) \ gforth
90 : crook 1.19 \G @code{User} variable -- initial value of the return stack pointer.
91 : pazsan 1.38 \ ' rp0 Alias r0 ( -- a-addr ) \ gforth
92 : crook 1.10 \G OBSOLETE alias of @code{rp0}
93 :    
94 : pazsan 1.25 has? floating [IF]
95 : crook 1.10 AUser fp0 ( -- a-addr ) \ gforth
96 : crook 1.19 \G @code{User} variable -- initial value of the floating-point stack pointer.
97 : crook 1.10 \ no f0, because this leads to unexpected results when using hex
98 : pazsan 1.25 [THEN]
99 : crook 1.10
100 : pazsan 1.25 has? glocals [IF]
101 : crook 1.10 AUser lp0 ( -- a-addr ) \ gforth
102 : crook 1.19 \G @code{User} variable -- initial value of the locals stack pointer.
103 : pazsan 1.38 \ ' lp0 Alias l0 ( -- a-addr ) \ gforth
104 : crook 1.10 \G OBSOLETE alias of @code{lp0}
105 : pazsan 1.25 [THEN]
106 : crook 1.10
107 : pazsan 1.52 AUser throw-entry \ pointer to task-specific signal handler
108 :    
109 : jwilke 1.3 AUser handler \ pointer to last throw frame
110 : jwilke 1.18 has? backtrace [IF]
111 : anton 1.13 AUser backtrace-rp0 \ rp at last call of interpret
112 : jwilke 1.18 [THEN]
113 : anton 1.1 \ AUser output
114 :     \ AUser input
115 :    
116 :     AUser errorhandler
117 :    
118 :     AUser "error 0 "error !
119 :    
120 : pazsan 1.51 has? EC 0= [IF]
121 :     auser holdbufptr
122 :     here word-pno-size chars allot dup holdbufptr !
123 :     word-pno-size chars +
124 :     : holdbuf ( -- addr ) holdbufptr @ ;
125 :     : holdbuf-end holdbuf word-pno-size chars + ;
126 :     auser holdptr dup holdptr a!
127 :     auser holdend holdend a!
128 :     [THEN]
129 :    
130 : pazsan 1.25 has? new-input [IF]
131 :     User current-input
132 :     [ELSE]
133 :     [IFUNDEF] #tib \ in ec-Version we may define this ourself
134 :     User tibstack \ saves >tib in execute
135 :     User >tib \ pointer to terminal input buffer
136 :     User #tib ( -- a-addr ) \ core-ext number-t-i-b
137 :     \G @code{User} variable -- @i{a-addr} is the address of a cell containing
138 :     \G the number of characters in the terminal input buffer.
139 :     \G OBSOLESCENT: @code{source} superceeds the function of this word.
140 :    
141 :     User >in ( -- a-addr ) \ core to-in
142 :     \G @code{User} variable -- @i{a-addr} is the address of a cell containing the
143 :     \G char offset from the start of the input buffer to the start of the
144 :     \G parse area.
145 :     0 >in ! \ char number currently processed in tib
146 :     [THEN]
147 :    
148 : pazsan 1.7 has? file [IF]
149 : crook 1.20 User blk ( -- a-addr ) \ block b-l-k
150 : crook 1.19 \G @code{User} variable -- @i{a-addr} is the address of a cell containing zero
151 : crook 1.10 \G (in which case the input source is not a block and can be identified
152 :     \G by @code{source-id}) or the number of the block currently being
153 :     \G interpreted. A Standard program should not alter @code{blk} directly.
154 :     0 blk !
155 :    
156 : anton 1.1 User loadfile 0 loadfile !
157 :    
158 : anton 1.32 2user loadfilename 0 0 loadfilename 2! \ addr u for sourcefilename
159 : anton 1.37
160 : anton 1.1 User loadline \ number of the currently interpreted
161 :     \ (in TIB) line if the interpretation
162 :     \ is in a textfile
163 :     \ the first line is 1
164 :    
165 :     2User linestart \ starting file postition of
166 :     \ the current interpreted line (in TIB)
167 : pazsan 1.25 [THEN]
168 : pazsan 1.7 [THEN]
169 : anton 1.37
170 :     2user includefilename 0 0 includefilename 2! \ innermost included file
171 :    
172 : anton 1.1
173 : anton 1.26 User base ( -- a-addr ) \ core
174 : anton 1.45 \G @code{User} variable -- @i{a-addr} is the address of a cell that
175 :     \G stores the number base used by default for number conversion during
176 :     \G input and output. Don't store to @code{base}, use
177 :     \G @code{base-execute} instead.
178 : anton 1.26 A base !
179 :     User dpl ( -- a-addr ) \ gforth
180 :     \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
181 :     \G position of the decimal point in the most recent numeric conversion.
182 :     \G Initialised to -1. After the conversion of a number containing no
183 : anton 1.36 \G decimal point, @code{dpl} is -1. After the conversion of @code{2.} it holds
184 : anton 1.26 \G 0. After the conversion of 234123.9 it contains 1, and so forth.
185 :     -1 dpl !
186 : anton 1.1
187 : pazsan 1.53 User dp-char ( -- a-addr ) \ VFX
188 :     \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
189 :     \G decimal point character for double number conversion
190 :     '.' dp-char !
191 :    
192 :     User fp-char ( -- a-addr ) \ VFX
193 :     \G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
194 :     \G decimal point character for floating point number conversion
195 :     '.' fp-char !
196 :    
197 : anton 1.26 User state ( -- a-addr ) \ core,tools-ext
198 :     \G @code{User} variable -- @i{a-addr} is the address of a cell
199 :     \G containing the compilation state flag. 0 => interpreting, -1 =>
200 :     \G compiling. A program shall not directly alter the value of
201 :     \G @code{state}. The following Standard words alter the value in
202 :     \G @code{state}: @code{:} (colon) @code{;} (semicolon) @code{abort}
203 :     \G @code{quit} @code{:noname} @code{[} (left-bracket) @code{]}
204 :     \G (right-bracket) @code{;code}. Don't use @code{state}! For an
205 :     \G alternative see @ref{Interpretation and Compilation Semantics}.
206 :     \ Recommended reading: @cite{@code{State}-smartness--Why it is evil
207 :     \ and how to exorcise it},
208 :     \ @url{http://www.complang.tuwien.ac.at/papers/ertl98.ps.gz}; short
209 :     \ version: Don't use @code{state}!
210 :     0 state !
211 : crook 1.10
212 : anton 1.1 AUser normal-dp \ the usual dictionary pointer
213 :     AUser dpp normal-dp dpp !
214 :     \ the pointer to the current dictionary pointer
215 :     \ ist reset to normal-dp on (doerror)
216 :     \ (i.e. any throw caught by quit)
217 : pazsan 1.49 has? ec [IF]
218 :     AUser LastCFA
219 :     [THEN]
220 : anton 1.1 AUser Last
221 : anton 1.26
222 : pazsan 1.41 has? flash [IF]
223 :     AUser flash-dp
224 :     : rom flash-dp dpp ! ;
225 :     : ram normal-dp dpp ! ;
226 :     [THEN]
227 :    
228 : anton 1.33 User max-name-length \ maximum length of all names defined yet
229 :     32 max-name-length !
230 :    
231 :     \ has? peephole [IF]
232 :     \ 0 value peeptable \ initialized in boot
233 :     \ [THEN]
234 : anton 1.1
235 : pazsan 1.7 has? glocals [IF]
236 : anton 1.1 User locals-size \ this is the current size of the locals stack
237 :     \ frame of the current word
238 : pazsan 1.7 [THEN]
239 : anton 1.1
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help