25 GC-PARAMS GC-FCN MOVE-FCN GROW-FCN ZONE-ID ALL-SPACES GC-CTL
26 GCC-MIN-SPACE GCC-MS-FREQ GCC-MS-CT
28 GCSFLG ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY CURRENT-ZONE
31 M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
34 M$$GVAL M$$LVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML
35 M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL
36 M$$H-CLASS M$$H-FUNCTION M$$H-PRIORITY M$$H-ARG M$$H-NEXT
37 M$$C-NAME M$$C-ENABLE M$$C-HANDLER M$$C-CHANNEL M$$C-PRIORITY
38 M$$INFINT M$$CONTINT M$$PIPEINT M$$IOINT M$$URGINT
40 M$$INT-LEVEL M$$INT-CLASSES
41 M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT
44 CHANNEL-TYPE CHANNEL-SCRIPT CHANNEL-NAME CHANNEL-OPEN?
45 CHANNEL-DATA CHANNEL-USER
46 MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-ORAD MC-BITS MC-IRAD
47 BIT-ACCESS BIT-INTELLIGENT
50 ; "Read character types"
53 <SETG M$$R-MIN-BRACK 2>
58 <SETG M$$R-SQUIGGLE 6>
60 <SETG M$$R-MAX-BRACK 7>
65 <SETG M$$R-PERCENT 12>
67 <SETG M$$R-MAX-ATM-BRK 13>
71 <SETG M$$R-MIN-NUM-PART 17>
77 <MANIFEST M$$R-BREAK M$$R-ESCAPE M$$R-MIN-BRACK M$$R-PAREN M$$R-ANGLE M$$R-SQUARE
78 M$$R-DOUBLE M$$R-SQUIGGLE M$$R-ENDBR M$$R-MAX-BRACK M$$R-EXCL
79 M$$R-SEMI M$$R-SHARP M$$R-COMMA M$$R-PERCENT M$$R-QUOTE
80 M$$R-MAX-ATM-BRK M$$R-VERT M$$R-BACKS M$$R-DOT M$$R-ALPHA
81 M$$R-E M$$R-MIN-NUM-PART
82 M$$R-DIGIT M$$R-PLUS M$$R-STAR>
84 <GDECL (I$TRANS-TABLE) BYTES>
86 ; "PRINT's magic finite-state machine for atoms"
88 <SETG M$$FS-NSTATE 9> ; "# states, not counting terminals"
89 <SETG M$$FS-NOSLASH <+ ,M$$FS-NSTATE 1>> ; "No initial \ needed"
90 <SETG M$$FS-SLASH1 <+ ,M$$FS-NSTATE 2>> ; "Initial \ needed"
91 <SETG M$$FS-SLASH2 <+ ,M$$FS-NSTATE 3>> ; "Initial \ needed, done otherwise"
92 <SETG M$$END-STATE 6> ; "Slot in state for end of string"
93 <MANIFEST M$$FS-NSTATE M$$FS-NOSLASH M$$FS-SLASH1 M$$FS-SLASH2 M$$END-STATE>
97 <COND (<NOT <GASSIGNED? NEW-CHANNEL-TYPE>>
98 <DEFINE NEW-CHANNEL-TYPE ("TUPLE" FOO) T>)>
99 <SETG T$NEW-CHANNEL-TYPE ,NEW-CHANNEL-TYPE>
103 <PUTPROP ATOM ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
106 <OR OBLIST !<FALSE!>>
107 <OR TYPE-C !<FALSE!>>>>
109 <DEFINE MY-LINK (OBJ STR OBL)
110 <COND (<LOOKUP .STR .OBL><REMOVE .STR .OBL>)>
111 <LINK .OBJ .STR .OBL>>
113 <MY-LINK ATOM "T$ATOM" <ROOT>>
115 <PUTPROP T$TYPE-C ALT-DECL TYPE-C>
117 <MY-LINK OBLIST "T$OBLIST" <ROOT>>
119 <PUTPROP LVAL ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
122 <OR OBLIST !<FALSE!>>
123 <OR TYPE-C !<FALSE!>>>>
124 <MY-LINK LVAL "T$LVAL" <ROOT>>
125 <PUTPROP GVAL ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
128 <OR OBLIST !<FALSE!>>
129 <OR TYPE-C !<FALSE!>>>>
130 <MY-LINK GVAL "T$GVAL" <ROOT>>
131 <PUTPROP OBLIST ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
134 <OR OBLIST !<FALSE!>>
135 <OR TYPE-C !<FALSE!>>>>
138 <PUTPROP LINK ALT-DECL '<<PRIMTYPE ATOM> GBIND
141 <OR OBLIST !<FALSE!>>
142 <OR TYPE-C !<FALSE!>>>>
144 <MY-LINK LINK "T$LINK" <ROOT>>
145 <PUTPROP FRAME ALT-DECL '<<PRIMTYPE FRAME> MSUBR>>
146 <MY-LINK FRAME "T$FRAME" <ROOT>>
147 <NEWTYPE I$TERMIN FIX>
148 <NEWTYPE T$DEFER LIST>
149 <NEWTYPE T$TYPE-C FIX>
150 <NEWTYPE T$TYPE-W FIX>
151 <MY-LINK LBIND "T$LBIND" <ROOT>>
154 <MY-LINK GBIND "T$GBIND" <ROOT>>
155 <PUTPROP GBIND ALT-DECL '<<PRIMTYPE GBIND> ANY
157 <OR ATOM FORM !<FALSE!>>>>
159 <PUTPROP LBIND ALT-DECL '<<PRIMTYPE LBIND> ANY
161 <OR ATOM FORM !<FALSE!>>
162 [2 <OR LBIND !<FALSE!>>]
166 <NEWTYPE T$SPLICE LIST>
167 <NEWTYPE T$FUNCTION LIST>
168 <NEWTYPE T$ADECL VECTOR>
169 <NEWTYPE ADECL VECTOR>
170 <NEWTYPE T$MCODE UVECTOR>
171 <NEWTYPE MCODE UVECTOR '<<PRIMTYPE UVECTOR> [REST FIX]>>
174 '<<PRIMTYPE VECTOR> MCODE T$ATOM LIST [REST ANY]>>
175 <NEWTYPE MSUBR VECTOR>
176 <NEWTYPE T$IMSUBR VECTOR>
177 <NEWTYPE IMSUBR VECTOR>
178 <NEWTYPE T$MACRO LIST>
180 <SETG POBL (<MOBLIST INITIAL> <ROOT>)>
183 <COND (<OR <LENGTH? .STR 2>
184 <AND <==? <1 .STR> !\T>
186 <PARSE .STR 10 ,POBL>)
187 (T <PARSE <STRING "T$" .STR> 10 ,POBL>)>>
191 <DEFINE P-E (STR) <PARSE <STRING !\@ .STR> 10 ,POBL>>
193 <NEWTYPE T$UNBOUND FIX>
196 ; "Stuff for compiling BOOT i/o"
197 <SETG M$$CHAN 1> ;"channel identifier"
198 <SETG M$$MODE 2> ;"mode: PRINT, READ, etc."
199 <SETG M$$DEV 3> ;"device name"
200 <SETG M$$FNAM 4> ;"file name"
201 <SETG M$$HLEN 5> ;"horizontal line length"
202 <SETG M$$HPOS 6> ;"horizontal position"
203 <SETG M$$VLEN 7> ;"vertical length"
204 <SETG M$$VPOS 8> ;"vertical position"
205 <SETG M$$RADX 9> ;"radix"
206 <SETG M$$BUFF 10> ;"channel buffer"
207 <SETG M$$BUFL 11> ;"buffer valid length"
208 <SETG M$$BPOS 12> ;"buffer position"
209 <SETG M$$INTR 13> ;"internal: 0=normal, 1=PRINC, 2=UNPARSE"
210 <SETG M$$NXTC 14> ;"read ahead character (or FALSE CHARACTER)"
211 <SETG M$$FFRM 15> ;"Frame to go to in flatsize"
213 <MANIFEST M$$CHAN M$$MODE M$$DEV M$$FNAM M$$HLEN M$$HPOS M$$VLEN M$$VPOS
214 M$$RADX M$$BUFF M$$BUFL M$$BPOS M$$INTR M$$NXTC M$$FFRM>
218 '<<PRIMTYPE VECTOR> FIX [3 STRING] [5 FIX] STRING [3 FIX]>>
221 <NEWTYPE I$SDTABLE VECTOR
222 '!<<PRIMTYPE VECTOR> ATOM <OR FALSE ATOM <LIST [REST ATOM]>>
223 <LIST [REST ATOM <OR ATOM MSUBR FALSE>]>>>
225 <SETG I$SD-INHERIT 2>
227 <MANIFEST I$SDNAME I$SD-INHERIT I$SD-OPER>
229 <NEWTYPE I$DISK-CHANNEL VECTOR>
231 <GDECL (I$CHANNEL-TYPES) <LIST [REST ATOM I$SDTABLE]>>
232 <GDECL (T$DEVVEC) <VECTOR [REST FIX <OR ATOM VECTOR>]>>
238 <PUT-DECL CHANNEL '!<<PRIMTYPE VECTOR> ATOM
244 <MY-LINK CHANNEL "T$CHANNEL" <ROOT>>
247 <SETG T$CHANNEL-TYPE 1> ;"Type of CHANNEL"
248 <SETG T$CHANNEL-SCRIPT 2> ;"Scripting CHANNEL"
249 <SETG T$CHANNEL-NAME 3> ;"Passed to CHANNEL-OPEN"
250 <SETG T$CHANNEL-OPEN? 4> ;"Is CHANNEL still open?"
251 <SETG T$CHANNEL-DATA 5> ;"Device-dependent stuff"
252 <SETG T$CHANNEL-USER 6> ;"Application-dependent stuff"
254 <MANIFEST T$CHANNEL-TYPE T$CHANNEL-SCRIPT T$CHANNEL-NAME T$CHANNEL-OPEN?
255 T$CHANNEL-DATA T$CHANNEL-USER>
257 <NEWTYPE T$MUD-CHAN VECTOR '!<<PRIMTYPE VECTOR>
263 <PUT-DECL MUD-CHAN '!<<PRIMTYPE VECTOR>
281 <SETG T$BIT-ACCESS 1>
282 <SETG T$BIT-INTELLIGENT 2>
283 <MANIFEST T$MC-HLEN T$MC-HPOS T$MC-VLEN T$MC-VPOS T$MC-ORAD
284 T$MC-INTR T$MC-NCHR T$MC-FFRM T$MC-BITS T$MC-IRAD T$BIT-ACCESS
287 <SETG CHANNEL-TYPE 1>
288 <SETG CHANNEL-SCRIPT 2>
289 <SETG CHANNEL-NAME 3>
290 <SETG CHANNEL-OPEN? 4>
291 <SETG CHANNEL-DATA 5>
292 <SETG CHANNEL-USER 6>
293 <MANIFEST CHANNEL-TYPE CHANNEL-SCRIPT CHANNEL-NAME CHANNEL-OPEN?
294 CHANNEL-DATA CHANNEL-USER>
304 <SETG BIT-INTELLIGENT 2>
305 <MANIFEST MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-RADX BIT-ACCESS BIT-INTELLIGENT>
307 ;"Internal modes of a channel."
308 <SETG M$$PR-PRC 1> ; "Bit--on if PRINC"
309 <SETG M$$PR-UNP 2> ; "UNPARSE"
310 <SETG M$$PR-FLT 4> ; "FLATSIZE"
311 <MANIFEST M$$PR-PRC M$$PR-UNP M$$PR-FLT>
313 ;"Some globals used in PRINT."
314 <SETG M$$PR-MAX 10000000> ;"Maximum size of UNPARSE buffer."
315 <SETG M$$PR-TAB 8> ;"Maximum number of <SPACE>s in a <TAB>."
316 <SETG M$$PR-SIGD 10> ;"Number of significant digits in a FLOAT."
317 <SETG M$$PR-FRAD 2> ;"Number of decimal places in a FLOAT."
318 <SETG M$$PR-BUFL 64> ;"Size of temporary buffer."
320 <MANIFEST M$$PR-MAX M$$PR-TAB M$$PR-SIGD M$$PR-FRAD M$$PR-BUFL>
322 <GDECL (M$$PR-BUFS M$$PR-BREAKS M$$PR-BRACKS M$$PR-NUMBER) STRING
323 (M$$FLATCHAN M$$INTCHAN M$$OUTCHAN M$$INCHAN) T$CHANNEL
324 (M$$CHANLIST) <LIST [REST T$CHANNEL]>>
326 <GDECL (I$R?) ANY (BI$RADIX QWSIZ) FIX>
327 <GDECL (I$CHRSTR BREAKS BRACKS) STRING>
328 <GDECL (I$POWERS I$FLOAT-TABLE) <VECTOR [REST FLOAT]>>
329 <GDECL (BI$NCHR) <OR CHARACTER FALSE> (BI$STR) STRING>
331 ;"Offsets for FRAME."
333 ;"More cretinous offsets"
337 ;"The FRAME's MSUBR."
345 ;"Number of arguments"
353 ;"The previous FRAME"
361 ;"We will hide <ARGS .FRAME> here in simulation"
365 ;"The FRAME's BINDing."
369 ;"The FRAME's ACTIVATION."
371 <MANIFEST M$$FRM-MSUB
383 ;"ATOM - offset to LVAL binding"
387 ;"ATOM - offset to GVAL binding"
391 ;"ATOM - offset to PNAME string"
395 ;"ATOM - offset to OBLIST (primtype ATOM)"
399 ;"ATOM - valid type TYPE-C or FALSE"
403 ;"ATOM - length of block for atom"
405 <MANIFEST M$$LVAL M$$GVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML>
407 ;"Offsets for LBIND."
411 ;"BIND - value of this binding"
415 ;"BIND - ATOM that this binding represent"
419 ;"BIND - this binding's DECL or FALSE if none"
423 ;"BIND - closest previous binding block for any atom"
427 ;"BIND - closest previous binding block for this atom"
431 ;"BIND - unique bind id for this binding block"
435 ;"BIND - length of block for bind"
437 <MANIFEST M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL>
439 <SETG M$$T-FIX 0> ;"SAT code for FIX."
440 <SETG M$$T-LST 1> ;"SAT code for LIST."
441 <SETG M$$T-REC 2> ;"SAT code for RECORD."
442 <SETG M$$T-TEM 3> ;"SAT code for TEMPLATE."
443 <SETG M$$T-BYT 4> ;"SAT code for BYTES."
444 <SETG M$$T-STR 5> ;"SAT code for STRING."
445 <SETG M$$T-UVC 6> ;"SAT code for UVECTOR."
446 <SETG M$$T-VEC 7> ;"SAT code for VECTOR."
447 <SETG M$$T-UBK [,M$$T-BYT ,M$$T-STR ,M$$T-UVC ,M$$T-VEC]>
448 ;"SAT codes for UBLOCK types."
450 <MANIFEST M$$T-FIX M$$T-LST M$$T-REC M$$T-TEM M$$T-BYT M$$T-STR
451 M$$T-UVC M$$T-VEC M$$T-UBK>
453 <NEWTYPE T$TYPE-ENTRY
455 '<<PRIMTYPE VECTOR> T$ATOM
457 <OR APPLICABLE T$ATOM FALSE>
458 <OR APPLICABLE T$ATOM FALSE>
459 <OR APPLICABLE T$ATOM FALSE>
461 <OR FALSE T$ATOM FORM SEGMENT>>>
464 '<<PRIMTYPE VECTOR> ATOM
466 <OR APPLICABLE ATOM FALSE>
467 <OR APPLICABLE ATOM FALSE>
468 <OR APPLICABLE ATOM FALSE>
470 <OR FALSE ATOM FORM SEGMENT>>>
472 <SETG M$$NTYPE 1> ;"TYPE name."
473 <SETG M$$PTYPE 2> ;"PRIMTYPE name."
474 <SETG M$$APPLY 3> ;"Applicable for APPLYTYPE."
475 <SETG M$$NEVAL 4> ;"Applicable for EVALTYPE."
476 <SETG M$$PRINT 5> ;"Applicable for PRINTTYPE."
477 <SETG M$$TYWRD 6> ;"TYPE-WORD for this type."
478 <SETG M$$TDECL 7> ;"DECL for this type."
480 ;"Bit offset for TYPE-WORD slot."
482 <SETG M$$TYSAT 7> ;"The first three bits are used for SAT."
483 <SETG M$$TYOFF 6> ;"Amount to LSH to get offset."
485 <MANIFEST M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
488 ;"Definition for ADECL."
492 '!<<PRIMTYPE VECTOR> [2 ANY]>>
494 <SETG M$$ADCL-VAL 1> ;"The VALUE of the ADECL."
495 <SETG M$$ADCL-DCL 2> ;"The DECL of the ADECL."
497 ;"Definition for OFFSET."
501 '!<<PRIMTYPE VECTOR> FIX <OR T$ATOM FORM SEGMENT>
502 <OR T$ATOM FORM SEGMENT FALSE>>>
508 <MANIFEST M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT>
510 <GDECL (M$$TOPLEV-FRAME) T$FRAME (M$$INT-LEVEL) FIX
511 (M$$DECL-CHECK) <OR ATOM FALSE>
512 (I$INTCHAN) T$CHANNEL
513 (M$$PI/2 M$$LIMIT T$MINFL T$MAXFL I$PMINFL) FLOAT
514 (M$$OBLIST) <VECTOR [REST <LIST [REST <OR T$ATOM T$LINK>]>]>
515 (M$$OBLNAM) <LIST [REST T$OBLIST]> (M$$OBLSIZ) FIX
516 (M$$OBLSTK) <LIST [REST <LIST <OR T$OBLIST
517 <LIST [REST <OR T$OBLIST
519 (M$$TBIND) <OR T$LBIND FALSE> (M$$BINDID) FIX
520 (M$$OBLIST-ROOT M$$ONLIST-ERRORS M$$OBLIST-INTERRUPTS) T$OBLIST
521 (I$BREAKS I$BRACKS) STRING (I$POWERS) <VECTOR [REST FLOAT]>
522 (I$RDCHRSTR) <STRING CHARACTER>
523 (M$$TYPE-UNSTRUC) <VECTOR [REST ATOM]>
524 ;(M$$CHANLIST) ;<LIST [REST T$CHANNEL]>
525 (M$$GBIND) <LIST [REST T$GBIND]> (M$$UNBOUND) T$UNBOUND
526 (M$$TYP-COUNT) FIX (M$$TYP-NEW) STRING
527 (M$$TYP-GROUP) <VECTOR [REST ATOM]>
528 (M$$TYPE-INFO) <VECTOR [REST <OR T$TYPE-ENTRY FALSE>]>
529 (M$$PRINT-TYPES M$$NEVAL-TYPES M$$APPLY-TYPES M$$LOCATIVE
530 M$$STRUCTURED) <VECTOR [REST ATOM]>
532 <VECTOR [REST <VECTOR [2 STRING]
536 (M$$NEWTYPE?) <OR ATOM FALSE>
537 (M$$ALLTYPES) <VECTOR [REST T$ATOM]>
538 (M$$PRINT-TYPES M$$NEVAL-TYPES M$$APPLY-TYPES M$$LOCATIVE M$$STRUCTURED)
540 (M$$FREE-FRAMES M$$FRAMES) <LIST [REST T$FRAME]>
542 (M$$LBIND) <OR FALSE T$LBIND>
543 (M$$STRUCTURED) <VECTOR [REST ATOM]>
544 (M$$RHI M$$RLOW I$MINFX I$MAXFX) FIX>
546 ;"Manifest GVALs for APPLY"
548 <SETG M$$F-PROG 1> ;"For the SUBR PROG."
549 <SETG M$$F-BIND 2> ;"For the SUBR BIND."
550 <SETG M$$F-REPEAT 3> ;"For the SUBR REPEAT."
551 <SETG M$$F-APPLY 4> ;"For the SUBR APPLY."
552 <SETG M$$F-EVAL 5> ;"For functional calls."
554 <MANIFEST M$$F-PROG M$$F-BIND M$$F-REPEAT M$$F-APPLY M$$F-EVAL>
557 <SETG M$$TYPE-INFO-SIZE 1024>
559 <MANIFEST M$$TYPE-INFO-SIZE>
561 ;"Offsets for MSUBR."
563 <SETG M$$MSB-CODE 1> ;"Code for the T$MSUBR."
564 <SETG M$$MSB-NAME 2> ;"Name of the T$MSUBR."
565 <SETG M$$MSB-DECL 3> ;"Decl of the T$MSUBR."
567 <MANIFEST M$$MSB-CODE M$$MSB-NAME M$$MSB-DECL>
569 <GDECL (M$$INT-LEVEL) FIX
570 (M$$INT-CLASSES) <OR CLASS FALSE>>
574 '<<PRIMTYPE VECTOR> STRING
582 <SETG M$$C-HANDLER 3>
583 <SETG M$$C-CHANNEL 4>
584 <SETG M$$C-PRIORITY 5>
585 <MANIFEST M$$C-NAME M$$C-ENABLE M$$C-HANDLER M$$C-CHANNEL M$$C-PRIORITY>
592 <MANIFEST M$$INFINT M$$CONTINT M$$PIPEINT M$$URGINT M$$IOINT>
596 '<<PRIMTYPE VECTOR> CLASS
597 <OR APPLICABLE T$FUNCTION>
600 <OR FALSE T$HANDLER>>>
603 <SETG M$$H-FUNCTION 2>
604 <SETG M$$H-PRIORITY 3>
608 <MANIFEST M$$H-CLASS M$$H-FUNCTION M$$H-PRIORITY M$$H-ARG M$$H-NEXT>
610 <GDECL (M$$INT-QUEUE) <LIST ATOM [REST FIX LIST LIST]>
611 (M$$INT-CLASSES) <VECTOR [REST <OR FALSE CLASS>]>
613 (M$$EVALCLASS M$$CREATECLASS) CLASS>
615 ;"Some offsets for ASSOCIATIONs."
619 <MANIFEST M$$AS-ITEM M$$AS-INDIC M$$AS-VALUE>
621 ;"***************************************************************
622 * Some OFFSETs used in TEMPLATE *
623 ***************************************************************"
625 ;"NOTE: The following notation is used -
626 TDT - Template Data Table
627 TAT - Template Access Table
628 DT - Discriminant Table
631 PT - Position Table."
633 ;"ATOMs in <ROOT> that are used by TEMPLATE:
634 ANY, BOOLEAN, ENUM, FIX, SBOOL, STRUC."
636 ;"Newtype for the Template Access Table (TAT)."
637 <PUT-DECL PT-DECL '<VECTOR TYPE-C [3 FIX]>>
640 '<VECTOR ATOM <OR ATOM FORM> [2 FIX] [OPTIONAL <OR FIX VECTOR>]>>
642 <PUT-DECL TT-DECL '<VECTOR ET-DECL [OPTIONAL PT-DECL PT-DECL]>>
644 <PUT-DECL DT-DECL '<VECTOR [2 FIX] [REST ET-DECL]>>
648 '<<PRIMTYPE VECTOR> ATOM FORM [3 FIX] VECTOR [REST DT-DECL]>>
650 ;"Table to store the TAT and TDT for all Templates."
651 <SETG M$$R-TAT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
652 <SETG M$$R-TDT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
654 <GDECL (M$$R-TAT) <VECTOR [REST <OR FALSE TAT>]>
655 (M$$R-TDT) <VECTOR [REST <OR FALSE UVECTOR>]>>
657 ;"Flags to indicate the type of template element."
658 <SETG M$$R-BOOLN 1> ;"Boolean - off:BOOLEAN"
659 <SETG M$$R-ENUMO 2> ;"Enumeration - off:(ENUM [obj])"
660 <SETG M$$R-ENUME 3> ;"Enumeration - off:(ENUM vec)"
661 <SETG M$$R-SUBRA 4> ;"Sub-range - off:(FIX prim-fix low-lim high-lim)"
662 <SETG M$$R-SUBSB 5> ;"Sub-range (S) - off:(SBOOL prim-fix low-lim high-lim)"
663 <SETG M$$R-UNSTR 6> ;"Unstruc - off:type"
664 <SETG M$$R-UNSSB 7> ;"Unstruc (S) - off:(SBOOL type)"
665 <SETG M$$R-STRUC 8> ;"Struc - off:struc"
666 <SETG M$$R-STRSB 9> ;"Struc (S) - off:(SBOOL struc)"
667 <SETG M$$R-STRLN 10> ;"Struc+lnt - off:(STRUC struc #-of-ele)"
668 <SETG M$$R-SLNSB 11> ;"Struc+lnt (S) - off:(SBOOL struc #-of-ele)"
669 <SETG M$$R-ANYOB 12> ;"Any - off:ANY"
671 <MANIFEST M$$R-BOOLN M$$R-ENUMO M$$R-ENUME M$$R-SUBRA M$$R-SUBSB M$$R-UNSTR
672 M$$R-UNSSB M$$R-STRUC M$$R-STRSB M$$R-STRLN M$$R-SLNSB M$$R-ANYOB>
674 ;"Offsets in the Template Access Table (TAT)."
675 <SETG M$$R-TNAM 1> ;"ATOM - Name of this template."
676 <SETG M$$R-TDCL 2> ;"FORM - Decl for this template."
677 <SETG M$$R-TTYP 3> ;"FIX - Offset of this template in the type table."
678 <SETG M$$R-TLNT 4> ;"FIX - Length info is stored here."
679 <SETG M$$R-TLOC 5> ;"FIX - Location of the discriminant type in record."
680 <SETG M$$R-TDIS 6> ;"VECTOR - Vector of discriminants."
681 <SETG M$$R-TSDT 6> ;"VECTOR - 1 word before start of discriminant field data."
682 <SETG M$$R-TDTA 7> ;"VECTOR - Beginning of each discriminant field data."
684 <MANIFEST M$$R-TNAM M$$R-TDCL M$$R-TTYP M$$R-TLNT M$$R-TLOC M$$R-TDIS
687 ;"Offsets in the Discriminant Table (DT)."
688 <SETG M$$R-DLNT 1> ;"FIX - Length of this discriminant type."
689 <SETG M$$R-DWRD 2> ;"FIX - Number of words required by this discriminant."
690 <SETG M$$R-DATA 2> ;"VECTOR - (start of discriminant element data) - 1."
692 <MANIFEST M$$R-DLNT M$$R-DWRD M$$R-DATA>
694 ;"Offsets in the Element Table (ET)."
695 <SETG M$$R-EOFF 1> ;"ATOM - Name of the offset for this element."
696 <SETG M$$R-EDCL 2> ;"<OR ATOM FORM> - Decl for this element."
697 <SETG M$$R-EFLG 3> ;"FIX - Flag to indicate what this element is."
698 <SETG M$$R-EELE 4> ;"FIX - Record offset for this element."
699 <SETG M$$R-ESBL 5> ;"FIX - Record offset for the SBOOL flag."
700 <SETG M$$R-ESLN 5> ;"FIX - Record offset for fix STRUCTURED length."
701 <SETG M$$R-EVEC 5> ;"VECTOR - Enumeration or Subrange information."
703 <MANIFEST M$$R-EOFF M$$R-EDCL M$$R-EFLG M$$R-EELE M$$R-ESBL M$$R-ESLN
706 ;"Offsets in the Position Table (PT)."
707 <SETG M$$R-PTYP 1> ;"TYPE-C - Type code for this element."
708 <SETG M$$R-PBIT 2> ;"FIX - Length of structured or position of bit."
709 <SETG M$$R-PLOC 3> ;"FIX - First half-word location of storage in template."
710 <SETG M$$R-PLNT 4> ;"FIX - Length (in half-words) of storage in template."
712 <MANIFEST M$$R-PTYP M$$R-PBIT M$$R-PLOC M$$R-PLNT>
714 ;"Number of half-words needed to store various MUDDLE objects."
715 <SETG M$$R-FCNT 1> ;"Half-words to store structured object length."
716 <SETG M$$R-FPTR 2> ;"Half-words to store object pointer or unstructured."
717 <SETG M$$R-STLN 3> ;"Half-words to store object pointer and length."
718 <SETG M$$R-FULL 4> ;"Half-words to store an ANY."
720 <MANIFEST M$$R-FCNT M$$R-FPTR M$$R-STLN M$$R-FULL>
722 ;"Number of bits in a byte, half-word and word. -- Replaced to be computed
724 ;<SETG M$$R-BQWD 9> ;"Number of bits in 1/4 of a word."
725 ;<SETG M$$R-BHWD 18> ;"Number of bits in a half-word."
726 ;<SETG M$$R-BWRD 36> ;"Number of bits in a word."
727 <GDECL (M$$R-BQWD M$$R-BHWD M$$R-BWRD M$$R-BQWD!-INTERNAL M$$R-BHWD!-INTERNAL
728 M$$R-BWRD!-INTERNAL) FIX>
729 ;<MANIFEST M$$R-BQWD M$$R-BHWD M$$R-BWRD>
730 <SETG M$$CHR-CHR 1> ;"Character to xlate to"
731 <SETG M$$CHR-ASC 2> ;"Code of character to act like"
732 <SETG M$$CHR-BRK 3> ;"True ==> break on this, else don't"
733 <SETG M$$CHR-APL 4> ;"Apply this to read object"
734 <SETG M$$CHR-PRE 5> ;"Pass previously read object"
736 ;<SETG M$$EXCALT *1033*> ;"!$"
737 <SETG M$$EXCALT *10000*> ; "! followed by some escape-like character"
738 <SETG M$$CNCLSQBK *2000*> ;"Control close square bracket"
740 <MANIFEST M$$EXCALT M$$CNCLSQBK M$$CHR-CHR M$$CHR-ASC M$$CHR-BRK
741 M$$CHR-APL M$$CHR-PRE>
743 '<GDECL (I$READ-TABLE) <OR FALSE <VECTOR [REST <OR FALSE VECTOR>]>>>
745 <GDECL (I$MACHINE-INFO) !<UVECTOR [10 FIX]>>
747 <SETG I$MINF-TTYI 1> ;"TTY input jfn"
748 <SETG I$MINF-TTYO 2> ;"TTY output jfn"
749 <SETG I$MINF-WDSIZE 3> ;"Bits per word"
750 <SETG I$MINF-BYTE-SIZE 4> ;"Bits per byte"
751 <SETG I$MINF-PAGE-SIZE 5> ;"Words per page"
752 <SETG I$MINF-BYTES-PER-WORD 6> ;"characters per word"
753 <SETG I$MINF-ADDRESS-SHIFT 7> ;"Amount to shift from 'word' address"
754 <SETG I$MINF-8BYTES-PER-WORD 8> ;"8-bit bytes per word"
755 <SETG I$MINF-MINFL 9> ;"Largest floating point number"
756 <SETG I$MINF-MAXFL 10> ;"Smallest f.p. number"
758 <MANIFEST I$MINF-TTYI I$MINF-TTYO I$MINF-WDSIZE I$MINF-BYTE-SIZE
759 I$MINF-PAGE-SIZE I$MINF-BYTES-PER-WORD I$MINF-ADDRESS-SHIFT
760 I$MINF-8BYTES-PER-WORD I$MINF-MAXFL I$MINF-MINFL>
762 <PUTPROP I$SEG-EVAL FRAME T>
764 <PUTPROP T$EVAL FRAME T>
766 <PUTPROP T$PRINT-OUTPUT-BUFFER FRAME T>
768 <PUTPROP T$READ-INPUT-BUFFER FRAME T>
770 <SETG I$READ-TABLE 1> ;"current read-table if any"
771 <SETG I$RDCONT 2> ;"characters available"
772 <SETG I$CHANNEL 3> ;"CHANNEL"
773 <SETG I$RADIX 4> ;"radix for numbers"
774 <SETG I$POINT 5> ;"decimal point seen flag"
775 <SETG I$RDBUFFER 6> ;"buffer used w/ access channels"
776 <SETG I$RDCT 7> ;"bytes in buffer"
777 <SETG I$SAVCHR 8> ;"re-read character"
779 <MANIFEST I$READ-TABLE I$RDCONT I$CHANNEL I$RADIX I$POINT
780 I$RDBUFFER I$RDCT I$RDACC I$SAVCHR I$TBUFFER>
782 <PUT-DECL READ-INFO '<TUPLE <OR !<FALSE> VECTOR> FIX
783 CHANNEL FIX <OR ATOM !<FALSE>>
784 <OR STRING !<FALSE>> FIX CHARACTER
785 <OR STRING !<FALSE>>>>
787 <MANIFEST RI-CHANNEL>
790 ; "Stuff for MAPPUR and friends"
792 <NEWTYPE T$PCODE UVECTOR '<<PRIMTYPE UVECTOR> [5 FIX]>>
793 <PUT-DECL PCODE '<<PRIMTYPE UVECTOR> [5 FIX]>>
795 <SETG M$$MP-IDENT -10> ; "Used to mark pages taken by mappur"
796 <SETG M$$PC-ID 1> ; "File ID"
797 <SETG M$$PC-DB 2> ; "DB index"
798 <SETG M$$PC-DBLOC 3> ; "Location in DB"
799 <SETG M$$PC-CORLOC 4> ; "Location in core"
800 <SETG M$$PC-LEN 5> ; "Length of code"
801 <SETG M$$PC-ENTLEN 5> ; "length of entry"
802 <MANIFEST M$$MP-IDENT M$$PC-ID M$$PC-DB M$$PC-DBLOC M$$PC-CORLOC M$$PC-LEN
805 ; "Needed here for BOOT to compile"
807 <SETG DB-CHANNEL <OFFSET 2 DB>>
808 <COND (<GASSIGNED? MUDDLE>
809 <PUT DB DECL '<VECTOR STRING <OR FALSE FIX>>>)
810 (<PUT-DECL DB '<VECTOR STRING <OR FALSE FIX>>>)>
812 <MANIFEST DB-NAME DB-CHANNEL>
814 <GDECL (T$PSIZE T$CHARS-WD T$BYTES-WD) FIX>
818 <NEWTYPE T$ZONE VECTOR
819 '<<PRIMTYPE VECTOR> <OR FALSE T$GC-PARAMS>
820 <OR T$ATOM FALSE> <OR T$ATOM FALSE>
821 <OR T$ATOM FALSE> FIX <LIST [REST T$AREA]>
822 <OR FALSE <UVECTOR [3 FIX]>>>>
824 '<<PRIMTYPE VECTOR> <OR FALSE GC-PARAMS>
825 <OR ATOM FALSE> <OR ATOM FALSE> <OR ATOM FALSE>
826 FIX <LIST [REST AREA]>
827 <OR FALSE <UVECTOR [3 FIX]>>>>
835 <MANIFEST GC-PARAMS GC-FCN MOVE-FCN GROW-FCN ZONE-ID ALL-SPACES GC-CTL>
837 <SETG GCC-MIN-SPACE 1>
840 <MANIFEST GCC-MIN-SPACE GCC-MS-FREQ GCC-MS-CT>
842 <NEWTYPE T$GC-PARAMS UVECTOR '<<PRIMTYPE UVECTOR> [16 FIX]>>
843 <PUT-DECL GC-PARAMS '<<PRIMTYPE UVECTOR> [16 FIX] [REST FIX]>>
845 <SETG RCL 1> <SETG RCLV 2> <SETG RCLV1 3> <SETG RCLV2 4>
846 <SETG RCLV3 5> <SETG RCLV4 6> <SETG RCLV5 7> <SETG RCLV6 8>
847 <SETG RCLV7 9> <SETG RCLV8 10> <SETG RCLV9 11> <SETG RCLV10 12>
848 <SETG GCSBOT 13> <SETG GCSMIN 14> <SETG GCSMAX 15> <SETG GCSFLG 16>
849 <MANIFEST RCL RCLV RCLV1 RCLV2 RCLV3 RCLV4 RCLV5 RCLV6 RCLV7 RCLV8
850 RCLV9 RCLV10 GCSBOT GCSMIN GCSMAX GCSFLG>
851 <SETG GCF-NO-DOPE *400000000000*>
852 <SETG GCF-PAGE-ONLY *200000000000*>
853 <MANIFEST GCF-NO-DOPE GCF-PAGE-ONLY>
855 <NEWTYPE T$AREA UVECTOR '<<PRIMTYPE UVECTOR> [4 FIX]>>
856 <PUT-DECL AREA '<<PRIMTYPE UVECTOR> [4 FIX]>>
862 <SETG AF-READ-ONLY 2>
863 <MANIFEST ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY>
865 <GDECL (T$CURRENT-ZONE) T$ZONE (I$ZONE-LIST) <LIST [REST T$ZONE]>
866 (I$ALL-ZONES) <VECTOR [REST <OR FALSE T$ZONE>]>>
868 <GDECL (I$LENGTH-GC-PARAMS I$LH-MASK I$RH-MASK T$MIN-NEW-SPACE
870 I$NEW-SPACE-SIZE I$HHIGH-BIT I$ZONE-COUNT I$ADDR-SHIFT
871 I$PSIZE I$CHARS-WD I$CHARS-WD-1) FIX>
874 <SETG M$$MY-PROC *400000*>
875 <SETG M$$MY-PROC-LH <LSH ,M$$MY-PROC 18>>
876 <SETG M$$SETZ <LSH *400000* 18>>
877 <SETG M$$COPY-ON-WRITE *000400000000*>
878 <SETG M$$READ-ONLY-EXECUTE *120000000000*>
879 <MANIFEST M$$MY-PROC M$$MY-PROC-LH M$$SETZ M$$COPY-ON-WRITE M$$READ-ONLY-EXECUTE>
881 <DEFMAC ISYSOP (NAME "ARGS" STUFF)
882 <COND (<AND <TYPE? .NAME ATOM>
883 <MEMBER <SPNAME .NAME> '["BIN" "WAIT" "DISMS"]>>
885 <FORM CALL SETS RUNINT -1>
886 <FORM SET VAL <FORM CALL SYSOP .NAME !.STUFF>>
887 <FORM CALL SETS RUNINT 0>
889 (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSOP>)>>
891 <DEFMAC ISYSCALL (NAME "ARGS" STUFF)
892 <COND (<AND <TYPE? .NAME ATOM>
893 <MEMBER <SPNAME .NAME>
894 '["WAIT" "SIGPAUSE" "READ" "READV" "WRITE" "WRITEV"
895 "CONNECT" "SELECT" "SEND" "RECV" "RECVMSG" "SENDMSG"
896 "SENDTO" "RECVFROM" "ACCEPT"]>>
898 <FORM CALL SETS RUNINT -1>
899 <FORM SET VAL <FORM CALL SYSCALL .NAME !.STUFF>>
900 <FORM CALL SETS RUNINT 0>
902 (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSCALL>)>>
904 <DEFMAC M$$NO-SAVCHR () '<CHTYPE -1 CHARACTER>>
909 <FORM GETBITS .WD <FORM BITS 18 0>>)
911 <FORM GETBITS .WD <FORM BITS 16 0>>)>>
915 <FORM GETBITS .WD <FORM BITS 18 18>>)
917 <FORM GETBITS .WD <FORM BITS 16 16>>)>>
918 <DEFMAC PUTRHW ('WD 'NEW)
921 <FORM PUTBITS .WD <FORM BITS 18 0> .NEW>)
923 <FORM PUTBITS .WD <FORM BITS 16 0> .NEW>)>>
924 <DEFMAC PUTLHW ('WD 'NEW)
927 <FORM PUTBITS .WD <FORM BITS 18 18> .NEW>)
929 <FORM PUTBITS .WD <FORM BITS 16 16> .NEW>)>>
930 <DEFMAC PAGE-ADDRESS ('PAGENO)
933 <FORM * .PAGENO 512>)
935 <FORM * .PAGENO 1024>)>>
936 <DEFMAC ADDRESS-PAGE ('ADDR)
941 <FORM LSH .ADDR -10>)>>
942 <GDECL (I$ATM-FSM) VECTOR>