1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 get "head"
23 get "runoff_head"
24
25 global
26 $( Global : 0 $)
27
28 manifest
29 $( NUMBER = 1
30 STRING = 2
31 CTABLE = 3
32 FUNCTION = 4
33 COUNTER = 5
34 BUILTIN = 8
35 SETS_PRINT = 16
36 READ_ONLY = 32
37 RELOCATE = 64
38 $)
39
40
41 let Tree_search (Name, Create) = valof
42 $( let x = Name!0
43 let k = LengthInWords (Name) - 1
44 let P, Q = 0, lv TreeRoot
45 $( P := rv Q
46 if P = 0 break
47 let d = P!4 - x
48 if d = 0 for i = 1 to k do
49 $( d := P!(i + 4) - Name!i
50 unless d = 0 break
51 $)
52 if d = 0 resultis P
53 Q := d < 0 -> lv P!3, lv P!2
54 $) repeat
55
56 unless Create resultis 0
57
58 P := Newvec (k + 4)
59 for i = 0 to k do P!(i + 4) := Name!i
60 P!0, P!1, P!2, P!3 := 0, NUMBER, 0, 0
61 rv Q := P
62 resultis P
63 $)
64
65 let GetSymbol (Name, Space) be
66 $( let P = Tree_search (Name, false)
67 if P = 0 do
68 $( Space!0 := 0
69 return
70 $)
71
72 let Value, Flags = lv P!0, P!1
73 if (Flags & BUILTIN) ne 0 do
74 $( Value := rv Value
75 if (Flags & RELOCATE) ne 0 do Value := Value + (lv Global)
76 $)
77 switchon Flags & 7 into
78 $( case NUMBER:
79 StoreArabic (rv Value, Space)
80 return
81
82 case STRING:
83 Unpackstring (rv Value, Space)
84 return
85
86 case FUNCTION:
87 Value (Space, false)
88 return
89
90 case CTABLE:
91 StoreCtable (Value, Space)
92 return
93
94 case COUNTER:
95 rv Value := rv Value + 1
96 StoreArabic (rv Value - 1, Space)
97 return
98 $)
99 $)
100
101 and SetSymbol (Name, Type, Value) be
102 $( let P = Tree_search (Name, true)
103 let OldValue, Flags = lv P!0, P!1
104 if (Flags & BUILTIN) ne 0 & (Flags & READ_ONLY) = 0 do
105 $( OldValue := rv OldValue
106 if (Flags & RELOCATE) ne 0 do OldValue := OldValue + (lv Global)
107 switchon Flags & 7 into
108 $( case NUMBER:
109 case COUNTER:
110 unless Type = NUMBER goto UserCell
111 rv OldValue := Value
112 if (Flags & SETS_PRINT) ne 0 do Print := Fp le Np le Lp & Passes le 1
113 return
114
115 case STRING:
116 unless Type = STRING goto UserCell
117 Freevec (rv OldValue)
118 rv OldValue := Value
119 return
120
121 case CTABLE:
122 unless Type = STRING goto UserCell
123 SetCtable (OldValue, Value)
124 return
125
126 case FUNCTION:
127 unless Type = NUMBER goto UserCell
128 OldValue (Value, true)
129 return
130 $)
131 $)
132
133 if Flags = STRING do Freevec (P!0)
134 UserCell:
135 P!0, P!1 := Value, Type
136 $)
137 and SetCtable (Table, Value) be
138 $( let w = vec 512
139 Unpackstring (Value, w)
140 let l = w!0
141 if l > 128 do l := 128
142 while l < 128 do
143 $( l := l + 1
144 w!l := '*s'
145 $)
146 for i = 0 to 127 do Table!i := w!(i + 1)
147 Freevec (Value)
148 $)
149 and StoreCtable (Table, v) be
150 $( let j = 0
151 for i = 0 to 127 do
152 $( j := j + 1
153 let c = Table!i
154 c := valof switchon c into
155 $( case '*b':resultis 'b'
156 case '*n':resultis 'n'
157 case '*t':resultis 't'
158 case '**':resultis '**'
159 case '"': resultis '"'
160 default:
161 if $8040 le c le $8176 do
162 $( v!j := c
163 loop
164 $)
165 v!j := '**'
166 v!(j + 1) := 'c'
167 v!(j + 2) := c / 100 + '0'
168 v!(j + 3) := c / 10 rem 10 + '0'
169 v!(j + 4) := c rem 10 + '0'
170 j := j + 4
171 loop
172 $)
173 v!j := '**'
174 v!(j + 1) := c
175 j := j + 1
176 loop
177 $)
178 v!0 := j
179 $)
180
181 let UpdateSymbol (Name) be
182 $( Check_ref ()
183 let Type, Value = 0, 0
184 test Rawchar!Nrx = '"'
185 then Type, Value := STRING, GetString ()
186 or $( let v = vec Maxline
187 ExpError := false
188 Type, Value := NUMBER, ReadExp (0, v)
189 if ExpError | Nrx < Nr do Report ("Malformed expression")
190 $)
191 SetSymbol (Name, Type, Value)
192 $)
193
194 and Set_ref () be
195 $( let v = vec Maxline / 4
196 if ReadName (v) = 0 return
197 UpdateSymbol (v)
198 $)
199
200 and Use_ref (In, Out, Inl) = valof
201 $( let Ini, Outi = 0, 0
202 let v = vec Maxline * 2
203 while Ini < Inl & Outi < Maxline do
204 $( Ini := Ini + 1
205 unless In!Ini = Spec_char do
206 $( Outi := Outi + 1
207 Out!Outi := In!Ini
208 loop
209 $)
210 if In!(Ini + 1) = Spec_char do
211 $( Ini := Ini + 1
212 Outi := Outi + 1
213 Out!Outi := Spec_char
214 loop
215 $)
216 for i = Ini + 1 to Inl do
217 $( let c = In!i
218 if c = Spec_char do
219 $( let w = vec Maxline
220 for j = 1 to i - Ini - 1 do v!j := In!(Ini + j)
221 v!0 := i - Ini - 1
222 Packstring (v, w)
223 GetSymbol (w, v)
224 Ini := i
225 goto StoreS
226 $)
227 unless 'a' le c le 'z' logor 'A' le c le 'Z' logor '0' le c le '9' logor c = '_' break
228 $)
229 (Roman -> StoreRoman, StoreArabic) (Np, v)
230 StoreS: for i = 1 to v!0 do Out!(Outi + i) := v!i
231 Outi := Outi + v!0
232 $)
233 resultis Outi
234 $)
235
236
237 and Check_ref () be
238 $( unless Rawchar!Nrx = Spec_char logor Rawchar!(Nrx + 1) = Spec_char return
239 let w = vec Maxline
240 for i = 1 to Nr do w!i := Rawchar!i
241 let OldRoman = Roman
242 Roman := false
243 Nr := Use_ref (w + Nrx - 1, Rawchar + Nrx - 1, Nr - Nrx + 1) + Nrx - 1
244 Roman := OldRoman
245 $)
246
247 let InitializeSymbolTree () be
248 $( TreeRoot := 0
249
250 Define ("Ad", lv Ad, NUMBER | RELOCATE)
251 Define ("Ce", lv Ce, NUMBER | RELOCATE)
252 Define ("Eq", lv Eq, NUMBER | RELOCATE)
253 Define ("Fi", lv Fi, NUMBER | RELOCATE)
254 Define ("Fr", lv Fr, NUMBER | RELOCATE)
255 Define ("Ft", lv Ft, NUMBER | RELOCATE)
256 Define ("Ll", lv Ll, NUMBER | RELOCATE)
257 Define ("Ms", lv Ms, NUMBER | RELOCATE)
258 Define ("Nl", lv Nl, NUMBER | RELOCATE)
259 Define ("Pi", lv Pi, NUMBER | RELOCATE)
260 Define ("Pl", lv Pl, NUMBER | RELOCATE)
261 Define ("To", lv To, NUMBER | RELOCATE)
262 Define ("Un", lv Un, NUMBER | RELOCATE)
263 Define ("Ma1", lv Ma1, NUMBER | RELOCATE)
264 Define ("Ma2", lv Ma2, NUMBER | RELOCATE)
265 Define ("Ma3", lv Ma3, NUMBER | RELOCATE)
266 Define ("Ma4", lv Ma4, NUMBER | RELOCATE)
267 Define ("NNp", lv NNp, NUMBER | RELOCATE)
268 Define ("Foot", lv Foot, NUMBER | RELOCATE)
269 Define ("From", lv From, NUMBER | RELOCATE)
270 Define ("Print", lv Print, NUMBER | RELOCATE)
271 Define ("Start", lv Start, NUMBER | RELOCATE)
272 Define ("Roman", lv Roman, NUMBER | RELOCATE)
273 Define ("NoFtNo", lv NoFtNo, NUMBER | RELOCATE)
274 Define ("Stopsw", lv Stopsw, NUMBER | RELOCATE)
275 Define ("Waitsw", lv Waitsw, NUMBER | RELOCATE)
276 Define ("PadLeft", lv PadLeft, NUMBER | RELOCATE)
277 Define ("ExtraMargin", lv ExtraMargin, NUMBER | RELOCATE)
278 Define ("Hyphenating", lv Hyphenating, NUMBER | RELOCATE)
279 Define ("PrintLineNumbers", lv PrintLineNumbers, NUMBER | RELOCATE)
280 Define ("MultiplePagecount", lv MultiplePagecount, NUMBER | RELOCATE)
281
282 Define ("Fp", lv Fp, NUMBER | SETS_PRINT | RELOCATE)
283 Define ("Lp", lv Lp, NUMBER | SETS_PRINT | RELOCATE)
284 Define ("Passes", lv Passes, NUMBER | SETS_PRINT | RELOCATE)
285
286 Define ("In", lv In, NUMBER | READ_ONLY | RELOCATE)
287 Define ("Np", lv Np, NUMBER | READ_ONLY | RELOCATE)
288 Define ("Selsw", lv Selsw, NUMBER | READ_ONLY | RELOCATE)
289 Define ("Time", lv TimeNow, NUMBER | READ_ONLY | RELOCATE)
290 Define ("Filesw", lv Filesw, NUMBER | READ_ONLY | RELOCATE)
291 Define ("LinesLeft", lv LinesLeft, NUMBER | READ_ONLY | RELOCATE)
292 Define ("Printersw", lv Printersw, NUMBER | READ_ONLY | RELOCATE)
293 Define ("InputLines", lv InputLines, NUMBER | READ_ONLY | RELOCATE)
294 Define ("NestingDepth", lv NestingDepth, NUMBER | READ_ONLY | RELOCATE)
295
296 Define ("Eqcnt", lv Eqcnt, COUNTER | RELOCATE)
297
298 Define ("FootRef", lv FootRef, STRING | RELOCATE)
299 Define ("TextRef", lv TextRef, STRING | RELOCATE)
300 Define ("Parameter", lv Parameter, STRING | RELOCATE)
301
302 Define ("FileName", lv FileName, STRING | READ_ONLY | RELOCATE)
303 Define ("InputFileName", lv InputFileName, STRING | READ_ONLY | RELOCATE)
304
305 Define ("ConvTable", Conv, CTABLE)
306 Define ("TrTable", TrTable, CTABLE)
307 Define ("CharsTable", CharsTable, CTABLE)
308 Define ("DeviceTable", DeviceTable, CTABLE)
309
310 Define ("Date", StoreDate, FUNCTION | READ_ONLY)
311 Define ("Console", ConsoleReadline, FUNCTION | READ_ONLY)
312
313 Define ("NoPaging", NoPagingFUNCTION, FUNCTION)
314 Define ("Charsw", CharswFUNCTION, FUNCTION)
315 Define ("Device", DeviceFUNCTION, FUNCTION)
316 $)
317 and Define (Name, Value, Flag) be
318 $( let P = Tree_search (Name, true)
319 if (Flag & RELOCATE) ne 0 do Value := Value - (lv Global)
320 P!0, P!1 := Value, Flag | BUILTIN
321 $)
322
323 and NoPagingFUNCTION (Arg, SetSw) be
324 test SetSw
325 then SetPaging (Arg)
326 or StoreArabic (NoPaging, Arg)
327
328 and CharswFUNCTION (Arg, SetSw) be
329 test SetSw
330 then SetCharsw (Arg)
331 or StoreArabic (Charsw, Arg)
332
333 and DeviceFUNCTION (Arg, SetSw) be
334 test SetSw
335 then SetDevice (Arg)
336 or StoreArabic (Device, Arg)