Forgot your password?
Document Actions
COM: Data structures.
COM: Data structures. stlcom.opl
1 .=member intro
2$ ssssssss eeeeeeeeee tttttttttt ll
3$ ssssssssss eeeeeeeeee tttttttttt ll
4$ ss ss ee tt ll
5$ ss ee tt ll
6$ sssssssss eeeeee tt ll
7$ sssssssss eeeeee tt ll
8$ ss ee tt ll
9$ ss ss ee tt ll
10$ ssssssssss eeeeeeeeee tt llllllllll
11$ ssssssss eeeeeeeeee tt llllllllll
12$
13$
14$ cccccccc oooooooo mm mm
15$ cccccccccc oooooooooo mmm mmm
16$ cc cc oo oo mmmm mmmm
17$ cc oo oo mm mmmm mm
18$ cc oo oo mm mm mm
19$ cc oo oo mm mm mm
20$ cc oo oo mm mm
21$ cc cc oo oo mm mm
22$ cccccccccc oooooooooo mm mm
23$ cccccccc oooooooo mm mm
24$
25$
26$ t h e s e t l d a t a s t r u c t u r e s
27$
28$
29$ this software is part of the setl programming system
30$ address queries and comments to
31$
32$ setl project
33$ department of computer science
34$ new york university
35$ courant institute of mathematical sciences
36$ 251 mercer street
37$ new york, ny 10012
38$
1 .=member mods
2
3
4
5$ program revision history
6$ ------- -------- -------
7
8$ this section contains a description of each revision to this library.
9$ these descriptions have the following format:
10$
11$ mm-dd-jj jdate author(s)
12$
13$ 1.............15.........25...........................................
14$
15$ where mm-dd-yy is the month, day, and year, and jdate is the julian
16$ date.
17$
18$ whenever a revision is installed, the author should insert a
19$ description after line 'mods.21' below.
20$
21$ ......................................................................
bnda 1
bnda 2
bnda 3$ 11/09/84 84314 s. freudenberger
bnda 4$
bnda 5$ 1. increase the q1 val table for r32.
bnda 6$ module affected: q1symtab.
stra 1
stra 2
stra 3$ 07/24/84 84206 d. shields and s. freudenberger
stra 4$
stra 5$ 1. support short character strings. binary, q2-, q2a-, and q2e-files
stra 6$ are upward but not downward compatible.
stra 7$ modules affected: q2flds, q2macs, q2vars, binio, and strpkg.
asca 1
asca 2
asca 3$ 03/05/84 84065 d. shields
asca 4$
asca 5$ 1. for s37, enable option ascebc to support ascii mode for
asca 6$ nyu ada/ed ada compiler.
asca 7$ modules affected: cndasm and q2vars.
suna 1
suna 2
suna 3$ 02/05/84 84065 s. freudenberger
suna 4$
suna 5$ 1. support motorola mc68000 microprocessor on sun workstation.
suna 6$ modules affected: cndasm, sysmac, and q2macs.
suna 7$ 2. change the r32 field definition for otvalue_.
suna 8$ module affected: q2flds.
smfd 1
smfd 2
smfd 3$ 09/01/83 83244 s. freudenberger
smfd 4$
smfd 5$ 1. correct the definition of the heap file slices macro.
smfd 6$ module affected q2macs.
smfd 7$ 2. introduce a new binary i/o type: bt_sint. the bt_val_ field
smfd 8$ of a bt_sint is an unsigned integer in the range 0 .. 2**(ws/2)-1.
smfd 9$ module affected: binio.
smfc 1
smfc 2
smfc 3$ 09/01/83 83244 s. freudenberger
smfc 4$
smfc 5$ 1. introduce conditional symbol r36 for 36-bit field definitions.
smfc 6$ module affected: cndasm.
smfc 7$ 2. change the parameterisation of reals.
smfc 8$ module affected: q2macs.
mjsa 1
mjsa 2
mjsa 3$ 08/08/83 83220 s. freudenberger and m. smosna
mjsa 4$
mjsa 5$ 1. implement arbitrary precision integer arithmetic.
mjsa 6$ modules affected: q2macs and q2vars.
smfb 1
smfb 2
smfb 3$ 08/08/83 83220 s. freudenberger
smfb 4$
smfb 5$ 1. increase various q1 tables for s66: symtab to 1500, names to
smfb 6$ 2047, and blocktab to 511.
smfb 7$ these changes are needed to compile the test library.
smfb 8$ modules affected: q1symtab and q1code.
smfb 9$ 2. change the is_fprim form table predicate to exclude f_elmt.
smfb 10$ module affected: formtab.
smfb 11$ 3. change the q1 code table dimensions.
smfb 12$ module affected: q1code.
smfb 13$ 4. add a unary predicate q1_pos for use in arithmetic iterators when
smfb 14$ the sign of the increment is not know. this allows the optimiser
smfb 15$ to detect the special nature of this test easily.
smfb 16$ module affected: q1code.
smfb 17$ 5. add three conditional branches to q1, one to q2:
smfb 18$ q1_bif and q1_bifnot if a1 is known to be boolean;
smfb 19$ q1_ifasrt and q2_ifasrt to test and branch on assert=0.
smfb 20$ modules affected: q1code and q2opcd.
smfb 21$ 6. change the field definition for li_nwords.
smfb 22$ module affected: q2flds.
smfb 23$ 7. update the q2 date.
smfb 24$ module affected: q2vars.
smfa 1
smfa 2
smfa 3$ 12/16/82 82350 s. freudenberger
smfa 4$
smfa 5$ 1. run-time names are stored differently: see module q2macs for a
smfa 6$ detailed account of the change.
smfa 7$ modules affected: q2macs and q2vars.
22
23
24$ 08/12/82 82224 s. freudenberger
25$
26$ 1. a clerical error which selected mts as the default s37 operating
27$ system has been corrected: cms is the default for s37.
28$ module affected: cndasm.
29$ 2. string pattern sets have been defined as a separate entity. they
30$ are (still) represented as packed tuples, but are parameterised
31$ to generate byte tables for r32.
32$ modules affected: sysmac, formtab, q2macs, and strpkg.
33$ 3. the form table layout has been changed: the fields 'ft_deref' and
34$ 'ft_imset' have been added; ft_low has been widened for r32 and
35$ s66, and narrowed for s10 and s20; ft_lim has been narrowed for
36$ s10 and s20.
37$ module affected: formtab.
38$ 4. the q2 opcodes have been updated: all aliases and unused codes
39$ have been eliminated.
40$ module affected: q2opcd.
41$ 5. several variables have been moved from nsintp to nsgparam: these
42$ are the variables which define q2 but were not part of the q2 file
43$ in the past. in addition, ten spare variables were added to the
44$ q2 file header.
45$ module affected: q2vars.
46$ 6. the q2 file format has changed, and the relevant macros have been
47$ updated.
48$ module affected: q2vars.
49$ 7. the code table limit has been increased for s10 and s20.
50$ module affected: q1code.
51
52
53$ 06/15/82 82166 s. freudenberger and d. shields
54$
55$ 1. the pageof macro for the dec vax vms implementation (s32) has been
56$ corrected to reflect the fact that little allocates array(0), even
57$ though it defines arrays to be one-origined.
58$ module affected: mhfpkg.
59
60
61$ 06/01/82 82152 s. freudenberger
62$
63$ 1. we introduced the s37cms and s37mts conditional assembly for s37
64$ to mark code specific for the cms and mts operating systems, resp.
65$ module affected: cndasm.
66$ 2. the environment options for the setl get and put routines have
67$ been enabled for the s10 and s20 implementations.
68$ module affected: cndasm.
69$ 3. the names table has been increased for the s10 and s20
70$ implementations.
71$ module affected: q1symtab.
72$ 4. the field definitions for codea2 and codea3 have been corrected
73$ for the s20 implementation.
74$ module affected: q2flds.
75$ 5. four more run-time library routines have been renamed to avoid
76$ problems with certain loaders.
77$ module affected: q2macs.
78$ 6. the current q2 checkdate has been updated to 82152, to reflect
79$ changes around short integer forms (the use of ft_low, the
80$ semantic change of q2_checki1). note that old code files (81300)
81$ are still accepted, though they will produce errors if they
82$ contained the repr clause 'integer i..j'.
83$ module affected: q2vars.
84
85
86$ 03/16/82 82075 s. freudenberger
87$
88$ ****** this version is q1 incompatible ******
89$
90$ 1. several library routines have been renamed to remove problems they
91$ caused for various implementations.
92$ modules affected: cndasm and q2macs.
93$ 2. the q1 symbol table flags is_base, is_proc, and is_memb have been
94$ replace by equivalent expressions testing the ft_type field of the
95$ symbol's form.
96$ module affected: q1symtab.
97$ 3. the q1 symbol table flag is_rec has been made known to sem, opt,
98$ and cod.
99$ module affected: q1symtab.
100$ 4. the q1 symbol table flag is_init has been introduced to flag
101$ initialised variables. this enables us to remove all restrictions
102$ from the init ddeclaration of global variables.
103$ module affected: q1symtab.
104$ 5. the ambiguous map keyword has been reserved again, to eventually
105$ enable us to implement this type of map efficiently and correctly.
106$ new keyword: map.
107$ module affected: q1symtab.
108$ 6. outstanding corrections for the s20 implementation have been
109$ included:
110$ 6.1 's10' is reset for 's20' (cndasm).
111$ 6.2 'is_casemap' has been added to q1 symbol table (q1symtab).
112$ 6.3 long atoms have been modified corresponding to 81155.3
113$ 6.4 the heap dimension has been increased to 256k words.
114$ 6.5 the default heap size has been increased to 16k words.
115$ 6.6 the maximum nesting level has been increased to 100.
116$ modules affected: cndasm, q1symtab, q2flds, and q2macs.
117
118
119$ 02/01/82 82032 d. shields
120$
121$ use r32 conditional symbol for standard 32-bit fields.
122$ this replaces the field definitions for s32, s37 and s47.
123
124
125$ 01/15/82 82015 d.shields
126$
127$ 1. enable defenv_for for s32u; disable for s47.
128$ 2. disable defenv_envmhl for s32 (both s32v and s32u), use little cod
129$ code for main allocation procedure.
130
131
132$ 11/29/81 81333 d.shields
133$
134$ 1. support s47: amdahl uts (universal timesharing system).
135$ this implementation runs on s37 architecture using an operating
136$ system very close to unix (v7), and uses the ascii character set.
137$ 2. use dynamic heap for s32u (unix).
138$ 3. enable foreign language interface for s32u (unix), s47.
139
140
141$ 10/27/81 81300 s. freudenberger and d. shields
142$
143$ 1. for the dec vax vms version we now allocate the heap dynamically.
144$ modules affected: cndasm, q2macs, and q2vars.
145$ 2. the setl-fortran interface has been implemented for the
146$ s32, s37, and s66 versions.
147$ the interface uses a communication area which is kept as a
148$ tuple in the setl heap as the symbol intf: sym_intf replaces
149$ sym_spare1, and s_intf replaces s_spare1.
150$ the actual call to fortran is done by the new built-in function
151$ callf, for which a new q1 symbol table entry and a new q2 opcode
152$ were needed.
153$ the new conditional assembly symbol defenv_envfor marks the
154$ relevant code.
155$ modules affected: cndasm, q1symtab, q2opcd, q2macs, and q2vars.
156$ 3. for the dec vax vms version (s32), using the vms crmpsc system
157$ service, we provide the option to create and use q2 file formats
158$ which allow to map the heap image directly into the virtual
159$ address space, thus eliminating the need to read the heap before
160$ execution starts. the conditional symbol 'hf' is used to mark
161$ the code related to this option (the heap file option).
162$ modules affected: cndasm, q2macs, and q2vars.
163$ module added: mhfpkg.
164$ 4. the declaration for the err_val utility has been moved to the
165$ nameset nsutil.
166$ module affected: q2vars.
167$ 5. the maximum nesting level for setl objects has been increased
168$ to 5000 for the s32 implementation.
169$ module affected: q2macs.
170$ 6. the q2 file check constants have been renamed, using shorter
171$ names.
172$ module affected: q2macs.
173$ 7. the reserved words 'spec' and 'unspec' have been deleted.
174$ modules affected: q1symtab and q2opcd.
175$ 8. move the string primitive definition section from module
176$ libpl.stlini to compl.strpkg.
177$ module added: strpkg.
178
179
180$ 08/20/81 81232 s. tihor
181$
182$ 1. add hs4, hs8 parameters for s32.
183$ 2. add support for s20 (s10 with extended addressing).
184
185
186$ 06/04/81 81155 s. freudenberger
187$
188$ 1. we made some changes to implement first parts of a dynamic
189$ symbolic debugger for setl:
190$
191$ 1.1 we deleted the run-time debugging options rtrs0 and rtrs1.
192$ they have been functionally replaced by trace statements and
193$ notrace statements, resp. we also deleted the q2 opcodes
194$ q2_trs and q2_notrs.
195$ 1.2 we added four system globals to be used for the following
196$ purposes:
197$ ovar holds a bit string giving all q2 operators with
198$ o-variables.
199$ scopes maps members to scopes to symbol table bounds.
200$ rnspec holds, in compressed form, 'string specifiers'
201$ into the run-time names table.
202$ rnames holds the run-time names table as a setl long
203$ character string.
204$ 1.3 we added the following q2 opcodes:
205$ q2_trcstmts enables/disbales the statement trace
206$ q2_trccalls enables/disbales the call trace
207$ q2_trcsym enables/disbales the watch point on sym
208$ 1.4 we added the following global flags:
209$ debug_flag we are currently running in debugging mode
210$ trace_stmts we are currently tracing statements
211$ trace_calls we are currently tracing calls and returns
212$ modules affected: q1symtab, q2opcd, and q2vars.
213$ 3. the initialisation of the form table predicate is_fbsd has been
214$ changed to exclude bases and sparse maps(elmt b) untyped xxx,
215$ where xxx is a numeric mode.
216$ module affected: formtab.
217$ 3. the data structure for long atom data blocks has been changed:
218$ we have added the field la_form giving the form table pointer to
219$ the long atom's plex base.
220$ modules affected: s10q2f, s32q2f, s37q2f, s66q2f, and q2flds.
221$ 4. we added q2 opcodes to allow us to do type checks on atoms:
222$ q2_eqform4 checks whether a2 is a t_latom of plex base a3,
223$ q2_chkatom checks whether a2 is an atom (either short or long).
224$ module affected: q2opcd.
225$ 5. to implement case map optimisation as described in nl. 215,
226$ we added a q1 symbol predicate is_casemap, to flag based case
227$ maps in cod, added several q2 opcodes: q2_caset, q2_caselsm,
228$ q2_casersm, and renamed q2_case to q2_caseusm.
229$ modules affected: q1symtab and q2opcd.
230
231
232$ 04/09/81 81099 s. tihor
233$
234$ 1. update q2 file format variables and macros.
235$ 2. add 20 variable for expansions and tests such as psetl
236$ 3. increase the maximum nesting level to 500
237$ 4. add q2 ops q2_nins, q2_ninu, q2_lessflsm, q2_lessflmm,
238$ q2_lessfrsm, q2_lessfrsm (where the sm ops are identified with
239$ the old -m op.
240$ 5. add q2 ops goif, goifnot, eqif, eqifnot to separate the cases
241$ when an eq or go may require its arguement to be boolean
242$ from those where it may not.
243$ 6. move a block of conditional assembly code from q2macs into cndasm
244
245
246$ 12/05/80 80340 d. shields and s. tihor
247$
248$ 1. shields export mods
249$ make s37 support mixed-case (since cms permits it).
250$ enable get,put for s66
251$ 2. update description of atoms in val table.
252$ 3. add max_no_files to all phase macros so that true name of term
253$ file can be extracted by namesio.
254$ 4. add q2 date stamps to q2opcd
255
256
257$ 11/05/80 80310 s. freudenberger
258$
259$ 1. the variable max_heap_dim has been added to the nameset nsheap.
260$ this allows for varying heap sizes if static heap menagement
261$ is used, in that the external csect can easily be modified.
262$ 2. the variable eitotal has been added to the nameset nsutil.
263$ this variable holds the instruction counter for calls to the
264$ error processing routine, and is used to break possible recur-
265$ sive calls to this routine.
266$ 3. for s32 and s37, several q2 fields have been moved within non-
267$ primitive data block headers, shortening the header sizes for
268$ packed tuples, local and remote sets, local maps, and packed
269$ local maps.
270$ 4. the sequence of the form type codes (ft_type's) has been
271$ changed: the code for local packed maps has been moved after
272$ the code for local integer maps, and the code for remote
273$ packed maps has been moved after the code for remote integer
274$ maps.
275$ 5. the following form table fields have been moved within the
276$ form table entry: ft_lim, ft_tup, ft_pos. the following
277$ fields have been added: ft_low, ft_bit.
278$ additionally, the macro ft_low_max has been added.
279
280
281$ 80/08/12 80225 s. freudenberger
282$
283$ 1. a typo in the heap dimension macro for s37 has been corrected.
284
285
286$ 08/01/80 80214 s. freudenberger
287$
288$ 1. q1 table sizes have been changed for s32 and s37. the table sizes
289$ for these two machines are now equal.
290$ 2. the following field definitions have been changed for s37
291$ hform - widened and moved to the low-order bits
292$ is_hashok, is_neltok - moved to the third word
293$ codeop, codea1, etc. - compacted so that each instruction
294$ occupies two instead of four words
295$ 3. a new member has been added: cndasm. it contains all the condi-
296$ tional compilation symbols for all phases.
297$ 4. the code pointer (codep) has been moved into the nameset
298$ nsgparam.
299$ 5. the macro file_max giving the maximum little file identifier has
300$ been changed to allow for twenty files on s32 and s37.
301
302
303$ 07/10/80 80192 s. freudenberger
304$
305$ 1. the following q1 opcode has been introduced: q1_error.
306$ 2. the following q2 opcodes have been introduced:
307$ q2_nincs, q2_gonincs, and q2_error
308$ 3. the following q2 opcodes have been dropped:
309$ q2_goimp and q2_gonimp
310
311
312$ 06/28/80 80180 s. freudenberger
313$
314$ a field has been added to the q1 symbol table: is_backpr. it is
315$ used during code generation to mark temporaries for which mode back-
316$ wards propagation is needed.
317
318
319$ 06/20/80 80172 s. freudenberger
320$
321$ 1. a bug has been fixed relating to the global string specifiers
322
323
324$ 05/29/80 80150 s. freudenberger
325$
326$ 1. the hash table header data structure introduced in 80130.4 has
327$ been incorporated into the compiler and run-time environment.
328$ deck affected: q2_macs
329
330
331$ 05/09/80 80130 s. freudenberger
332$
333$ 1. the is_ebfree flag has been eliminated.
334$ 2. the q1_query and q2_query opcodes have been eliminated.
335$ 3. the standard q1 symbol is_primitive, and the q1_isprim and
336$ q2_isprim opcodes have been eliminated.
337$ 4. a new q2 data structure has been introduced: the hash table
338$ block. its htype is htb, its length is hl_htb.
339$ 5. a new q2 limit macro has been introduced: max_logn. this
340$ macro defines the maximum number which will fit into the
341$ lognhedrs field.
342
343
344$ 04/11/80 80102 d. shields
345$
346$ 1. eliminate cdc update yankdeck directives.
347$ 2. increase some limits for s32 to permit compilation of lalr.
348$ 3. install miscellaneous s10 corrections needed to get setl
349$ running on s10.
350$ 4. install conditional code to permit clc and mvc to be done
351$ in machine-dependent fashion, and do this for s32.
352$ 5. fix size error for itotal.
353
354
355$ 02/04/80 80035 s. freudenberger and d. shields
356$
357$ 1. the 'words-per-card' macro has been corrected (first use of it
358$ when the deck sysmac was included by prs).
359$ 2. the 'countup' macro has been changed to test for overflow
360$ before the increment.
361$ 3. once again, the q1 symbol table fields have been widened for
362$ s32 and s37.
363$ 4. implement unary operators acos, asin, atan, char, cos, exp,
364$ log, sin, sqrt, tan and tanh.
365$ 5. implement binary operators atan2 and interrogation (?).
366$ 6. implement type predicates is_atom, is_boolean, is_integer,
367$ is_map, is_real, is_set, is_string and is_tuple.
368$ change prim to is_primitive.
369$ 7. add procedure host() to provide means for adding
370$ implementation- or site-dependent features.
371$ 8. the '.=member' cards have been deleted. s66 does pre-pass on
372$ the update source to convert *deck cards to .=member cards.
373$ systems maintained by little.upd do not require this pre-pass.
374$ 9. two new lexical classes have been introduced: read_name and
375$ read_bool. they are used by lib.read2
376$ 10. the 'hcsd' values for s32 and s37 have been changed to 2089.
377$ this prime was found to produce a better distribution of small
378$ integers than the factor used before.
379$ 11. two global string specifiers were added: mvc_ss1 and mvc_ss2.
380$ their intended use is in conjunction with the 'move-character'
381$ macro.
382
383
384$ 01/21/80 80021 s. freudenberger
385$
386$ 1. the form table limit has been increased for s32. corresponding
387$ changes have been made for the s32 q2 fields.
388$ 2. the s32 q2 instruction format has been modified to require two
389$ words per instruction (down from four).
390$ 3. macros 'max_code_address' and 'max_symtab' have been introduced
391$ to allow compile time checks for range of addressability.
392$ 4. long character string access has been parameterized differently
393$ to allow for the peculiar way the s32 stores bytes in words.
394
395
396$ 01/16/79 80016 s. freudenberger
397$
398$ subr garbcol has been renamed to grbcol.
399
400
401$ 01/15/79 80015 s. freudenberger
402$
403$ 1. the move-character macro has been recoded for greater efficiency.
404$ 2. a compare-character macro has been added.
405$ 3. an unneeded jump has been deleted from the probe_loop macro.
406$ 4. a hash-code-seed macro has been added to regain some of the
407$ efficiency lost due to the modified hashing strategy.
408
409
410$ 12/17/79 79351 s. freudenberger
411$
412$ 1. the field definition for the q1 symbol table and the form table
413$ have been redone for s32 and s37.
414$ 2. the macro 'init_probe' has been changed to reflect the current
415$ hashing strategy.
416
417
418$ 11/30/79 79334 s. freudenberger
419$
420$ 1. four new q2 opcodes have been introduced to compare for equality
421$ to true and false.
422$ 2. the maximum nesting level for setl objects has been increased to
423$ 100 for the s32.
424$ 3. the macro 'sc_max' has been introduced. although we currently do
425$ not support short character strings, the documentation of the q2
426$ data structures (setl newsletter 189) includes their definition.
427
428
429$ 11/12/79 79316 s. freudenberger
430$
431$ 1. the mode keyword 'map' has been dropped. deck 'q1symtab' has
432$ been updated accordingly.
433$ 2. the code- and argument table sizes for s32 have been doubled.
434$ 3. 'nargs_lim' has been introduced, giving the maximum number of
435$ arguments for a q1 instruction.
436$ 4. s66 now saves ten characters per q2 name, up from five.
437
438
439$ 09/13/79 79256 s. freudenberger
440$
441$ 1. the macro 'filenamlen' has been introduced.
442
443
444$ 08/31/79 79243 s. freudenberger
445$
446$
447$ this correction set installs setl 2.1
448$
449$
450$ 1. several additional utility macros have been placed into member
451$ sysmac.
452$ 2. the sequence of pre-defined symbol table entries has been
453$ changed and amended.
454$ 3. the limit for the value table has been increased for s32.
455$ 4. the form table layout for s37 has been changed to allow a
456$ maximum heap size of 4,194,302 words.
457$ 5. the sequence of q1 opcodes has been changed and amended.
458$ 6. the sequence of q2 opcodes has been changed and amended.
459$ 7. the heap dimension for s37 has been increased to 65000 words
460$ statically.
461$ 8. new standard values have been added for 'true' and 'false'.
462$ (affects nameset nsstd)
463$ 9. the dimension of 'a_s_types' has been increased to hold the
464$ string 'boolean'.
465$ 10. the values for 'next_atom' and 'max_atom' have been changed to
466$ reflect the use of 'atom 0' for 'true' and 'atom maxsi' for
467$ 'false'.
468
469
470$ 07/25/79 79206 s. freudenberger
471$
472$ 1. this deck has been installed.
473$ 2. various table limits have been modified, and are now given in
474$ conditional assembly. generally, tables have been increased for
475$ s32 (and s37), but decreased for s66.
476$ 3. the s32 and s37 code table field defnitions have been revised to
477$ achieve better pointer alignment and sizes.
478$ 4. member 'binryio' has been renamed to 'binio' to conform to update
479$ deck name.
480$ 5. the macro 'maycontract' has been corrected, so it actually tests
481$ for sparseness of the hash table, and contracts it if applicable.
482$ 6. the macro 'rs_alloc' has been corrected to return the correct value
483$ for multiples of 'rs_bpw'.
484
485
486
487
1 .=member cndasm
2
3
4$ conditional assembly
5$ ----------- -------
6
7$ this section (as well as the next section) are not neccessarily
8$ recomended first reading of the setl system. they are included
9$ here, as they describe configuration parameters for the entire
10$ setl system (such as whether a particular implementation supports
11$ upper case input only, or both upper and lower case input).
12
13$ the conditional assembly options part1, part2, ...partn divide
14$ the library into convenient sections for compilation. the limit
15$ on the length of each section is determined by the amount of macro
16$ text it contains. the various part options are selected through
17$ the -iset- option on the little control card.
18
19 .+all. $ compile the complete run-time library
20
21 .+set part1
22 .+set part2
23 .+set part3
24 .+set part4
25
26 ..all
27
28
29$ set r32 if using standard 32-bit definitions.
30$ the fields are documented once, in r32 text; the purpose
31$ is the same for other implementations.
32
33 .+s32.
34 .+set r32
35 ..s32
36 .+s37.
37 .+set r32
38 ..s37
39 .+s47.
40 .+set r32
41 ..s47
suna 9 .+s68.
suna 10 .+set r32
suna 11 ..s68
smfc 9
smfc 10$ set r36 for standard 36-bit definitions.
smfc 11
smfc 12 .+s10.
smfc 13 .+set r36
smfc 14 ..s10
smfc 15
smfc 16 .+s20.
smfc 17 .+set r36
smfc 18 ..s20
42
43$ set defenv_envrsi if procedure 'envrsi' is defined in the environment
44
45$ mhl_static is referenced in the definition of the env_mhl routine.
46$ it controls whether a static heap allocation scheme is used, in which
47$ the heap is allocated as a fixed-size array from which storage is
48$ allocated, or whether a dynamic heap allocation scheme is used, in
49$ which case requests to the operating system are issued to acquire
50$ additional storage.
51$ use mhl_dynamic for dynamic heap allocation. use mhl_s66 for s66
52$ heap allocation.
53
54$ env_gss and env_pss are set when the setl get- and put procedures are
55$ defined in the environment.
56$ set defenv_envmvc to do mvc in environment.
57$ set defenv_envclc to do clc in environment.
58
59 .+s10.
60 .+set mc $ text input is mixed case
61 .+set ssi $ string specifiers stored indirectly
62 .-set sq1 $ setl q1 interface
63 .+set defenv_envrsi
64 .+set mhl_static $ static heap menagement
65 .+set env_gss $ get setl string
66 .+set env_pss $ put setl string
67 .-set defenv_envfor $ setl-fortran interface
68 ..s10
69
70 .+s20.
71 .-set s10
72
73 .+set mc $ text input is mixed case
74 .+set ssi $ string specifiers stored indirectly
75 .-set sq1 $ setl q1 interface
76 .+set defenv_envrsi
77 .+set mhl_static $ static heap menagement
78 .+set env_gss $ get setl string
79 .+set env_pss $ put setl string
80 .-set defenv_envfor $ setl-fortran interface
81 ..s20
82
83
84 .+s32.
85 .+set s32v $ default operating system is vms
86
87 .+s32u. $ if this is unix operating system then
88 .-set s32v $ reset vms flag
89 .+set s32u $ set unix flag
90 .+set mcl $ primary case is lower case
91 ..s32u
92
93 .+set mc $ text input is mixed case
94 .+set ssi $ string specifiers stored indirectly
95 .+set sq1 $ setl q1 interface
96 .+set mhl_dynamic $ dynamic heap allocation
97 .+set env_gss $ get setl string
98 .+set env_pss $ put setl string
99 .+set defenv_envmvc
100 .+set defenv_envclc
101 .+set defenv_envfor $ setl-fortran interface
102 .-set defenv_envmhl $ use little code
103 .+set defenv_envrsi $ restart interpreter from environment
104 .+set hf $ heap file mapped to paging file
105 ..s32
106
107 .+s37.
108 .+set s37cms $ default operating system is cms
109
110 .+s37mts. $ if this is mts operating system
111 .-set s37cms $ reset cms flag
112 .+set s37mts $ set mts flag (redundant)
113 ..s37mts
114
115 .+set mc $ text input is mixed case
116 .+set ssi $ string specifiers stored indirectly
117 .+set sq1 $ setl q1 interface
118 .+set mhl_dynamic $ dynamic heap menagement
119 .+set env_gss $ get setl string
120 .+set env_pss $ put setl string
121 .+set defenv_envfor $ setl-fortran interface
asca 8 .+set ascebc $ support ebcdic-to-ascii translation
122 ..s37
123
124 .+s47.
125 .+set mc $ text input is mixed case
126 .+set mcl $ primary case is lower
127 .+set ssi $ string specifiers stored indirectly
128 .+set sq1 $ setl q1 interface
129 .-set defenv_envrsi $ use little code for envrsi
130 .+set mhl_dynamic $ dynamic heap menagement
131 .+set env_gss $ get setl string
132 .+set env_pss $ put setl string
133 .-set defenv_envfor $ setl-fortran interface
134 ..s47
135
136 .+s66.
137 .-set mc $ text input is upper case only
138 .-set ssi $ string specifiers stored directly
139 .-set sq1 $ setl q1 interface
140 .+set mhl_s66 $ dynamic heap menagement
141 .+set env_gss $ get setl string
142 .+set env_pss $ put setl string
143 .+set defenv_envfor $ setl-fortran interface
144 ..s66
suna 12
suna 13 .+s68.
suna 14 .+set mc $ text input is mixed case
suna 15 .+set mcl $ primary case is lower case
suna 16 .+set ssi $ string specifiers stored indirectly
suna 17 .+set sq1 $ setl q1 interface available
suna 18 .+set env_gss $ get setl string
suna 19 .+set env_pss $ put setl string
sunb 1 .+set defenv_envmvc $ move characters
sunb 2 .+set defenv_envclc $ compare logical characters
sunb 3 .+set defenv_envfor $ setl-fortran interface
suna 23 .+set mhl_dynamic $ dynamic heap allocation
suna 24 .-set defenv_envmhl $ manage heap length
suna 25 .+set defenv_envrsi $ restart interpreter
suna 26 .-set hf $ mapped heap file
suna 27 ..s68
145
146
147 .+set ct $ compile interpreter code trace
148 .+set gt $ garbage collector trace
149 .+set gs $ garbage collect share bits
150 .+set ic $ check interpreter opcodes
151 .-set st $ collect statistics
152 .-set tr $ compile little monitor package
153
154 .+s32u.
155 .-set defenv_envmvc $ use little version for checkout
156 .-set defenv_envclc $ use little version for checkout
157 .-set hf $ no heap map for s32u
158 ..s32u
159
160 .+mc.
161 .+mcl. $ if mixed-case to be lower
162 +* ctpc(x) = ctlc(x) ** $ primary case is lower.
163 +* stpc(x) = stlc(x) ** $ primary case is lower.
164 +* ctsc(x) = ctuc(x) ** $ secondary case is upper.
165 +* stsc(x) = stuc(x) ** $ secondary case is upper.
166 .-mcl.
167 +* ctpc(x) = ctuc(x) ** $ primary case is upper.
168 +* stpc(x) = stuc(x) ** $ primary case is upper.
169 +* ctsc(x) = ctlc(x) ** $ secondary case is lower.
170 +* stsc(x) = stlc(x) ** $ secondary case is lower.
171 ..mcl
172 ..mc
173
1 .=member sysmac
2
3$ w a r n i n g
4
5$ strange bugs can result from the use of expressions as macro
6$ arguments. the expression is evaluated in the context of the
7$ expanded macro, and thus precedences are not always what they
8$ appear to be when the macro is used. for example consider the
9$ macro
10
11$ +* half(a) = a/2 **
12
13$ then
14
15$ half(4+4)
16
17$ expands to
18
19$ 4 + 4/2
20
21$ giving the value 6, rather than the expcted value 4. to avoid this
22$ macro definitions should be written with their arguments
23$ parenthesized where there is any question of proper precedence, i.e.
24
25$ +* half(a) = (a)/2 **
26
27
28
29
30$ machine parameters
31$ ------- ----------
32
33 +* ws = .ws. ** $ machine word size
34 +* ps = .ps. ** $ machine pointer (address) size
35 +* cs = .cs. ** $ machine character size
36
37 +* cssz = $ character set size
38 .+s10 512
39 .+s20 512
40 .+r32 256
41 .+s66 64
42 **
43
44
45 +* pset_sz = $ size of string pattern set entry
46 .+s10 1 $ - use bit string
47 .+s20 1 $ - use bit string
48 .+r32 8 $ - use byte table
49 .+s66 1 $ - use bit string
50 **
51
52$ since little does not provide for exponentiation, 'compute' the
53$ limit for pattern set entries by a macro.
54
55 +* pset_lim = $ (2 ** pset_sz) - 1
56 .+s10 1
57 .+s20 1
58 .+r32 255
59 .+s66 1
60 **
61
62 +* cpc = $ characters per card
63 .+s10 80
64 .+s20 80
65 .+r32 80
66 .+s66 90
67 **
68
69 +* scpc = 72 ** $ significant characters per card
70
71 +* cpw = (ws/cs) ** $ characters per machine word
72
73 +* wpc = $ words per card
74 (((cpc-1) / cpw) + 1)
75 **
76
77 +* yes = 1 ** $ logical constant true
78 +* no = 0 ** $ logical constant false
79
80
81 +* sorg = $ origin field for sds string
82 .f. .sl.+1, .so.,
83 **
84
85 +* slen = $ length field of sds string
86 .len.
87 **
88
89 +* sds(n) = $ length of n character string
90 (.sds.(n))
91 **
92
93 +* toklen_lim = $ length of maximum symbol name
94 128
95 **
96
97 +* sds_sz = $ standard size for sds
98 (.sds. toklen_lim)
99 **
100
101
102 +* filenamlen = $ maximum length of logical file names
103 .+s10 30
104 .+s20 30
105 .+s32 64
106 .+s37 30
107 .+s47 64
108 .+s66 30
suna 28 .+s68 64
109 **
110
111
112
113$ maximum number of open files should be set to the value from little
114$ libupl, member macros, macro maxfiles, since some some std files
115$ get numbers relative to the highest legal file number
116
117 +* max_no_files = $ see file_max in q2macs below
118 .+s10 10
119 .+s20 10
120 .+r32 20
121 .+s66 10
122 **
123
124
125$ meta macros
126$ ---- ------
127
128 +* q3(a, b, c) =
129 a b c
130 **
131
132 +* macdef(text) = $ define a macro
133 q3(+, * text *, *)
134 **
135
136 +* macdrop(nam) = $ drop a macro
137 macdef(nam = )
138 **
139
140$ as will be seen from the handling of recursive variables, we often
141$ drop several macros at a time. to save ink, we use the following:
142
143 +* macdrop2(a, b) =
144 macdrop(a)
145 macdrop(b)
146 **
147
148 +* macdrop4(a, b, c, d) =
149 macdrop2(a, b)
150 macdrop2(c, d)
151 **
152
153 +* macdrop8(a, b, c, d, e, f, g, h) =
154 macdrop4(a, b, c, d)
155 macdrop4(e, f, g, h)
156 **
157
158
159
160
161$ macros to define symbolic constants
162
163$ the following two macros are used to define a series of
164$ constant identifiers. the first macro gives the identifiers
165$ values starting with 1. the second gives the identifiers
166$ zero origined values and requires considerably more compiler
167$ space. these meta macros use the counter zzyz which must
168$ be initialized before creating each set of macros.
169
170 +* defc(nam) =
171 macdef(nam = zzyz)
172 **
173
174 +* defc0(nam) =
175 macdef(nam = (zzyz-1))
176 **
177
178
179
180
181$ macro to define two dimensional indexed labels
182
183$ this is a meta-macro which defines macros for a series of indexed
184$ labels with two indices. it also defines the macros 'minlab'
185$ and 'maxlab' to be the minimum and maximum real indices.
186
187 +* deflab(l, lo, hi) =
188 macdef( l(i, j) = zzzy( (i-lo)*(hi-lo+1) + j-lo+1 ) )
189
190 macdef(minlab = 1)
191 macdef( maxlab = (hi-lo+1) * (hi-lo+1) )
192 **
193
194
195$ macro to define zero origin arrays
196
197$ the following meta-macro generates a macro for a zero origin array.
198
199 +* defzero(mac, ara) =
200 macdef(mac(i) = ara(i+1))
201 **
202
203
204$ macro to define two dimensional arrays
205
206$ the following meta-macro generates macros for two dimensional
207$ arrays with given upper and lower bounds. its parameters are:
208
209$ mac: name of macro to be defined
210$ ara: name of actual 1 dimensional array
211$ lo: lower bound for two dimensional array
212$ hi: upper bound for two dimensional array
213$ dim: macro defined for dimension of 1 dimensional array
214
215 +* defmatrix(mac, ara, lo, hi, dim) =
216
217 macdef( mac(i, j) = ara( (i-lo)*(hi-lo+1) + j-lo+1 ) )
218
219 macdef( dim = (hi-lo+1) * (hi-lo+1) )
220 **
221
222
223$ general utility macros
224$ ----------------------
225
226 +* countup(ptr, lim, msg) = $ increment array pointer
227 if (ptr >= lim) call overfl(msg);
228 ptr = ptr + 1;
229 **
230
231
232 +* swap(a, b) = $ swap word sized items
233 size zzza(ws);
234
235 zzza = a;
236 a = b;
237 b = zzza;
238 **
239
240
241 +* digofchar(c) = $ maps character to digit
242 (c - 1r0)
243 **
244
245
246 +* charofdig(d) = $ maps digit to character
247 (d + 1r0)
248 **
249
250
251
252
1 .=member q1symtab
2
3$ s y m b o l t a b l e
4$ ----------- ---------
5
6
7$ symtab contains an entry for each symbol in the program. it
8$ contains the following fields:
9
10$ name: pointer to names
11$ vptr: points to auxiliary table for value of constant
12$ vlen: gives length of value table entry in words
13$ link: links entries with same name or hash
14$ alias: used by optimizer for name splitting
15$ form: pointer to formtab for type of symbol
16$ tprev: see above
17$ tlast: see above
18$ is_mode: indicates mode
19$ is_perf: indicates perform block
20$ is_decl: indicates name has been declared
21$ is_repr: indicates repr supplied
22$ is_temp: indicates temporary
23$ is_stk: indicates stacked variable
24$ is_read: indicates variable can be read
25$ is_write: indicates variable can be written
26$ is_param: indicates formal parameter
27$ is_store: indicates storage required
28$ is_init: indicates initialised variable
29$ is_seen: indicates member, label or procedure has been seen
30$ is_avail: indicates procedure is available
31$ is_alias: indicates there exists an alias for this symbol
32$ is_back: indicates backtracked variable
33
34
35$ there are several fields which deserve special mention:
36
37$ 1. alias:
38
39$ when the optimizer performs name splitting, it will
40$ generate new names which are aliases for names in the
41$ original program. aliases always share storage with
42$ the original name.
43
44$ if a symbol is an alias, its alias field points to
45$ the symtab entry for the original name.
46
47$ 2. labval:
48
49$ this field gives the 'value' of labels and procedures. its
50$ meaning depends on the value of is_ldef:
51
52$ is_ldef = yes: q2 pointer to label or entry point
53$ is_ldef = no: q2 pointer to chain of forward references
54
55$ 3. is_ldef:
56
57$ indicates that a label or procedure has already been defined in
58$ q2.
59
60$ 4. is_store:
61
62$ this flag indicates that the symbol requires an entry in the
63$ run time symbol table. it is zero for all literals, mode names,
64$ etc.
65
66$ 5. address:
67
68$ gives run time address of symbol
69
70$ 6. is_seen
71
72$ is_seen is used to check for duplicate members and procedures.
73$ it is also used to indicate that a temporary has already been
74$ processed during the fixup phase.
75
76
77$ each temporary can be thought of as being the result of a code
78$ fragment. we provide two maps on temporaries which are used
79$ to identify their code fragment. these two maps are known as
80$ 'tprev' and 'tlast'. if 't' is a temporary, then 'tlast(t)'
81$ is not only the end of the code fragment, but actually points
82$ to the instruction which generates 't'.
83
84$ during the semantic pass, the symbol table is kept as a hash
85$ table, with the link field used to resolve all collisions.
86
87$ internally generated symbols do not have names entries. they
88$ are simply added to the end of symtab rather than hashed in.
89$ they appear in various compiler dumps as t.xxx, where xxx is
90$ their symtab index.
91
92$ the macros for symtab are:
93
94
95 .+s10. $ fields for dec-10
96 +* name(p) = .f. 001, 18, symtab(p) ** $ sem cod
97 +* link(p) = .f. 019, 18, symtab(p) ** $ sem
98 +* labval(p) = .f. 019, 18, symtab(p) ** $ cod
99 +* vptr(p) = .f. 037, 18, symtab(p) ** $ sem cod
100 +* vlen(p) = .f. 055, 08, symtab(p) ** $ sem cod
101 +* form(p) = .f. 063, 08, symtab(p) ** $ sem cod
102 +* alias(p) = .f. 073, 18, symtab(p) ** $ sem cod
103 +* tprev(p) = .f. 091, 18, symtab(p) ** $ sem
104 +* address(p) = .f. 091, 18, symtab(p) ** $ cod
105 +* tlast(p) = .f. 109, 18, symtab(p) ** $ sem
106 +* altrep(p) = .f. 109, 18, symtab(p) ** $ cod
107 +* is_mode(p) = .f. 127, 01, symtab(p) ** $ sem
108 +* is_ldef(p) = .f. 127, 01, symtab(p) ** $ cod
109 +* is_rec(p) = .f. 128, 01, symtab(p) ** $ sem cod
110 +* is_backpr(p) = .f. 129, 01, symtab(p) ** $ cod
111 +* is_perf(p) = .f. 130, 01, symtab(p) ** $ sem
112 +* is_casemap(p) = .f. 130, 01, symtab(p) ** $ cod
113 +* is_decl(p) = .f. 131, 01, symtab(p) ** $ sem
114 +* is_repr(p) = .f. 132, 01, symtab(p) ** $ sem cod
115 +* is_temp(p) = .f. 133, 01, symtab(p) ** $ sem cod
116 +* is_stk(p) = .f. 134, 01, symtab(p) ** $ sem cod
117 +* is_read(p) = .f. 135, 01, symtab(p) ** $ sem cod
118 +* is_write(p) = .f. 136, 01, symtab(p) ** $ sem cod
119 +* is_param(p) = .f. 137, 01, symtab(p) ** $ sem cod
120 +* is_store(p) = .f. 138, 01, symtab(p) ** $ sem cod
121 +* is_init(p) = .f. 139, 01, symtab(p) ** $ sem cod
122 +* is_seen(p) = .f. 140, 01, symtab(p) ** $ sem cod
123 +* is_avail(p) = .f. 141, 01, symtab(p) ** $ sem
124 +* is_alias(p) = .f. 141, 01, symtab(p) ** $ cod
125 +* is_back(p) = .f. 142, 01, symtab(p) ** $ sem cod
126 ..s10
127
128 .+s20. $ fields for dec-10
129 +* name(p) = .f. 001, 18, symtab(p) ** $ sem cod
130 +* link(p) = .f. 019, 18, symtab(p) ** $ sem
131 +* labval(p) = .f. 019, 18, symtab(p) ** $ cod
132 +* vptr(p) = .f. 037, 18, symtab(p) ** $ sem cod
133 +* vlen(p) = .f. 055, 08, symtab(p) ** $ sem cod
134 +* form(p) = .f. 063, 08, symtab(p) ** $ sem cod
135 +* alias(p) = .f. 073, 18, symtab(p) ** $ sem cod
136 +* tprev(p) = .f. 091, 18, symtab(p) ** $ sem
137 +* address(p) = .f. 091, 18, symtab(p) ** $ cod
138 +* tlast(p) = .f. 109, 18, symtab(p) ** $ sem
139 +* altrep(p) = .f. 109, 18, symtab(p) ** $ cod
140 +* is_mode(p) = .f. 127, 01, symtab(p) ** $ sem
141 +* is_ldef(p) = .f. 127, 01, symtab(p) ** $ cod
142 +* is_rec(p) = .f. 128, 01, symtab(p) ** $ sem cod
143 +* is_backpr(p) = .f. 129, 01, symtab(p) ** $ cod
144 +* is_perf(p) = .f. 130, 01, symtab(p) ** $ sem
145 +* is_casemap(p) = .f. 130, 01, symtab(p) ** $ cod
146 +* is_decl(p) = .f. 131, 01, symtab(p) ** $ sem
147 +* is_repr(p) = .f. 132, 01, symtab(p) ** $ sem cod
148 +* is_temp(p) = .f. 133, 01, symtab(p) ** $ sem cod
149 +* is_stk(p) = .f. 134, 01, symtab(p) ** $ sem cod
150 +* is_read(p) = .f. 135, 01, symtab(p) ** $ sem cod
151 +* is_write(p) = .f. 136, 01, symtab(p) ** $ sem cod
152 +* is_param(p) = .f. 137, 01, symtab(p) ** $ sem cod
153 +* is_store(p) = .f. 138, 01, symtab(p) ** $ sem cod
154 +* is_init(p) = .f. 139, 01, symtab(p) ** $ sem cod
155 +* is_seen(p) = .f. 140, 01, symtab(p) ** $ sem cod
156 +* is_avail(p) = .f. 141, 01, symtab(p) ** $ sem
157 +* is_alias(p) = .f. 141, 01, symtab(p) ** $ cod
158 +* is_back(p) = .f. 142, 01, symtab(p) ** $ sem cod
159 ..s20
160
161
162
163 .+r32. $ fields for regular 32-bit implementation
164 +* name(p) = .f. 001, 16, symtab(p) ** $ sem cod
165 +* form(p) = .f. 017, 16, symtab(p) ** $ sem cod
166 +* vptr(p) = .f. 033, 16, symtab(p) ** $ sem cod
167 +* vlen(p) = .f. 049, 16, symtab(p) ** $ sem cod
168 +* alias(p) = .f. 065, 16, symtab(p) ** $ sem cod
169 +* link(p) = .f. 081, 16, symtab(p) ** $ sem
170 +* altrep(p) = .f. 081, 16, symtab(p) ** $ cod
171 +* tprev(p) = .f. 097, 16, symtab(p) ** $ sem
172 +* labval(p) = .f. 097, 24, symtab(p) ** $ cod
173 +* tlast(p) = .f. 129, 16, symtab(p) ** $ sem
174 +* address(p) = .f. 129, 24, symtab(p) ** $ cod
175 +* is_perf(p) = .f. 121, 01, symtab(p) ** $ sem
176 +* is_ldef(p) = .f. 121, 01, symtab(p) ** $ cod
177 +* is_rec(p) = .f. 122, 01, symtab(p) ** $ sem cod
178 +* is_decl(p) = .f. 123, 01, symtab(p) ** $ sem
179 +* is_alias(p) = .f. 123, 01, symtab(p) ** $ cod
180 +* is_backpr(p) = .f. 124, 01, symtab(p) ** $ cod
181 +* is_mode(p) = .f. 125, 01, symtab(p) ** $ sem
182 +* is_casemap(p) = .f. 125, 01, symtab(p) ** $ cod
183 +* is_repr(p) = .f. 126, 01, symtab(p) ** $ sem cod
184 +* is_temp(p) = .f. 127, 01, symtab(p) ** $ sem cod
185 +* is_stk(p) = .f. 128, 01, symtab(p) ** $ sem cod
186 +* is_read(p) = .f. 153, 01, symtab(p) ** $ sem cod
187 +* is_write(p) = .f. 154, 01, symtab(p) ** $ sem cod
188 +* is_param(p) = .f. 155, 01, symtab(p) ** $ sem cod
189 +* is_store(p) = .f. 156, 01, symtab(p) ** $ sem cod
190 +* is_init(p) = .f. 157, 01, symtab(p) ** $ sem cod
191 +* is_avail(p) = .f. 158, 01, symtab(p) ** $ sem
192 +* is_seen(p) = .f. 159, 01, symtab(p) ** $ sem cod
193 +* is_back(p) = .f. 160, 01, symtab(p) ** $ sem cod
194 ..r32
195
196
197
198 .+s66. $ fields for cdc 6600
199 +* name(p) = .f. 001, 15, symtab(p) ** $ sem cod
200 +* vptr(p) = .f. 016, 15, symtab(p) ** $ sem cod
201 +* link(p) = .f. 031, 15, symtab(p) ** $ sem
202 +* labval(p) = .f. 031, 15, symtab(p) ** $ cod
203 +* alias(p) = .f. 046, 15, symtab(p) ** $ sem cod
204 +* tprev(p) = .f. 061, 15, symtab(p) ** $ sem
205 +* address(p) = .f. 061, 15, symtab(p) ** $ cod
206 +* tlast(p) = .f. 076, 15, symtab(p) ** $ sem
207 +* altrep(p) = .f. 076, 15, symtab(p) ** $ cod
208 +* form(p) = .f. 091, 08, symtab(p) ** $ sem cod
209 +* vlen(p) = .f. 099, 06, symtab(p) ** $ sem cod
210 +* is_mode(p) = .f. 105, 01, symtab(p) ** $ sem
211 +* is_ldef(p) = .f. 105, 01, symtab(p) ** $ cod
212 +* is_rec(p) = .f. 106, 01, symtab(p) ** $ sem cod
213 +* is_backpr(p) = .f. 107, 01, symtab(p) ** $ cod
214 +* is_perf(p) = .f. 108, 01, symtab(p) ** $ sem
215 +* is_casemap(p) = .f. 108, 01, symtab(p) ** $ cod
216 +* is_decl(p) = .f. 109, 01, symtab(p) ** $ sem
217 +* is_repr(p) = .f. 110, 01, symtab(p) ** $ sem cod
218 +* is_temp(p) = .f. 111, 01, symtab(p) ** $ sem cod
219 +* is_stk(p) = .f. 112, 01, symtab(p) ** $ sem cod
220 +* is_read(p) = .f. 113, 01, symtab(p) ** $ sem cod
221 +* is_write(p) = .f. 114, 01, symtab(p) ** $ sem cod
222 +* is_param(p) = .f. 115, 01, symtab(p) ** $ sem cod
223 +* is_store(p) = .f. 116, 01, symtab(p) ** $ sem cod
224 +* is_init(p) = .f. 117, 01, symtab(p) ** $ sem cod
225 +* is_seen(p) = .f. 118, 01, symtab(p) ** $ sem cod
226 +* is_avail(p) = .f. 119, 01, symtab(p) ** $ sem
227 +* is_alias(p) = .f. 119, 01, symtab(p) ** $ cod
228 +* is_back(p) = .f. 120, 01, symtab(p) ** $ sem cod
229 ..s66
230
231
232$ the first few symbol table entries are used for standard symbols.
233$ these locations are identified by the following macros:
234
235 .=zzyorg z
236
237 $ system defined modes
238 defc(sym_mgen) $ general
239 defc(sym_mint) $ integer
240 defc(sym_mreal) $ real
241 defc(sym_mstring) $ string
242 defc(sym_mbool) $ boolean
243 defc(sym_matom) $ atom
244 defc(sym_merror) $ error
245 defc(sym_melmt) $ element
246 defc(sym_mtuple) $ tuple
247 defc(sym_mset) $ set
248 defc(sym_mmap) $ ambiguous map
249 defc(sym_msmap) $ single-valued map
250 defc(sym_mmmap) $ multi-valued map
251
252 $ base types
253 defc(sym_local) $ local
254 defc(sym_remote) $ remote
255 defc(sym_sparse) $ sparse
256 defc(sym_packed) $ packed
257 defc(sym_untyped) $ untyped
258
259 $ read-write keys for routine parameters
260 defc(sym_rd) $ rd
261 defc(sym_wr) $ wr
262 defc(sym_rw) $ rw
263
264 $ 'rights' for global names
265 defc(sym_libs) $ libraries
266 defc(sym_reads) $ reads
267 defc(sym_writes) $ writes
268 defc(sym_imports) $ imports
269 defc(sym_exports) $ exports
270
271 $ system define binary operators
272 defc(sym_impl) $ impl
273 defc(sym_or) $ or
274 defc(sym_and) $ and
275 defc(sym_in) $ in
276 defc(sym_notin) $ notin
277 defc(sym_incs) $ incs
278 defc(sym_subset) $ subset
279 defc(sym_lt) $ <
280 defc(sym_le) $ <=
281 defc(sym_gt) $ >
282 defc(sym_ge) $ >=
283 defc(sym_eq) $ =
284 defc(sym_ne) $ /=
285 defc(sym_with) $ with
286 defc(sym_from) $ from
287 defc(sym_fromb) $ fromb
288 defc(sym_frome) $ frome
289 defc(sym_less) $ less
290 defc(sym_lessf) $ lessf
291 defc(sym_npow) $ npow
292 defc(sym_min) $ min
293 defc(sym_max) $ max
294 defc(sym_plus) $ +
295 defc(sym_minus) $ -
296 defc(sym_mult) $ *
297 defc(sym_slash) $ /
298 defc(sym_div) $ div
299 defc(sym_mod) $ mod
300 defc(sym_query) $ query (?)
301 defc(sym_atan2) $ atan2
302 defc(sym_exp) $ **
303
304 $ system define unary operators
305 defc(sym_not) $ not
306 defc(sym_even) $ even
307 defc(sym_odd) $ odd
308 defc(sym_isint) $ is_integer
309 defc(sym_isreal) $ is_real
310 defc(sym_isstr) $ is_string
311 defc(sym_isbool) $ is_boolean
312 defc(sym_isatom) $ is_atom
313 defc(sym_istuple) $ is_tuple
314 defc(sym_isset) $ is_set
315 defc(sym_ismap) $ is_map
316 defc(sym_arb) $ arb
317 defc(sym_dom) $ domain
318 defc(sym_range) $ range
319 defc(sym_pow) $ pow
320 defc(sym_nelt) $ #
321 defc(sym_abs) $ abs
322 defc(sym_char) $ char
323 defc(sym_ceil) $ ceil
324 defc(sym_floor) $ floor
325 defc(sym_fix) $ fix
326 defc(sym_float) $ float
327 defc(sym_sin) $ sin
328 defc(sym_cos) $ cos
329 defc(sym_tan) $ tan
330 defc(sym_arcsin) $ asin
331 defc(sym_arccos) $ acos
332 defc(sym_arctan) $ atan
333 defc(sym_tanh) $ tanh
334 defc(sym_expf) $ exp
335 defc(sym_log) $ log
336 defc(sym_sqrt) $ sqrt
337 defc(sym_rand) $ random
338 defc(sym_sign) $ sign
339 defc(sym_type) $ type
340 defc(sym_str) $ str
341 defc(sym_val) $ val
342
343 $ options for the 'debug' statement:
344
345 $ 1. parser options
346 defc(sym_ptrm0) $ macro processor trace
347 defc(sym_ptrm1)
348 defc(sym_ptrp0) $ parser trace
349 defc(sym_ptrp1)
350 defc(sym_ptrt0) $ token trace
351 defc(sym_ptrt1)
352 defc(sym_prsod) $ open token dump
353 defc(sym_prspd) $ poilish and xpolish string dumps
354 defc(sym_prssd) $ parser symbol table dump
355
356 $ 2. semantic pass options
357 defc(sym_stre0) $ entry trace
358 defc(sym_stre1)
359 defc(sym_strs0) $ stack trace
360 defc(sym_strs1)
361 defc(sym_sq1cd) $ q1 code dump
362 defc(sym_sq1sd) $ q1 symbol table dump
363 defc(sym_scstd) $ cstack dump
364
365 $ 3. code generator options
366 defc(sym_cq1cd) $ q1 code dump during fixup
367 defc(sym_cq1sd) $ q1 symbol table dump during codegen
368 defc(sym_cq2cd) $ q2 code dump during codegen
369
370 $ 4. run time options
371 defc(sym_rtre0) $ entry trace
372 defc(sym_rtre1)
373 defc(sym_rtrc0) $ code trace
374 defc(sym_rtrc1)
375 defc(sym_rtrg0) $ garbage collector trace
376 defc(sym_rtrg1)
377 defc(sym_rgcd0) $ dumps during garbage collection
378 defc(sym_rgcd1)
379 defc(sym_rdump) $ dump storage
380 defc(sym_rgarb) $ call garbage collector
381
382 $ options for the 'trace' statement
383 defc(sym_calls) $ trace calls
384 defc(sym_stmts) $ trace statements
385
386 $ system constants
387 defc(sym_int) $ 'integer'
388 defc(sym_real) $ 'real'
389 defc(sym_string) $ 'string'
390 defc(sym_bool) $ 'boolean'
391 defc(sym_atom) $ 'atom'
392 defc(sym_tuple) $ 'tuple'
393 defc(sym_set) $ 'set'
394 defc(sym_om) $ om
395 defc(sym_nullset) $ << >>
396 defc(sym_nulltup) $ (/ /)
397 defc(sym_nullstr) $ ''
398 defc(sym_true) $ true
399 defc(sym_false) $ false
400
401 $ standard integers
402 defc(sym_zero) $ 0
403 defc(sym_one) $ 1
404 defc(sym_two) $ 2
405 defc(sym_three) $ 3
406 defc(sym_four) $ 4
407 defc(sym_five) $ 5
408 defc(sym_six) $ 6
409 defc(sym_seven) $ 7
410 defc(sym_eight) $ 8
411 defc(sym_nine) $ 9
412
413 defc(sym_main_) $ name of main program
414
415 $ the run time library uses several special variables with
416 $ primal scope:
417 defc(sym_t1_) $ 'system' temporaries
418 defc(sym_t2_)
419 defc(sym_t3_)
420 defc(sym_t4_)
421 defc(sym_okval) $ value returned by 'ok'
422 defc(sym_fid) $ maps file names into numbers
423 defc(sym_free) $ set of free file numbers
424 defc(sym_fmax) $ maximum file number so far
425 defc(sym_fmode) $ maps strings for file modes into integer
426 defc(sym_io1) $ work area used by io
427 defc(sym_io2) $ work area used by io
428 defc(sym_stat) $ tuple used by statistics package
429 defc(sym_ss1) $ first system string specifier
430 defc(sym_ss2) $ second system string specifier
431 defc(sym_ovar) $ packed tuple for q2 ops_ovar
432 defc(sym_scopes) $ maps scope names to symbol table section
433 defc(sym_rnspec) $ untyped tuple for run-time names specs
434 defc(sym_rnames) $ long char block for run-time names
435 defc(sym_intf) $ fortran interface tuple
436 defc(sym_spare2)
437 defc(sym_spare3)
438 defc(sym_spare4)
439 defc(sym_spare5)
440 defc(sym_spare6)
441 defc(sym_spare7)
442 defc(sym_spare8)
443 defc(sym_spare9)
444 defc(sym_sparea)
445 defc(sym_spareb)
446 defc(sym_sparec)
447 defc(sym_spared)
448 defc(sym_sparee)
449 defc(sym_sparef)
450 defc(sym_spareg)
451 defc(sym_spareh)
452 defc(sym_sparei)
453 defc(sym_sparej)
454 defc(sym_sparek)
455
456 $ built-in procedures
457 defc(sym_open) $ open
458 defc(sym_close) $ close
459 defc(sym_print) $ print
460 defc(sym_read) $ read
461 defc(sym_printa) $ printa
462 defc(sym_reada) $ reada
463 defc(sym_get) $ get
464 defc(sym_put) $ put
465 defc(sym_getb) $ getb
466 defc(sym_putb) $ putb
467 defc(sym_getk) $ getk
468 defc(sym_putk) $ putk
469 defc(sym_getf) $ getf
470 defc(sym_callf) $ callf
471 defc(sym_putf) $ putf
472 defc(sym_rewind) $ rewind
473 defc(sym_eof) $ eof
474 defc(sym_eject) $ eject
475 defc(sym_title) $ title
476
477 defc(sym_getipp) $ getipp
478 defc(sym_getspp) $ getspp
479 defc(sym_getem) $ getem
480 defc(sym_setem) $ setem
481
482 defc(sym_host) $ host
483
484 defc(sym_span) $ span
485 defc(sym_break) $ break
486 defc(sym_match) $ match
487 defc(sym_lpad) $ lpad
488 defc(sym_len) $ len
489 defc(sym_any) $ any
490 defc(sym_notany) $ notany
491 defc(sym_rspan) $ rspan
492 defc(sym_rbreak) $ rbreak
493 defc(sym_rmatch) $ rmatch
494 defc(sym_rpad) $ rpad
495 defc(sym_rlen) $ rlen
496 defc(sym_rany) $ rany
497 defc(sym_rnotany) $ rnotany
498
499 +* sym_minumum = sym_mgen **
500 +* sym_maximum = sym_rnotany **
501
502 +* sym_mode_min = sym_mgen ** $ first mode keyword
503 +* sym_mode_max = sym_mmmap ** $ last mode keyword
504
505 +* sym_bip_min = sym_open ** $ first built-in procedure
506 +* sym_bip_max = sym_rnotany ** $ last built-in procedure
507
508 +* sym_rts_min = sym_libs ** $ minimum right to globals
509 +* sym_rts_max = sym_exports ** $ maximum right to globals
510
511 +* sym_debug_min = sym_ptrm0 ** $ minimum debugging token
512 +* sym_pdebug_min = sym_ptrm0 ** $ minimum parser option
513 +* sym_pdebug_max = sym_prssd ** $ maximum parser option
514 +* sym_sdebug_min = sym_stre0 ** $ minimum for semantic pass
515 +* sym_sdebug_max = sym_scstd ** $ maximum for semantic pass
516 +* sym_cdebug_min = sym_cq1cd ** $ minimum for code generator
517 +* sym_cdebug_max = sym_cq2cd ** $ maximum for code generator
518 +* sym_debug_max = sym_rgarb ** $ maximum debugging token
519
520
521$ symbols are considered local if they are part of the current
522$ page or unit.
523$
524$ a name is internal if its name field is zero.
525
526 +* is_local(nam) = (symtab_org < nam) **
527 +* is_internal(nam) = (name(nam) = 0) **
528 +* is_base(nam) = (is_fbase(form(nam))) **
529 +* is_proc(nam) = (ft_type(form(nam)) = f_proc) **
530 +* is_memb(nam) = (ft_type(form(nam)) = f_memb) **
531
532
533$ a symbol is a constant if it is read-only and has a val entry,
534$ or if it is omega.
535
536 +* is_const(nam) =
537 (^ is_write(nam) &
538 (vptr(nam) ^= 0 ! (nam) = sym_om ! alias(nam) = sym_om) )
539 **
540
541
542 +* is_intcon(nam) = $ internal constant
543 (is_internal(nam) & is_const(nam))
544 **
545
546
547 +* is_bip(nam) = $ true for built in procedures
548 (sym_bip_min <= nam & nam <= sym_bip_max)
549 **
550
551
552 +* symtab_sz = $ size of symtab
553 .+s10 144
554 .+s20 144
555 .+r32 160
556 .+s66 120
557 **
558
559
560 +* symtab_lim = $ symbol table limit
561 .+s10 1500
562 .+s20 1500
563 .+r32 16383
smfb 25 .+s66 1500
565 **
566
567
568 nameset nssymtab;
569
570 size symtab(symtab_sz);
571 dims symtab(symtab_lim);
572
573 size symtabp(ps),
574 symtab_org(ps);
575
576 data symtabp = 0:
577 symtab_org = 0;
578
579
580$ the following variables are used to point to the part of the
581$ symbol table occupied by global variables:
582
583 size gsym_org(ps), $ points to zero-th global
584 gsymp(ps); $ points to last global variable
585
586$ user_org points to the zero-th symbol table entry supplied from
587$ the source program.
588
589 size user_org(ps);
590
591
592
593
594$ n a m e s
595$ ---------
596
597
598$ names is a word-sized array used to store the names of tokens.
599$ we pack each token into names by converting it to a 'standard'
600$ self defining string, then putting each word of the string into
601$ a successive word of names, starting with the low order word.
602
603
604$ pointers to names always point to the low order word of a string,
605$ and thus allow us to access its slen and sorg fields.
606
607$ names entries are 'standardized' in the sense that an
608$ n-character token will always have an sorg of .sds. n + 1.
609
610
611 +* names_lim = $ dimension of -names-
612 .+s10 2500
613 .+s20 2500
614 .+r32 16343
smfb 26 .+s66 2047
616 **
617
618
619 size names(ws);
620 dims names(names_lim);
621
622 size namesp(ps),
623 names_org(ps);
624
625 data namesp = 0:
626 names_org = 0;
627
628
629$ the following macros access the slen and sorg fields of names
630$ entries:
631
632 +* n_slen(p) = slen names(p) **
633 +* n_sorg(p) = sorg names(p + (.sl.+1)/ws) **
634
635
636
637
638$ v a l
639$ -----
640
641
642$ 'val' is used to give the values of various symbols. we distinguish
643$ between two types of val entries:
644
645$ 1. run time values
646
647$ these entries represent the values of constants and constant
648$ expressions. they will eventually be translated into actual
649$ setl values and become part of the run time environment.
650
651$ val entries for run time values are not actual setl data
652$ structures, but instead are represented as follows:
653
654
655$ form val entry
656$ ---- ---------
657
658$ integers untyped integer representation of value
659
660$ reals untyped real representation of value
661
662$ strings like names entry, but without enclosing quotes
663
664$ elements symtab pointer to element
665
666$ atoms zero for atoms generated by newat, only the
667$ boolean constants true and false have a val
668$ entry (zero and -maxsi-) respectively. all
669$ other atoms with val entries must be aliased
670$ to one of these two.
671
672$ tuples the val entries for tuples have one word per
673$ component. the i-th word contains a symtab
674$ pointer to the i-th component.
675
676$ sets and maps these are like entries for tuples, except
677$ that the elements are sorted in ascending order
678$ with duplicates removed.
679
680
681
682$ 2. compile time values
683
684$ there are certain names which can be thought of as having
685$ constant values, even though the recieve no actual storage
686$ at run time. such symbols include labels, procedures, and
687$ perform blocks.
688
689$ the representation of these values is as follows:
690
691$ a. labels
692
693$ labels have a one word val entry which gives the instruction
694$ where the label is defined.
695
696$ b. perform blocks
697
698$ perform blocks have a two word entry. the first word gives
699$ the name of the label for the perform block. the second
700$ word gives the label immediately following the call to
701$ the block.
702
703$ c. members
704
705$ members have a multiword val entry with:
706
707$ 1. a set of libraries
708$ 2. a set of reads variables
709$ 3. a set of writes variables
710$ 4. a set of exported procedures
711$ 5. a set of imported procedures
712
713$ each set of procedures is represented as an integer n
714$ followed by n symbol table pointers sorted alphabeticly
715$ by their names.
716
717$ d. procedures
718
719$ procedures have a multiword val entry with:
720
721$ word 1: gives global variable used to return procedure value.
722$ word 2: yes/no indicating variable number of arguments
723$ word 3: number of arguents
724
725$ the remaining words contain one of sym_rd, sym_wr, or
726$ sym_rw to indicate the mode of the corresponding
727$ parameter.
728
729$ for procedures with a variable number of arguments, word 2
730$ gives the minimum number of arguments.
731
732
733
734$ the macros for val are:
735
736
737 +* val_lim = $ compile time value table limit
738 .+s10 2000
739 .+s20 2000
bnda 7 .+r32 24575
741 .+s66 1024
742 **
743
744
745 +* vlen_lim = $ maximum length of val entry
746 .+s10 255
747 .+s20 255
748 .+r32 65535
749 .+s66 63
750 **
751
752
753 size val(ws);
754 dims val(val_lim);
755
756 size valp(ps),
757 val_org(ps);
758
759 data valp = 0:
760 val_org = 0;
761
762 end nameset nssymtab;
763
764
765
766
1 .=member formtab
2$ -------
3
4$ formtab is used to store type information about variables, etc.
5$ the type of a variable is gathered from repr statements, from
6$ the context in which the symbol is useed, or by the global
7$ optimizer.
8
9$ the form of a variable is essentially a tree corresponding to the
10$ parse tree of the which appeared in the variables repr.
11$ each formtab entry contains a basic type code such as integer
12$ or set together with pointers to other types.
13
14$ the terminal nodes of each type tree are standard types such
15$ as integer, set(general), etc. these standard types are
16$ stored in the first few entries of formtab. the type descriptor
17$ for 'general' is stored at formtab(0). this allows us to
18$ initialize a whole series of fields to general with a single
19$ instruction.
20
21$ the basic types are identified by codes f_xxx. these codes
22$ can be used as pointers to formtab entries of the desired type.
23
24$ each base and local objects is considred to have a unique type,
25$ even though the reprs of two local sets may match. this is
26$ done since the assignment of one local object to another or
27$ one base to another always requires conversion.
28
29$ the fields of formtab are:
30
31$ ft_type: type code f_xxx
32$ ft_mapc: code ft_xxx signifiyng map, smap, or mmap.
33$ ft_elmt: form of element for sets, maps, and tuples.
34$ ft_dom: domain form for sets and maps
35$ ft_im: image form for sets and maps
36$ ft_base: base form for elements and local and remote forms
37$ ft_lim: see below
38$ ft_tup: maps remote maps into form of imbedded tuple
39$ ft_samp: see below
40$ ft_hashok: indicates hash code being maintained at run time
41$ ft_neltok: indicates nelt being maintained at run time
42$ ft_nonzero: indicates short integer is non-zero
43$ ft_link: see below
44$ ft_num: see below
45$ ft_pos: see below
46$ ft_bit: see below
47
48$ several fields deserve special mention:
49
50$ 1. ft_lim:
51
52$ this field is used differently for different types:
53
54$ a. f_mtuple
55
56$ a mixed tuple can have any number of element types. since
57$ these cannot fit directly in a formtab entry we place them
58$ in a separate table called mttab (m-ixed t-uple tab-le).
59$ mixed tuples have:
60
61$ ft_elmt: points to zero-th entry in mttab
62$ ft_lim: number of mttab entries used
63
64$ b. f_proc
65
66$ procedures can have any number of argument types. they use
67$ mttab just like mixed tuples.
68
69$ c. f_sint
70
71$ if ft_lim is non-zero it indicates the maximum value
72$ of the integer.
73
74$ d. f_tuple, f_ituple, etc.
75
76$ for homogeneous tuples, ft_lim indicates the minimum length
77$ of the tuple.
78
79$ e. bases
80
81$ ft_lim is zero for standard bases and gives the number of
82$ elements for constant bases.
83
84$ 2. ft_samp:
85
86$ ft_samp is used at run time to map each type into a 'sample
87$ value'. sample values are defined as follows:
88
89$ the sample value of a base is the base itself.
90
91$ the sample value of any other type is an omega of the proper
92$ type. in general we will use an omega which takes as little
93$ storage as possible.
94
95$ if 'f' is a form then 'ft_samp(f)' points to the symbol table
96$ entry for f's sample value.
97
98$ 3. ft_link:
99
100$ during compile time, formtab is kept as a hash table.
101$ the ft_link field is used to link entries with the same hash
102$ code.
103
104$ note that the hashing algorith is arranged so that type
105$ descriptors appear in formtab in the order in which they
106$ appear in the source. thus mode 'm' always appears before
107$ 'set(m)'. this means that formtab is topologicly sorted.
108
109$ 4. ft_num:
110
111$ ft_num is actually an array of fields which is used
112$ only for bases. it indicates how many local objects
113$ of each type are based on a particular base, and is
114$ used to determine the size of the bases element blocks.
115$ ft_num is indexed by a pair [type of base, ft_type of
116$ local object].
117
118$ 5. ft_pos:
119
120$ ft_pos is used only for local objects. it indicates the
121$ objects position in its base relative to other objects
122$ of the same type. ft_pos is used together with ft_num
123$ to determine the final position of each local object
124$ within its base.
125$ when the code generator does optimal packing, it modifies
126$ this field to the final word offset within the base element
127$ block.
128$
129$ 6. ft_bit:
130$
131$ ft_bit is used for local objects and bases. it is filled in by
132$ the code generator during optimal packing, and gives the
133$ bit position relative within the word for local sets, and
134$ the starting bit position within the word for the index
135$ field for packed local maps. for bases, it specifies the
136$ total length (ebsize) for the base element blocks.
137
138
139
140
141$ the ft_type codes are:
142
143 .=zzyorg z
144
145 defc0(f_gen) $ general
146 defc0(f_sint) $ short integer
147 defc0(f_sstring) $ short character string
148 defc0(f_atom) $ short atom
149 defc0(f_latom) $ long atom
150 defc0(f_elmt) $ element
151 defc0(f_uint) $ untyped integer
152 defc0(f_ureal) $ untyped real
153 defc0(f_int) $ long or short integer
154 defc0(f_string) $ long or short character string
155 defc0(f_real) $ real
156 defc0(f_ituple) $ integer tuple
157 defc0(f_rtuple) $ real tuple
158 defc0(f_ptuple) $ packed tuple
159 defc0(f_tuple) $ standard tuple
160 defc0(f_mtuple) $ mixed tuple
161 defc0(f_uset) $ standard set
162 defc0(f_lset) $ local subset
163 defc0(f_rset) $ remote subset
164 defc0(f_umap) $ standard map
165 defc0(f_lmap) $ local map
166 defc0(f_rmap) $ remote map
167 defc0(f_limap) $ local integer map
168 defc0(f_lrmap) $ local real map
169 defc0(f_lpmap) $ local packed map
170 defc0(f_rimap) $ remote integer map
171 defc0(f_rrmap) $ remote real map
172 defc0(f_rpmap) $ remote packed map
173 defc0(f_base) $ base
174 defc0(f_pbase) $ plex base
175
176$ the next two types are included for completeness, but are not
177$ implemented in the run time library:
178
179 defc0(f_uimap) $ unbased untyped integer map
180 defc0(f_urmap) $ unbased untyped real map
181
182 defc0(f_error) $ error
183
184$ the following types are used only within the compiler
185
186 defc0(f_proc) $ procedure or operator
187 defc0(f_memb) $ member
188 defc0(f_lab) $ label
189
190
191 +* f_min = f_gen ** $ minimum ftype
192 +* f_max = f_lab ** $ maximum ftype
193
194$ the location after f_max is reserved for 'pair of general'
195
196 +* f_pair = (f_max + 1) **
197
198$ the setl foreign i/o primitives build tuples whose elements
199$ are either zero or omega. these tuples are given the repr
200$ 'packed tuple(1 ... 1)'. the formtab entry for this repr is:
201
202 +* f_pt11 = 39 **
203
204
205 +* f_pset = $ string pattern set form
206 .+s10 39
207 .+s20 39
208 .+r32 42
209 .+s66 39
210 **
211
212$ the codes for ft_mapc are:
213
214 .=zzyorg z
215
216 defc(ft_map) $ map
217 defc(ft_smap) $ smap
218 defc(ft_mmap) $ mmap
219
220 +* ft_min = ft_map **
221 +* ft_max = ft_mmap **
222
223$ macros for formtab:
224$ ------ --- --------
225
226 +* formtab_sz = $ size of formtab
227 .+s10 108
228 .+s20 108
229 .+r32 160
230 .+s66 120
231 **
232
233
234 +* formtab_lim = $ form table limit
235 .+s10 255
236 .+s20 255
237 .+r32 2047
238 .+s66 255
239 **
240
241
242 +* formtab(p) = a_formtab(p+1) **
243
244
245 nameset nsformtab;
246
247 size a_formtab(formtab_sz);
248 dims a_formtab(formtab_lim+1);
249
250$ we maintain two pointers to formtab:
251
252$ formtabp: pointer to last entry
253
254$ formtab_org: pointer to last entry which is still needed, but has
255$ already been written on the q1 file.
256
257$ since formtab is zero origined, formtabp must have an initial
258$ value of -1, and must therefore be word sized.
259
260 size formtabp(ws),
261 formtab_org(ws);
262
263 data formtabp = -1:
264 formtab_org = -1;
265
266
267 .+s10.
268 +* ft_link(p) = .f. 1, 8, formtab(p) ** $ s
269 +* ft_samp(p) = .f. 1, 18, formtab(p) ** $ c l
270 +* ft_type(p) = .f. 19, 6, formtab(p) ** $ s o c l
271 +* ft_deref(p) = .f. 25, 8, formtab(p) ** $ s o c l
272 +* ft_mapc(p) = .f. 33, 2, formtab(p) ** $ s o c l
273 +* ft_hashok(p) = .f. 35, 1, formtab(p) ** $ s o c l
274 +* ft_neltok(p) = .f. 36, 1, formtab(p) ** $ s o c l
275 +* ft_base(p) = .f. 37, 8, formtab(p) ** $ s o c l
276 +* ft_dom(p) = .f. 45, 8, formtab(p) ** $ s o c l
277 +* ft_im(p) = .f. 53, 8, formtab(p) ** $ s o c l
278 +* ft_imset(p) = .f. 61, 8, formtab(p) ** $ s o c l
279 +* ft_elmt(p) = .f. 73, 8, formtab(p) ** $ s o c l
280 +* ft_lim(p) = .f. 81, 16, formtab(p) ** $ s o c l
281 +* ft_pos(p) = .f. 81, 8, formtab(p) ** $ s o c l
282 +* ft_tup(p) = .f. 81, 8, formtab(p) ** $ s o c l
283 +* ft_low(p) = .f. 97, 12, formtab(p) ** $ s o c l
284 +* ft_bit(p) = .f. 97, 8, formtab(p) ** $ c l
285
286 +* ft_num(p, tp) = .f. 37+(tp-f_lset)*4, 4, formtab(p) **
287 ..s10
288
289 .+s20.
290 +* ft_link(p) = .f. 1, 8, formtab(p) ** $ s
291 +* ft_samp(p) = .f. 1, 18, formtab(p) ** $ c l
292 +* ft_type(p) = .f. 19, 6, formtab(p) ** $ s o c l
293 +* ft_deref(p) = .f. 25, 8, formtab(p) ** $ s o c l
294 +* ft_mapc(p) = .f. 33, 2, formtab(p) ** $ s o c l
295 +* ft_hashok(p) = .f. 35, 1, formtab(p) ** $ s o c l
296 +* ft_neltok(p) = .f. 36, 1, formtab(p) ** $ s o c l
297 +* ft_base(p) = .f. 37, 8, formtab(p) ** $ s o c l
298 +* ft_dom(p) = .f. 45, 8, formtab(p) ** $ s o c l
299 +* ft_im(p) = .f. 53, 8, formtab(p) ** $ s o c l
300 +* ft_imset(p) = .f. 61, 8, formtab(p) ** $ s o c l
301 +* ft_elmt(p) = .f. 73, 8, formtab(p) ** $ s o c l
302 +* ft_lim(p) = .f. 81, 16, formtab(p) ** $ s o c l
303 +* ft_pos(p) = .f. 81, 8, formtab(p) ** $ s o c l
304 +* ft_tup(p) = .f. 81, 8, formtab(p) ** $ s o c l
305 +* ft_low(p) = .f. 97, 12, formtab(p) ** $ s o c l
306 +* ft_bit(p) = .f. 97, 8, formtab(p) ** $ c l
307
308 +* ft_num(p, tp) = .f. 37+(tp-f_lset)*4, 4, formtab(p) **
309 ..s20
310
311
312 .+r32.
313 +* ft_type(p) = .f. 153, 6, formtab(p) ** $ s o c l
314 +* ft_mapc(p) = .f. 159, 2, formtab(p) ** $ s o c l
315 +* ft_link(p) = .f. 131, 16, formtab(p) ** $ s
316 +* ft_samp(p) = .f. 131, 22, formtab(p) ** $ c l
317 +* ft_hashok(p) = .f. 129, 1, formtab(p) ** $ s o c l
318 +* ft_neltok(p) = .f. 130, 1, formtab(p) ** $ s o c l
319 +* ft_elmt(p) = .f. 113, 16, formtab(p) ** $ s o c l
320 +* ft_deref(p) = .f. 97, 16, formtab(p) ** $ s o c l
321 +* ft_base(p) = .f. 65, 16, formtab(p) ** $ s o c l
322 +* ft_dom(p) = .f. 81, 16, formtab(p) ** $ s o c l
323 +* ft_im(p) = .f. 49, 16, formtab(p) ** $ s o c l
324 +* ft_imset(p) = .f. 33, 16, formtab(p) ** $ s o c l
325 +* ft_low(p) = .f. 1, 16, formtab(p) ** $ s o c l
326 +* ft_bit(p) = .f. 1, 8, formtab(p) ** $ c l
327 +* ft_lim(p) = .f. 17, 16, formtab(p) ** $ s o c l
328 +* ft_pos(p) = .f. 17, 16, formtab(p) ** $ s o c l
329 +* ft_tup(p) = .f. 17, 16, formtab(p) ** $ s o c l
330
331 +* ft_num(p, tp) = .f. 33+(tp-f_lset)*8, 8, formtab(p) **
332 ..r32
333
334
335 .+s66.
336 +* ft_type(p) = .f. 1, 8, formtab(p) ** $ s o c l
337 +* ft_elmt(p) = .f. 9, 8, formtab(p) ** $ s o c l
338 +* ft_dom(p) = .f. 17, 8, formtab(p) ** $ s o c l
339 +* ft_im(p) = .f. 25, 8, formtab(p) ** $ s o c l
340 +* ft_imset(p) = .f. 33, 8, formtab(p) ** $ s o c l
341 +* ft_base(p) = .f. 41, 8, formtab(p) ** $ s o c l
342 +* ft_deref(p) = .f. 49, 8, formtab(p) ** $ s o c l
343 +* ft_mapc(p) = .f. 57, 2, formtab(p) ** $ s o c l
344 +* ft_hashok(p) = .f. 59, 1, formtab(p) ** $ s o c l
345 +* ft_neltok(p) = .f. 60, 1, formtab(p) ** $ s o c l
346 +* ft_low(p) = .f. 61, 16, formtab(p) ** $ s o c l
347 +* ft_bit(p) = .f. 61, 8, formtab(p) ** $ c l
348 +* ft_lim(p) = .f. 77, 16, formtab(p) ** $ s o c l
349 +* ft_pos(p) = .f. 77, 8, formtab(p) ** $ s o c l
350 +* ft_tup(p) = .f. 77, 8, formtab(p) ** $ s o c l
351 +* ft_link(p) = .f. 93, 8, formtab(p) ** $ s
352 +* ft_samp(p) = .f. 93, 16, formtab(p) ** $ c l
353
354 +* ft_num(p, tp) = .f. 17+(tp-f_lset)*4, 4, formtab(p) **
355 ..s66
356
357
358 +* ft_lim_max = $ maximum value which will fit in ft_lim
359 .+s10 65535
360 .+s20 65535
361 .+r32 65535
362 .+s66 65535
363 **
364
365
366 +* ft_low_max = $ maximum value which will fit in ft_low
367 .+s10 4095
368 .+s20 4095
369 .+r32 65535
370 .+s66 65535
371 **
372
373
374 +* ft_num_max = $ maximum value which will fit in ft_num
375 .+s10 15
376 .+s20 15
377 .+r32 255
378 .+s66 15
379 **
380
381
382$ predicates on forms:
383$ ---------- -- ------
384
385$ we provide the following predicates on forms:
386
387$ is_fint: true for typed and untyped integers
388$ is_freal: true for typed and untyped reals
389$ is_funt: true for untyped integers and reals
390$ is_fnum: true for integers and reals
391$ is_fstr: true for strings
392$ is_fprim: true for primitive types
393$ is_ftup: true for tuples
394$ is_fset: true for sets, maps, and bases
395$ is_fmap: true for maps
396$ is_floc: true for local sets and maps
397$ is_frem: true for remote sets and maps
398$ is_fbsd: true for based types, bases, and long atoms
399$ is_fimap: true for untyped integer maps
400$ is_frmap: true for untyped real maps
401$ is_fbase: true for bases and plex bases
402
403 +* is_fint(fm) = .f. 01, 1, ft_type_tab(1+ft_type(fm)) **
404 +* is_freal(fm) = .f. 02, 1, ft_type_tab(1+ft_type(fm)) **
405 +* is_funt(fm) = .f. 03, 1, ft_type_tab(1+ft_type(fm)) **
406 +* is_fnum(fm) = .f. 04, 1, ft_type_tab(1+ft_type(fm)) **
407 +* is_fstr(fm) = .f. 05, 1, ft_type_tab(1+ft_type(fm)) **
408 +* is_fprim(fm) = .f. 06, 1, ft_type_tab(1+ft_type(fm)) **
409 +* is_ftup(fm) = .f. 07, 1, ft_type_tab(1+ft_type(fm)) **
410 +* is_fset(fm) = .f. 08, 1, ft_type_tab(1+ft_type(fm)) **
411 +* is_fmap(fm) = .f. 09, 1, ft_type_tab(1+ft_type(fm)) **
412 +* is_floc(fm) = .f. 10, 1, ft_type_tab(1+ft_type(fm)) **
413 +* is_frem(fm) = .f. 11, 1, ft_type_tab(1+ft_type(fm)) **
414 +* is_fbsd(fm) = .f. 12, 1, ft_type_tab(1+ft_type(fm)) **
415 +* is_fimap(fm) = .f. 13, 1, ft_type_tab(1+ft_type(fm)) **
416 +* is_frmap(fm) = .f. 14, 1, ft_type_tab(1+ft_type(fm)) **
417 +* is_fbase(fm) = .f. 15, 1, ft_type_tab(1+ft_type(fm)) **
418
419$ ft_type_tab gives values for predicates on forms. the array
420$ is indexed by (zero-origin) type, and is defined to yield
421$ zero if other than expected type used. thus dimension of
422$ ft_type_tab corresponds to width of ft_type field.
423
424 size ft_type_tab(ws);
425 dims ft_type_tab(64);
426 data ft_type_tab =
427 $ b r i b r l m s t p s n u r i
428 $ a m m s e o a e u r t u n e n
429 $ s a a d m c p t p i r m t a t
430 $ e p p m l
431 $
432 1b' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0', $ f_gen
433 1b' 0 0 0 0 0 0 0 0 0 1 0 1 0 0 1', $ f_sint
434 1b' 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0', $ f_sstring
435 1b' 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0', $ f_atom
436 1b' 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0', $ f_latom
smfb 27 1b' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0', $ f_elmt
438 1b' 0 0 0 0 0 0 0 0 0 1 0 1 1 0 1', $ f_uint
439 1b' 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0', $ f_ureal
440 1b' 0 0 0 0 0 0 0 0 0 1 0 1 0 0 1', $ f_int
441 1b' 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0', $ f_string
442 1b' 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0', $ f_real
443 1b' 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0', $ f_ituple
444 1b' 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0', $ f_rtuple
445 1b' 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0', $ f_ptuple
446 1b' 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0', $ f_tuple
447 1b' 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0', $ f_mtuple
448 1b' 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0', $ f_uset
449 1b' 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0', $ f_lset
450 1b' 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0', $ f_rset
451 1b' 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0', $ f_umap
452 1b' 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0', $ f_lmap
453 1b' 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0', $ f_rmap
454 1b' 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0', $ f_limap
455 1b' 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0', $ f_lrmap
456 1b' 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0', $ f_lpmap
457 1b' 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0', $ f_rimap
458 1b' 0 1 0 1 1 0 1 1 0 0 0 0 0 0 0', $ f_rrmap
459 1b' 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0', $ f_rpmap
460 1b' 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0', $ f_base
461 1b' 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0', $ f_pbase
462 1b' 0 0 1 0 0 0 1 1 0 0 0 0 0 0 0', $ f_uimap
463 1b' 0 1 0 0 0 0 1 1 0 0 0 0 0 0 0', $ f_urmap
464 1b' 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0', $ f_error
465 1b' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0', $ f_proc
466 1b' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0', $ f_memb
467 1b' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0', $ f_lab
468 0(28);
469
470
471$ 'is_local_repr' is true if a repr 'fm' was given in the current
472$ scope:
473
474 +* is_local_repr(fm) =
475 (fm >= formtab_org)
476 **
477
478
479$ 'is_fplex' is true for 'local set(elmt plex base)'
480 +* is_fplex(fm) =
481 (is_floc(fm) & ft_type(ft_base(fm)) = f_pbase)
482 **
483
484
485$ two local objects always have different formtab entries even if
486$ they have the same repr. 'same_repr' is true if the forms for
487$ two sets came from the same repr:
488
489 +* same_repr(f1, f2) =
490 (ft_type(f1) = ft_type(f2) &
491 ft_elmt(f1) = ft_elmt(f2) &
492 ft_im(f1) = ft_im(f2) &
493 ft_mapc(f1) = ft_mapc(f2))
494 **
495
496
497$ two sets are said to have similar reprs if they are the same
498$ except for their ft_mapc values.
499
500 +* similar_repr(f1, f2) =
501 (ft_type(f1) = ft_type(f2) & ft_elmt(f1) = ft_elmt(f2))
502 **
503
504
505$ macros for mttab:
506$ ------ --- ------
507
508
509 +* mttab_lim = $ mixed-tuple table limit
510 .+s10 255
511 .+s20 255
512 .+r32 2047
513 .+s66 255
514 **
515
516
517 size mttab(ps);
518 dims mttab(mttab_lim);
519
520 size mttab_org(ps), $ origin of current slice
521 mttabp(ps); $ end of current slice
522
523 data mttab_org = 0:
524 mttabp = 0;
525
526 end nameset nsformtab;
527
528
529
530
1 .=member q1code
2
3
4$ q1 code data structures
5$ -- ---- ---- ----------
6
7
8$ the q1 code uses three data structure: codetab, argtab, and
9$ blocktab.
10
11$ codetab is a list space used to build lists of instructions.
12$ the code for the current routine is a list which starts at
13$ 'prog_start' and ends at 'prog_end'.
14
15$ argtab contains the actual arguments for instructions. its
16$ entries are always symbol table pointers.
17
18$ blocktab contains various maps defined on the set of basic
19$ block which make up the q1 code at the end of the semantic pass.
20
21
22$ codetab has the following fields:
23
24$ opcode: code q1_xxx
25$ nargs: number of arguments
26$ argp: pointer to zero-th argument in argtab
27$ blockof: pointer to blocktab for containing block
28$ next: pointer to next instruction
29$ cflag: copy flag, see below.
30$ sflag: share flag, see below.
31
32$ arguments are accessed by the following macros:
33
34$ argn(i, n): n-th argument of instruction i
35$ arg1(i): first argument
36$ arg2(i): second argument
37$ arg3(i): third argument
38$ arg4(i): fourth argument
39
40$ certain instructions destroy one of their inputs. in general,
41$ the input must be copied before it can be used destructively.
42$ the optimizer detects cases where the copy is unnecessary,
43$ or where it is necessary only if the input is shared.
44
45$ if an instruction is destructive, then its 'cflag' field
46$ indicates what copying must be performed. it has one of the
47$ following values:
48
49 .=zzyorg z
50
51 defc0(copy_no); $ no copy
52 defc0(copy_yes); $ copy unconditionally
53 defc0(copy_test); $ make run time test; copy if shared
54
55$ the opcode of an instruction determines which argument is used
56$ destructively, if any.
57
58$ whenever there is more than one pointer to a run time object
59$ we say that it is 'shared'. shared object can never be used
60$ destructively.
61
62$ each run time object contains a bit which indicates whether
63$ the object is shared. certain instructions, such as 's with x'
64$ cause one of their inputs to be shared, and thus must set its
65$ share bit. the optimizer eliminates unnecessary setting of share
66$ bits.
67
68$ the 'sflag' field of each instruction indicates whether the
69$ relavent input must have its share bit set. its values are
70$ 'yes' and 'no'.
71
72
73$ macros for codetab:
74$ ------ --- --------
75
76
77 .+s10.
78 +* cflag(p) = .f. 01, 02, codetab(p) **
79 +* argp(p) = .f. 03, 14, codetab(p) **
80 +* sflag(p) = .f. 17, 01, codetab(p) **
81 +* next(p) = .f. 19, 18, codetab(p) **
82 +* opcode(p) = .f. 37, 08, codetab(p) **
83 +* nargs(p) = .f. 45, 08, codetab(p) **
84 +* blockof(p) = .f. 53, 12, codetab(p) **
85 ..s10
86
87 .+s20.
88 +* cflag(p) = .f. 01, 02, codetab(p) **
89 +* argp(p) = .f. 03, 14, codetab(p) **
90 +* sflag(p) = .f. 17, 01, codetab(p) **
91 +* next(p) = .f. 19, 18, codetab(p) **
92 +* opcode(p) = .f. 37, 08, codetab(p) **
93 +* nargs(p) = .f. 45, 08, codetab(p) **
94 +* blockof(p) = .f. 53, 12, codetab(p) **
95 ..s20
96
97
98 .+r32.
99 +* opcode(p) = .f. 01, 08, codetab(p) **
100 +* nargs(p) = .f. 09, 08, codetab(p) **
101 +* blockof(p) = .f. 17, 12, codetab(p) **
102 +* cflag(p) = .f. 29, 02, codetab(p) **
103 +* sflag(p) = .f. 31, 01, codetab(p) **
104 +* argp(p) = .f. 33, 16, codetab(p) **
105 +* next(p) = .f. 49, 16, codetab(p) **
106 ..r32
107
108
109 .+s66.
110 +* cflag(p) = .f. 01, 02, codetab(p) **
111 +* argp(p) = .f. 03, 14, codetab(p) **
112 +* sflag(p) = .f. 17, 01, codetab(p) **
113 +* next(p) = .f. 18, 15, codetab(p) **
114 +* opcode(p) = .f. 33, 08, codetab(p) **
115 +* nargs(p) = .f. 41, 08, codetab(p) **
116 +* blockof(p) = .f. 49, 12, codetab(p) **
117 ..s66
118
119
120 +* argn(i, n) = argtab(argp(i) + n) **
121 +* arg1(i) = argn(i, 1) **
122 +* arg2(i) = argn(i, 2) **
123 +* arg3(i) = argn(i, 3) **
124 +* arg4(i) = argn(i, 4) **
125
126
127
128 +* codetab_sz = $ codetab size
129 .+s10 72
130 .+s20 72
131 .+r32 64
132 .+s66 60
133 **
134
135
136 +* codetab_lim = $ code table limit
137 .+s10 8191
138 .+s20 8191
smfb 28 .+r32 12287
140 .+s66 2048
141 **
142
143
144 +* argtab_lim = $ argument table limit
145 .+s10 4000
146 .+s20 4000
smfb 29 .+r32 24575
148 .+s66 4096
149 **
150
151
152 +* blocktab_lim = $ block table limit
153 .+s10 256
154 .+s20 256
smfb 30 .+r32 2047
smfb 31 .+s66 511
157 **
158
159
160 +* nargs_lim = $ maximum number of arguements
161 255
162 **
163
164
165 nameset nsq1code;
166
167 size codetab(codetab_sz);
168 dims codetab(codetab_lim);
169
170 size codetabp(ps),
171 codetab_org(ps);
172
173 data codetabp = 0:
174 codetab_org = 0;
175
176 size prog_start(ps), $ start of program
177 prog_end(ps); $ end of program
178
179
180$ argtab:
181$ -------
182
183$ argtab contains the actual arguments for instructions. its
184$ entries are always symbol table pointers.
185$ the macros for argtab are:
186
187 size argtab(ps);
188 dims argtab(argtab_lim);
189
190 size argtabp(ps),
191 argtab_org(ps);
192
193 data argtabp = 0:
194 argtab_org = 0;
195
196
197$ blocktab:
198$ ---------
199
200$ in its final format, the q1 code consists of a set of basic
201$ blocks, each of which contains a list of instructions. blocktab
202$ contains various maps which are defined on these blocks.
203$ these are:
204
205$ b_first: pointer to first instruction
206$ b_rout: pointer to routine name for block
207
208$ blocks are identified by their blocktab index.
209
210 +* b_first(p) = .f. 01, 16, blocktab(p) **
211 +* b_rout(p) = .f. 17, 16, blocktab(p) **
212
213
214 size blocktab(32);
215 dims blocktab(blocktab_lim);
216
217 size blocktabp(ps),
218 blocktab_org(ps);
219
220 data blocktabp = 0:
221 blocktab_org = 0;
222
223 end nameset nsq1code;
224
225
226$ q1 operator codes
227$ -- -------- -----
228
229
230 .=zzyorg z
231
232$ binary operators
233
234 defc(q1_add) $ +
235 defc(q1_div) $ .div
236 defc(q1_exp) $ **
237 defc(q1_eq) $ =
238 defc(q1_ge) $ >=
239 defc(q1_lt) $ <
smfb 32 defc(q1_pos) $ > 0 (used only for arithmetic iterators)
240 defc(q1_in) $ in
241 defc(q1_incs) $ .incs, .subset
242 defc(q1_less) $ .less
243 defc(q1_lessf) $ .lessf
244 defc(q1_max) $ .max
245 defc(q1_min) $ .min
246 defc(q1_mod) $ //
247 defc(q1_mult) $ *
248 defc(q1_ne) $ /=
249 defc(q1_notin) $ notin
250 defc(q1_npow) $ .npow
251 defc(q1_atan2) $ atan2
252 defc(q1_slash) $ /
253 defc(q1_sub) $ -
254 defc(q1_with) $ .with
255
256$ unary operators - of form a1 := op a2 except where noted
257
258 defc(q1_abs) $ .abs
259 defc(q1_char) $ char
260 defc(q1_ceil) $ ceiling
261 defc(q1_floor) $ floor
262 defc(q1_isint) $ is_integer
263 defc(q1_isreal) $ is_real
264 defc(q1_isstr) $ is_string
265 defc(q1_isbool) $ is_boolean
266 defc(q1_isatom) $ is_atom
267 defc(q1_istup) $ is_tuple
268 defc(q1_isset) $ is_set
269 defc(q1_ismap) $ is_map
270 defc(q1_arb) $ .arb
271 defc(q1_val) $ .val
272 defc(q1_dom) $ .domain
273 defc(q1_fix) $ .fix
274 defc(q1_float) $ .float
275 defc(q1_nelt) $ ?
276 defc(q1_not) $ .not
277 defc(q1_pow) $ .pow
278 defc(q1_rand) $ .random
279 defc(q1_sin) $ sin
280 defc(q1_cos) $ cos
281 defc(q1_tan) $ tan
282 defc(q1_arcsin) $ asin
283 defc(q1_arccos) $ acos
284 defc(q1_arctan) $ atan
285 defc(q1_tanh) $ tanh
286 defc(q1_expf) $ exp
287 defc(q1_log) $ log
288 defc(q1_sqrt) $ sqrt
289 defc(q1_range) $ .range
290 defc(q1_type) $ .type
291 defc(q1_umin) $ unary minus
292 defc(q1_even) $ .even
293 defc(q1_odd) $ .odd
294 defc(q1_str) $ .str
295 defc(q1_sign) $ .sign
296
297$ miscellaneous
298
299 defc(q1_end) $ a1 := a2(a3...)
300 defc(q1_subst) $ a1 := a2(a3...a4)
301 defc(q1_newat) $ a1 := .newat
302 defc(q1_time) $ a1 := .time
303 defc(q1_date) $ a1 := .date
304 defc(q1_na) $ number of arguments for current routine
305 defc(q1_set) $ set former
306 defc(q1_set1) $ set formed with loop
307 defc(q1_tup) $ tuple former
308 defc(q1_tup1) $ tuple formed with loop
309 defc(q1_from) $ a1 .from a2;
310 defc(q1_fromb) $ fromb
311 defc(q1_frome) $ frome
312
313$ iterators
314
315 defc(q1_next) $ a1 := next element of a3
316 defc(q1_nextd) $ a1 := next element of domain a3
317 defc(q1_inext) $ initialize next loop
318 defc(q1_inextd) $ initialize nextd loop
319
320$ mappings
321
322 defc(q1_of) $ a1 := a2(a3)
323 defc(q1_ofa) $ a1 := a2<>
324
325 defc(q1_sof) $ a1(a2) := a3
326 defc(q1_sofa) $ a1<> := a3
327 defc(q1_send) $ a1(a2...) := a3
328 defc(q1_ssubst) $ a1(a2...a3) := a4
329
330$ assignments - all assign a2 to a1
331
332 defc(q1_asn) $ a1 := a2
333
334$ argument passage - a1 is argument, a2 is routine, a3 is argument no.
335
336 defc(q1_argin) $ assign argument to formal parameter
337 defc(q1_argout) $ assignment back to argument
338
339 defc(q1_push) $ push element for set former
340 defc(q1_free) $ free stack space after call
341
342$ control statements
343
344 defc(q1_call) $ call a1. a2 is no. of args
345 defc(q1_goto) $ goto a1
346
347 defc(q1_if) $ if a1 then goto a2
348 defc(q1_ifnot) $ if .not a1 then go to a2;
smfb 33 defc(q1_bif) $ if a1 then goto a2 (a1 is boolean)
smfb 34 defc(q1_bifnot) $ if not a1 then goto a2 (a1 is boolean)
smfb 35 defc(q1_ifasrt) $ if getipp('assert=1/2') = 0 then goto a1
349 defc(q1_case) $ t := a1(a2); if t = om then goto a3;
350 defc(q1_stop) $ stop
351
352 defc(q1_entry) $ procedure entry point. a1 is routine
353 defc(q1_exit) $ routine exit. a1 is routine name
354
355 defc(q1_ok) $ ok
356 defc(q1_lev) $ get ok level
357 defc(q1_fail) $ fail
358 defc(q1_succeed) $ succeed
359
360 defc(q1_asrt) $ if not a1 then error; end;
361 defc(q1_stmt) $ indicates start of new statement
362 defc(q1_label) $ 'a1:' defines label a1
363 defc(q1_tag) $ label for case tag
364 defc(q1_debug) $ debugging request
365 defc(q1_trace) $ trace request
366 defc(q1_notrace) $ cancel trace request
367 defc(q1_error) $ compile time error
368 defc(q1_noop) $ indicates dead instruction
369
370 +* q1_minimum = q1_add ** $ minumum opcode
371 +* q1_maximum = q1_noop ** $ maximum opcode
372
373
1 .=member q2flds
2
3
4$ macros for accessing words of heap, etc.
5
6$ define q2flds.
7
8 .+r32. $ macros for regular 32-bit implementations
9
10$ field extractors
11
12$ fields for specifiers
13
14 +* value_ = .f. 03, 22, ** $ value
15 +* type_ = .f. 25, 04, ** $ type code
16 +* is_om_ = .f. 29, 01, ** $ flags om value
17 +* is_multi_ = .f. 02, 01, ** $ flags multivalued image
18 +* is_shared_ = .f. 01, 01, ** $ share bit
19
20
21$ fields overlapping several specifiers fields
22
23 +* otype_ = .f. 25, 08, ** $ type and is_om
24 +* tvalue_ = .f. 03, 26, ** $ type and value
suna 29 +* otvalue_ = .f. 03, 30, ** $ is_om, type, and value
26 +* ivalue_ = .f. 03, 22, ** $ short integer value
27
28$ standard pointer
29
30$ all pointers except -hlink- are aligned with the following field:
31 +* stdptr_ = .f. 03, 22, **
32
33
34
35$ fields for short strings
36
stra 8 +* sc_chars_ = .f. 09, 08, ** $ characters
stra 9 +* sc_nchars_ = .f. 03, 01, ** $ length
39
40$ standard header fields for heap blocks
41
42 +* hlink_ = .f. 03, 22, ** $ links header to specifier
43 +* htype_ = .f. 25, 08, ** $ type h_xxx
44
45$ between garbage collections the -hlink- field cannot contain a
46$ pointer into the collectable part of the heap. since the first
47$ few hundred words of the heap are not garbage collectable, the
48$ -hlink- field can be reused to hold flags or small integers.
49$ these values will be restored as the first step of the collectors
50$ pointer adjustment phase. thus this is a good place for ebsize
51$ and similar small values.
52
53
54$ the garbage collector assumes that each dead heap block is large
55$ enough to hold the htype, hlink, and one additional pointer
56$ sized field called -hsize- which gives the size of the next live
57$ block following the dead one.
58
59 +* hsize_ = .f. 01, hs, **
60
61
62
63
64$ fields for long integers
65
smfb 36 +* li_nwords_ = .f. 01, 16, ** $ number of words in block
67
68$ fields for long character string data blocks
69
70 +* lc_nwords_ = .f. 01, hs, ** $ no. of words in block
71
72
73$ fields for indirect string data blocks
74
75 +* ic_ptr_ = stdptr_ ** $ pointer to valu
76 +* ic_len_ = .f. 17, 16, ** $ length in string
77 +* ic_ofs_ = .f. 01, 16, ** $ offset within word
78
79$ long atoms
80
81 +* la_form_ = .f. 01, 16, ** $ long atom form
82 +* la_nwords_ = .f. 17, 08, ** $ block length
83 +* la_nlmaps_ = .f. 25, 08, ** $ no. of local maps
84
85$ note that there is no field macro for la_value_ since it always
86$ occupies a full word.
87
88$ reals
89
90 +* rval_ = .f. 01, ws, ** $ value
91
92
93$ common fields for set and tuple headers
94
95 +* hform_ = .f. 01, 16, ** $ form table pointer
96 +* nelt_ = .f. 17, 16, ** $ cardinality
97 +* hash_ = .f. 01, 16, ** $ hash code
98 +* is_hashok_ = .f. 31, 01, ** $ flags valid hash field
99 +* is_neltok_ = .f. 32, 01, ** $ flags valid nelt field
100
101
102
103$ aditional fields for set header
104
105 +* hashtb_ = stdptr_ ** $ ptr to hash table
106 +* is_based_ = .f. 26, 01, ** $ flags subset or based map
107 +* is_map_ = .f. 27, 01, ** $ flags map of any type
108 +* is_mmap_ = .f. 28, 01, ** $ map always kept in mmap form
109 +* is_smap_ = .f. 29, 01, ** $ flags smap
110 +* is_elset_ = .f. 30, 01, ** $ flags set or map of base elem
111
112$ extra fields for bases
113
114 +* blink_ = stdptr_ ** $ chains all bases
115 +* rlink_ = stdptr_ ** $ chains base to its remote
116 +* nlmaps_ = .f. 25, 08, ** $ no. of local maps
117
118
119$ extra fields for tuple header
120
121 +* is_range_ = .f. 25, 01, ** $ flags iteration over range
122 +* maxindx_ = stdptr_ ** $ maximum index
123
124$ fields for hash table header
125
126
127 +* neb_ = .f. 01, 16, ** $ number of headers.
128 +* lognhedrs_ = .f. 25, 08, ** $ log2 number of hash headers
129
130$ fields for local maps and subsets
131
132
133 +* ls_bits_ = .f. 25, 08, ** $ bits/packed value
134 +* ls_word_ = .f. 17, 08, ** $ word offset
135 +* ls_bit_ = .f. 25, 08, ** $ bit offset
136
137$ note there is no field macro for ls_key since it always
138$ occupies a full word.
139
140$ fields for remote sets
141
142 +* rs_maxi_ = .f. 17, 16, ** $ maximum index
143
144
145$ fields for -pack word- used by packed tuples
146
147
148 +* ptbits_ = .f. 17, 08, ** $ bits per value
149 +* ptvals_ = .f. 25, 08, ** $ values per word
150
151$ note there is no field macro for ptkey since it occupies a full
152$ word.
153
154
155$ fields for element block
156
157 +* eblink_ = stdptr_ ** $ link to next eb
158 +* is_ebhedr_ = .f. 25, 01, ** $ flags hash header
159 +* is_ebtemp_ = .f. 27, 01, ** $ flags template block
160 +* ebsize_ = hlink_ ** $ eb size - overlaps hlink
161
162$ note that -ebspec- has no field macro since it is always
163$ a full heap word.
164
165$ fields for base ebs.
166
167 +* ebform_ = .f. 01, 16, ** $ pointer to base form
168 +* is_eblive_ = .f. 17, 01, ** $ live eb during base compact
169 +* ebindx_ = .f. 01, 16, ** $ index in base
170 +* ebhash_ = .f. 17, 16, ** $ element hash code
171
172
173$ extra field for unbased map eb-s
174
175$ ebimag has no field macro since it is always a full heap word
176
177
178$ fields for interpretable code
179
180$ a code block consists of a header followed by a series of
181$ instructions. the header has one field:
182
183$ codenw: length of block
184
185$ each instruction has:
186
187$ codeop: opcode q2_xxx
188$ codea1: first argument
189$ codea2: second argument
190$ codea3: third argumrent
191$ codea4: fourth argument
192
193$ the first three arguments may be pointers or small integers. the
194$ fourth argument is a code copy_xxx used to pass copying information
195$ onto certain library routines.
196
197 +* codenw_ = .f. 01, hs, **
198
199 +* codeop_ = .f. 23, 10, ** $ q2 opcode
200 +* codea1_ = .f. 03, 20, ** $ first argument
201 +* codea2_ = .f. 01, 16, ** $ second argument
202 +* codea3_ = .f. 17, 16, ** $ third argument
203 +* codea4_ = .f. 01, 02, ** $ copy flag
204
205
206
207
208
209$ macros for word offsets of fields
210
211 +* off_value = 00 ** $ value
212 +* off_type = 00 ** $ type code
213 +* off_is_om = 00 ** $ flags om value
214 +* off_is_multi = 00 ** $ flags multivalued image
215 +* off_is_shared = 00 ** $ flags shared value
216
217
218$ fields overlapping several specifiers fields
219
220 +* off_otype = 00 ** $ type and is_om
221 +* off_tvalue = 00 ** $ type and value
222 +* off_otvalue = 00 ** $ type, value and is_om
223 +* off_ivalue = 00 ** $ short integer value
224
225
226 +* off_stdptr = 00 ** $ standard pointer
227
228$ fields for short strings
229
230 +* off_sc_chars = 00 ** $ actual value.
231 +* off_sc_nchars = 00 ** $ length. overlaps sb_nbits
232
233
234$ common fields for block headers
235
236 +* off_hlink = 00 ** $ garbage collector chain
237 +* off_htype = 00 ** $ type h_xxx
238 +* off_hsize = 01 ** $ block size
239
240
241
242
243$ fields for long integers
244
245 +* off_li_nwords = 01 ** $ number of words in block
246
247
248$ field for long string data blocks
249
250 +* off_lc_nwords = 01 ** $ block length
251
252
253$ fields for indirect strings
254
255 +* off_ic_ptr = 02 ** $ pointer to valu
256 +* off_ic_len = 01 ** $ length in characters
257 +* off_ic_ofs = 01 ** $ offset within word
258
259 $ long atoms
260
261 +* off_la_value = 01 ** $ long atom value
262 +* off_la_form = 02 ** $ long atom form
263 +* off_la_nwords = 02 ** $ length
264 +* off_la_nlmaps = 02 ** $ no. of local maps
265
266$ reals
267
268 +* off_rval = 01 ** $ value
269
270
271$ common fields for set and tuple headers
272
273 +* off_hform = 02 ** $ pointer to form
274 +* off_nelt = 01 ** $ cardinality
275 +* off_hash = 01 ** $ hash code
276 +* off_is_hashok = 03 ** $ flags valid hash field
277 +* off_is_neltok = 03 ** $ flags valid nelt field
278
279
280
281$ aditional fields for set header
282
283 +* off_hashtb = 03 ** $ ptr to hash table
284 +* off_is_based = 03 ** $ flags subset or based map
285 +* off_is_map = 03 ** $ flags map of any type
286 +* off_is_mmap = 03 ** $ map alwats kept in mmap for
287 +* off_is_smap = 03 ** $ flags smap
288 +* off_is_elset = 03 ** $ flags set or map of base elem
289
290$ extra fields for bases
291
292 +* off_blink = 04 ** $ chains all bases
293 +* off_rlink = 05 ** $ links remote objects
294 +* off_nlmaps = 04 ** $ no. of local maps
295
296
297$ extra fields for tuple header
298
299 +* off_is_range = 03 ** $ flags range set iteration
300 +* off_maxindx = 03 ** $ maximum index
301
302$ fields for hash table header
303
304
305$ note the link field of this word is reserved
306 +* off_neb = 01 ** $ number of headers.
307 +* off_lognhedrs = 01 ** $ log2 number of hash headers
308
309$ fields for local maps and subsets
310
311
312 +* off_ls_key = 05 ** $ vector for packed maps
313 +* off_ls_bits = 04 ** $ bits/packed value
314 +* off_ls_word = 02 ** $ word offset
315 +* off_ls_bit = 02 ** $ bit offset
316
317$ fields for remote sets
318
319 +* off_rs_maxi = 02 ** $ maximum index
320
321$ fields for -pack word- used by packed maps and tuples
322
323
324 +* off_ptkey = 04 ** $ vector for constant set
325 +* off_ptbits = 02 ** $ bits per value
326 +* off_ptvals = 02 ** $ values per word
327
328
329$ fields for element block
330
331
332 +* off_eblink = 01 ** $ link to next eb
333 +* off_is_ebhedr = 01 ** $ flags hash header
334 +* off_is_ebtemp = 01 ** $ flags template block
335 +* off_ebsize = 00 ** $ block size
336
337 +* off_ebspec = 02 ** $ specifier
338
339
340 +* off_ebimag = 03 ** $ unbased map image
341
342
343$ fields for interpretable code
344
345 +* off_codenw = 01 ** $ block length
346
347 +* off_codeop = 00 ** $ q2 opcode
348 +* off_codea1 = 00 ** $ first argument
349 +* off_codea2 = 01 ** $ second argument
350 +* off_codea3 = 01 ** $ third argument
351 +* off_codea4 = 00 ** $ copy flag
352
353
354$ extra fields for base element blocks
355
356 +* off_ebform = 03 ** $ pointer back to base
357 +* off_is_eblive = 03 ** $ flags base element
358 +* off_ebindx = 04 ** $ index in base
359 +* off_ebhash = 04 ** $ element hash code
360 ..r32
361
362 .+s10. $ macros for dec-10
363 +* value_ = .f. 01, 29, **
364 +* type_ = .f. 30, 04, **
365 +* is_om_ = .f. 34, 01, **
366 +* is_multi_ = .f. 35, 01, **
367 +* is_shared_ = .f. 36, 01, **
368 +* otype_ = .f. 30, 05, **
369 +* tvalue_ = .f. 01, 33, **
370 +* otvalue_ = .f. 01, 34, **
371 +* ivalue_ = .f. 01, 18, **
372 +* stdptr_ = .f. 01, 18, **
373 +* sc_chars_ = stdptr_ **
stra 10 +* sc_nchars_ = .f. 19, 01, **
375 +* hlink_ = .f. 01, 18, **
376 +* htype_ = .f. 19, 05, **
377 +* hsize_ = .f. 01, hs, **
smfb 37 +* li_nwords_ = .f. 01, 18, **
379 +* lc_nwords_ = .f. 01, hs, **
380 +* ic_ptr_ = stdptr_ **
381 +* ic_len_ = .f. 19, 18, **
382 +* ic_ofs_ = .f. 01, 18, **
383 +* la_form_ = .f. 01, 18, **
384 +* la_nwords_ = .f. 19, 08, **
385 +* la_nlmaps_ = .f. 27, 08, **
386 +* rval_ = .f. 01, ws, **
387 +* hform_ = .f. 19, 08, **
388 +* nelt_ = .f. 19, 18, **
389 +* hash_ = .f. 01, 18, **
390 +* is_neltok_ = .f. 35, 01, **
391 +* is_hashok_ = .f. 36, 01, **
392 +* hashtb_ = stdptr_ **
393 +* is_based_ = .f. 19, 01, **
394 +* is_map_ = .f. 20, 01, **
395 +* is_mmap_ = .f. 21, 01, **
396 +* is_smap_ = .f. 22, 01, **
397 +* is_elset_ = .f. 23, 01, **
398 +* blink_ = stdptr_ **
399 +* rlink_ = stdptr_ **
400 +* nlmaps_ = .f. 19, 08, **
401 +* is_range_ = .f. 19, 01, **
402 +* maxindx_ = .f. 01, 18, **
403 +* neb_ = .f. 01, 18, **
404 +* lognhedrs_ = .f. 19, 08, **
405 +* ls_bits_ = .f. 19, 08, **
406 +* ls_word_ = .f. 01, 08, **
407 +* ls_bit_ = .f. 09, 08, **
408 +* rs_maxi_ = .f. 01, 18, **
409 +* ptbits_ = .f. 19, 08, **
410 +* ptvals_ = .f. 27, 08, **
411 +* eblink_ = stdptr_ **
412 +* is_ebhedr_ = .f. 19, 01, **
413 +* is_ebtemp_ = .f. 20, 01, **
414 +* ebsize_ = hlink_ **
415 +* ebform_ = .f. 01, 08, **
416 +* is_eblive_ = .f. 09, 01, **
417 +* ebindx_ = .f. 01, 18, **
418 +* ebhash_ = .f. 19, 18, **
419 +* codenw_ = stdptr_ **
420 +* codeop_ = .f. 19, 16, **
421 +* codea1_ = stdptr_ **
422 +* codea2_ = .f. 19, 18, **
423 +* codea3_ = stdptr_ **
424 +* codea4_ = .f. 35, 02, **
425 +* off_value = 00 **
426 +* off_type = 00 **
427 +* off_is_om = 00 **
428 +* off_is_multi = 00 **
429 +* off_is_shared = 00 **
430 +* off_otype = 00 **
431 +* off_tvalue = 00 **
432 +* off_otvalue = 00 **
433 +* off_ivalue = 00 **
434 +* off_stdptr = 00 **
435 +* off_sc_chars = 00 **
436 +* off_sc_nchars = 00 **
437 +* off_hlink = 00 **
438 +* off_htype = 00 **
439 +* off_hsize = 01 **
440 +* off_li_nwords = 01 **
441 +* off_lc_nwords = 01 **
442 +* off_ic_ptr = 02 **
443 +* off_ic_len = 01 **
444 +* off_ic_ofs = 01 **
445 +* off_la_value = 01 **
446 +* off_la_form = 02 **
447 +* off_la_nwords = 02 **
448 +* off_la_nlmaps = 02 **
449 +* off_rval = 01 **
450 +* off_hform = 02 **
451 +* off_nelt = 01 **
452 +* off_hash = 01 **
453 +* off_is_neltok = 03 **
454 +* off_is_hashok = 03 **
455 +* off_hashtb = 03 **
456 +* off_is_based = 03 **
457 +* off_is_map = 03 **
458 +* off_is_mmap = 03 **
459 +* off_is_smap = 03 **
460 +* off_is_elset = 03 **
461 +* off_blink = 04 **
462 +* off_rlink = 05 **
463 +* off_nlmaps = 04 **
464 +* off_is_range = 03 **
465 +* off_maxindx = 03 **
466 +* off_neb = 01 **
467 +* off_lognhedrs = 01 **
468 +* off_ls_key = 06 **
469 +* off_ls_bits = 05 **
470 +* off_ls_word = 04 **
471 +* off_ls_bit = 04 **
472 +* off_rs_maxi = 04 **
473 +* off_ptkey = 05 **
474 +* off_ptbits = 04 **
475 +* off_ptvals = 04 **
476 +* off_eblink = 01 **
477 +* off_is_ebhedr = 01 **
478 +* off_is_ebtemp = 01 **
479 +* off_ebsize = 00 **
480 +* off_ebspec = 02 **
481 +* off_ebimag = 03 **
482 +* off_codenw = 01 **
483 +* off_codeop = 00 **
484 +* off_codea1 = 00 **
485 +* off_codea2 = 01 **
486 +* off_codea3 = 01 **
487 +* off_codea4 = 00 **
488 +* off_ebform = 03 **
489 +* off_is_eblive = 03 **
490 +* off_ebindx = 04 **
491 +* off_ebhash = 04 **
492 ..s10
493 .+s20. $ macros for dec 20 (extended addressing)
494 +* value_ = .f. 01, 29, **
495 +* type_ = .f. 30, 04, **
496 +* is_om_ = .f. 34, 01, **
497 +* is_multi_ = .f. 35, 01, **
498 +* is_shared_ = .f. 36, 01, **
499 +* otype_ = .f. 30, 05, **
500 +* tvalue_ = .f. 01, 33, **
501 +* otvalue_ = .f. 01, 34, **
502 +* ivalue_ = .f. 01, 29, **
503 +* stdptr_ = .f. 01, 24, **
504 +* sc_chars_ = stdptr_ **
stra 11 +* sc_nchars_ = .f. 25, 01, **
506 +* hlink_ = .f. 01, 24, **
507 +* htype_ = .f. 25, 05, **
508 +* hsize_ = .f. 01, hs, **
smfb 38 +* li_nwords_ = .f. 01, 18, **
510 +* lc_nwords_ = .f. 01, hs, **
511 +* ic_ptr_ = stdptr_ **
512 +* ic_len_ = .f. 19, 18, **
513 +* ic_ofs_ = .f. 01, 18, **
514 +* la_form_ = .f. 01, 18, **
515 +* la_nwords_ = .f. 19, 08, **
516 +* la_nlmaps_ = .f. 27, 08, **
517 +* rval_ = .f. 01, ws, **
518 +* hform_ = .f. 19, 08, **
519 +* nelt_ = .f. 19, 18, **
520 +* hash_ = .f. 01, 18, **
521 +* is_hashok_ = .f. 35, 01, **
522 +* is_neltok_ = .f. 36, 01, **
523 +* hashtb_ = stdptr_ **
524 +* is_based_ = .f. 26, 01, **
525 +* is_map_ = .f. 27, 01, **
526 +* is_mmap_ = .f. 28, 01, **
527 +* is_smap_ = .f. 29, 01, **
528 +* is_elset_ = .f. 30, 01, **
529 +* blink_ = stdptr_ **
530 +* rlink_ = stdptr_ **
531 +* nlmaps_ = .f. 25, 08, **
532 +* is_range_ = .f. 25, 01, **
533 +* maxindx_ = stdptr_ **
534 +* neb_ = .f. 01, 18, **
535 +* lognhedrs_ = .f. 25, 08, **
536 +* ls_bits_ = .f. 25, 08, **
537 +* ls_word_ = .f. 17, 08, **
538 +* ls_bit_ = .f. 25, 08, **
539 +* rs_maxi_ = .f. 17, 16, **
540 +* ptbits_ = .f. 17, 08, **
541 +* ptvals_ = .f. 25, 08, **
542 +* eblink_ = stdptr_ **
543 +* is_ebhedr_ = .f. 25, 01, **
544 +* is_ebtemp_ = .f. 27, 01, **
545 +* ebsize_ = hlink_ **
546 +* ebform_ = .f. 01, 16, **
547 +* is_eblive_ = .f. 17, 01, **
548 +* ebindx_ = .f. 01, 16, **
549 +* ebhash_ = .f. 17, 16, **
550 +* codenw_ = .f. 01, hs, **
551 +* codeop_ = .f. 23, 10, **
552 +* codea1_ = .f. 03, 20, **
553 +* codea2_ = .f. 01, 18, **
554 +* codea3_ = .f. 19, 18, **
555 +* codea4_ = .f. 01, 02, **
556 +* off_value = 00 **
557 +* off_type = 00 **
558 +* off_is_om = 00 **
559 +* off_is_multi = 00 **
560 +* off_is_shared = 00 **
561 +* off_otype = 00 **
562 +* off_tvalue = 00 **
563 +* off_otvalue = 00 **
564 +* off_ivalue = 00 **
565 +* off_stdptr = 00 **
566 +* off_sc_chars = 00 **
567 +* off_sc_nchars = 00 **
568 +* off_hlink = 00 **
569 +* off_htype = 00 **
570 +* off_hsize = 01 **
571 +* off_li_nwords = 01 **
572 +* off_lc_nwords = 01 **
573 +* off_ic_ptr = 02 **
574 +* off_ic_len = 01 **
575 +* off_ic_ofs = 01 **
576 +* off_la_value = 01 **
577 +* off_la_form = 02 **
578 +* off_la_nwords = 02 **
579 +* off_la_nlmaps = 02 **
580 +* off_rval = 01 **
581 +* off_hform = 02 **
582 +* off_nelt = 01 **
583 +* off_hash = 01 **
584 +* off_is_hashok = 03 **
585 +* off_is_neltok = 03 **
586 +* off_hashtb = 03 **
587 +* off_is_based = 03 **
588 +* off_is_map = 03 **
589 +* off_is_mmap = 03 **
590 +* off_is_smap = 03 **
591 +* off_is_elset = 03 **
592 +* off_blink = 04 **
593 +* off_rlink = 05 **
594 +* off_nlmaps = 04 **
595 +* off_is_range = 03 **
596 +* off_maxindx = 03 **
597 +* off_neb = 01 **
598 +* off_lognhedrs = 01 **
599 +* off_ls_key = 05 **
600 +* off_ls_bits = 04 **
601 +* off_ls_word = 02 **
602 +* off_ls_bit = 02 **
603 +* off_rs_maxi = 02 **
604 +* off_ptkey = 04 **
605 +* off_ptbits = 02 **
606 +* off_ptvals = 02 **
607 +* off_eblink = 01 **
608 +* off_is_ebhedr = 01 **
609 +* off_is_ebtemp = 01 **
610 +* off_ebsize = 00 **
611 +* off_ebspec = 02 **
612 +* off_ebimag = 03 **
613 +* off_codenw = 01 **
614 +* off_codeop = 00 **
615 +* off_codea1 = 00 **
616 +* off_codea2 = 01 **
617 +* off_codea3 = 01 **
618 +* off_codea4 = 00 **
619 +* off_ebform = 03 **
620 +* off_is_eblive = 03 **
621 +* off_ebindx = 04 **
622 +* off_ebhash = 04 **
623 ..s20
624 .+s66. $ macros for cdc 6600
625 +* value_ = .f. 01, 52, **
626 +* type_ = .f. 53, 04, **
627 +* is_om_ = .f. 57, 01, **
628 +* is_multi_ = .f. 58, 01, **
629 +* is_shared_ = .f. 60, 01, **
630 +* otype_ = .f. 53, 05, **
631 +* tvalue_ = .f. 01, 56, **
632 +* otvalue_ = .f. 01, 57, **
633 +* ivalue_ = .f. 01, 17, **
634 +* stdptr_ = .f. 01, 17, **
635 +* sc_chars_ = stdptr_ **
stra 12 +* sc_nchars_ = .f. 19, 01, **
637 +* hlink_ = .f. 37, 17, **
638 +* htype_ = .f. 55, 05, **
639 +* hsize_ = stdptr_ **
640 +* li_nwords_ = stdptr_ **
641 +* lc_nwords_ = stdptr_ **
642 +* ic_ptr_ = stdptr_ **
643 +* ic_len_ = .f. 19, 17, **
644 +* ic_ofs_ = .f. 37, 16, **
645 +* la_form_ = stdptr_ **
646 +* la_nwords_ = .f. 19, 08, **
647 +* la_nlmaps_ = .f. 27, 08, **
648 +* rval_ = .f. 01, ws, **
649 +* hform_ = .f. 23, 08, **
650 +* nelt_ = .f. 31, 15, **
651 +* hash_ = .f. 46, 12, **
652 +* is_neltok_ = .f. 58, 01, **
653 +* is_hashok_ = .f. 59, 01, **
654 +* hashtb_ = stdptr_ **
655 +* is_based_ = .f. 19, 01, **
656 +* is_map_ = .f. 20, 01, **
657 +* is_mmap_ = .f. 21, 01, **
658 +* is_smap_ = .f. 22, 01, **
659 +* is_elset_ = .f. 23, 01, **
660 +* blink_ = stdptr_ **
661 +* rlink_ = .f. 19, 17, **
662 +* nlmaps_ = .f. 37, 09, **
663 +* is_range_ = .f. 01, 01, **
664 +* maxindx_ = .f. 19, 17, **
665 +* neb_ = .f. 01, 15, **
666 +* lognhedrs_ = .f. 16, 06, **
667 +* ls_bits_ = .f. 19, 06, **
668 +* ls_word_ = .f. 25, 09, **
669 +* ls_bit_ = .f. 34, 09, **
670 +* rs_maxi_ = .f. 01, 17, **
671 +* ptbits_ = .f. 19, 06, **
672 +* ptvals_ = .f. 25, 06, **
673 +* eblink_ = stdptr_ **
674 +* is_ebhedr_ = .f. 19, 01, **
675 +* is_ebtemp_ = .f. 20, 01, **
676 +* ebsize_ = hlink_ **
677 +* ebform_ = stdptr_ **
678 +* ebindx_ = .f. 19, 15, **
679 +* ebhash_ = .f. 34, 12, **
680 +* is_eblive_ = .f. 46, 01, **
681 +* codenw_ = stdptr_ **
682 +* codeop_ = .f. 01, 10, **
683 +* codea1_ = .f. 11, 16, **
684 +* codea2_ = .f. 27, 16, **
685 +* codea3_ = .f. 43, 16, **
686 +* codea4_ = .f. 59, 02, **
687 +* off_value = 00 **
688 +* off_type = 00 **
689 +* off_is_om = 00 **
690 +* off_is_multi = 00 **
691 +* off_is_shared = 00 **
692 +* off_otype = 00 **
693 +* off_tvalue = 00 **
694 +* off_otvalue = 00 **
695 +* off_ivalue = 00 **
696 +* off_stdptr = 00 **
697 +* off_sc_chars = 00 **
698 +* off_sc_nchars = 00 **
699 +* off_hlink = 00 **
700 +* off_htype = 00 **
701 +* off_hsize = 00 **
702 +* off_li_nwords = 00 **
703 +* off_lc_nwords = 00 **
704 +* off_ic_ptr = 00 **
705 +* off_ic_len = 00 **
706 +* off_ic_ofs = 00 **
707 +* off_la_form = 00 **
708 +* off_la_nwords = 00 **
709 +* off_la_nlmaps = 00 **
710 +* off_la_value = 01 **
711 +* off_rval = 01 **
712 +* off_hform = 01 **
713 +* off_nelt = 01 **
714 +* off_hash = 01 **
715 +* off_is_neltok = 01 **
716 +* off_is_hashok = 01 **
717 +* off_hashtb = 00 **
718 +* off_is_based = 00 **
719 +* off_is_map = 00 **
720 +* off_is_mmap = 00 **
721 +* off_is_smap = 00 **
722 +* off_is_elset = 00 **
723 +* off_blink = 02 **
724 +* off_rlink = 02 **
725 +* off_nlmaps = 02 **
726 +* off_is_range = 00 **
727 +* off_maxindx = 00 **
728 +* off_neb = 00 **
729 +* off_lognhedrs = 00 **
730 +* off_ls_key = 03 **
731 +* off_ls_bits = 02 **
732 +* off_ls_word = 02 **
733 +* off_ls_bit = 02 **
734 +* off_rs_maxi = 01 **
735 +* off_ptkey = 03 **
736 +* off_ptbits = 02 **
737 +* off_ptvals = 02 **
738 +* off_eblink = 00 **
739 +* off_is_ebhedr = 00 **
740 +* off_is_ebtemp = 00 **
741 +* off_ebsize = 00 **
742 +* off_ebspec = 01 **
743 +* off_ebimag = 02 **
744 +* off_ebform = 02 **
745 +* off_ebindx = 02 **
746 +* off_ebhash = 02 **
747 +* off_is_eblive = 02 **
748 +* off_codenw = 00 **
749 +* off_codeop = 00 **
750 +* off_codea1 = 00 **
751 +* off_codea2 = 00 **
752 +* off_codea3 = 00 **
753 +* off_codea4 = 00 **
754 ..s66
755
756
757$ macros for header lengths
758$ ------ --- ------ -------
759
760$ the folowing macros give the lengths of headers for
761$ various data blocks.
762
763
764 .+r32. $ regular 32 bit definitions.
765 +* hl_latom = 3 ** $ header for long atom
766 +* hl_real = 1 ** $ real
767 +* hl_lint = 2 ** $ long integer
768 +* hl_ic = 3 ** $ long characters
769 +* hl_tuple = 4 ** $ tuples
770 +* hl_ptuple = 5 ** $ packed tuples
771 +* hl_ituple = 4 ** $ integer tuple
772 +* hl_rtuple = 4 ** $ real tuple
773 +* hl_uset = 4 ** $ unbased sets
774 +* hl_lset = 4 ** $ local sets
775 +* hl_rset = 4 ** $ remote sets
776 +* hl_rmap = 4 ** $ remote maps
777 +* hl_rpmap = 4 ** $ remote packed map
778 +* hl_umap = 4 ** $ unbased map
779 +* hl_lmap = 4 ** $ local map
780 +* hl_lpmap = 6 ** $ local packed map
781 +* hl_lchars = 2 ** $ long chars
782 +* hl_base = 6 ** $ base
783 +* hl_eb = 2 ** $ element block
784 +* hl_ebb = 5 ** $ base eb, including eb specifier
785 +* hl_ht = 2 ** $ hash table header
786 +* hl_htb = 2 ** $ hash table block
787 +* hl_code = 2 ** $ code
788 +* hl_skip = 2 ** $ skip word
789 ..r32
790
791 .+s10. $ dec-10
792 +* hl_latom = 3 **
793 +* hl_real = 1 **
794 +* hl_lint = 2 **
795 +* hl_ic = 3 **
796 +* hl_tuple = 4 **
797 +* hl_ptuple = 6 **
798 +* hl_ituple = 4 **
799 +* hl_rtuple = 4 **
800 +* hl_uset = 4 **
801 +* hl_lset = 5 **
802 +* hl_rset = 5 **
803 +* hl_rmap = 4 **
804 +* hl_rpmap = 4 **
805 +* hl_umap = 4 **
806 +* hl_lmap = 5 **
807 +* hl_lpmap = 6 **
808 +* hl_lchars = 2 **
809 +* hl_base = 6 **
810 +* hl_eb = 2 **
811 +* hl_ebb = 5 **
812 +* hl_ht = 2 **
813 +* hl_htb = 2 **
814 +* hl_code = 2 **
815 +* hl_skip = 2 **
816 ..s10
817
818 .+s20. $ dec-20 (extended addressing)
819 +* hl_latom = 3 **
820 +* hl_real = 1 **
821 +* hl_lint = 2 **
822 +* hl_ic = 3 **
823 +* hl_tuple = 4 **
824 +* hl_ptuple = 6 **
825 +* hl_ituple = 4 **
826 +* hl_rtuple = 4 **
827 +* hl_uset = 4 **
828 +* hl_lset = 5 **
829 +* hl_rset = 5 **
830 +* hl_rmap = 4 **
831 +* hl_rpmap = 4 **
832 +* hl_umap = 4 **
833 +* hl_lmap = 5 **
834 +* hl_lpmap = 6 **
835 +* hl_lchars = 2 **
836 +* hl_base = 6 **
837 +* hl_eb = 2 **
838 +* hl_ebb = 5 **
839 +* hl_ht = 2 **
840 +* hl_htb = 2 **
841 +* hl_code = 2 **
842 +* hl_skip = 2 **
843 ..s20
844
845
846
847 .+s66.
848 +* hl_latom = 2 **
849 +* hl_real = 1 **
850 +* hl_lint = 1 **
851 +* hl_ic = 0 **
852 +* hl_tuple = 2 **
853 +* hl_ptuple = 4 **
854 +* hl_ituple = 2 **
855 +* hl_rtuple = 2 **
856 +* hl_uset = 2 **
857 +* hl_lset = 3 **
858 +* hl_rset = 2 **
859 +* hl_rmap = 2 **
860 +* hl_rpmap = 2 **
861 +* hl_umap = 2 **
862 +* hl_lmap = 3 **
863 +* hl_lpmap = 4 **
864 +* hl_lchars = 1 **
865 +* hl_base = 3 **
866 +* hl_eb = 1 **
867 +* hl_ebb = 3 **
868 +* hl_ht = 1 **
869 +* hl_htb = 1 **
870 +* hl_code = 1 **
871 ..s66
872
873$ macros for specifiers
874
875 +* value(p) = value_ heap(p+off_value) **
876 +* type(p) = type_ heap(p+off_type) **
877 +* is_om(p) = is_om_ heap(p+off_is_om) **
878 +* otype(p) = otype_ heap(p+off_otype) **
879 +* tvalue(p) = tvalue_ heap(p+off_tvalue) **
880 +* otvalue(p) = otvalue_ heap(p+off_otvalue) **
881 +* ivalue(p) = ivalue_ heap(p+off_ivalue) **
882
883 +* stdptr(p) = stdptr_ heap(p+off_stdptr) **
884 +* is_multi(p) = is_multi_ heap(p+off_is_multi) **
885 +* is_shared(p) = is_shared_ heap(p+off_is_shared) **
886
887$ macros for data words
888
889 +* sc_chars(p) = sc_chars_ heap(p+off_sc_chars) **
890 +* sc_nchars(p) = sc_nchars_ heap(p+off_sc_nchars) **
891
892 +* hlink(p) = hlink_ heap(p+off_hlink) **
893 +* htype(p) = htype_ heap(p+off_htype) **
894 +* hsize(p) = hsize_ heap(p+off_hsize) **
895
896 +* li_nwords(p) = li_nwords_ heap(p+off_li_nwords) **
897
898 +* lc_nwords(p) = lc_nwords_ heap(p+off_lc_nwords) **
899
900 +* ic_ptr(p) = ic_ptr_ heap(p+off_ic_ptr) **
901 +* ic_len(p) = ic_len_ heap(p+off_ic_len) **
902 +* ic_ofs(p) = ic_ofs_ heap(p+off_ic_ofs) **
903
904 +* la_value(p) = heap(p+off_la_value) **
905 +* la_form(p) = la_form_ heap(p+off_la_form) **
906 +* la_nwords(p) = la_nwords_ heap(p+off_la_nwords) **
907 +* la_nlmaps(p) = la_nlmaps_ heap(p+off_la_nlmaps) **
908
909 +* rval(p) = rval_ heap(p+off_rval) **
910
911 +* hform(p) = hform_ heap(p+off_hform) **
912 +* nelt(p) = nelt_ heap(p+off_nelt) **
913 +* hash(p) = hash_ heap(p+off_hash) **
914 +* is_neltok(p) = is_neltok_ heap(p+off_is_neltok) **
915 +* is_hashok(p) = is_hashok_ heap(p+off_is_hashok) **
916
917 +* hashtb(p) = hashtb_ heap(p+off_hashtb) **
918 +* is_based(p) = is_based_ heap(p+off_is_based) **
919 +* is_map(p) = is_map_ heap(p+off_is_map) **
920 +* is_mmap(p) = is_mmap_ heap(p+off_is_mmap) **
921 +* is_smap(p) = is_smap_ heap(p+off_is_smap) **
922 +* is_elset(p) = is_elset_ heap(p+off_is_elset) **
923
924 +* blink(p) = blink_ heap(p+off_blink) **
925 +* rlink(p) = rlink_ heap(p+off_rlink) **
926 +* nlmaps(p) = nlmaps_ heap(p+off_nlmaps) **
927
928 +* is_range(p) = is_range_ heap(p+off_is_range) **
929 +* maxindx(p) = maxindx_ heap(p+off_maxindx) **
930
931
932 +* neb(p) = neb_ heap(p+off_neb) **
933 +* lognhedrs(p) = lognhedrs_ heap(p+off_lognhedrs) **
934
935
936 +* ls_key(p) = heap(p+off_ls_key) **
937 +* ls_bits(p) = ls_bits_ heap(p+off_ls_bits) **
938 +* ls_word(p) = ls_word_ heap(p+off_ls_word) **
939 +* ls_bit(p) = ls_bit_ heap(p+off_ls_bit) **
940
941 +* rs_maxi(p) = rs_maxi_ heap(p+off_rs_maxi) **
942
943
944 +* ptkey(p) = heap(p+off_ptkey) **
945 +* ptbits(p) = ptbits_ heap(p+off_ptbits) **
946 +* ptvals(p) = ptvals_ heap(p+off_ptvals) **
947
948
949 +* eblink(p) = eblink_ heap(p+off_eblink) **
950 +* is_ebhedr(p) = is_ebhedr_ heap(p+off_is_ebhedr) **
951 +* is_ebtemp(p) = is_ebtemp_ heap(p+off_is_ebtemp) **
952 +* ebsize(p) = ebsize_ heap(p+off_ebsize) **
953 +* ebspec(p) = heap(p+off_ebspec) **
954
955
956 +* ebimag(p) = heap(p+off_ebimag) **
957
958 +* ebform(p) = ebform_ heap(p+off_ebform) **
959 +* ebindx(p) = ebindx_ heap(p+off_ebindx) **
960 +* ebhash(p) = ebhash_ heap(p+off_ebhash) **
961 +* is_eblive(p) = is_eblive_ heap(p+off_is_eblive) **
962
963 +* codenw(p) = codenw_ heap(p+off_codenw) **
964
965 +* codeop(p) = codeop_ heap(p+off_codeop) **
966 +* codea1(p) = codea1_ heap(p+off_codea1) **
967 +* codea2(p) = codea2_ heap(p+off_codea2) **
968 +* codea3(p) = codea3_ heap(p+off_codea3) **
969 +* codea4(p) = codea4_ heap(p+off_codea4) **
970
971
972$ macros for accessing indirect character fields
973
974$ the fields of indirect strings are unusual in that they
975$ are sometimes stored in a value specifier and sometimes in a
976$ data block, depending on the machine. the conditional assembly
977$ option 'ssi' is on when these fields are stored in a data
978$ block.
979
980$ a 'string specifier' is defined as follows:
981
982$ 1. if 'ssi' is set, a string specifier is a pointer to a
983$ heap block containing the fields ic_ptr, etc.
984
985$ 2. otherwise, a string specifier is a word containing these
986$ fields. in this case, the fields must be small enough to
987$ fit in the value field of a value specifier.
988
989$ the macro 'ssz' gives the size of a string specifier.
990
991$ the macros ss_ptr, ss_ofs, and ss_len access the fields of
992$ string specifiers. there are seperate versions of these
993$ macros depending on the setting of 'ssi'.
994
995 .+ssi. $ macros for indirect string specifiers
996
997 +* ssz = ps ** $ string specifiers are pointers
998
999 +* ss_ptr(ss) = ic_ptr(ss) ** $ pointer to string
1000 +* ss_ofs(ss) = ic_ofs(ss) ** $ character offset
1001 +* ss_len(ss) = ic_len(ss) ** $ length
1002
1003 ..ssi
1004
1005
1006 .-ssi. $ fields for direct strings
1007
1008 +* ssz = hs ** $ string specifiers are value specifi
1009
1010 +* ss_ptr(ss) = ic_ptr_ ss ** $ pointer to string
1011 +* ss_ofs(ss) = ic_ofs_ ss ** $ character offset
1012 +* ss_len(ss) = ic_len_ ss ** $ length
1013
1014 ..ssi
1 .=member q2opcd
2$ interpreter (q2) operator codes
3$ ----------- ---- -------- -----
4
5
6
7
8 .+part1.
9
10
11 .=zzyorg z $ initialize counter for opcodes
12
13$ q2 contains the following opcodes:
14
15$ group 1 - copy instructions
16
17$ these instructions have the form a1 = copy(a2).
18
19 defc(q2_copy) $ unconditional copy
20 defc(q2_ccopy) $ copy if shared
21
22$ group 2 - set share bit of a1
23
24 defc(q2_share) $ set share bit of a1
25
26$ group 3 - general purpose arithmetic
27
28$ these instructions have the form a1 = a2 op a3. they
29$ attempt to do in line integer arithmetic, and branch off line
30$ if this fails.
31
32 defc(q2_add) $ +
33 defc(q2_div) $ div
34 defc(q2_mult) $ *
35 defc(q2_slash) $ /
36 defc(q2_sub) $ -
37 defc(q2_mod) $ //
38 defc(q2_exp) $ **
39
40$ short integer ariyhmetic - a1 = a2 op a3
41
42 defc(q2_addi) $ +
43 defc(q2_inci) $ increment short integer
44 defc(q2_divi) $ div
45 defc(q2_modi) $ //
46 defc(q2_multi) $ *
47 defc(q2_slashi) $ /
48 defc(q2_subi) $ -
49
50$ group 4 - shifts
51
52$ these instructions set a1 = a2 shifted by a3 places. the shifts
53$ are algrebraic.
54
55 defc(q2_shiftl) $ multiply by power of two
56 defc(q2_shiftr) $ divide by power of 2
57
58$ untyped integer arithmetic - a1 = a2 op a3
59
60 defc(q2_addui) $ +
61 defc(q2_incui) $ increment untyped integer
62 defc(q2_divui) $ div
63 defc(q2_multui) $ *
64 defc(q2_modui) $ //
65 defc(q2_slashui) $ /
66 defc(q2_subui) $ -
67
68$ shifts on untyped integers
69
70 defc(q2_shiftlui) $ shift left
71 defc(q2_shiftrui) $ shift right
72
73$ tests for untyped integer underflow-overflow. a1 is integer.
74
75 defc(q2_over)
76 defc(q2_under)
77
78$ untyped real arithmetic - a1 = a2 op a3.
79
80 defc(q2_addur) $ +
81 defc(q2_multur) $ *
82 defc(q2_subur) $ -
83 defc(q2_slashur) $ /
84
85$ real overflow-underflow. a1 is the real.
86
87 defc(q2_rover) $ real overflow
88 defc(q2_runder) $ real underflow. see note above
89
90$ long 'arithmetic' - a1 = a2 op a3
91
92
93 defc(q2_addli) $ long integers
94 defc(q2_addtup) $ tuple
95 defc(q2_addstr) $ strings
96 defc(q2_diffli) $ long integer subtraction
97 defc(q2_divli) $ long integer division
98 defc(q2_modli) $ modulo on long integers
99 defc(q2_multli) $ long integer multiply
100
101$ union
102
103 defc(q2_union) $ union on declared sets and maps
104 defc(q2_unset) $ unbased sets
105 defc(q2_unlset) $ local sets
106 defc(q2_unrset) $ remote sets
107
108$ intersection
109
110 defc(q2_inter) $ general case
111 defc(q2_inset) $ unbased set
112 defc(q2_inlset) $ local set
113 defc(q2_inrset) $ remote set
114
115$ set difference
116
117 defc(q2_setdiff) $ general case
118 defc(q2_difset) $ unbased sets
119 defc(q2_diflset) $ local sets
120 defc(q2_difrset) $ remote sets
121
122$ symetric difference on sets
123
124 defc(q2_setmod)
125
126$ with - a1 = a2 with a3
127
128 defc(q2_with) $ general case
129 defc(q2_withs) $ with on declared sets and maps.
130 defc(q2_withus) $ unbased sets
131 defc(q2_withls) $ local sets
132 defc(q2_withrs) $ remote sets
133 defc(q2_witht) $ tuples
134 defc(q2_withut) $ untyped tuples
135
136$ the next instruction is used for 'map with [x, y]'.
137$ rather than building the pair [x, y] we push x and y
138$ onto the stack then call a special library routine.
139
140$ here a3 is an immediate operand giving the number of arguments.
141 defc(q2_withm)
142
143$ less - a1 = a2 less a3
144
145 defc(q2_less) $ general case
146 defc(q2_lessls) $ local set
147 defc(q2_lessrs) $ remote sets
148
149$ lessf - a1 = a2 lessf a3
150
151 defc(q2_lessf) $ general
152 defc(q2_lessflm) $ local map
153 defc(q2_lessfrm) $ remote map
154
155$ from - a1 from a2
156
157 defc(q2_from) $ from
158 defc(q2_froms) $ sets
159
160$ fromb - a1 fromb a2
161
162 defc(q2_fromb) $ general case
163 defc(q2_frombt) $ tuples
164
165$ frome - a1 frome a2
166
167 defc(q2_frome) $ general case
168 defc(q2_fromet) $ tuples
169
170$ min - a1 = a2 min a3
171
172 defc(q2_mini) $ short ints
173 defc(q2_minui) $ untyped integer
174 defc(q2_minur) $ untyped reals
175 defc(q2_min) $ general case
176
177$ max - a1 = a2 max a3
178
179 defc(q2_maxi) $ short ints
180 defc(q2_maxui) $ untyped ints
181 defc(q2_maxur) $ untyped reals
182 defc(q2_max) $ generl case
183
184$ npow - a1 = a2 npow a3
185
186 defc(q2_npow)
187
188$ atan2 - a1 = a2 atan2 a3
189
190 defc(q2_atan2) $ atan2
191
192
193$ equality tests - a1 := (a2 = a3)
194
195 defc(q2_eq1) $ 1 word test
196 defc(q2_eqv) $ equal values and types
197 defc(q2_eq) $ general test
198 defc(q2_zr) $ test a2 = 0
199 defc(q2_eqom) $ a1 := a2 = om
200 defc(q2_eqnl) $ a1 := a2 = << >>
201 defc(q2_eqnult) $ a1 := a2 = [ ]
202
203$ a1 := (a2 >= a3)
204
205 defc(q2_gei) $ short integer
206 defc(q2_geui) $ untyped ints
207 defc(q2_geur) $ untyped reals
208 defc(q2_ge) $ general
209
210$ subset and set inclusion - a1 := (a2 incs a3)
211
212 defc(q2_incs) $ incs
213
214$ membership - a1 := a2 .in a3
215
216 defc(q2_in) $ general case - offline call
217 defc(q2_ins) $ set or map
218 defc(q2_inu) $ unbased set
219 defc(q2_inl) $ local subset
220 defc(q2_inr) $ remote subset
221
222$ less than - a1 := a2 < a3;
223
224 defc(q2_lti) $ short ints
225 defc(q2_ltui) $ untyped ints
226 defc(q2_ltur) $ untyped reals
227 defc(q2_lt) $ general case
228
229$ inequality - a1 := a2 /= a3;
230
231 defc(q2_ne1) $ 1 word test
232 defc(q2_nev) $ test values and types
233 defc(q2_ne) $ general case
234 defc(q2_nz) $ test againt 0
235 defc(q2_neom) $ test against om
236 defc(q2_nenl) $ test against nl
237 defc(q2_nenult) $ test against nult
238
239$ subset and set inclusion - a1 := not (a2 incs a3)
240
241 defc(q2_nincs) $ not incs / not subset
242
243$ notin - a1 := a2 notin a3
244
245 defc(q2_nin) $ general case - offline call
246 defc(q2_nins) $ set or map
247 defc(q2_ninu) $ unbased set
248 defc(q2_ninl) $ local subset
249 defc(q2_ninr) $ remote subset
250
251$ unary operators - a1 = op a2
252
253 defc(q2_not) $ not - general case
254
255 defc(q2_even) $ even - general case
256 defc(q2_eveni) $ even - short integers
257 defc(q2_evenui) $ even - untyped integers
258
259 defc(q2_odd) $ odd - general case
260 defc(q2_oddi) $ odd - short integers
261 defc(q2_oddui) $ odd - untyped integers
262
263 defc(q2_isint) $ is_integer
264 defc(q2_isreal) $ is_real
265 defc(q2_isstr) $ is_string
266 defc(q2_isbool) $ is_boolean
267 defc(q2_isatom) $ is_atom
268 defc(q2_istup) $ is_tuple
269 defc(q2_isset) $ is_set
270 defc(q2_ismap) $ is_map
271
272 defc(q2_arb) $ arb - general case
273 defc(q2_arbs) $ arb - sets
274 defc(q2_arbt) $ arb - tuples
275 defc(q2_arbut) $ arb - untyped tuples
276
277 defc(q2_domain) $ domain - general case
278
279 defc(q2_range) $ range - general case
280
281 defc(q2_pow) $ pow - general case
282
283 defc(q2_nelt) $ nelt - general case
284 defc(q2_neltc) $ nelt - short character string
285 defc(q2_neltic) $ nelt - indirect character strings
286 defc(q2_neltst) $ nelt - sets and tuples
287 defc(q2_neltok) $ nelt - sets and tuples, nelt valid
288
289 defc(q2_abs) $ abs - general case
290 defc(q2_absi) $ abs - short integers
291 defc(q2_absui) $ abs - untyped integers
292 defc(q2_absur) $ abs - untyped reals
293
294 defc(q2_char) $ char
295
296 defc(q2_ceil) $ ceil - general case
297 defc(q2_ceilur) $ ceil - untyped reals
298
299 defc(q2_floor) $ floor - general case
300 defc(q2_floorur) $ floor - untyped reals
301
302 defc(q2_fix) $ fix - general case
303 defc(q2_fixur) $ fix - untyped reals
304
305 defc(q2_float) $ float - general case
306 defc(q2_floatui) $ float - untyped integer
307
308 defc(q2_asrt) $ if ^ a1 then abort
smfb 39 defc(q2_ifasrt) $ if getipp('assert=1/2') = 0 then goto a1
309
310 defc(q2_val) $ val
311
312 defc(q2_rand) $ random
313 defc(q2_sin) $ sin
314 defc(q2_cos) $ cos
315 defc(q2_tan) $ tan
316 defc(q2_arcsin) $ asin
317 defc(q2_arccos) $ acos
318 defc(q2_arctan) $ atan
319 defc(q2_tanh) $ tanh
320 defc(q2_expf) $ exp
321 defc(q2_log) $ log
322 defc(q2_sqrt) $ sqrt
323
324 defc(q2_type) $ type
325
326 defc(q2_umin) $ unary minus - general case
327 defc(q2_umini) $ unary minus - integer
328 defc(q2_uminui) $ unary minus - untyped integer
329 defc(q2_uminur) $ unary minus - untyped real
330
331 defc(q2_str) $ integer to string conversion
332
333 defc(q2_sign) $ sign
334
335$ substring extraction
336
337 defc(q2_end) $ a1 = a2(a3:)
338 defc(q2_subst) $ a1 = a2(a3:a4). a4 is in next quadruple.
339
340$ newat - a1 = newat
341
342 defc(q2_newat1) $ newat for simple atoms
343 defc(q2_newat2) $ newat for atoms with fields - a2 gives f
344
345$ time and date
346 defc(q2_time) $ time
347 defc(q2_date) $ date
348 defc(q2_na) $ number of arguments to current procedure
349
350$ set formers - arguments are:
351
352$ a1: address of result
353$ a2: form of set
354$ a3: pointer to short int giving number of elements
355
356 defc(q2_set1) $ decide dynamically whether to build set
357 defc(q2_set2) $ elements are all proper type
358
359$ tuple formers - arguments as setformer
360
361 defc(q2_tup1) $ elements are proper type
362 defc(q2_tup2) $ mixed tuple, elements require conversion
363
364$ of - a1 = a2(a3)
365
366 defc(q2_of) $ general case
367 defc(q2_ofcs) $ short character string
368 defc(q2_ofcl) $ long chars. index is short int
369 defc(q2_oftoks) $ index in range, set share bit
370 defc(q2_oftok) $ index is in range.
371 defc(q2_oft) $ index is short int.
372 defc(q2_ofts) $ as above, but set share bit
373 defc(q2_ofusms) $ unbased smap - set share bit
374 defc(q2_ofusm) $ unbased smap
375 defc(q2_ofums) $ unbased map - set share bit
376 defc(q2_ofum) $ unbased map
377 defc(q2_oflsms) $ local smap - set share bit
378 defc(q2_oflsm) $ local smap
379 defc(q2_oflms) $ local map - set share bit
380 defc(q2_oflm) $ local map.
381 defc(q2_ofrsm) $ remote smap
382 defc(q2_ofrsms) $ as above, but set share bit
383 defc(q2_ofrm) $ remote map
384 defc(q2_ofrms) $ same, but set share bit
385
386
387 defc(q2_ofa) $ general case
388 defc(q2_ofaumms) $ unbased mmap - set share bit
389 defc(q2_ofaumm) $ unbased mmap
390 defc(q2_ofalmms) $ local mmap - set share bit
391 defc(q2_ofalmm) $ local mmap
392 defc(q2_ofarmm) $ remote mmap
393 defc(q2_ofarmms) $ as above, but set share bit
394
395$ simple assignments - a1 = a2
396
397 defc(q2_asn) $ simple case
398 defc(q2_asnsb) $ set share bit
399
400$ a1 = nl. a2 is form of set
401
402 defc(q2_asnnl) $ a1 = nl. use a1 as sample value.
403
404$ a1 = nult, as above
405
406 defc(q2_asnnult) $ a1 = nult. similar to the above
407
408$ push and pop. the arguments are:
409
410$ a1: address of first item to push
411$ a2: immediate argument, number of items to push
412
413$ the remaining arguments are in the a1 positions of successive quadrupl
414
415 defc(q2_push) $ stack push
416 defc(q2_pop) $ stack pop
417
418$ single argument push and pop - push1(a1), etc.
419
420 defc(q2_push1) $ push 1 value
421 defc(q2_push1u) $ push untyped integer or real
422 defc(q2_pop1) $ pop 1 value
423
424$ free - free value(a1) stack entries
425
426 defc(q2_free) $ free stack space
427
428$ free1 - free 1 stack entry
429
430 defc(q2_free1)
431
432$ sof - a1(a2) = a3
433
434 defc(q2_sof) $ general case
435 defc(q2_sofcs) $ short chars inputs as above, but
436 defc(q2_sofcl) $ long chars. inputs as above
437 defc(q2_softok) $ index assumed in range
438 defc(q2_soft)
439 defc(q2_soflm) $ local maps + smaps
440 defc(q2_sofrm) $ remote maps
441
442$ sofa - a1<> := a3
443
444 defc(q2_sofa) $ general case
445 defc(q2_sofas) $ declared sets and maps
446 defc(q2_sofalmm) $ local mmap
447 defc(q2_sofarmm) $ remote mmap
448
449$ substring assignments
450
451 defc(q2_send) $ a1(a2:) = a3
452 defc(q2_ssubst) $ a1(a2:a3) = a4. a4 is in next quadruple
453
454$ tests for matching reprs - a1 is input, a2 is form
455 defc(q2_eqform1) $ test for elements oof same base
456 defc(q2_eqform2) $ sets and tuples - copy if match
457 defc(q2_eqform3) $ sets and tuples - set share bit if match
458 defc(q2_eqform4) $ check if element of plex base
459
460$ conversion - a1 = convert(a2, a3) where a2 is input, a3 is form
461
462 defc(q2_convert) $ general case
463
464$ locate - a1 = locate(a2 in a3)
465
466 defc(q2_locate)
467
468$ 1 level dererence
469
470 defc(q2_deref1) $ 1 level deref
471$ dereference - arguments are:
472
473$ a1: address of output
474$ a2: address of input
475$ a3: number of times to dereference
476
477
478 defc(q2_deref) $ multi level deref
479
480$ check type code - a2 is desired type t_xxx
481
482 defc(q2_checktp) $ check type
483
484 defc(q2_checki1) $ check that a1 is a short int <= a2
485 defc(q2_checki2) $ check that a1 is a long or short int
486 defc(q2_chkatom) $ check if atom (short or long)
487
488$ typed - untyped conversions
489
490 defc(q2_tint1) $ short int = untyped int
491 defc(q2_tint2) $ long int = untyped int
492 defc(q2_treal) $ real = untyped real
493 defc(q2_uint1) $ untyped int = short int
494 defc(q2_uint2) $ untyped integer := general
495 defc(q2_ureal1) $ untyped real = real
496 defc(q2_ureal2) $ untyped real = general
497
498$ goto a1
499
500 defc(q2_goto) $ goto
501
502$ case jump
503
504$ the case jump has the semantics
505$ t := a1(a2); if t /= om then go to t; end;
506
507 defc(q2_caset) $ a1 is a tuple, a2 an integer
508 defc(q2_caselsm) $ a1 is a local smap, a2 a base element
509 defc(q2_casersm) $ a1 is a remote smap, a2 a base element
510 defc(q2_caseusm) $ a1 is an unbased smap, a2 any value
511
512
513$ conditional branches - if a2 op a3 goto a1
514
515 defc(q2_goeq1) $ one word test
516 defc(q2_goeqv) $ test value and type
517 defc(q2_goeq) $ general test
518 defc(q2_gozr) $ branch if a2 = 0
519 defc(q2_gotrue) $ if a2 = true then go to a1; end;
520 defc(q2_gofalse) $ if a2 = false then go to a1; end;
521 defc(q2_goom) $ if a2 = om then go to a1; end;
522 defc(q2_gonl) $ if a2 = << >> then go to a1; end;
523 defc(q2_gonult) $ if a2 = [ ] then go to a1; end;
524 defc(q2_gogei) $ branch on ge. - short ints.
525 defc(q2_gogeui) $ untyped int
526 defc(q2_gogeur) $ branch on ge. - untyped reals
527 defc(q2_goge) $ branch on ge - general case
528 defc(q2_goincs) $ if a2 incs a3 then go to a1; end;
529 defc(q2_goin) $ general case
530 defc(q2_goins) $ general set/map case
531 defc(q2_goinus) $ unbased set
532 defc(q2_goinl) $ local set
533 defc(q2_goinr) $ remote set
534 defc(q2_golti) $ branch on lt - int
535 defc(q2_goltui) $ untyped int
536 defc(q2_goltur) $ branch on lt - untyped real
537 defc(q2_golt) $ branch on lt - general case
538 defc(q2_gone1) $ one word compare
539 defc(q2_gonev) $ compare value and type.
540 defc(q2_gone) $ general test
541 defc(q2_gonz) $ branch on non zero
542 defc(q2_gonom) $ branch on non om
543 defc(q2_gonnl) $ branch on not nl
544 defc(q2_gonnult) $ branch on not nult
545 defc(q2_gonincs) $ if not a2 incs a3 then go to a1; end;
546 defc(q2_gonin) $ general case
547 defc(q2_gonins) $ general set/map case
548 defc(q2_goninus) $ unbased set
549 defc(q2_goninl) $ local subset
550 defc(q2_goninr) $ remote subset
551
552$ initialize set iterator 'a1 _ a3'. a2 is a temporary in
553$ 'iterator' format.
554 defc(q2_inexts) $ set.
555 defc(q2_inextt) $ tuples
556 defc(q2_inext) $ general initialization
557
558$ set iterators 'a1 _ a3'. a2 is only used in the general cases;
559$ it is a temporary in 'iterator' format.
560
561$ these instructions are always followed by a q2_goom instruction
562$ which branches if a1 = om. the branch is exectued as part of
563$ the next instruction.
564
565
566 defc(q2_nextt) $ tuples
567 defc(q2_nextut) $ untyped tuples
568 defc(q2_nextus) $ unbased sets
569 defc(q2_nextls) $ local sets
570 defc(q2_nextrs) $ remote sets
571 defc(q2_next) $ general case
572 defc(q2_nexts) $ sets and maps
573
574$ domain iterators - as above
575
576 defc(q2_inextd)
577 defc(q2_nextd) $ domain iterator
578
579$ call - push return address and jump to a1. a2 is routine name and
580$ a3 is number of arguments.
581
582 defc(q2_call) $ call to procedure constant
583
584 defc(q2_ucall) $ call unsatisfied external
585
586$ pop return address and jump to it
587
588 defc(q2_retn)
589
590$ the next few opcodes are emitted by the code generator only
591$ when we plan to emit assembly code. they have no run time semantics,
592$ and are treated as noops.
593
594 defc(q2_lab) $ define label
595 defc(q2_tag) $ define case tag
596 defc(q2_mentry) $ define main entry point
597 defc(q2_pentry) $ procedure entry
598
599
600$ linkage instructions
601
602$ these instructions move blocks of symbol table entries to and from
603$ the stack as part of routine prologues and epilogues. there
604$ arguments are:
605
606$ a1: address of first word of block
607$ a2: length of block
608
609 defc(q2_swap) $ swap parameters for recursive ca
610 defc(q2_savel) $ push local variables onto stack,
611 defc(q2_loadp) $ non-recursive prolog. move param
612 defc(q2_resetp) $ reset parameters
613 defc(q2_clearl) $ zero out local variables
614 defc(q2_resetl) $ restore local variables
615
616$ opcodes for backtracking
617
618 defc(q2_entry) $ procedure entry
619 defc(q2_exit) $ procedure exit
620 defc(q2_bcall) $ call
621 defc(q2_bpop1) $ pop
622 defc(q2_bpopu1) $ pop untyped value
623 defc(q2_bfree)
624 defc(q2_ok) $ ok
625 defc(q2_lev) $ lev
626 defc(q2_fail1) $ fail
627 defc(q2_dexit) $ dummy exit
628 defc(q2_fail2) $ fail
629 defc(q2_undo) $ undo a return
630 defc(q2_succeed) $ succeed
631
632
633
634$ built in procedures
635
636$ setl is defined in terms of a number of built in procedures. for
637$ the moment we treat calls to these builtin procedures very much
638$ like any other procedure call, except that the procedures are
639$ in little. a call to a builtin procedure xxx consists of:
640
641$ 1. a series of stack pushes
642$ 2. an instruction q2_xxx which calls the library procedure xxx
643$ 3. a series of stack pops.
644
645$ built in procedures access their arguments through the stack. if a
646$ built in procedure has a variable number of arguments then we
647$ pass each argument individually rather than gathering them into a
648$ tuple.
649
650$ the quadruples for built in procedure calls have:
651
652$ a1: temporary for procedure result
653$ a2: symbol table pointer to procedure name
654$ a3: symbol table pointer to number of arguments.
655
656$ the built in procedure opcodes are:
657
658 defc(q2_open) $ open
659 defc(q2_close) $ close
660 defc(q2_print) $ print
661 defc(q2_read) $ read
662 defc(q2_printa) $ printa
663 defc(q2_reada) $ reada
664 defc(q2_get) $ get
665 defc(q2_put) $ put
666 defc(q2_getb) $ getb
667 defc(q2_putb) $ putb
668 defc(q2_getk) $ getk
669 defc(q2_putk) $ putk
670 defc(q2_getf) $ getf
671 defc(q2_callf) $ callf
672 defc(q2_putf) $ putf
673 defc(q2_rewind) $ rewind
674 defc(q2_eof) $ eof
675 defc(q2_eject) $ eject
676 defc(q2_titl) $ title
677
678 defc(q2_getipp) $ get integer control card parameter
679 defc(q2_getspp) $ get string control card parameter
680 defc(q2_getem) $ get current error mode and limit
681 defc(q2_setem) $ set error mode and limit
682
683 defc(q2_host) $ host
684
685
686 defc(q2_span) $ span
687 defc(q2_break) $ break
688 defc(q2_match) $ match
689 defc(q2_lpad) $ blank pad on left
690 defc(q2_len) $ len
691 defc(q2_any) $ any
692 defc(q2_notany) $ notany
693 defc(q2_rspan) $ rspan
694 defc(q2_rbreak) $ rbreak
695 defc(q2_rmatch) $ rmatch
696 defc(q2_rpad) $ blank pad on right
697 defc(q2_rlen) $ rlen
698 defc(q2_rany) $ rany
699 defc(q2_rnotany) $ rnotany
700
701$ debugging options
702
703 defc(q2_tre) $ trace entry
704 defc(q2_notre) $ notrace entry
705 defc(q2_trcstmts) $ trace statements
706 defc(q2_trccalls) $ trace calls
707 defc(q2_trcsym) $ trace modifications of sym
708 defc(q2_trc) $ trace code pointer
709 defc(q2_notrc) $ no code trace
710 defc(q2_trg) $ trace garbage collector
711 defc(q2_notrg) $ notrace garbage collector
712 defc(q2_gdump) $ enable dumps during garbage collection
713 defc(q2_nogdump) $ disable dumps during garbage collection
714 defc(q2_dump) $ dump dynamic storage
715 defc(q2_garb) $ call garbage collector
716
717$ statement trace
718
719 defc(q2_stmt) $ statement trace
720
721$ stop and abort
722
723 defc(q2_abort) $ abort
724 defc(q2_error) $ compile time error
725 defc(q2_stop)
726
727 defc(q2_noop) $ dummy, used to hold extra arguments
728
729 +* q2_minimum = q2_copy ** $ minimum opcode
730 +* q2_maximum = q2_noop ** $ maximum opcode
731
732
733 ..part1
734
735
1 .=member q2macs
2$ s y s t e m c o n s t a n t s
3$ ----------- -----------------
4
5
6$ type codes
7$ ---- -----
8
9$ these type codes are arranged in the following order:
10
11$ short types
12$ long types requiring only 1 word equality test
13$ long types
14$ om types
15
16$ short integers always have type 0 to speed up integer addition.
17$ this means that type codes must be zero origined.
18
19 .=zzyorg z $ initialize counter for type values.
20
21 defc0(t_int) $ short int
22 defc0(t_string) $ short chars
23 defc0(t_atom) $ short atom
24 defc0(t_error) $ error
25 defc0(t_proc) $ subroutine
26 defc0(t_lab) $ function
27 defc0(t_latom) $ long atom
28 defc0(t_elmt) $ compressed element
29 defc0(t_lint) $ long integer
30 defc0(t_istring) $ long chars
31 defc0(t_real) $ real
32 defc0(t_tuple) $ standard tuple
33 defc0(t_stuple) $ packed or untyped tuple
34 defc0(t_set) $ set
35 defc0(t_map) $ map
36 defc0(t_skip) $ skip word
37
38 $ types with om flag set
39 defc0(t_oint) $ om short int
40 defc0(t_ostring) $ om short chars
41 defc0(t_oatom) $ om short atom
42 defc0(t_oerror) $ om error
43 defc0(t_oproc) $ om subroutine
44 defc0(t_olab) $ om function
45 defc0(t_olatom) $ om 'long' atom
46 defc0(t_oelmt) $ om compressed element
47 defc0(t_olint) $ om long integer
48 defc0(t_oistring) $ om long chars
49 defc0(t_oreal) $ om real
50 defc0(t_otuple) $ om standard tuple
51 defc0(t_ostuple) $ om packed or untyped tuple
52 defc0(t_oset) $ om set
53 defc0(t_omap) $ om map
54 defc0(t_oskip) $ skip word
55
56
57 +* t_min = t_int ** $ minimum type
58 +* t_max = t_oskip ** $ maximum type
59
60$ long and short types
61
62$ specifiers are considered to be 'long' or 'short' depending on
63$ their type codes.
64
65$ 'short' specifiers contain their value directly in the specifier.
66
67$ 'long' specifiers contain a pointer to their value.
68
69$ the distinction between long and short is made essentially for
70$ the garbage collector.
71
72 +* t_smax = t_lab ** $ maximum short type
73 +* t_lmin = t_latom ** $ minimum long type
74
75
76$ relationship between type codes and equality tests
77
78$ short objects can be tested for equality using a one word test,
79$ while long objects must be compared off line, since they may
80$ contain pointers to different copies of equal objects. thus
81$ we may divide type codes into inline and offline types.
82$ this division is not quite the same as the division between
83$ long and short types. rather it reflects the fact that long
84$ atoms, even though they contain pointers, are equal if and
85$ only if their specifiers are equal. thus we have:
86
87 +* t_pmax = t_real ** $ maximum primitive type
88 +* t_lmax = t_skip ** $ maximum defined type
89
90 +* t_inline_max = t_latom ** $ maximum for inline test
91 +* t_offline_min = t_elmt ** $ minimum for offline test
92 +* t_offline_max = t_lmax ** $ maximum for offline test
93
94
95$ header types
96$ ------ -----
97
98$ these codes are arranged so that we can jump on the following
99$ subsets of htypes:
100
101$ tuples
102$ sets
103$ maps
104$ sets and maps
105$ sets, maps, and bases
106$ remote sets and maps
107
108$ in addition, those blocks which can be pointed to exclusively by
109$ specifiers appear before those which can be pointed to by any
110$ pointer.
111
112 .=zzyorg z $ initialize counter for h_xxx values
113
114 defc(h_latom) $ long atom
115 defc(h_real) $ real
116 defc(h_lint) $ long integer
117 defc(h_istring) $ long chars
118 defc(h_lstring) $ long chars
119 defc(h_tuple) $ standard tuple
120 defc(h_ptuple) $ packed tuple
121 defc(h_ituple) $ integer tuple
122 defc(h_rtuple) $ real tuple
123 defc(h_uset) $ standard set
124 defc(h_lset) $ local set
125 defc(h_rset) $ remote set
126 defc(h_rmap) $ remote map
127 defc(h_rpmap) $ remote packed map
128 defc(h_rimap) $ remote integer map
129 defc(h_rrmap) $ remote real map
130 defc(h_umap) $ unbased map
131 defc(h_lmap) $ local map
132 defc(h_lpmap) $ local packed map
133 defc(h_limap) $ local integer map
134 defc(h_lrmap) $ local real map
135 defc(h_base) $ base
136 defc(h_ebs) $ set element block
137 defc(h_ebm) $ map element block
138 defc(h_ebb) $ base element block
139 defc(h_ht) $ hash table header
140 defc(h_htb) $ hash table block
141 defc(h_code) $ code
142
143 +* h_min = h_latom ** $ minimum htype
144 +* h_max = h_code ** $ maximum htype
145
146
147$ map types
148$ --- -----
149
150$ for certain jumps on the types of maps, type codes are too general,
151$ while htypes are two specific, and lead to many redundant labels.
152$ instead, we use a separate set of codes known as map types, and
153$ provide a mapping from htypes to map types. the main advantage
154$ of this is to compact several two dimensional jump tables.
155
156 .=zzyorg z $ initialize counter for m_xxx values
157
158 defc(m_umap) $ unbased map
159 defc(m_rmap) $ all remote maps
160 defc(m_lmap) $ all local maps
161
162 +* m_min = m_umap ** $ minimum map type
163 +* m_max = m_lmap ** $ maximum map type
164
165
166$ copy conditions
167$ ---- ----------
168
169$ for the general arithmetic routines such as +, -, and *,
170$ we pass the copying information gathered by the compiler
171$ to the library. the possible copying options are:
172
173 .=zzyorg z $ reset counter
174
175 defc0(copy_no) $ dont copy
176 defc0(copy_yes) $ copy
177 defc0(copy_test) $ copy if shared
178
179 +* copy_min = copy_no **
180 +* copy_max = copy_test **
181
182$ it would seem wasteful to test a bit to distinguish between
183$ a conditional copy and an unconditional copy. however when
184$ the optimizer detects that some use of 'x' requires an
185$ unconditional copy, it will suppress the setting of the
186$ share bits of all corresponding definitions of 'x'. thus
187$ we will no longer be in a position to test x-s share bit.
188
189
190$ sizes and dimensions of data structures
191$ ----- --- ---------- -- ---- ----------
192
193 +* hs = $ h e a p
194 .ws.
195 **
196
197 +* heap_dims = $ dimension of heap
198 .+s10 32000
199 .+s20 (256 * 1024 - 5)
200 .+r32 1 $ allocate dynamically
201 .+s66 1 $ allocated dynamicly
202 **
203
204
205 +* default_sym = $ default size for symbol table
206 .+s10 65535
207 .+s20 65535
208 .+r32 8191
209 .+s66 65535 $ prefer to take h_lim/8
210 **
211
212
213 +* default_ca = $ default size for constant area
214 .+s10 65535
215 .+s20 65535
216 .+r32 65535
217 .+s66 65535 $ prefer to take h_lim/2
218 **
219
220
221 +* default_h = $ default size for initial heap
222 .+s10 8000
223 .+s20 16384
224 .+r32 524288
225 .+s66 8000
226 **
227
228
229 .+s66 +* nsheap = blank ** $ use fortran blank common
230
231
232 +* max_depth = $ guess as to the maximum depth of a setl object
233 .+s10 100
234 .+s20 100
235 .+r32 5000
236 .+s66 010
237 **
238
239 +* ngarb_vars = $ number of local variables used in garbage coll
240 5
241 **
242
243 +* init_min_gap = $ initial value for min_gap
244 (max_depth * ngarb_vars)
245 **
246
247
248$ miscellaneous constants
249$ ------------- ---------
mjsa 7
mjsa 8
mjsa 9$ maximum number of significant digits in a real number: this value is
mjsa 10$ used by the floating point/integer conversion routines to establish
mjsa 11$ the maximum number of significant digits which can be expected to be
mjsa 12$ returned by or utilized by cref$io and cefr$io. note that this number
mjsa 13$ is exactly one less than the maximum value returned as the second
mjsa 14$ parameter of cref$io.
mjsa 15
mjsa 16 +* max_nsigdigs = $ maximum number of significant digits
mjsa 17 .+s10 7
mjsa 18 .+s20 7
mjsa 19 .+r32 7
mjsa 20 .+s66 13
mjsa 21 **
mjsa 22
smfc 19$ parameterise the floating point representation of the target machine.
smfc 20
smfc 21 +* real_mant_sz = $ number of bits in the floating mantissa
smfc 22 .+r32 24
smfc 23 .+r36 27
smfc 24 .+s66 48
smfc 25 **
smfc 26
smfc 27
smfc 28 +* real_exp_base = $ base by which the mantissa is multiplied
smfc 29 .+s32 2.0
smfc 30 .+s37 16.0
smfc 31 .+s47 16.0
smfc 32 .+r36 2.0
smfc 33 .+s66 2.0
suna 30 .+s68 2.0
smfc 34 **
smfc 35
smfc 36
smfc 37 +* real_exp_base_sz = $ real_exp_base = 2.0 ** real_exp_base_sz
smfc 38 .+s32 1
smfc 39 .+s37 4
smfc 40 .+s47 4
smfc 41 .+r36 1
smfc 42 .+s66 1
suna 31 .+s68 1
smfc 43 **
smfc 44
250
251 +* chsiz = $ character size
252 .cs.
253 **
254
255
256 +* chpw = $ characters per heap word
257 (hs/chsiz)
258 **
259
260
261 +* chorg = $ bit offset for first character in word
262 .+s10 (hs-chsiz+1)
263 .+s20 (hs-chsiz+1)
264 .+s32 1
265 .+s37 (hs-chsiz+1)
266 .+s47 (hs-chsiz+1)
267 .+s66 (hs-chsiz+1)
suna 32 .+s68 (hs-chsiz+1)
268 **
269
270
271 +* chinc = $ bit increment between characters in word
272 .+s10 (- chsiz)
273 .+s20 (- chsiz)
274 .+s32 chsiz
275 .+s37 (- chsiz)
276 .+s47 (- chsiz)
277 .+s66 (- chsiz)
suna 33 .+s68 (- chsiz)
278 **
279
280
281 +* chlst = $ bit offset of last character in word
282 .+s10 1
283 .+s20 1
284 .+s32 (hs-chsiz+1)
285 .+s37 1
286 .+s47 1
287 .+s66 1
suna 34 .+s68 1
288 **
289
290
291 +* hcsz = $ maximum size of hash code
292 .+s66 12
293 .+r32 16
294 .+s10 18
295 .+s20 18
296 **
297
298
299 +* hcsd = $ hash code seed
300 .+s10 8191
301 .+s20 8191
302 .+r32 2089
303 .+s66 127
304 **
305
306
stra 13$ note that we often assume that sc_max = 1.
stra 14
stra 15 +* sc_max = $ max number of characters in short string
stra 16 01
stra 17 **
stra 18
308$ sc_org is similar to the 'sorg' field of self definining strings. it
309$ gives the position of the bit immediately to the left of the string
310$ value.
stra 19 +* sc_org = $ origin for short character string
stra 20 .+r32 (09 + sc_max*chsiz)
stra 21 .+r36 (01 + sc_max*chsiz)
stra 22 .+s66 (01 + sc_max*chsiz)
stra 23 **
321
322
323 +* max_ebindx = $ maximum ebindx
324 .+s66 3b'77777'
325 .+r32 4b'ffff'
326 .+s10 4b'ffff'
327 .+s20 4b'ffff'
328 **
329
330
331 +* rs_bpw = $ remote set - bits per word
332 .+s66 32
333 .+r32 32
334 .+s10 32
335 .+s20 32
336 **
337
338
339 +* bpos_max = $ maximum bit position in packed tuple
340 hs
341 **
342
343 +* pack_max = $ maximum number of elements in constant set
344 256
345 **
346
347 +* real_nw = $ number of words in real data block
348 (hl_real+1)
349 **
350
351 +* ebs_nw = $ number of words in unbased set eb
352 (hl_eb + 1)
353 **
354
355 +* ebm_nw = $ number of words in unbased map eb
356 (hl_eb + 2)
357 **
358
359
360 +* inst_nw = $ no. of words per interpreter instruction
361 .+s10 2
362 .+s20 2
363 .+r32 2
364 .+s66 1
365 **
366
367
368 +* maxsi = $ maximum short integer
369 .+s66 3b'377777'
370 .+r32 4b'3fffff'
371 .+s10 3b'777777'
372 .+s20 3b'777777'
373 **
374
375
376 +* hc_tuple = $ constant added to tuple hashes
377 1
378 **
379
380 +* hc_set = $ constant added to hashes of sets
381 2
382 **
383
384
385$ limits for various fields
386$ ------ --- ------- ------
387
388$ the following macros give the maximum values which can fit in
389$ various fields.
390
391 +* max_hash = $ maximum for hash field
392 .+s66 3b'7777'
393 .+r32 4b'ffff'
394 .+s10 maxsi
395 .+s20 maxsi
396 **
397
398
399 +* max_nelt = $ maximum for nelt field
400 .+s66 3b'77777'
401 .+r32 4b'ffff'
402 .+s10 maxsi
403 .+s20 maxsi
404 **
405
406
407 +* max_logn = $ maximum for lognhedrs field
408 .+s10 255
409 .+s20 255
410 .+r32 255
411 .+s66 63
412 **
smfa 8
smfa 9
smfa 10 +* max_ic_len = $ maximum value for ic_len field.
smfa 11 .+s10 3b'777777'
smfa 12 .+s20 3b'777777'
smfa 13 .+r32 4b'ffff'
smfa 14 .+s66 3b'377777'
smfa 15 **
413
414
415 +* max_code_address = $ maximum branch address in codea1 field
416 .+s10 262143 $ - 2 ** 18 - 1
417 .+s20 262143 $ - 2 ** 18 - 1
418 .+r32 1048575 $ - 2 ** 20 - 1
419 .+s66 32767 $ - 2 ** 15 - 1
420 **
421
422
423 +* max_symtab = $ maximum size for run-time symbol table
424 .+s10 262143 $ - 2 ** 18 - 1
425 .+s20 262143 $ - 2 ** 18 - 1
426 .+r32 65535 $ - 2 ** 16 - 1
427 .+s66 32767 $ - 2 ** 15 - 1
428 **
429
430
431
432
433$ storage administration
434$ ------- --------------
435
436$ the heap is organized as follows:
437
438$ high core
439
440$ h_lim -----> +---------+
441$ i i
442$ >=========< stack area
443$ t, savet --> i i
444$ i/////////i
445$ i/////////i
446$ >=========< free storage
447$ i/////////i
448$ h ---------> i/////////i
449$ i i
450$ i i
451$ >=========< heap proper
452$ i i
453$ i i
454$ h_org -----> i i
455$ i i
456$ i i
457$ >=========< constants and interpretable code
458$ i i
459$ i i
460$ ca_org ----> i i
461$ sym_end ---> i i
462$ i i
463$ >=========< symbol table
464$ i i
465$ sym_org --> i i
466$ i/////////i
467$ >=========< wasted storage
468$ i/////////i
469$ snam_end --> i i
470$ i i
471$ >=========< run-time names table
472$ i i
473$ snam_org --> i i
474$ i/////////i
475$ >=========< wasted storage
476$ i/////////i
477$ +---------+
478
479$ the stack and heap both grow towards the middle of the free
480$ storage area. the garbage collector uses the gap between the
481$ stack and the heap as a work space. when this gap reaches the
482$ value 'min_gap' we call the garbage collector.
483
484$ as indicated above, the q2 code is stored in the heap. the
485$ code for each procedure is arranged as a data block with:
486
487$ htype: indicates h_code
488$ code_nwords: indicates length of block
489
490$ the area below the heap porper is ignored by the garbage collector.
491$ pointers into this area are viewed as null pointers.
492
493$ there are several standard pointers into the heap:
494
495$ t: points to top of stack
496$ h: points to next free word of heap
497$ h_org: points to first word of heap proper
498$ sym_end: points to last word of symbol table
499
500
501$ the symbol table contains one location for each variable, constant,
502$ and base. it also contains an entry for each unique data type
503$ which is used to store the standard representation for omega
504$ for that type.
505
506
507$ we assume that no garbage collection will ever take place while
508$ the library is active. this is implemented in the following
509$ manner: various macros are supplied to request heap space and
510$ push words onto the stack. whenever these macros detect a
511$ shortage of space they will envoke the garbage collector. the
512$ garbage collector will backup the interpreter one quadruple
513$ and return control to the interpreter rather than the routine
514$ which called it. the interpreter will then repeat the
515$ operation which ran short of space.
516
517$ there are two requirements for this to work:
518
519$ 1. whenever the interpreter adjusts -t- it must save the new value_
520$ of -t- in the globa -savet-. the garbage collector will always
521$ begin by restoring -t- to this value.
522
523$ 2. on entry to the library, all heap blocks are properly formed.
524$ before linking an old block to a new one, the new block must
525$ also be properly formed.
526
527$ 3. before requesting stack or heap space, we must be sure that all
528$ heap blocks requested since entry to the library are at least
529$ partially formed. by this we mean that they must have a valid
530$ htype, a null hlink, and all other information necessary
531$ to tell the size of the block.
532
533
534
535$ the garbage collector requires a work space between the stack and
536$ the heap in order to operate. this space is used for stacking
537$ recursive variables during the marking phase and for building
538$ several temporary data structures during base compaction. the size
539$ of this space is given by the variable min_gap, and is the maximum
540$ of:
541
542$ 1. the space needed to compact the largest base. this is given
543$ by the macro gb_space(i) where i is the maximum eb index.
544
545$ 2. the number of recursive variables in the garbage collector
546$ times some guess as to the maximum depth of any setl object.
547$ n.b. this number must be large enough to guarantee that no
548$ garbage collection is caused while collection garbage.
549$ in particular, it must be large enough to save the
550$ recursion stack of any routine invoked during garbage
551$ collection (such as, for example, the routine -nullp-).
552
553$ the garbage collector is called whenever the space between the
554$ stack and the heap is about to become less than min_gap.
555
556
557 +* gb_space(i) = $ space needed to compact base with
558
559$ maximum index 'i'
560$ the garbage collector requires room for a remote set with rs_maxi
561$ equal to the maximum ebindx of any base, plus a vector whose length
562$ is the maximum ebindx / rs_bpw. on machines like the 66 00 which
563$ have alot of unused space in remote sets, this vector is packed
564$ in with the remote set.
565
566 .+s66 (rsalloc(i) + max_depth * ngarb_vars)
567 .+r32 (rsalloc(i) + (i)/rs_bpw + max_depth * ngarb_vars)
568 .+s10 (rsalloc(i) + (i)/rs_bpw + max_depth * ngarb_vars)
569 .+s20 (rsalloc(i) + (i)/rs_bpw + max_depth * ngarb_vars)
570 **
571
572$
573$ as we have seen, the heap consists of several segments, such as the
574$ symbol table, the heap proper, the stack, etc. we do not write the
575$ complete heap image to the q2 file, but only the defined segments.
576$ the following macro gives the number of heap segments in the q2 file.
577$
smfd 10 +* hf_slices = 6 ** $ number of heap slices in the q2 file
579
580
581 +* reserve(n) = $ reserve stack or heap space
582 if ((t - h -(n)) < min_gap) call grbcol;
583 **
584
585 +* get_heap(n, p) = $ get n word heap block and set p
586 reserve(n); $ make sure the space is there
587 p = h;
588 h = h + (n);
589 **
590
591 +* get1(p) = $ shorthand for get_heap(1, p)
592 get_heap(1, p);
593 **
594
595 +* get2(p) = $ shorthand for get_heap(2, p)
596 get_heap(2, p);
597 **
598
599 +* get_real(p) = $ allocate block for real
600 get_heap(real_nw, p);
601 htype(p) = h_real;
602 hlink(p) = 0;
603 **
604
605 +* get_lint1(p) = $ get block for 1 word long integer
606 get_heap(hl_lint+1, p);
607 htype(p) = h_lint;
608 hlink(p) = 0;
609 li_nwords(p) = hl_lint+1;
610 **
611
612
613 +* get_pair(p) = $ allocate block for pair
614 size zzza(ps); $ loop index
615 size zzzb(ps); $ pointer to standard pair
616
617 get_heap(talloc(2), p);
618
619 zzzb = value(s_pair);
620
621 do zzza = 0 to talloc(2)-1;
622 heap(p+zzza) = heap(zzza+zzzb);
623 end do;
624
625 set_nelt(p, 2);
626 **
627
628
629$ stack manipulation
630$ ----- ------------
631
632$ there are two sets of stack manipulation macros. the first moves the
633$ stack pointer. the second moves data in and out of the stack.
634
635
636 +* get_stack(n) = $ adjust pointer for push
637 reserve(n); $ make sure the space is there
638 t = t - (n);
639 **
640
641 +* free_stack(n) = $ adjust pointer for pop
642 t = t + (n);
643 **
644
645
646 +* push1(a) = $ push 'a'
647 get_stack(1);
648 heap(t) = a;
649 **
650
651 +* push2(a, b) = $ push 'a', push 'b'
652 get_stack(2);
653 heap(t+1) = a;
654 heap(t) = b;
655 **
656
657 +* push3(a, b, c) = $ push 'a', push 'b', push 'c'
658 get_stack(3);
659 heap(t+2) = a;
660 heap(t+1) = b;
661 heap(t) = c;
662 **
663
664 +* pop1(a) = $ pop 'a'
665 a = heap(t);
666 free_stack(1);
667 **
668
669 +* pop2(a, b) = $ pop 'a', pop 'b'
670 a = heap(t);
671 b = heap(t+1);
672 free_stack(2);
673 **
674
675 +* pop3(a, b, c) = $ pop 'a', pop 'b', pop 'c'
676 a = heap(t);
677 b = heap(t+1);
678 c = heap(t+2);
679 free_stack(3);
680 **
681
682
683 +* push_int(n) = $ push integer
684 size zzza(hs);
685
686 build_spec(zzza, t_int, n);
687 push1(zzza);
688 **
689
690 +* pop_int(n) = $ pop integer
691 size zzza(hs);
692
693 pop1(zzza);
694 n = value_ zzza;
695 **
696
697$ various library routines recieve their arguments through the stack.
698$ the following macro is used to access them:
699
700 +* stack_arg(i, na) = $ i-th of n arguments
701 heap(t + na - (i))
702 **
703
704
705
706
707
708$ macros for accessing data structures
709$ ------ --- --------- ---- ----------
710
711
712$ the following macros are used to access various parts of
713$ the data structures, for example the i-th component of
714$ a tuple or the j-th character of a string.
715
716
717$ macros for accessing sets and maps
718$ ------ --- --------- ---- --- ----
719
720
721 +* template(s) = $ pointer to template block of set
722 (hashtb(s)+hl_ht)
723 **
724
725 +* om_image(map) = $ om image value for a map
726 heap(ft_samp(ft_im(hform(map))))
727 **
728
729
730$ macros for accessing remote sets
731$ ------ --- --------- ------ ----
732
733
734$ note that in order to simplify access, the bit strings in remote sets
735$ are zero origin. since we never have an ebindx of zero, the zero bit
736$ is always off.
737
738 +* rsoffs(i) = $ word offset of bit of remote set
739 ((i)/rs_bpw + hl_rset)
740 **
741
742 +* rsorg(i) = $ bit position in word of bit of long bit string
743 (mod(i, rs_bpw) + 1)
744 **
745
746 +* rsword(p, i) = $ i-th word of remote set
suna 35 heap(p + (hl_rset-1) + (i))
748 **
749
750 +* rswords(p) = $ number of significant words of remote set
751 (rs_maxi(p)/rs_bpw + 1) $ rs_maxi is always (k * rs_bpw) - 1.
752 **
753
754 +* rsbit(p, i) = $ i-th bit
755 .f. rsorg(i), 1, heap(p+rsoffs(i))
756 **
757
758 +* rsalloc(n) = $ allocation for n bit set
suna 36 (hl_rset + 1 + (n)/rs_bpw)
760 **
761
762
763$ macros for accessing local maps
764$ ------ --- --------- ----- ----
765
766
767 +* localoffs(i) = $ offset of i-th local map
suna 37 ((hl_ebb-1) + (i))
769 **
770
771 +* atomoffs(i) = $ offset of i-th long atom image
suna 38 ((hl_latom-1) + (i))
773 **
774
775
776$ macros for accessing tuples
777$ ------ --- --------- ------
778
779
780 +* compoffs(n) = $ offset of n-th tuple component
781 (n+hl_tuple)
782 **
783
784 +* tcomp(p, n) = $ n-th component of tuple pointed to by p
785 heap(p+compoffs(n))
786 **
787
788 +* breath_space(n) = $ amount of breathing space allocated
789 ((n)/2) $ for an n-tuple
790 **
791
792 +* talloc(n) = $ allocation for a tuple with maxindx of n
suna 39 (hl_tuple + 1 + (n)) $ header + zero component + components
794 **
795
796 +* tuplen(p) = $ total length of tuple
suna 40 (hl_tuple + 1 + maxindx(p))
798 **
799
800
801$ macros for accessing packed tuples
802$ ------ --- --------- ------ ------
803
804
805 +* packoffs(p, i) = $ word offset of packed tuple component
806 ((i - 1)/ptvals(p) + hl_ptuple)
807 **
808
809 +* packorg(p, i) = $ bit orogin of packed tuple component
810 (mod(i - 1, ptvals(p)) * ptbits(p) + 1)
811 **
812
813 +* packword(p, i) = $ i-th word component
suna 41 heap(p + (hl_ptuple-1) + (i))
815 **
816
817 +* packwords(p) = $ number of words used
818 ((maxindx(p) - 1)/ptvals(p) + 1)
819 **
820
821 +* pcomp(p, i) = $ packed tuple component
822 .f. packorg(p, i), ptbits(p), heap(p+packoffs(p, i))
823 **
824
825 +* palloc(p, n) = $ allocation for packed tuple p with maxindx n
suna 42 (hl_ptuple + 1 + (n-1)/ptvals(p))
827 **
828
829 +* ptuplen(p) = $ total length of packed tuple
suna 43 (hl_ptuple + 1 + (maxindx(p)-1)/ptvals(p))
831 **
832
833
834$ there is one very important special case for packed tuples:
835$ packed tuples(int 1 ... 1). the components of these tuples
836$ require only 1 bit of storage and can have the values 1 and
837$ omega. they are used for bit vectors, for foriegn i/o and
838$ for representing sets of characters in the string primitives.
839
840$ these packed tuples always have a standard form given by the
841$ macro 'f_pt11'. we provide a special set of access macros which
842$ take ptbits = 1 and ptvals = ws.
843
844 +* pt11offs(p, i) = $ word offset of pt11 tuple component
suna 44 ((hl_ptuple*ws - 1 + (i)) / ws)
846 **
847
848 +* pt11org(p, i) = $ bit orogin of pt11 tuple component
849 (mod(i - 1, ws) + 1)
850 **
851
852 +* pt11word(p, i) = $ i-th component word
suna 45 heap(p + (hl_ptuple-1) + (i))
854 **
855
856 +* pt11words(p) = $ number of words used
suna 46 ((ws - 1 + maxindx(p)) / ws)
858 **
859
860 +* pt11comp(p, i) = $ pt11 tuple component
861 .f. pt11org(p, i), 1, heap(p+pt11offs(p, i))
862 **
863
864 +* pt11alloc(p, n) = $ allocation for pt11 tuple p with maxindx n
suna 47 (((hl_ptuple+1)*ws - 1 + (n)) / ws)
866 **
867
868 +* pt11len(p) = $ total length of pt11 tuple
suna 48 (((hl_ptuple+1)*ws - 1 + maxindx(p)) / ws)
870 **
871
872
873 +* psetoffs(pset, i) = $ word offset of pattern set component
874 ((i)/(ws/pset_sz) + hl_ptuple)
875 **
876
877 +* psetorg(pset, i) = $ bit origin of pattern set component
878 .+s10 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
879 .+s20 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
880 .+s32 ( 1 + mod((i), (ws/pset_sz)) * pset_sz)
881 .+s37 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
882 .+s47 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
883 .+s66 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
suna 49 .+s68 ((hs+1-pset_sz) - mod((i), (ws/pset_sz)) * pset_sz)
884 **
885
886 +* psetword(pset, i) = $ i-th word of patter set component
887 heap(pset + hl_ptuple + (i))
888 **
889
890 +* psetwords(pset, i) = $ number of words used
suna 50 ((ws/pset_sz - 1 + maxindx(pset)) / (ws/pset_sz))
892 **
893
894 +* psetcomp(pset, i) = $ pattern set component
895 .f. psetorg(pset, i), pset_sz, heap(p+psetoffs(pset, i))
896 **
897
898 +* psetalloc(pset, n) = $ allocation for pattern set
suna 51 (((hl_ptuple+1)*(ws/pset_sz)-1 + (n)) / (ws/pset_sz))
900 **
901
902 +* psetlen(pset) = $ total length of pattern set
suna 52 (((hl_ptuple+1)*(ws/pset_sz)-1 + maxindx(pset))/(ws/pset_sz))
904 **
905
906
907$ macros for accessing short strings
908$ ------ --- --------- ----- -------
909
910
stra 24 +* scchar(spec, i) =
stra 25 sc_chars_ spec $ sc_max = 1, so extract single character
913 **
918
919
920$ macros for accessing long strings
921$ ------ --- --------- ---- -------
922
923
924$ these macros take string specifiers as their arguments.
925
926 +* icoffs(ss, i) = $ word offset of i-th character
927 (hl_lchars + (ss_ofs(ss) + i - 1) / chpw)
928 **
929
930 +* icorg(ss, i) = $ bit origin of i-th character
931 (chorg + mod(ss_ofs(ss)+i-1, chpw) * chinc)
932 **
933
934 +* icword(ss, i) = $ word containing i-th character
935 heap(ss_ptr(ss) + icoffs(ss, i))
936 **
937
938 +* icchar(ss, i) = $ i-th character
939 .f. icorg(ss, i), chsiz, icword(ss, i)
940 **
941
942 +* lcalloc(n) = $ allocation for n character long character bloc
suna 53 (((hl_lchars+1)*chpw - 1 + (n)) / chpw)
944 **
945
946
947 +* mvc(target_ss, source_ss, len) = $ move character
948
949 .-defenv_envmvc.
950 $ variables for target string
951 size zzza(ps); $ pointer to current word
952 size zzzb(ps); $ offset in current word
953
954 $ variables for source string
955 size zzzc(ps); $ pointer to current word
956 size zzzd(ps); $ offset in current word
957
958 size zzze(ps); $ loop index
959
960
961 zzza = ss_ptr(target_ss) + icoffs(target_ss, 1);
962 zzzc = ss_ptr(source_ss) + icoffs(source_ss, 1);
963
964 zzzb = icorg(target_ss, 1);
965 zzzd = icorg(source_ss, 1);
966
967 do zzze = 1 to len;
968 .f. zzzb, chsiz, heap(zzza) =
969 .f. zzzd, chsiz, heap(zzzc);
970
971 $ update pointer to first string
972 if zzzb = chlst then
973 zzzb = chorg; zzza = zzza + 1;
974 else
975 zzzb = zzzb + chinc;
976 end if;
977
978 $ update pointer to second string
979 if zzzd = chlst then
980 zzzd = chorg; zzzc = zzzc + 1;
981 else
982 zzzd = zzzd + chinc;
983 end if;
984
985 end do;
986 .+defenv_envmvc.
987 $ call env procedure to do move
988 call envmvc(target_ss, source_ss, len, heap);
989 ..defenv_envmvc
990 **
991
992
993 +* clc(cc, ss1, ss2, len) = $ compare logical character
994
995 .-defenv_envclc.
996 $ variables for first string
997 size zzza(ps); $ pointer to current word
998 size zzzb(ps); $ offset in current word
999 size zzzc(chsiz); $ current character
1000
1001 $ variables for second string
1002 size zzzd(ps); $ pointer to current word
1003 size zzze(ps); $ offset in current word
1004 size zzzf(chsiz); $ current character
1005
1006 size zzzg(ps); $ loop index
1007
1008
1009 zzza = ss_ptr(ss1)+icoffs(ss1, 1); zzzb = icorg(ss1, 1);
1010 zzzd = ss_ptr(ss2)+icoffs(ss2, 1); zzze = icorg(ss2, 1);
1011
1012 cc = 0; $ assume equality holds
1013
1014 do zzzg = 1 to len;
1015 zzzc = .f. zzzb, chsiz, heap(zzza);
1016 zzzf = .f. zzze, chsiz, heap(zzzd);
1017
1018 if zzzc ^= zzzf then
1019 if zzzc < zzzf then
1020 cc = 1; quit do zzzg;
1021 elseif zzzc > zzzf then
1022 cc = 2; quit do zzzg;
1023 end if;
1024 end if;
1025
1026 $ update pointer to first string
1027 if zzzb = chlst then
1028 zzzb = chorg; zzza = zzza + 1;
1029 else
1030 zzzb = zzzb + chinc;
1031 end if;
1032
1033 $ update pointer to second string
1034 if zzze = chlst then
1035 zzze = chorg; zzzd = zzzd + 1;
1036 else
1037 zzze = zzze + chinc;
1038 end if;
1039
1040 end do;
1041 .+defenv_envclc.
1042 call envclc(ss1, ss2, len, heap, cc);
1043 ..defenv_envclc
1044 **
1045
1046
1047 +* build_ss(spec, ptr, ofs, len) = $ build string specifier
1048 .+ssi.
1049 get_heap(hl_ic, spec);
1050
1051 htype(spec) = h_istring;
1052 hlink(spec) = 0;
1053
1054 ss_ptr(spec) = ptr;
1055 ss_ofs(spec) = ofs;
1056 ss_len(spec) = len;
1057 ..ssi
1058
1059 .-ssi.
1060
1061 ss_ptr(spec) = ptr;
1062 ss_ofs(spec) = ofs;
1063 ss_len(spec) = len;
1064 ..ssi
1065 **
1066
1067
1068$ macros for accessing long integers
1069$ ------ --- --------- ---- --------
1070
1071
1072 +* liwords(p) = $ number of data words in long int
1073 (li_nwords(p) - hl_lint)
1074 **
1075
1076 +* liword(p, i) = $ i-th word of long int
1077 heap(p + hl_lint + (i-1))
1078 **
1079
1080
1081 +* get_intval(val, spec) = $ get integer value
1082 size zzza(hs);
1083
1084 zzza = spec;
1085 deref(zzza);
1086
1087 if is_om_ zzza then
1088 val = om_int;
1089
1090 elseif type_ zzza = t_int then
mjsa 36 val = ivalue_ zzza;
1092
1093 elseif type_ zzza = t_lint then
mjsa 37 val = getintli(zzza);
1096
1097 else
1098 call err_type(1);
1099 val = err_val(f_uint);
1100 end if;
1101 **
1102
1103
1104 +* put_intval(val, spec) = $ store integer value
1105 size zzza(ps);
1106
1107 if val = om_int then
1108 build_spec(spec, t_oint, 0);
1109
1110 elseif val < 0 ! val > maxsi then
mjsa 38 spec = putintli(val);
1114
1115 else
1116 build_spec(spec, t_int, val);
1117 end if;
1118 **
1119
1120
1121$ macros for accessing packed tuples and maps
1122$ ------ --- --------- ------ ------ --- ----
1123
1124
1125$ the following macros are used to access values contained in
1126$ packed tuples and maps.
1127
1128$ the values stored in packed tuples(maps) are small integers known as
1129$ indices. these indices are mapped into specifiers by using a 'key'.
1130$ the key for a packed tuple is contained in its 'ptkey' field; the
1131$ key for a packed local map is kept in its 'ls_key' field.
1132
1133$ there are two types of keys depending on the repr of the tuple or map:
1134
1135$ 1. packed tuple(i ... j) where i and j are integer constants and
1136$ j-i is fairly small.
1137
1138$ in this case the values i ... j are stored as indices 1 ... j-i,
1139$ with an index of zero signifying omega. the key has:
1140
1141$ type: t_int
1142$ value: i-1
1143
1144$ 2. packed tuple(_ b) where b is a constant base.
1145
1146$ in this case the indices stored in the packed tuple correspond
1147$ to the ebindx values of the elements of 'b'.
1148
1149$ in order to map the indices back into elements of b we require
1150$ a standard tuple(_ b) sending each ebindx into the corresponding
1151$ base element. in this case key has:
1152
1153$ type: t_tuple
1154$ value: pointer to tuple(_ b)
1155
1156$ note that once again, omega is represented by 0, and is used
1157$ to access the o-th component of the tuple and get the proper
1158$ omega.
1159
1160 +* pack(key, indx, val) = $ convert to packed format
1161 if is_om_ val then
1162 indx = 0;
1163
1164 elseif type_ val = t_int then
1165 indx = value_ val - value_ key;
1166
1167 else $ must be type element
1168 indx = ebindx(value_ val);
1169 end if;
1170 **
1171
1172
1173 +* unpack(key, indx, val) = $ convert to unpacked format
1174 if type_ key = t_int then
1175 if indx = 0 then
1176 build_spec(val, t_oint, 0);
1177 else
1178 build_spec(val, t_int, indx + value_ key);
1179 end if;
1180
1181 else
1182 val = tcomp(value_ key, indx);
1183 end if;
1184 **
1185
1186
1187$ macros for accessing untyped reals
1188$ ------ --- --------- ------- -----
1189
1190
1191 +* get_realval(val, spec) = $ untyped real value := real value
1192 if is_om_ spec then
1193 val = om_real;
1194
1195 elseif otype_ spec = t_real then
1196 val = rval(value_ spec);
1197
1198 else
1199 call err_type(45);
1200 val = err_val(f_ureal);
1201 end if;
1202 **
1203
1204
1205 +* put_realval(val, spec) = $ real value := untyped real value
1206 size zzza(ps);
1207
1208 get_real(zzza);
1209 rval(zzza) = val;
1210
1211 build_spec(spec, t_real, zzza);
1212 if (val = om_real) is_om_ spec = yes;
1213 **
1214
1215
1216
1217
1218
1219
smfa 16$ run-time symbol table organisation
smfa 17$ -------- ------ ----- ------------
smfa 18
smfa 19$ the run-time symbol table is organised as follows. the array slice
smfa 20$ sym_org..sym_end represents the (setl) system symbol table proper,
smfa 21$ i.e. all specifiers accessible from the code (and also certain other
smfa 22$ specifiers needed by various parts of the system) are allocated in
smfa 23$ this area. the array slice snam_org..snam_end contains additional
smfa 24$ information about each symbol table entry, which is useful for
smfa 25$ debugging purposes.
smfa 26$
smfa 27$ each sname entry consists of a compressed string specifier plus three
smfa 28$ predicates. a compressed string specifier consists of an index i into
smfa 29$ the rnames tuple, an offset into the i'th string of rnames, and a
smfa 30$ length for this string. the three predicates mark whether the symbol
smfa 31$ table entry is currently being traced, and whether this is a member or
smfa 32$ procedure entry, thus enabling us to determine the name of the current
smfa 33$ member and procedure scopes.
smfa 34
smfa 35 +* rn_offs(i) = .f. 1, 16, heap(snam_end-(sym_end-(i))) **
smfa 36 +* rn_indx(i) = .f. 17, 6, heap(snam_end-(sym_end-(i))) **
smfa 37 +* rn_len(i) = .f. 23, 7, heap(snam_end-(sym_end-(i))) **
smfa 38 +* rn_memb(i) = .f. 30, 1, heap(snam_end-(sym_end-(i))) **
smfa 39 +* rn_proc(i) = .f. 31, 1, heap(snam_end-(sym_end-(i))) **
smfa 40 +* rn_traced(i) = .f. 32, 1, heap(snam_end-(sym_end-(i))) **
1241
1242
1243
1244
1245$ local subroutines
1246$ ----- -----------
1247
1248$ very often a standard block of code will be repeated several times
1249$ in the same routine. we would like to treat such blocks as separate
1250$ small subroutines, both for elegence and space economy. however
1251$ however calls are expensive, and separate routines cannot be made
1252$ mutually recursive. therefor we make these standard code blocks
1253$ into -local subroutines-. in actuality they are labeled code
1254$ blocks located at the end of the routine which uses them.
1255$ the macro -l_call- simulates a local procedure call
1256
1257 +* l_call(lab) = $ local call to code block at label -lab
1258
1259 $ store a goto index in retpt and go to l
1260 retpt = zzya;
1261 go to lab;
1262 /rlab(zzya)/ $ label for return point
1263 **
1264
1265 $ note each local block must save -retpt-
1266 $ before doing any other calls.
1267
1268$ returns from local routines are coded:
1269
1270 $ go to rlab(retpt) in 1 to zzya;
1271
1272$ note that since this statement uses the previous value of zzya,
1273$ it cannot appear within a macro definition.
1274
1275$ recursion
1276$ ---------
1277
1278$ recursive routines are implimented as local subroutines, described
1279$ above. by convention, recursive routines start with a label -entry-
1280$ and end with a label -exit-. recursive variables are implimented as
1281$ reserved locations on the stack.
1282
1283$ the macro -local- is used in place of a size statement to declare a
1284$ name to be a recursive variable. its effect is to define -name-
1285$ as a macro for a stack location relative to the stack pointer
1286$ -t-. whenever we enter the recursive portion of a routine we
1287$ must increment the stack pointer and push the return pointer
1288$ onto stack. this is done by the macro -r_entry-, and the
1289$ corresponding pop is done by the macro -r_exit-.
1290
1291
1292 +* local(name) = $ declare recursive variable.
1293
1294 $ we assign stack offsets using the counter zzyb.
1295 $ this counter is reserved for this purpose and
1296 $ must be initialized at the start of each recursive
1297 $ routine.
1298 macdef(name = heap(t+(zzyb-1)))
1299 **
1300
1301
1302$ the macros for adjusting the stack on recursive entry and exit assume
1303$ that each routine has a single recursive entry point followed by a
1304$ single recursive exit point. they use the counter zzyb to determine
1305$ how much stack space to allocate or return. however they must subtract
1306$ 1 or 2 for the extra occurrences of 'zzyb' in the macros.
1307
1308 +* r_entry =
1309 get_stack(zzyb-1); $ first extra occurrence of zzyb
1310 **
1311
1312
1313 +* r_exit =
1314 free_stack(zzyb-2); $ second extra occurrence of zzyb
1315 **
1316
1317
1318 +* r_call = $ recursive call
1319 l_call(entry);
1320 **
1321
1322
1323
1324
1325$ which variables are stacked
1326
1327$ we use the following rules to determine which variables are stacked.
1328
1329$ 1. certain variables are used as parameters and returned values for
1330$ the recursive part of a routine. these variables should never be
1331$ stacked. if we wish to save a parameter across a recursive call,
1332$ we assign it to a stacked variable.
1333
1334$ 2. all other variables can be stacked relatively cheaply. the time
1335$ taken in stacking and referencing them is a function of the
1336$ number of recursive calls and the number of basic blocks in
1337$ which stacked variables are used. since setl objects are not
1338$ usually deeply nested, the space cost should be small.
1339
1340$ 3. do loop indices cannot be stacked.
1341
1342$ 4. stacked variables passed as subroutine arguments are call by
1343$ value. in particular, the first argument to locate and insert
1344$ cannot be made local variables since they are value recieving.
1345
1346$ 5. finally, better safe than sorry - we can optimize once it works
1347$ ------------------------------------------------------
1348
1349
1350
1351$ loops over sets
1352
1353$ we provide two groups of macros for iterating over
1354$ sets. each group of macros consists of an opener, a
1355$ continue, a quit, and an ender. the -next- macros are
1356$ used for iterating over an entire set. the -loc- macros
1357$ are used for iterating over a single clash list, typical
1358$ to locate some set element.
1359
1360$ we use some strange loops such as -while 3-. this is not
1361$ done out of fanaticism for structured programming but because
1362$ it is the only way to generate unique labels when the macros
1363$ are used in a nested fashion.
1364
1365
1366
1367 +* next_loop(p, s) = $ (forall p in s)
1368
1369 $ p = pointer to current element
1370 $ s = pointer to set
1371 p = template(s);
1372
1373 while 2;
1374 p = eblink(p);
1375 if is_ebhedr(p) then $ hash table header block
1376 if (is_ebtemp(p)) quit; $ reached template block
1377 cont;
1378 end if;
1379 **
1380
1381
1382 +* cont_next = $ matching -cont-
1383 cont while 2;
1384 **
1385
1386 +* quit_next = $ matching -quit-
1387 quit while 2;
1388 **
1389
1390 +* end_next = $ matching -end-
1391 end while 2;
1392 **
1393
1394
1395
1396
1397$ loop used to locate set elements
1398
1399 +* probe_loop(p, head) = $ loop over a clash list
1400
1401$ note that at the end of the loop p points either to the next hash
1402$ header or the set terminator. there are many loops which take
1403$ advantage of this.
1404
1405 $ p = pointer to current element
1406 $ head = ponter to set header
1407 p = head;
1408
1409 while 3;
1410 p = eblink(p);
1411 if (is_ebhedr(p)) quit;
1412 **
1413
1414
1415 +* cont_probe = $ corresponding -cont-
1416 cont while 3;
1417 **
1418
1419 +* quit_probe = $ corresponding -quit-
1420 quit while 3;
1421 **
1422
1423 +* end_probe = $ corresponding -ender-
1424 end while 3;
1425 **
1426
1427
1428 +* init_probe(arg, set, hashc, head) =
1429 $
1430 $ initialize for a hashed search of x in s. we first
1431 $ compute the hash code for x into 'hashc', then set
1432 $ set 'head' to point to the proper hash header of 's'.
1433 $
1434 size zzza(ps); $ pointer to hashtab/template of 's'
1435 size zzzb(ps); $ log of hash header number
1436 size zzzc(ps); $ index of hash header
1437
1438 hashc = gethash(arg);
1439 zzza = hashtb(set);
1440 zzzb = lognhedrs(zzza);
1441 zzzc = .f. hcsz-zzzb+1, zzzb, hashc;
1442
1443 zzza = zzza + hl_ht; $ zzza now points to the template of s
1444 head = eblink(zzza) + (zzzc * hl_htb);
1445 **
1446
1447
1448
1449
1450
1451
1452
1453$ inline equality tests
1454$ ------ -------- -----
1455
1456$ we ty to handle as many equality tests in line as possible; the
1457$ remaining cases are handled by the general equality routine.
1458$ equality tests use the following format:
1459
1460$ 1. test the otvalue fields of the arguments for equality. this
1461$ will catch all short, non-om items which are equal, plus
1462$ some long items. this is done using the macro -eq-.
1463
1464$ 2. short objects can only be equal if they pass the 'eq' test.
1465$ the same goes for long atoms, since there can never be two
1466$ copies of the same long atom. types which can be compared by
1467$ 1 word tests are refered to as 'inline' types.
1468
1469$ after the eq test we check whether both objects have 'inline'
1470$ types. if so they cannot possibly be equal. this test is
1471$ handled by the 'ne' macro.
1472
1473$ note that if one argument is long and the other short, they
1474$ may still be equal. for example, one argument could be the
1475$ integer 1, and the other could be an element of b which
1476$ yields 1 when dereferenced.
1477
1478$ 3. otherwise the arguments are om, unequal long objects, or
1479$ different copies of the same object. in these cases we must
1480$ call the general equality routine.
1481
1482$ note that the inline tests will always be sufficient for such
1483$ crucial types as short integers and atoms. they will also catch
1484$ most cases of equal base elements.
1485
1486
1487 +* eq(a1, a2) = $ compare types and values
1488 (otvalue_ a1 = otvalue_ a2) **
1489
1490
1491 +* ne(a, b) = $ test for inequality to be applied after -eq-
1492 (otype_ a <= t_inline_max & otype_ b <= t_inline_max)
1493 **
1494
1495
1496$ the equality routine has several general cases. the codes for these
1497$ are:
1498
1499 .=zzyorg z $ reset counter for codes
1500
1501 defc(eq_fail) $ types incompatible
1502 defc(eq_prim) $ do test on primitive types
1503 defc(eq_elmt) $ check for elements of same base
1504 defc(eq_deref) $ dereference then test
1505 defc(eq_tup) $ compare two tuples
1506 defc(eq_set) $ compare two sets or maps
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518$ general utilities
1519$ ------- ---------
1520
1521
1522$ predicates
1523$ ----------
1524
1525
1526 +* isshort(t) = $ true for short types
1527 (t <= t_smax)
1528 **
1529
1530 +* islong(t) = $ inverse of isshort
1531 (t > t_smax)
1532 **
1533
1534 +* isprim(t) = $ true for all but sets and tuples
1535 (t < t_tuple)
1536 **
1537
1538 +* istuple(t) = $ true for all tuples
1539 (t = t_tuple ! t = t_stuple)
1540 **
1541
1542 +* isset(t) = $ true for all set types
1543 (t = t_set ! t = t_map)
1544 **
1545
1546 +* is_remote(ht) = $ true for htypes of remote objects
1547 .f. ht, 1, 3b'000174000'
1548 **
1549
1550
1551$ macros for rehashing hash tables
1552$ ------ --- --------- ---- ------
1553
1554
1555 +* toodense(ht) = $ time to expand
1556 (neb(ht) > pow2(lognhedrs(ht)+1))
1557 **
1558
1559 +* toosparse(ht) = $ time to contract. note this never contracts
1560 (neb(ht) < pow2(lognhedrs(ht))/2) $ a null set
1561 **
1562
1563 +* mayexpand(s) = $ expand hash table if desireable
1564 if (toodense(hashtb(s))) call expand(hashtb(s));
1565 **
1566
1567 +* maycontract(s) = $ contract if desireable
1568 if (toosparse(hashtb(s))) call contract(hashtb(s));
1569 **
1570
1571 +* mayrehash(s) = $ rehash if desireable
1572 mayexpand(s);
1573 maycontract(s);
1574 **
1575
1576
1577
1578
1579
1580 +* real_address(p) = $ get real machine pointer
1581
1582$ machine pointers are passed to assembly language routines in the
1583$ little run time library which do character moves, etc.
1584
1585 .+s66 heap_address - 1 + (p)
1586 .+r32 heap_address - 1 + (p)/4
1587 .+s10 heap_address - 1 + (p)
1588 .+s20 heap_address - 1 + (p)
1589 **
1590
1591
1592 +* maycopy(spec) = $ copy object if it shared
1593 if (is_shared_ spec) spec = copy1(spec);
1594 **
1595
1596
1597
1598
1599 +* swap(a, b) = $ swap two variables
1600 size zzza(hs);
1601 zzza = a;
1602 a = b;
1603 b = zzza;
1604 **
1605
1606
1607
1608
1609 +* build_spec(spec, t, val) =$ build specifier from type and value
1610 spec = 0;
1611 value_ spec = val;
1612 otype_ spec = t;
1613 **
1614
1615
1616 +* add1(spec) = $ increment short setl integer
1617
1618 .+s66 spec = spec+one; $ take advantage of cyclic addition
1619 .+r32 ivalue_ spec = ivalue_ spec+1;
1620 .+s10 spec = spec+1;
1621 .+s20 spec = spec+1;
1622 **
1623
1624
1625 +* le(spec1, spec2) = $ .le. for short setl ints
1626
1627 .+s66 (spec1 <= spec2)
1628 .+r32 (ivalue_ spec1 <= ivalue_ spec2)
1629 .+s10 (spec1 <= spec2)
1630 .+s20 (spec1 <= spec2)
1631 **
1632
1633
1634 +* newat1(spec) = $ spec = newat.
1635
1636$ newat1 performs the 'newat' function for short atoms. it returns
1637$ a specifier with:
1638
1639$ type: t_atom
1640$ value: unique integer in 1 ... maxsi
1641
1642$ short atoms with other values are reserved for constant atoms.
1643
1644$ we keep two global variables: next_atom is the next available
1645$ short atom, and max_atom is the maximum short atom.
1646$ code.
1647 spec = next_atom;
1648
1649 .+s66 next_atom = next_atom + 1; $ add to low order bit
1650 .+r32 next_atom = next_atom + 1b'100'; $ add to bit 3
1651 .+s10 next_atom = next_atom + 1; $ add to bit 1
1652 .+s20 next_atom = next_atom + 1; $ add to bit 1
1653
1654 if (next_atom > max_atom) call err_fatal(1);
1655 **
1656
1657
1658
1659
1660
1661
1662$ dereference macros
1663
1664$ there are two standard dereference macros, a 1 level dereference
1665$ macro, and a general deref macro which dereferences until it gets
1666$ to a primitive object.
1667
1668$ we cannot assume that eb specifiers always have their share bits set,
1669$ since even if we set the share bit whenever we insert an element into
1670$ a set, the garbage collector may turn it off. (the garbage collector
1671$ turns off share bits of objects which are not actually shared at the
1672$ time of garbage collection.) therefore every dereference must set
1673$ the share bit of the specifier.
1674
1675 +* deref1(spec) = $ dereference specifier one level
1676 is_shared_ ebspec(value_ spec) = yes;
1677 spec = ebspec(value_ spec);
1678 **
1679
1680
1681 +* deref(spec) = $ dereference specifier if its type t_elmt
1682 while type_ spec = t_elmt;
1683 deref1(spec);
1684 end while;
1685 **
1686
1687
1688$ maintenance of nelts and hashes
1689
1690$ the operation which determines the hash code of a set or tuple is quit
1691$ expensive. for this reason we impliment it as a 'remember' function. t
1692$ that is, every time we calcuate the hash code of a composite object,
1693$ we leave the result in the 'hash' field of the objects data block.
1694$ the hash field is then valid until the set or tuple is modified.
1695$ there are two ways to tell whether an object has been modified since
1696$ its hash field was set. on a local basis, we can examine what
1697$ operations have been performed on it. on a more global basis, we can
1698$ tell by setting the objects 'is_hashok' flag whenever we set 'hash'
1699$ and clearing the flag whenever we update the object without updating
1700$ its hash.
1701
1702$ if the hash code of a particular object is frequently required then
1703$ we would like to set its is_hashok flag whenever we find its hash;
1704$ this will save many redundant calculations. if the hash of the
1705$ object is seldom needed, but the object is often modified by inline
1706$ code, we would like to never set its is_hashok bit, since at minimum
1707$ this would require us to clear the bit every time we modify the
1708$ object.
1709
1710$ the ft_hashok flag of an objects form tells us whether to set the
1711$ objects is_hashok flag when we compute its hash. if the ft_hashok
1712$ flag is set, then every time we modify the object, we must either
1713$ modify its hash,or clear its is_hashok flag. this choice is made
1714$ on an individual basis by various library routines.
1715
1716$ the treatment of 'nelt' is identical to the treatment of hash
1717$ codes except that we assume that all tuples have their ft_neltok
1718$ flag set. furthermore all update operations on tuples update nelt.
1719
1720$ it is also worth noting that the nelt of an unbased set is equal
1721$ to the number of element blocks in its hash table, which is
1722$ always maintained. thus the nelt of such a set is trivially
1723$ available. this is useful since unbased sets come closest to the
1724$ list representation we would use for workpiles and other sets which
1725$ are constantly tested against nl.
1726
1727
1728 +* ok_hash(spec) = $ update hash of set or tuple and possibly set
1729 $ is_hashok.
1730 size zzza(ps);
1731 if (^ is_hashok(value_ spec)) zzza = gethash(spec);
1732 **
1733
1734
1735
1736
1737 +* ok_nelt(spec) = $ update nelt of set or tuple and possibly set
1738 $ is_neltok.
1739 if (^ is_neltok(value_ spec)) call okneltr(spec);
1740 **
1741
1742 +* set_hash(p, h) = $ store hash, and possibly set is_hashok
1743 hash(p) = h;
1744 is_hashok(p) = ft_hashok(hform(p));
1745 **
1746
1747
1748 +* set_nelt(p, n) = $ store nelt and possibly set is_neltok
1749 nelt(p) = n;
1750 is_neltok(p) = ft_neltok(hform(p));
1751 **
1752
1753
1754$ macros to adjust nelt and hash
1755
1756$ the following macros are used to adjust the nelt and hash
1757$ of an object. they contain tests to prevent the nelt and
1758$ hash fields from underflow/overflow.
1759
1760 +* down_hash(p, n) = $ decrement hash
1761 if hash(p) >= n then
1762 hash(p) = hash(p) - n;
1763 else
1764 is_hashok(p) = no;
1765 end if;
1766 **
1767
1768
1769 +* down_nelt(p, n) = $ decrement nelt
1770 if nelt(p) >= n then
1771 nelt(p) = nelt(p) - n;
1772 else
1773 is_neltok(p) = no;
1774 end if;
1775 **
1776
1777
1778 +* up_hash(p, n) = $ increment hash
1779 if hash(p) + n > max_hash then $ any standard hash will do
1780 hash(p) = max_hash;
1781 else
1782 hash(p) = hash(p) + n;
1783 end if;
1784 **
1785
1786
1787 +* up_nelt(p, n) = $ increment nelt
1788 if nelt(p) + n > max_nelt then $ fatal
1789 call err_fatal(44);
1790 else
1791 nelt(p) = nelt(p) + n;
1792 end if;
1793 **
1794
1795
1796 +* short_hash(spec) = $ hash code of short item
1797 .+s66 .f. 1, hcsz, (spec)
1798 .+r32 .f. 3, hcsz, spec
1799 .+s10 .f. 1, hcsz, spec
1800 .+s20 .f. 1, hcsz, spec
1801 **
1802
1803
1804
1805 +* case_om = $ this macro is used for jumps on otypes. it
1806 $ provides labels for all the om types
1807
1808 /case(t_oint)/ /case(t_ostring)/ /case(t_oatom)/
1809 /case(t_skip)/ /case(t_error)/ /case(t_oproc)/
1810 /case(t_olab)/ /case(t_olatom)/ /case(t_oelmt)/
1811 /case(t_olint)/ /case(t_oistring)/ /case(t_oreal)/
1812 /case(t_otuple)/ /case(t_ostuple)/ /case(t_oset)/
1813 /case(t_omap)/ /case(t_oskip)/ /case(t_oerror)/
1814 **
1815
1816
1817
1818$ general organization of i/o
1819
1820$ most i/o operations are performed by mapping a setl file name into
1821$ a little file number then using the appropriate i/o statement such
1822$ as get or put.
1823
1824$ the mapping from file names to numbers is handled by the utility
1825$ file_id. it makes use of three values which are stored in the symbol
1826$ table:
1827
1828$ heap(s_fid): a map from file names to numbers
1829$ heap(s_free): a set of free file numbers
1830$ heap(s_fmax): the maximum file number used so far
1831
1832$ the maximum file number allowed by little is given by 'file_max'.
1833
1834$ for the most part we rely on little to handle buffering, cursors, etc.
1835$ the exception is the formatted read routine 'read2' which does its
1836$ own buffering to avoid reading one character at a time.
1837
1838$ we keep two global arrays which are accessed by file numbers:
1839
1840$ buffer: current line image
1841$ cursor: current cursor position
1842
1843$ these arrays are maintained for coded input files only.
1844
1845$ characters may be read in using the following macros:
1846
1847$ getc(id): set the global 'rd_char' to the next character of file i
1848$ backc(id): backup one character on file id
1849$ endline(id): position id at end of new line
1850$ newline(id): read next line of id into buffer and reset cursor
1851
1852$ whenver we read directly from a file id we must position its cursor at
1853$ the end of the line so that the next getc reads in a new line.
1854
1855
1856$ the maximum linesize of a coded input file is given by the
1857$ macro linesize_max.
1858
1859$ each 'buffer' is a bit string large enough to hold linesize_max + cpw
1860$ characters. when we read a line, we add cpw trailing blanks then
1861$ store it in the buffer as a series of character codes, right aligned
1862$ with zero fill. the 'read' routine sees the blanks at the end of each
1863$ line and thus treats an end-of-line as an end-of-token. we use cpw
1864$ blanks rather than a single blank to speed up the 'newliner' routine.
1865
1866$ each 'cursor' points to the rightmost bit of the last character read
1867$ from the corresponding buffer.
1868
1869
1870
1871 +* getc(id) = $ get next character
1872 if cursor(id) = 1 then
1873 newline(id);
1874
1875 else
1876 cursor(id) = cursor(id) - cs;
1877 rd_char = .f. cursor(id), cs, buffer(id);
1878 end if;
1879 **
1880
1881
1882 +* backc(id) = $ back up cursor
1883 cursor(id) = cursor(id) + cs;
1884 **
1885
1886
1887 +* endline(id) = $ position cursor at end of line
1888 cursor(id) = 1;
1889 **
1890
1891
1892 +* newline(id) = $ read new line and reset cursor
1893 call newliner(id);
1894 **
1895
1896
1897
1898 +* linesize_max = $ characters per card image
1899 .+s10 132
1900 .+s20 132
1901 .+r32 132
1902 .+s66 130
1903 **
1904
1905 +* buffer_size = $ size of buffer
1906 (linesize_max*cs + ws)
1907 **
1908
1909 +* blank_buffer = $ initial value for buffer
1910 .+s66 10r
1911 .+r32 04r
1912 .+s10 04r $ sixbit blank word
1913 .+s20 04r $ sixbit blank word
1914 **
1915
1916
1917
1918 +* file_max = $ maximum file identifier--see max_no_files above
1919 .+s10 10
1920 .+s20 10
1921 .+r32 20
1922 .+s66 10
1923 **
1924
1925
1926 +* mem_bpw = $ basic address units per setl word
1927 $ (bytes per word)
1928 .+s10 1
1929 .+s20 1
1930 .+r32 4
1931 .+s66 1
1932 **
1933
1934
1935
1936
1937$ c a t a b
1938
1939$ the character attribute table(catab) is used to drive various
1940$ io and string manipulation primitives. its fields are:
1941
1942
1943$ lexclass: a code read_xxx used to drive the read routine
1944$ dig_val: value of digits
1945$ numeric: true for numbers
1946$ alphameric: true for letters, numbers and break character
1947
1948 +* lexclass(c) = .f. 01, 08, catab(c+1) ** $ lexical clas
1949 +* dig_val(c) = .f. 09, 08, catab(c+1) ** $ values of di
1950 +* numeric(c) = .f. 17, 01, catab(c+1) ** $ on for decim
1951 +* alphameric(c) = .f. 18, 01, catab(c) ** $ alphanumeric
1952
1953 +* cs_sz = $ size of character set
1954 .+s66 64 $ hah hah
1955 .+r32 256
1956 .+s10 512
1957 .+s20 512
1958 **
1959
1960
1961 +* catab_sz = $ size of catab
1962 20
1963 **
1964
1965$ there is one character which is reserved as a meta-symbol
1966$ for end of file.
1967
1968 +* eof_char = 1r$ **
1969
1970
1971$ several of the io routines cannot be interrupted by garbage
1972$ collections. before entering them we reserve all the space they are
1973$ likely to need and turn off the garbage collector. this space
1974$ is given by following macro:
1975
1976 +* reserve_io =
1977 ((talloc(2) +4) * max_depth)
1978 **
1979
1980
1981
1982
1983$ the following codes are used to identify types of i/o
1984$ operations. note that the first few codes correspond to
1985$ the values returned by filestat(xxx, access).
1986
1987 .=zzyorg z
1988
1989 defc(io_get) $ get
1990 defc(io_print) $ print
1991 defc(io_put) $ put
1992 defc(io_read) $ read
1993 defc(io_string) $ not used
1994 defc(io_write) $ write
1995 defc(io_open) $ open
1996 defc(io_close) $ close
1997 defc(io_rewind) $ rewind
1998
1999 +* io_min = io_get **
2000 +* io_max = io_rewind **
2001
2002$ the codes read_xxx are used to drive the formatted read routine.
2003
2004 .=zzyorg z
2005
2006 defc(read_init) $ start read
2007 defc(read_num) $ read number
2008 defc(read_str) $ read string
2009 defc(read_name) $ read identifier as string
2010 defc(read_bool) $ read boolean
2011 defc(read_set1) $ set former '@'
2012 defc(read_set2) $ set former '<'
2013 defc(read_tup1) $ tuple former '['
2014 defc(read_tup2) $ tuple former '('
2015 defc(read_set3) $ set former '\'
2016 defc(read_set4) $ set former '/'
2017 defc(read_tup3) $ tuple former ']' or ')'
2018 defc(read_tup4) $ tuple former '/'
2019 defc(read_om) $ read omega
2020 defc(read_blank) $ read blanks between items
2021 defc(read_eof) $ read eof
2022 defc(read_error) $ error
2023 defc(read_term) $ terminate read
2024
2025 +* read_min = read_init **
2026 +* read_max = read_term **
2027
2028
2029$ the codes getb_xxxx are used to resume execution after a binary read
2030$ had been interrupted by a garbage collection.
2031
2032 .=zzyorg z
2033
2034 defc(getb_init) $ start new read
2035 defc(getb_cont) $ continue read
2036 defc(getb_term) $ push result
2037$
2038$ the codes intf_xxxx are used to resume execution after a fortran
2039$ interface routine has been interrupted by a garbage collection.
2040$
2041 .=zzyorg z
2042
2043 defc(intf_init) $ start new operation
2044 defc(intf_cont) $ continue after garbage collection
2045
2046
2047$ error codes
2048$ ----- -----
2049
2050 .=zzyorg z
2051
2052 defc(err_off) $ ignore errors
2053 defc(err_part) $ count errors, print message
2054 defc(err_opt) $ count errors, no message
2055 defc(err_full) $ full error checking
2056
2057
2058$
2059$ the following renames are needed to map setl library routine names
2060$ into names consisting of alphamerics only.
2061$
2062 +* add = stladd **
2063 +* add_freq = msadfr **
2064 +* close = sclose **
2065 +* div = stldiv **
2066 +* err_fatal = serfat **
2067 +* err_misc = sermsc **
2068 +* err_om = serom **
2069 +* err_proc = serprc **
2070 +* err_q2 = serq2 **
2071 +* err_type = sertyp **
2072 +* err_val = serval **
2073 +* file_id = stlfid **
2074 +* file_mode = sfmode **
2075 +* find_stmt = fndstm **
2076 +* getspace = sgetsp **
2077 +* more_gen = morgen **
2078 +* open = sopen **
2079 +* put_freq = msptfr **
2080 +* put_stat = msptst **
2081 +* real_over = realof **
2082 +* real_under = realuf **
2083 +* str = stlstr **
2084 +* rdheap1 = rdhea1 **
2085 +* rdheap2 = rdhea2 **
2086 +* wrheap1 = wrhea1 **
2087 +* wrheap2 = wrhea2 **
2088 +* var_id = varid **
2089
2090
2091
2092
2093
2094
2095
2096$ this ends the macros shared with the compiler.
2097
1 .=member q2vars
2$ global variable declarations
3$ ------ -------- ------------
4
5$ the declarations in member 'q2vars' are shared by the library and
6$ the code generator. the shared variables must all be in namesets
7$ so that compiler procedures will load them at the same address as
8$ library procedures. additionally, all initialization code must go
9$ into this member.
10
11
12 nameset nsheap; $ h e a p
13
14 .+mhl_static.
15 size cur_heap_dim(ps); $ actual current size of heap
16 size max_heap_dim(ps); $ actual maximum size of heap
17
18
19 size heap(hs);
20 dims heap(heap_dims);
21 ..mhl_static
22 .+mhl_s66.
23 size cur_heap_dim(ps); $ actual current size of heap
24 size max_heap_dim(ps); $ actual maximum size of heap
25
26
27 size heap(hs);
28 dims heap(heap_dims);
29 ..mhl_s66
30 .+mhl_dynamic.
31
32 size heap_addr(ws); $ actual address of heap(0)
33
34 size heap(hs);
35 dims heap(heap_dims);
36 ..mhl_dynamic
37
38 end nameset nsheap;
39
40
41 nameset nsgparam; $ garbage collector parameters
42
43$ this nameset contains variables which are used by the garbage
44$ collector and are likely to be accessed by assembly language
45$ routines.
46
47 size snam_org(ps); $ run-time names table origin
48 size snam_end(ps); $ run-time names table limit
49 size sym_org(ps); $ symbol table origin
50 size sym_end(ps); $ symbol table limit
51 size ca_org(ps); $ constant area origin
52 size h_org(ps); $ zero'th collectable heap entry
53 size h(ps); $ pointer to last used word of heap
54 size t(ps); $ pointer to top of main stack
55 size savet(ps); $ value of 't' on library entry
56 size h_lim(ps); $ current heap limit
57
58 size codep(ps); $ code pointer to current instruction
59
60 size min_gap(ps); $ minimum gap between t and h
61 size can_collect(1); $ enables/disables garbage collection
62 size heap_valid(1); $ flags all pointers are valid
63 size runtime_flag(1); $ set during run time
64
65 data min_gap = init_min_gap:
66 can_collect = yes:
67 heap_valid = yes;
68 data runtime_flag = 0;
69
70 .+gt.
71 size gtrace(1), $ on if tracing garbage collections
72 gdump(1); $ on if dumping garbage collections
73
74 data gtrace = no:
75 gdump = no;
76 ..gt
77
78 size cur_na(ps); $ number of arguments of current routine
79 data cur_na = 0;
80
81 size back_flag(1); $ indicates backtracking allowed
82 size last_env(ps); $ pointer to last environment block
83 size cur_arg(ps); $ pointer to current argument
84 size ok_lev(ps); $ number of ok's currently being saved
85
86 data back_flag = no;
87 data last_env = 0;
88 data cur_arg = 0;
89 data ok_lev = 0;
90$
91$ variables for future expansions
92$
93 size spare9(ws); data spare9 = 0;
94 size spare8(ws); data spare8 = 0;
95 size spare7(ws); data spare7 = 0;
96 size spare6(ws); data spare6 = 0;
97 size spare5(ws); data spare5 = 0;
98 size spare4(ws); data spare4 = 0;
99 size spare3(ws); data spare3 = 0;
100 size spare2(ws); data spare2 = 0;
101 size spare1(ws); data spare1 = 0;
102 size spare0(ws); data spare0 = 0;
103
104
105 end nameset nsgparam;
106
107
108 nameset nsstd; $ standard setl values
109
110 size all_ones(hs); $ specifier with all ones
111
112 size zero(hs), $ integer 0
113 one(hs), $ integer one
114 two(hs), $ integer two
115 ten(hs); $ integer ten
116
117 size om_int(hs), $ om untyped int
118 om_real(hs); $ om untyped real
119
120 .+s66 real real_zero; $ used to get om_real on cdc 6600
121
122 size spec_elmt(hs), $ specifier for type t_elmt
123 spec_char(hs), $ specifier for single character
124 spec_om(hs); $ standard 'om' value
125
126$ the specifiers for standard values such as 'true' and 'false' must
127$ be kept in the symbol table since they have type element and
128$ must be adjusted by the garbage collector. the variables s_xxx
129$ give the addresses of their symbol table entries.
130
131 size s_true(ps); $ address of true
132 size s_false(ps); $ address of false
133 size s_pair(ps); $ omega with repr f_pair
134 size s_okval(ps); $ value returned by 'ok'
135
136$ there are three sets which are used by the i/o utilities. their
137$ symbol table addresses are given by:
138
139 size s_fid(ps), $ maps file names into integers
140 s_free(ps), $ set of free file numbers
141 s_fmax(ps), $ maximum file id
142 s_fmode(ps); $ maps i/o modes into integers
143
144$ there are also two locations used as an io work area:
145
146 size s_io1(ps),
147 s_io2(ps);
148
149$ there is also a reserved symbol table entry for the tuple
150$ used to save statistics.
151
152 size s_stat(ps);
153$
154$ the are two global string specifiers which are used by the mvc-
155$ and clc-macros.
156$
157 size s_ss1(ssz);
158 size s_ss2(ssz);
159$
160$ variables used for the dynamic tracing package
161$
162 size s_ovar(hs);
163 size s_scopes(hs);
164$
165$ the folowing two specifiers hold the run-time names table
166$
167 size s_rnspec(hs);
168 size s_rnames(hs);
169$
170$ the following specifier holds the tuple used for communication in the
171$ fortran interface, i.e. the putf, callf, and getf primitives.
172$
173 size s_intf(hs); $ foreign interface tuple
174$
175$ variables used for extensions
176$
177 size s_spare2(hs);
178 size s_spare3(hs);
179 size s_spare4(hs);
180 size s_spare5(hs);
181 size s_spare6(hs);
182 size s_spare7(hs);
183 size s_spare8(hs);
184 size s_spare9(hs);
185 size s_sparea(hs);
186 size s_spareb(hs);
187 size s_sparec(hs);
188 size s_spared(hs);
189 size s_sparee(hs);
190 size s_sparef(hs);
191 size s_spareg(hs);
192 size s_spareh(hs);
193 size s_sparei(hs);
194 size s_sparej(hs);
195 size s_sparek(hs);
196$
197$ each q2 file starts with two integers: a check word and a date stamp.
198$ the check word indetifies a file as a q2 file, and the date stamp is
199$ used to determine whether the file was written in a format accepted
200$ by the current system.
201$
202 +* q2_checkw = 3b'2135' **
203 +* q2a_checkw = 3b'6740' **
204 +* q2b_checkw = 3b'0467' **
205 +* q2e_checkw = 3b'2370' **
206
stra 26 +* current_q2 = 84206 **
smfb 41 +* oldest_q2 = 83220 **
stra 27 +* newest_q2 = 84206 **
210
stra 28 +* current_q2a = 84206 **
smfb 44 +* oldest_q2a = 83220 **
stra 29 +* newest_q2a = 84206 **
214
stra 30 +* current_q2b = 84206 **
smfb 47 +* oldest_q2b = 83220 **
stra 31 +* newest_q2b = 84206 **
218
stra 32 +* current_q2e = 84206 **
smfb 50 +* oldest_q2e = 83220 **
stra 33 +* newest_q2e = 84206 **
222
223
224 size check_word(ws); $ q2 format check word
225 size date_stamp(ws); $ q2 format date
226$
227$ the array s_types maps type codes t_xxx into the address of the
228$ symbol table entry for the corresponding type constant.
229
230 defzero(s_types, a_s_types);
231
232 size a_s_types(ps);
233 dims a_s_types(t_max + 2);
234
235
236$ we keep two global variables for allocating short atoms:
237
238$ next_atom: the next available atom.
239$ max_atom: the maximum allowable atom.
240$
241$ short atoms have:
242$
243$ type: t_atom
244$ value: integer 1 ... maxsi-1
245
246 size next_atom(hs),
247 max_atom(hs);
248
249$ we also keep a counter which gives the next la_value for
250$ long atoms.
251
252 size next_latom(hs);
253 data next_latom = 0;
254
255
256$ the array 'maptype' maps htypes for maps into the
257$ codes m_umap, m_rmap, and m_lmap.
258
259 size maptype(ps);
260 dims maptype(h_max);
261
262 data maptype(h_rmap) = m_rmap:
263 maptype(h_rpmap) = m_rmap:
264 maptype(h_rimap) = m_rmap:
265 maptype(h_rrmap) = m_rmap:
266
267 maptype(h_umap) = m_umap:
268
269 maptype(h_lmap) = m_lmap:
270 maptype(h_lpmap) = m_lmap:
271 maptype(h_limap) = m_lmap:
272 maptype(h_lrmap) = m_lmap;
273
274
275$ the map 'hl' maps htypes h_xxx into header lengths hl_xxx.
276
277 size hl(ps);
278 dims hl(h_max);
279
280 data hl(h_latom) = hl_latom: $ long atom
281 hl(h_real) = hl_real: $ real
282 hl(h_lint) = hl_lint: $ long integer
283 hl(h_istring) = hl_ic: $ long chars
284 hl(h_lstring) = hl_lchars: $ long chars
285 hl(h_tuple) = hl_tuple: $ standard tuple
286 hl(h_rtuple) = hl_rtuple: $ real tuple
287 hl(h_uset) = hl_uset: $ standard set
288 hl(h_lset) = hl_lset: $ local set
289 hl(h_rset) = hl_rset: $ remote set
290 hl(h_rmap) = hl_rmap: $ remote map
291 hl(h_rpmap) = hl_rpmap: $ remote packed map
292 hl(h_rimap) = hl_rmap: $ remote integer map
293 hl(h_rrmap) = hl_rmap: $ remote real map
294 hl(h_umap) = hl_umap: $ unbased map
295 hl(h_lmap) = hl_lmap: $ local map
296 hl(h_lpmap) = hl_lpmap: $ local packed map
297 hl(h_limap) = hl_lmap: $ local integer map
298 hl(h_lrmap) = hl_lmap: $ local real map
299 hl(h_base) = hl_base: $ base
300 hl(h_ebs) = hl_eb: $ set element block
301 hl(h_ebm) = hl_eb: $ map element block
302 hl(h_ebb) = hl_ebb: $ base element block
303 hl(h_ht) = hl_ht: $ hash table header
304 hl(h_htb) = hl_htb: $ hash header block
305 hl(h_code) = hl_code; $ code
306
307
308 end nameset nsstd;
309
310
311$ initialize the standard values.
312
313 data all_ones = 0;
314 all_ones = (^ all_ones);
315
316 build_spec(zero, t_int, 0);
317 build_spec(one, t_int, 1);
318 build_spec(two, t_int, 2);
319 build_spec(ten, t_int, 10);
320
321
322$ om_int and om_real are initialized to machine dependent values
323
324 .+s10.
325 om_int = 3b'400000000000';
326 om_real = 3b'000600000000';
327 ..s10
328
329 .+s20.
330 om_int = 3b'400000000000';
331 om_real = 3b'000600000000';
332 ..s20
333
334
335 .+r32.
336 om_int = 4b'80000000';
337 om_real = 4b'00000001';
338 ..r32
339
340 .+s66.
341 om_int = all_ones; $ negative 0.
342 real_zero = 0.0; $ this will only bomb if we do arithmetic
343 om_real = real_zero/real_zero; $ on it, which is exactly the pt
344 ..s66
345
346 build_spec(spec_elmt, t_elmt, 0);
347
348 build_spec(spec_char, t_string, 0);
349 sc_nchars_ spec_char = 1;
350
351 build_spec(spec_om, t_oint, 0);
352
353 build_spec(next_atom, t_atom, 1);
354 build_spec(max_atom, t_atom, maxsi-1);
355
356
357 nameset nsutil; $ utility tables
358
359 defzero(onebits, a_onebits); $ mask of low order ones
360
361 size a_onebits(hcsz);
362 dims a_onebits(hcsz+1);
363
364 defzero(pow2, a_pow2); $ (2 ** i)
365 size a_pow2(ps);
366 dims a_pow2(hcsz+1);
367
368$ the equality routine is driven by the matrix 'eq_case' which
369$ is defined on the cross product of type codes.
370
371 defmatrix(eq_case, a_eq_case, t_min, t_lmax, eq_case_lim);
372
373 size a_eq_case(ps);
374 dims a_eq_case(eq_case_lim);
375
376 data a_eq_case = eq_fail(eq_case_lim);
377
378 size heap_address(ps); $ actual address of the heap
379
380$ we will need a loop index to initilize these variables. since
381$ it will be global, we give it an unlikely name.
382
383 size qqq(ps);
384
385$ global outputs from 'locate' routine
386
387 size loc_found(1), $ indicates item found
388 loc_hash(hcsz), $ hash of element located
389 loc_prev(ps); $ pointer to previous eb
390
391 size snap_flag(1), $ give snaps with error messages
392 assert_mode(ps); $ mode for assert statement
393
394 size err_mode(ps), $ error processing mode
395 err_count(ps); $ error count
396
397 data err_count = 0;
398
399 size err_limit(ps); $ error limit
400
401 size err_val(hs); $ returns proper error value
mjsa 39
mjsa 40 size putintli(hs); $ convert integer value to specifier
mjsa 41 size getintli(ws); $ convert integer specifier to value
402
403 size trace_stmts(1); $ trace statements flag
404 data trace_stmts = no;
405
406 size trace_calls(1); $ trace calls flag
407 data trace_calls = no;
408
409 size debug_flag(1); $ enable/disable trace package
410 data debug_flag = no;
asca 9
asca 10 .+ascebc.
asca 11 size ascebc_flag(ps); $ set for ebcdic-to-ascii conversion
asca 12 data ascebc_flag = no;
asca 13 ..ascebc
411
412
413$ we keep measurements for statements in the range 'st_lo' to
414$ 'st_hi'. these values are read in from the q2 file. the actual
415$ statistics are kept in the tuple 's_stat' at the end of the
416$ constants area.
417
418 size st_lo(ps), $ first statement monitored
419 st_hi(ps), $ last statement monitored
420 st_no(ps); $ number of statements monitored
421
422$ the variable 'itotal' gives the total number of instructions
423$ executed so far. it is used for statistics, but its primary
424$ purpse is to enable the garbage collector to know when it has
425$ run out of space: if the garbage collector is called on two
426$ successive values of 'itotal' it knows it must get more space
427$ from the operating system or abort.
428
429 size itotal(ws); $ total number of instructions executed
430 data itotal = 0;
431
432 size eitotal(ws); $ instruction count at last error message
433 data eitotal = 0;
434
435 size cur_stmt(ps); $ current cummulative statement number
436 data cur_stmt = 0;
437 end nameset nsutil;
438
439
440 do qqq = 0 to hcsz;
441 .f. hcsz-qqq+1, qqq, onebits(qqq) = all_ones;
442 end do;
443
444
445 pow2(0) = 1;
446
447 do qqq = 1 to hcsz;
448 pow2(qqq) = 2 * pow2(qqq-1);
449 end do;
450
451$ we use a data statement to initialize the most common case, then
452$ make various exceptions.
453
454$ items which can be compared through inline equality tests are
455$ assumed to be unequal even if their type codes match.
456
457$ all long primitive items with matching types are compared
458$ through the eq_prim case.
459
460 do qqq = t_lmin to t_pmax;
461 eq_case(qqq, qqq) = eq_prim;
462 end do;
463
464$ if we are comparing an element with something else, we must
465$ dereference it first.
466
467 do qqq = t_min to t_lmax;
468 eq_case(t_elmt, qqq) = eq_deref;
469 eq_case(qqq, t_elmt) = eq_deref;
470 end do;
471
472$ there is an exception to the above two rules: before comparing
473$ two elements, we see if they are in the same base.
474
475 eq_case(t_elmt, t_elmt) = eq_elmt;
476
477$ long and short strings can be equal. this falls into the
478$ eq_prim case.
479
480 eq_case(t_string, t_istring) = eq_prim;
481 eq_case(t_istring, t_string) = eq_prim;
482
483$ finally, tuples use the tuple case; sets and maps use the set
484$ case:
485
486 eq_case(t_tuple, t_tuple) = eq_tup;
487 eq_case(t_stuple, t_stuple) = eq_tup;
488 eq_case(t_tuple, t_stuple) = eq_tup;
489 eq_case(t_stuple, t_tuple) = eq_tup;
490
491 eq_case(t_set, t_set) = eq_set;
492 eq_case(t_map, t_map) = eq_set;
493 eq_case(t_set, t_map) = eq_set;
494 eq_case(t_map, t_set) = eq_set;
495
496
497
1 .=member binio
2
3 /*
4 setl optimizer input/output file format
5
6 *** draft 2 14-may-79
7
8 (this definition of optimizer q1 format is best kept in sem
9 source for now.)
10
11 the setl compiler uses an intermediate representation known as
12 'q1' to pass information from the sem phase to the cod phase.
13 the q1 form produced by sem also serves as primary input to the
14 setl optimizer which produces as its primary output a transformed
15 q1.
16
17 currently only the low level binary form of q1 produced by sem
18 is used. this has required that the optimizer directly read the
19 file using setl foreign i/o, spec and unspec functions, and so forth.
20 this has delayed optimizer development due to a number of bugs in
21 these setl features and has also introduced an unnecessary level
22 of machine dependence in the optimizer, as the file layout is
23 machine dependent.
24
25 it is proposed to support two forms of the q1 file and to provide
26 appropriate conversion programs. the current little binary
27 form will be referred to as lq1. the new form - referred to as
28 sq1 - will be used by the setl optimizer.
29
30 sq1 is in setl binary format and contains setl integers, reals
31 and strings. values are setl integers unless otherwise specified.
32
33
34 the sq1 tables are divided into 'segments'.
35 each segment consists of a header followed by the arrays mentioned
36 in the previous section. these arrays are arranged in a manner
37 that permits simple construction of the maps needed by optimizer.
38
39 each header consists of five items:
40
41 1. an integer code sc_xxx indicating whether the segment represents a
42 module, library, procedure, etc.
43
44 2. a string giving the name of the current segment.
45
46 3. a symtab pointer to the segment identifier.
47 this pointer is needed for code generation. note also that
48 the segment name may not be unique, but the pointer would be.
49
50 4. the number of procedures in the current module, library, etc.
51 this number is used to tell when we have read in the last
52 procedure in a segment.
53
54 5. the statement count for the current member.
55
56 the header is followed by the following tables:
57
58 formtab
59 symtab
60 blocktab
61 codetab
62
63 tables are written in 'slices'.
64 each slice begins with a standard header consisting of two integers:
65
66 1. an integer 'org' giving the index of the 0-th entry to be
67 read in.
68
69 2. an integer 'last' giving the index of the last entry to be
70 read in.
71
72
73 sq1 formtab format
74 ------------------
75
76 the first two values are the standard slice header:
77
78 1. formtab org
79 2. formtab last
80
81 each formtab entry is represented as follows:
82
83 ft_type
84 ft_mapc
85 ft_elmt
86 ft_dom
87 ft_im
88 ft_base
89 ft_low
90 ft_lim
91 ft_hashok
92 ft_neltok
93 ft_nonzero
94 ft_pos
95
96 each formtab entry may be followed by additional values
97 according to the type ft_type as follows:
98
99 1. if ft_type is f_mtuple there follow ft_lim integers
100 giving the types of the components of a mixed tuple.
101 2. if ft_type is f_proc there follow ft_lim integers
102 giving the types of the arguments.
103 3. if ft_type is f_base or f_pbase there follow the following
104 which give the number of local objects based on the item:
105
106 f_lset
107 f_lmap
108 f_lpmap
109 f_limap
110 f_rmap
111
112 4. if ft_type is f_rmap, f_rpmap, f_rimap or f_rrmap there
113 follows the value ft_tup.
114
115 note that the mixed-tuple table mttab which appears in
116 lq1 does not occur in sq1
117 as lq1 mttab entries appear immediately following the sq1 formtab
118 entry which references them.
119
120 sq1 symtab format
121 -----------------
122
123 the first two values are the standard slice header:
124
125 1. symtab org
126 2. symtab last
127
128 each symtab entry contains the following values:
129
130 name (string)
131 vptr
132 form
133 alias
134 is_temp
135 is_repr
136 is_stk
137 is_read
138 is_write
139 is_store
140 is_param
141 is_init
142 is_seen
143 is_back
144 is_rec
145
146
147 the optimizer use of vptr is confined to distinguishing zero from
148 non-zero values, so that vptr can be considered to answer the
149 question "does this entry have a value". if so, the entry
150 is followed by an additional value, as follows:
151
152 1. if form is f_sint or f_int there follows an integer
153 giving the value of an integer denotation.
154 2. if form is f_sstring or f_string there follows a
155 string giving the value of a string denotation.
156 3. if form is f_real there follows a real giving
157 the value of a real denotation.
158 4. otherwise, there follows an integer vlen.
159 if vlen is non-zero, there follow vlen integer values.
160
161 sq1 blocktab format
162 -------------------
163
164 the first two values are the standard slice header:
165
166 1. blocktab org
167 2. blocktab last
168
169 each blocktab entry consists of a single value:
170
171 b_first
172
173
174 sq1 codetab format
175 ------------------
176
177 the first two values are the standard slice header:
178
179 1. codetab org
180 2. codetab last
181
182
183 codetab begins with standard origin and last values:
184 1. codetab org
185 2. codetab last
186
187 each codetab entry consists of the following values:
188
189 opcode
190 nargs
191 blockof
192 next
193 cflag
194 sflag
195
196 if nargs is greater than zero, there follow nargs integers.
197 note that the argtab table present in the lq1 form is
198 not present in the sq1 form as the argtab entries
199 are implicitly represented in the sq1 by the additional
200 values which occur if nargs is non-zero.
201
202
203 summary of lq1, the little binary form of q1
204 --------------------------------------------
205
206
207 the little data structures are set up so that we do not have to
208 keep the entire program in core during compilation.
209
210 the little q1 tables are divided into 'segments'. there is one segment
211 for each module, procedure, etc. in the program. each segment is
212 written out as soon as we are done compiling it. when the
213 symbols defined in a segment are no longer needed we throw away
214 the table space used to store the segment.
215
216 each segment consists of a header followed by a slice of each of
217 the arrays mentioned in the previous section. these slices
218 are arranged in a standard order.
219
220 each header consists of:
221
222 1. an integer code sc_xxx indicating whether the segment represents a
223 module, library, procedure, etc.
224
225 2. a string giving the name of the current segment. this is
226 always represented by a bit string whose length is 'sds_sz'.
227
228 3. a symtab pointer to the segment name.
229 this pointer is needed for code generation. note also that
230 the segment name may not be unique, but the pointer would be.
231
232 4. the number of procedures in the current module, library, etc.
233 this number is used to tell when we have read in the last
234 procedure in a segment.
235
236 5. the statement count for the current member.
237
238 each slice consists of:
239
240
241 1. an integer 'org' giving the index of the 0-th entry to be
242 read in.
243
244 2. an integer 'last' giving the index of the last entry to be
245 read in.
246
247 3. a series of entries.
248
249 the sequencing of information within each segment is as follow
250
251 1. segment type (integer code)
252 2. segment name (sds string)
253
254 3. scope name (integer index to symtab)
255 4. number of procedures (integer)
256 4a. statement count (integer)
257
258 5. mttab org and last (integers)
259 6. mttab body (integer index to formtab)
260
261 7. formtab org and last (integers)
262 8. formtab body (bitstrings containing various fields)
263
264 9. name table org and last (integers)
265 10. name table body (self defining strings)
266
267 11. val table org and last (integers)
268 12. val table body (bitstrings for elementary types
269 other than strings;
270 self defining strings for string values
271 sequences of symbol-table
272 pointers in compound cases)
273
274 13. symbtab org and last (integers)
275 14. symbtab body (bitstrings containing various fields)
276
277 15. blocktab org and last (integers)
278 16. blocktab body (integer pointers to codetab)
279
280 17. argtab org and last (integers)
281 18. argtab body (integer pointers to symtab)
282
283 19. codetab org and last (integers)
284 20. codetab body (bitstrings containing various fi
285
286 */
287
288$ the type codes for setl binary i/o are:
289
290 .=zzyorg z
291
292 defc(bt_int) $ integer
293 defc(bt_real) $ real
294 defc(bt_string) $ character string
stra 34 defc(bt_bool) $ boolean
296 defc(bt_atom) $ atom
297 defc(bt_tuple) $ tuple
298 defc(bt_set) $ set
299 defc(bt_map) $ map
300 defc(bt_omega) $ omega
smfd 11 defc(bt_sint) $ unsigned short integer
stra 35 defc(bt_char) $ binary character
301
302 +* bt_min = bt_int **
stra 36 +* bt_max = bt_char **
304
305 +* bh_typ_ = .f. 1, ws/2, **
306 +* bh_val_ = .f. ws/2+1, ws/2, **
smfd 13
smfd 14
smfd 15 +* bh_val_max = $ maximum short integer (2**(ws/2)-1)
smfd 16 .+r32 4b'ffff'
smfd 17 .+r36 3b'777777'
smfd 18 .+s66 3b'77777 77777'
smfd 19 **
stra 37
stra 38$ note that we assume that cs <= ws/2, i.e. one character fits into the
stra 39$ value field.
307
308
1 .=member lipkg
2
3
4$ arbitrary precision arithmetic package
5$ --------- --------- ---------- -------
6
7$ the setl arbitrary precision arithmetic package consists of a number
8$ of functions whose arguments may be long or short integer specifiers,
9$ and which return the specifier for a long or short integer. the
10$ following routines are provided:
11$
12$ the main set of arithmetic routines are:
13$
14$ fnct addli(arg1, arg2) addition of integers
15$ fnct diffli(arg1, arg2) subtraction of integers
16$ fnct multli(arg1, arg2) multiplication
17$ fnct divli(arg1, arg2) division
18$ fnct modli(arg1, arg2) mod
19$
20$ fnct uminli(arg1) unary minus
21$
22$ the following predicates on setl integers return a little value of yes
23$ or no (1 or 0).
24$
25$ fnct equalli(arg1, arg2) =
26$ fnct ltli(arg1, arg2) <
27$ fnct evenli(arg1, arg2) check for even integer
28$
29$ the following routines perform transformations between setl integer
30$ and real values:
31$
32$ fnct floatli(arg1) floating point from integer
33$ fnct fixli(arg1) returns long int from real notation
34$ fnct floorli(arg1) floor: returns long int from real
35$ fnct ceilli(arg1) ceiling: returns long int from real
36$
37$ the following functions aid in performing input/output on integers.
38$
39$ fnct strli(arg1) transform integer to string
40$ fnct putbli(arg1) output for long integers
41$ fnct getbli(arg1) input for long integers
42$
43$ the following functions perform miscellaneous tasks.
44$
45$ fnct putintli(arg1) transform little integer to setl int
46$ fnct getintli(arg1) transform setl integer to little int
47$ fnct hashli(arg1) integrates long int into sets
48$ fnct valli(arg1) transform string to integer
49$
50$ other functions required for long integer arithmetic which do not
51$ explicitly appear above are implemented by calls to other routines:
52$
53$ predicates /=, >, <=, >= (by equalli, ltli)
54$ max, min (by ltli)
55$ odd (by evenli)
56
57$ the package represents long integer values as follows: a long integer
58$ digit is not considered to be a word sized quantity, but is instead
59$ viewed as a quantity whose size is one bit smaller than half of the
60$ word size. this is done so that in performing operations such as
61$ multiplicaton, the result of the operation will not exceed the word
62$ size. an auxiliary base whose word size is twice that of the regular
63$ digit size is used in performing operations such as addition where the
64$ overflow is limited to one bit. the long integer data block has
65$ essentially the structure shown in the diagram below:
66$
67$ +-------------------------------------------+
68$ ! header word for garbage coll !
69$ >-------------------------------------------<
70$ ! # words in block ! # of digits in li !
71$ >-------------------------------------------<
72$ !s! ! ! least signif digit!
73$ >-------------------------------------------<
74$ ! ! ! !
75$ >-------------------------------------------<
76$ ! . !
77$ ! . !
78$ ! . !
79$ ! !
80$ >-------------------------------------------<
81$ ! ! most signif digit ! !
82$ >-------------------------------------------<
83$
84$ there are three quantities which must be set in constructing a setl
85$ long integer: the number of digits, the sign of the number, and the
86$ magnitude of the number. to each of these quantities there
87$ corresponds a macro which sets a field within the long integer.
88$
89$ 1. the field -li_ndig- field contains the number of digits which
90$ are present in the long integer. a digit is considered to have
91$ a base of li_bas.
92$
93$ 2. the field -li_sign- contains the sign of the long integer, and
94$ is set to zero if the integer is positive, one if the integer is
95$ negative. zero is considered to be a positive number.
96$
97$ 3. the field -li_digit- or -li_ddigits- contain the magnitude of
98$ the number. in a long integer with more than one digit these
99$ fields will have to be set several times.
100$
101$ the most significant digit of a long integer may be stored in either
102$ the left or the right part of the most significant word, depending
103$ upon whether there is an even or odd number of li_bas digits present.
104$ since two different bases are used throughout the package, we must be
105$ certain that in case a number has an odd number -n- of -li_bas-
106$ digits, the -n+1- digit is equal to zero.
107$
108$ the sign of a long integer is stored in the most significant bit of
109$ the first word which follows the header words.
110$
111$ the number of digits in an integer is based upon a digit of base
112$ li_bas (as opposed to li_dbas).
113
114
115$ macro definitions for the arithmetic package
116$ ----- ----------- --- --- ---------- -------
117
118$ the arithmetic routines use two different bases depending upon the
119$ operation begin performed. in the case of mult, for example, the base
120$ -li_bas- (roughly half a word) is used, while for addition or
121$ subtraction we use a base whose number of digits is twice as long (we
122$ call this -li_dbas-).
123
124$ we do make certain assumptions about the relative size of these bases.
125$ we assume that 3*ds > ws > 2*ds. we do not make any assumptions about
126$ the relative sizes of -maxsi- and ds. specifically, on some
127$ implementations li_bas will be greater than -maxsi-, while in other
128$ implementations li_bas will be smaller than -maxsi-.
129
130 +* ds = $ number of bits in li_bas
131 .+s10 17
132 .+s20 17
133 .+r32 15
134 .+s66 23
135 **
136
137 +* dds = (2*ds) ** $ number of bits in li_dbas
138
139 +* li_bas = $ 2 ** ds
140 .+s10 3b'000000400000'
141 .+s20 3b'000000400000'
142 .+r32 4b'00008000'
143 .+s66 3b'0000 0000 0000 4000 0000'
144 **
145
146 +* li_dbas = $ 2 ** (2*ds) = 2 ** dds
147 .+s10 3b'200000000000'
148 .+s20 3b'200000000000'
149 .+r32 4b'40000000'
150 .+s66 3b'0000 2000 0000 0000 0000'
151 **
152
153$ macros which access the number of digits in a long int:
154
155 .+s10.
156 +* li_ndig_ = .f. 19, 18, **
157 +* off_li_ndig = 01 **
158 ..s10
159 .+s20.
160 +* li_ndig_ = .f. 19, 18, **
161 +* off_li_ndig = 01 **
162 ..s20
163 .+r32.
164 +* li_ndig_ = .f. 17, 16, **
165 +* off_li_ndig = 01 **
166 ..r32
167 .+s66.
168 +* li_ndig_ = .f. 19, 17, **
169 +* off_li_ndig = 00 **
170 ..s66
171
172 +* li_ndig(p) = li_ndig_ heap((p) + off_li_ndig) **
173 +* li_nddig(p) = (li_ndig(p) + 1)/2 **
174
175$ in extracting a single digit (a single setl long integer digit) we
176$ need two pieces of information: the offset of the digit from the
177$ first word of the data block which contains it, and the starting bit
178$ of the digit (always 1 or ds). since we define the first digit of a
179$ long integer to sometimes be the least significant digit and at other
180$ times the most significant digit, we define a different set of macros
181$ for each case.
182
183 +* li_bitoff(i) = (ds * mod((i)-1,2) + 1) **
184 +* li_digoff(i) = (hl_lint + ((i)-1)/2) **
185
186 +* li_dbitoff = 01 **
187 +* li_ddigoff(i) = hl_lint + (i) - 1 **
188
189$ these macros allow us to extract long integer digits either with a
190$ value of i = 1 representing the least significant digit, the most
191$ significant digit, or the two least significant digits at a time.
192$ a multiplicity of methods for extracting digits is required since
193$ certain of the arithmetic routines can be made either more efficient
194$ or more clear through their use.
195
196 +* li_digit(p, i) =
197 .f. li_bitoff(i), ds, heap((p) + li_digoff(i))
198 **
199
200 +* li_ddigit(p, i) =
201 .f. 1, dds, heap((p) + li_ddigoff(i))
202 **
203
204 +* li_pdigit(p, i) =
205 li_digit((p), li_ndig(p) - (i) + 1)
206 **
207
208$ constants for positive and negative long integers
209
210 +* positive = 0 **
211 +* negative = 1 **
212
213$ fields which determine the sign of the number
214
215 +* li_sign(p) =
216 .f. ws, 1, heap((p) + hl_lint)
217 **
218
219 +* li_pos(p) =
220 li_sign(p) = positive
221 **
222
223 +* li_neg(p) =
224 li_sign(p) = negative
225 **
226
227$ check to see if a number is a small negative integer, i.e. a negative
228$ integer whose absolute value is less than or equal to maxsi. we use
229$ this macro in various places to attempt to predict the magnitude of
230$ certain operations.
231
232 +* li_snint(p) =
233 li_sign(p) = negative
234 & li_ndig(p) <= 2
235 & li_ddigit((p), 1) <= maxsi
236 **
237
238$ check to see if a value which is represented as a long integer is
239$ small enough to be represented as short integer. such a long integer
240$ may result in certain operations in which the operands may be long,
241$ but the result short.
242
243 +* li_spint(p) =
244 li_sign(p) = positive
245 & li_ndig(p) <= 2
246 & li_ddigit((p), 1) <= maxsi
247 **
248
249$ the following macros are used in various ways throughout the
250$ arithmetic package:
251
252$ odd number of digits in long integer?
253
254 +* li_oddndig(p) =
255 (mod(li_ndig(p), 2) = 1)
256 **
257
258$ allocates space in the heap for long integers
259
260 +* get_lint(n, p) = $ get block for n-word long integer
261 get_heap(hl_lint + (n), p);
262 htype(p) = h_lint;
263 hlink(p) = 0;
264 li_nwords(p) = hl_lint + (n);
265 **
266
267 +* get_lint1(p) = get_lint(1, p) **
268
269$ build up a long integer specifier and data block when the long
270$ integer has a value that will fit into one li_dbas digit.
271
272 +* build_lint1(spec, val, sign) =
273
274 size zzza(ps);
275
276 get_lint1(zzza);
277 build_spec(spec, t_lint, zzza);
278 li_ddigit(zzza, 1) = val;
279 li_sign(zzza) = sign;
280 li_ndig(zzza) = 1 + (val >= li_bas);
281 **
282
283$ the macro li_dbas_digit calculates the number of li_dbas digits which
284$ are required to represent a decimal number with -dec_digits- number
285$ of digits. since a li_dbas digit requires one heap word, this is
286$ equivalent to determining the number of heap words necessary to
287$ a decimal digit of this length (adding hl_lint to the result). the
288$ macro li_decbas_digits performs the reverse operation.
289
290 +* dbas_to_dec = alog10(float(li_dbas)) **
291
292 +* dec_to_dbas = (1.0 / dbas_to_dec) **
293
294 +* li_dbas_digits(dec_digits) =
295 (ifix( float(dec_digits) * dec_to_dbas) + 2)
296 **
297
298 +* li_decbas_digits(dbas_digits) =
299 (ifix( float(dbas_digits) * dbas_to_dec) + 2)
300 **
301
302
1 .=member measpkg
2
3
4$ measurements
5$ ------------
6
7$ the statistics package gives a breakdown of how much time is spen
8$ in each statement and how it is spent. we keep timing statistics
9$ for the following categories:
10
11 .=zzyorg z $ reset counter
12
13 defc(st_nubbin) $ time spent in nubbins
14 defc(st_lib) $ total time spent in library
15 defc(st_nelt) $ time spent in okneltr
16 defc(st_hash) $ time spent in gethash
17 defc(st_conv) $ time spent in convert routines
18 defc(st_cset) $ time spent converting sets and maps
19 defc(st_copy) $ time spent in copy routine
20 defc(st_garb) $ time spent in garbage collection
21
22$ the next two classes are not actually timing figures.
23
24 defc(st_count) $ no. of times stmt is executed
25 defc(st_space) $ total space requested
26
27 +* st_min = st_nubbin **
28 +* st_max = st_space **
29
30$ timing figures are obtained using the 'icr'(i-nstruction c-ycle
31$ r-egister) option of the little compiler. the icr option works
32$ as follows:
33
34$ little keeps two global variables:
35
36$ 1. an array of 'cycle registers'.
37$ 2. a pointer to the 'current cycle register'
38
39$ the little code generator estimates the number of instruction
40$ cycles used by each instruction. every time it exits a basic
41$ block it adds the appropriate number of cycles to the current
42$ cycle register.
43
44$ setl accesses the cycle registers through the following procedures
45$ which are contained in the little run time library:
46
47$ icrsel(i): set the 'current instruction register' to 'i'.
48$ icrput(i, n): set cycle register 'i' to 'n'.
49$ icrget(i): get the value of cycle register 'i'.
50$ icrini: set all registers to 0.
51
52$ we reserve one register for each class of timing statistics.
53$ each time we enter a library routine which falls into some
54$ new category st_xxx, we set the current register to st_xxx
55$ and initialize the register to icr_zero. when we exit the routine
56$ we get the time spent in the current category and charge it
57$ to the current statement. icr_zero is equal to 0 - the cost of the
58$ calls to icrsel, icrset, and icrget.
59
60
61
62 .+st.
63
64 nameset nsmeas;
65
66 +* icr_zero = (-36) ** $ 'zero' value for cycle registers
67
68 +* stat_tot(stat, class) =
69 tcomp(value(s_stat), (stat-st_lo) * st_max + class)
70 **
71
72 +* add_stat(cl, n) = $ increment statistic
73 if st_lo <= cur_stmt & cur_stmt <= st_hi then
74 stat_tot(cur_stmt, cl) = stat_tot(cur_stmt, cl) + n;
75 end if;
76 **
77
78 +* init_time(cl) = $ save initial time
79 call icrsel(cl);
80 call icrput(cl, icr_zero);
81 **
82
83 +* save_time(cl) = $ save ellapsed time
84 add_stat(cl, icrget(cl));
85 call icrsel(st_lib);
86 **
87
88$ the variable -stmt_h- saves the value of -h- at each q2_stmt
89$ istruction. this way we can determine how much space each setl
90$ statement required.
91
92 size stmt_h(ps); $ value of -h- at last q2_stmt
93
94$ the cycle register routines have a dollar sign attached to their
95$ names to avoid name conflicts.
96
97 +* icrget = 7nicrget$ **
98 +* icrput = 7nicrput$ **
99 +* icrsel = 7nicrsel$ **
100
101$ the function -icrget(i)- returns the cycle count of the i-th
102$ cycle register.
103
104 size icrget(ws); $ little clock
105
106$ the array op_time gives the time necessary to execute each q2
107$ opcode, including only the time spent directly in the interpreter
108$ for now we give each opcode a cost of 140 units.
109
110 +* op_time(op) = 140 **
111
112 end nameset nsmeas;
113
114 ..st
1 .=member strpkg
2
3
4$ string primitives
5$ ------ ----------
6
7$ setl contains a series of snobol-like string primitives. at the
8$ source level these primitives always have the form:
9$
10$ matched_string := xxx(subject, param);
11$
12$ matched_string and subject are strings. if the match is successful
13$ subject is reset to the unmatched portion of the string.
14$
15$ the value of param depends on the function:
16$
17$ 1. for len and rlen, param is a short integer giving the length
18$ of the string to be matched.
19$
20$ 2. for the other functions param is a character string which is used
21$ for a series of membership tests.
22$
23$ note that in (2) param is used more like a set than like a string.
24$ rather than perform membership tests on strings we do one of two
25$ things:
26$
27$ 2a. if the source code is
28$
29$ mstr := xxx(subj, 'xyz');
30$
31$ i.e. param is a constant, then rather than passing the string
32$ 'xyz' we will pass the set @'x', 'y', 'z'\ in some appropriate
33$ representation.
34$
35$ 2b. otherwise if param is a variable we will build the corresponding
36$ set on entry to the string primitive.
37$
38$ the sets used to represent param are called 'psets' and recieve a
39$ special representation which allows them to be indexed by character
40$ codes.
41$
42$ at the moment there is no standard representation of sets which
43$ is good for psets. rather than add some special purpose data
44$ structure we have decided to represent psets in a fairly crude
45$ fashion. in the meantime we will explore adding new reprs to setl
46$ which will handle psets for free.
47$
48$ for the moment a pset is simply an untyped integer tuple whose
49$ i-th component is 0/1 depending on whether the character with
50$ code i is in the corresponding string.
51$
52$ the following macros are used by the string primitives:
53$
54$ the arguments for the string primitives are always passed through
55$ the stack, and are accessed by the following macros:
56
57 +* subject = stack_arg(1, 2) ** $ subject string
58 +* param = stack_arg(2, 2) ** $ param
59
60 +* init_match = $ initialization for pattern match
61
stra 40 size zzza(hs); $ local copy of param
stra 41 size zzzb(ps); $ type of param
stra 42 size zzzc(cs); $ character code
stra 43 size zzzd(ssz); $ string specifier for param
stra 44 size zzze(ps); $ word position
stra 45 size zzzf(ps); $ bit position
stra 46 size zzzg(ps); $ loop index
stra 47
stra 48 size nulltup(hs); $ builds null tuple
stra 49
stra 50 zzza = param; $ get local copy of param
stra 51 zzzb = type_ zzza; $ and its type
stra 52
stra 53 if zzzb = t_istring then $ build pset
stra 54 p = value_ nulltup(f_pset, cs_sz-1);
stra 55 nelt(p) = cs_sz-1;
stra 56
stra 57 zzzd = value_ zzza; $ get string specifier for param
stra 58 zzze = ss_ptr(zzzd) + icoffs(zzzd, 1); $ first word
stra 59 zzzf = icorg(zzzd, 1); $ first character in first word
stra 60
stra 61 do zzzg = 1 to ss_len(zzzd);
stra 62 zzzc = .f. zzzf, chsiz, heap(zzze); $ get next char
stra 63
stra 64 if zzzf = chlst then $ advance to next word
stra 65 zzze = zzze + 1; zzzf = chorg;
stra 66 else $ advance to next character in current word
stra 67 zzzf = zzzf + chinc;
stra 68 end if;
stra 69
stra 70 psetcomp(p, zzzc) = 1;
stra 71 end do;
stra 72
stra 73 elseif zzzb = t_string then $ build pset
stra 74 p = value_ nulltup(f_pset, cs_sz-1);
stra 75 nelt(p) = cs_sz-1;
stra 76
stra 77 if sc_nchars_ zzza then
stra 78 zzzc = scchar(zzza, 1);
stra 79 psetcomp(p, zzzc) = 1;
stra 80 end if;
stra 81
stra 82 else $ param is pset or short integer
stra 83 p = value_ zzza;
stra 84 end if;
83 **
84
85
86$ there are two macros for iterating over strings. string_loop
87$ iterates forward and rstring_loop iterates in reverse.
stra 85$
stra 86$ in the following string loops we have chosen a less efficient code
stra 87$ sequence for its clarity. if efficiency is crucial, these routines
stra 88$ should be coded in assembly language in the first place, at which
stra 89$ point the type test can be moved out of the iteration and the loop
stra 90$ still be defined to yield the next character in c.
88
89 +* string_loop(c, j) = $ (forall c := subject(j))
90
stra 91 size zzza(hs); $ local copy of subject
stra 92 size zzzb(ps); $ type of subject
stra 93 size zzzc(ps); $ length of subject
stra 94 size zzzd(ssz); $ string specifier for subject
stra 95 size zzze(ps); $ word position
stra 96 size zzzf(ps); $ bit position
stra 97
stra 98 zzza = subject;
stra 99 zzzb = type_ zzza;
stra 100
stra 101 if zzzb = t_string then $ type_ subject = t_string
stra 102 zzzc = sc_nchars_ zzza; $ length of subject
stra 103 else $ type_ subject = t_istring
stra 104 zzzd = value_ zzza; $ pointer to string specifier
stra 105 zzzc = ss_len(zzzd); $ length of subject
stra 106 zzze = ss_ptr(zzzd) + icoffs(zzzd, 1); $ first word
stra 107 zzzf = icorg(zzzd, 1); $ first character in first word
stra 108 end if;
stra 109
stra 110 do j = 1 to zzzc;
stra 111 if zzzb = t_string then $ type_ subject = t_string
stra 112 c = scchar(zzza, j); $ get character
stra 113 else $ type_ subject = t_istring
stra 114 c = .f. zzzf, chsiz, heap(zzze); $ get next character
stra 115
stra 116 if zzzf = chlst then $ advance to next word
stra 117 zzze = zzze + 1; zzzf = chorg;
stra 118 else $ advance to next character in current word
stra 119 zzzf = zzzf + chinc;
stra 120 end if;
stra 121 end if;
stra 122
108 **
109
110
111
112 +* rstring_loop(c, j) = $ reverse loop
113
stra 123 size zzza(hs); $ local copy of subject
stra 124 size zzzb(ps); $ type of subject
stra 125 size zzzc(ps); $ length of subject
stra 126 size zzzd(ssz); $ string specifier for subject
stra 127 size zzze(ps); $ word position
stra 128 size zzzf(ps); $ bit position
stra 129
stra 130 zzza = subject;
stra 131 zzzb = type_ zzza;
stra 132
stra 133 if zzzb = t_string then $ type_ subject = t_string
stra 134 zzzc = sc_nchars_ zzza; $ length of subject
stra 135 else $ type_ subject = t_istring
stra 136 zzzd = value_ zzza; $ pointer to string specifier
stra 137 zzzc = ss_len(zzzd); $ length of subject
stra 138 zzze = ss_ptr(zzzd) + icoffs(zzzd, zzzc); $ last word
stra 139 zzzf = icorg(zzzd, zzzc); $ last character in last word
stra 140 end if;
stra 141
stra 142 do j = zzzc to 1 by -1;
stra 143 if zzzb = t_string then $ type_ subject = t_string
stra 144 c = scchar(zzza, j); $ get character
stra 145 else $ type_ subject = t_istring
stra 146 c = .f. zzzf, chsiz, heap(zzze); $ get next character
stra 147
stra 148 if zzzf = chorg then $ back up to previous word
stra 149 zzze = zzze - 1; zzzf = chlst;
stra 150 else $ back up to previous char in current word
stra 151 zzzf = zzzf - chinc;
stra 152 end if;
stra 153 end if;
stra 154
134 **
135
136
137 +* cont_string = $ matching 'cont'
138 cont do;
139 **
140
141
142 +* quit_string = $ matching quit
143 quit do;
144 **
145
146
147 +* end_string = $ matching end
148 end do;
149 **
150
151
152 +* memb_patt(c, pset) = $ check c for pattern membership
153 (psetcomp(pset, c) = 1)
154 **
155
156
157 +* match_result(nam, len, success) = $ store result of match
158
stra 155 size zzza(hs); $ local copy of subject
stra 156 size zzzb(ssz); $ string specifier
stra 157 size zzzc(ps); $ ss_ptr
stra 158 size zzzd(ps); $ ss_ofs
stra 159 size zzze(ps); $ ss_len
stra 160 size zzzf(ps); $ length of result subject
stra 161 size zzzg(ps); $ length of result string
stra 162 size zzzh(ssz); $ string specifier being built
stra 163
stra 164 if success then
stra 165
stra 166 zzza = subject; $ get local copy of subject
stra 167
stra 168 if type_ zzza = t_string then $ short string
stra 169 $ a match of a short string must match precisely one
stra 170 $ character, so the result is a copy of the input, and
stra 171 $ input is result to null string.
stra 172 nam = zzza; value_ zzza = 0;
stra 173
stra 174 else $ type_ subject = t_istring
stra 175 zzzg = len;
stra 176 zzzb = value_ zzza;
stra 177 zzzc = ss_ptr(zzzb); zzzd = ss_ofs(zzzb);
stra 178 zzze = ss_len(zzzb); zzzf = zzze - (zzzg);
stra 179
stra 180 if zzzg <= sc_max then $ result is short string
stra 181 if zzzg = 0 then $ result is null string
stra 182 build_spec(nam, t_string, 0);
stra 183 else
stra 184 nam = spec_char; $ one-character template
stra 185 scchar(nam, 1) = icchar(zzzb, 1);
stra 186 end if;
stra 187 else $ result subject string is long string
stra 188 build_ss(zzzh, zzzc, zzzd, zzzg);
stra 189 build_spec(nam, t_istring, zzzh);
stra 190 end if;
stra 191
stra 192 if zzzf <= sc_max then $ final subject is short
stra 193 if zzzf = 0 then $ final subject is null string
stra 194 build_spec(zzza, t_string, 0);
stra 195 else
stra 196 zzza = spec_char; $ one-character template
stra 197 scchar(zzza, 1) = icchar(zzzb, zzze);
stra 198 end if;
stra 199 else $ final subject is long string
stra 200 build_ss(zzzh, zzzc, zzzd+zzzg, zzzf);
stra 201 build_spec(zzza, t_istring, zzzh);
stra 202 end if;
stra 203 end if;
stra 204
stra 205 subject = zzza; $ restore modified subject
stra 206
stra 207 else
stra 208 nam = heap(ft_samp(f_string));
stra 209 end if;
stra 210
180 **
181
182
183 +* rmatch_result(nam, len, success) = $ result of reverse matc
184
stra 211 size zzza(hs); $ local copy of subject
stra 212 size zzzb(ssz); $ string specifier
stra 213 size zzzc(ps); $ ss_ptr
stra 214 size zzzd(ps); $ ss_ofs
stra 215 size zzze(ps); $ ss_len
stra 216 size zzzf(ps); $ start of result string
stra 217 size zzzg(ps); $ length of result string
stra 218 size zzzh(ssz); $ string specifier being built
stra 219
stra 220 if success then
stra 221
stra 222 zzza = subject; $ get local copy of subject
stra 223
stra 224 if type_ zzza = t_string then $ short string
stra 225 $ a match of a short string must match precisely one
stra 226 $ character, so the result is a copy of the input, and
stra 227 $ input is result to null string.
stra 228 nam = zzza; value_ zzza = 0;
stra 229
stra 230 else $ type_ subject = t_istring
stra 231 zzzg = len;
stra 232 zzzb = value_ zzza;
stra 233 zzzc = ss_ptr(zzzb); zzzd = ss_ofs(zzzb);
stra 234 zzze = ss_len(zzzb); zzzf = zzze - (zzzg);
stra 235
stra 236 if zzzg <= sc_max then $ result is short string
stra 237 if zzzg = 0 then $ result is null string
stra 238 build_spec(nam, t_string, 0);
stra 239 else
stra 240 nam = spec_char; $ one-character template
stra 241 scchar(nam, 1) = icchar(zzzb, zzze);
stra 242 end if;
stra 243 else $ result is long string
stra 244 build_ss(zzzh, zzzc, zzzd+zzzf, zzzg);
stra 245 build_spec(nam, t_istring, zzzh);
stra 246 end if;
stra 247
stra 248 if zzzf <= sc_max then $ final subject is short
stra 249 if zzzf = 0 then $ final subject is null string
stra 250 build_spec(zzza, t_string, 0);
stra 251 else
stra 252 zzza = spec_char; $ one-character template
stra 253 scchar(zzza, 1) = icchar(zzzb, 1);
stra 254 end if;
stra 255 else
stra 256 build_ss(zzzh, zzzc, zzzd, zzzf);
stra 257 build_spec(zzza, t_istring, zzzh);
stra 258 end if;
stra 259 end if;
stra 260
stra 261 subject = zzza; $ restore modified subject
stra 262
stra 263 else
stra 264 nam = heap(ft_samp(f_string));
stra 265 end if;
stra 266
206 **
207
208
1 .=member mhfpkg
2
3
4$ mapped heap file feature
5$ ------ ---- ---- -------
6
7
8 .+hf.
9$
10$ the heap file (hf) feature permits initializing the heap by using
11$ a 'mapped' file. the q2init option determines how heap initialized:
12$ 0 read in heap data from q2 file (default)
13$ 1 map heap data from file specified by q2h option; read other
14$ data from q2e file.
15$ 2 read in q2 file, create mapped heap file and write modified q2
16$ file to files specified by q2h and q2e options, respectively.
17$ execution terminates after these files established.
18$
19$ the basic idea is to split the standard q2 file into two files:
20$ the 'q2h' file contains the heap data in a form which permits direct
21$ mapping to virtual memory using the vms system service 'crmpsc'. the
22$ 'q2e' file consists of the other data in the q2 file. in creation
23$ mode two passes are made over the q2 file.
24$ the first is used to find the heap indices referenced, from which the
25$ page numbers are deduced. the appropriate pages of the heap are then
26$ mapped to the q2h file.
27$ on the second pass, the variables not contained in the heap are
28$ copied to the q2e file, as are the two tables hftab_first and
29$ hf_last which give page numbers of the heap slices. the heap data
30$ is now read in; since the heap has been mapped, references to the
31$ heap result in the values being written to the q2h file.
32$
33$ to initialize using the mapped heap file, the q2e file is used
34$ instead of the standard q2 file and the q2h file is specified.
35$ option q2init=1 is specified to indicated mapped initialization.
36$ the map tables hftab_first and hftab_last are used to indicate how
37$ to map the heap file.
38$
39$ new program parameters:
40$ -----------------------
41$
42$ q2init=0/0 initialization type. 0 is normal, 2 builds
43$ q2h and q2e files, 1 reads in q2e and q2h.
44$ q2e=q2e/ q2e file name
45$ q2h=q2h/ q2h file name
46$ hftrace=0/1 nonzero to trace hf procedures
47$
48$ implementation notes:
49$ ---------------------
50$
51$ this variant for vax/vms, but it may serve as starting point for
52$ putting in this feature for other operating systems with a facility
53$ similar to crmpsc.
54$
55$ this work has involved an extension to the vax little compiler to add
56$ program parameter 'nspages=0/1': nspages=1 causes all global
57$ namesets to be aligned on page boundaries and to occupy an integral
58$ number of pages.
59$
60$ the section to be mapped must be page-aligned, and consist of an
61$ integral number of pages, so that offset computations are done
62$ correctly. there are two ways to force the proper alignment: either
63$ specify nspages=1 to the little compiler's asm phase, or use the
64$ dynamic heap allocation scheme available on the vax. it should
65$ be noted that the current heap allocation scheme allocates pages
66$ using the vms expreg system service, thus satisfying the requirement
67$ trivially.
68$
69$ additional procedures required are hfcrst and hfmapr written in
70$ little and placed following wrheap2. procedures hfopen and hfcrms
71$ written in macro-32 are also required.
72$
73$ program parameter hftrace can be used to get trace output.
74
75 $ global variables for hf option.
76 nameset nshf;
77 size q2e_title(.sds. filenamlen); $ q2 e file
78 size q2h_title(.sds. filenamlen); $ q2 h file
79
80 +* hftablen = hf_slices **
81
82 size hftab_first(ws); dims hftab_first(hftablen);
83 size hftab_last(ws); dims hftab_last(hftablen);
84
85 size hftabp(ws); $ index of last entry in hftap
86 data hftabp = 0;
87
88 size hf_trace(ps); $ nonzero to trace hf.
89 size q2_init_type(ps);
90
91 size 7nmptr$li(ps); $ little function, returns address
92 +* mptr(i) = 7nmptr$li(i) **
93
94 size hf_heap_nsadr(ps); $ starting address of heap nameset
95 size hf_heap_adr(ps); $ byte address of heap(1)
96 size hf_org(ws); $ byte offset of heap(1)
97
98$ constants 4 and 512 in pageof are bytes per word and bytes per page,
99$ respectively. they should be parameterized if this hf extended to
100$ other systems.
101$
102$ the hf feature is qualified by conditional symbol 'hf'.
103$ it has not been checked that compilation with this symbol not set
104$ works, though this should be straightforward task.
105
106 +* pageof(i) = (((i)*4 + hf_org) / 512 + 1) **
107 end nameset nshf;
108 ..hf
109
110