Personal tools
You are here: Home Projects SETL SETL Source code COM: Data structures.
Document Actions

COM: Data structures.

by Paul McJones last modified 2021-03-18 20:22

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

« May 2022 »
Su Mo Tu We Th Fr Sa
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: