26 GC-PARAMS GC-FCN MOVE-FCN GROW-FCN ZONE-ID ALL-SPACES GC-CTL
27 GCC-MIN-SPACE GCC-MS-FREQ GCC-MS-CT
29 GCSFLG ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY CURRENT-ZONE
32 M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
35 M$$GVAL M$$LVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML
36 M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL
37 M$$H-CLASS M$$H-FUNCTION M$$H-PRIORITY M$$H-ARG M$$H-NEXT
38 M$$C-NAME M$$C-ENABLE M$$C-HANDLER M$$C-CHANNEL M$$C-PRIORITY
40 M$$INT-QUEUE M$$INT-QUEUE-R
41 M$$INT-LEVEL M$$INT-CLASSES
42 M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT
45 CHANNEL-TYPE CHANNEL-SCRIPT CHANNEL-NAME CHANNEL-OPEN?
46 CHANNEL-DATA CHANNEL-USER
47 MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-ORAD MC-BITS MC-IRAD
48 BIT-ACCESS BIT-INTELLIGENT
51 ; "Read character types"
54 <SETG M$$R-MIN-BRACK 2>
59 <SETG M$$R-SQUIGGLE 6>
61 <SETG M$$R-MAX-BRACK 7>
66 <SETG M$$R-PERCENT 12>
68 <SETG M$$R-MAX-ATM-BRK 13>
72 <SETG M$$R-MIN-NUM-PART 17>
78 <MANIFEST M$$R-BREAK M$$R-ESCAPE M$$R-MIN-BRACK M$$R-PAREN M$$R-ANGLE M$$R-SQUARE
79 M$$R-DOUBLE M$$R-SQUIGGLE M$$R-ENDBR M$$R-MAX-BRACK M$$R-EXCL
80 M$$R-SEMI M$$R-SHARP M$$R-COMMA M$$R-PERCENT M$$R-QUOTE
81 M$$R-MAX-ATM-BRK M$$R-VERT M$$R-BACKS M$$R-DOT M$$R-ALPHA
82 M$$R-E M$$R-MIN-NUM-PART
83 M$$R-DIGIT M$$R-PLUS M$$R-STAR>
85 <GDECL (I$TRANS-TABLE) BYTES>
87 ; "PRINT's magic finite-state machine for atoms"
89 <SETG M$$FS-NSTATE 9> ; "# states, not counting terminals"
90 <SETG M$$FS-NOSLASH <+ ,M$$FS-NSTATE 1>> ; "No initial \ needed"
91 <SETG M$$FS-SLASH1 <+ ,M$$FS-NSTATE 2>> ; "Initial \ needed"
92 <SETG M$$FS-SLASH2 <+ ,M$$FS-NSTATE 3>> ; "Initial \ needed, done otherwise"
93 <SETG M$$END-STATE 6> ; "Slot in state for end of string"
94 <MANIFEST M$$FS-NSTATE M$$FS-NOSLASH M$$FS-SLASH1 M$$FS-SLASH2 M$$END-STATE>
98 <COND (<NOT <GASSIGNED? NEW-CHANNEL-TYPE>>
99 <DEFINE NEW-CHANNEL-TYPE ("TUPLE" FOO) T>)>
100 <SETG T$NEW-CHANNEL-TYPE ,NEW-CHANNEL-TYPE>
102 <NEWTYPE T$BITS WORD>
104 <NEWTYPE T$ATOM TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
108 <OR T$TYPE-C FALSE>>>
109 <PUTPROP T$ATOM ALT-DECL ATOM>
111 <PUTPROP T$LINK ALT-DECL LINK>
113 <PUTPROP T$TYPE-C ALT-DECL TYPE-C>
115 <NEWTYPE LVAL TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
119 <OR T$TYPE-C FALSE>>>
120 <NEWTYPE T$LVAL T$ATOM>
121 <NEWTYPE GVAL TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
125 <OR T$TYPE-C FALSE>>>
126 <NEWTYPE T$GVAL T$ATOM>
127 <NEWTYPE T$OBLIST TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
131 <OR T$TYPE-C FALSE>>>
132 <NEWTYPE T$LINK TEMPLATE '<<PRIMTYPE TEMPLATE> T$GBIND
136 <OR T$TYPE-C FALSE>>>
137 <NEWTYPE I$TERMIN WORD>
138 <NEWTYPE T$DEFER LIST>
139 <NEWTYPE T$TYPE-C FIX>
140 <NEWTYPE T$TYPE-W FIX>
143 '<<PRIMTYPE TEMPLATE> T$MSUBR>>
146 '<<PRIMTYPE TEMPLATE> ANY
148 <OR T$ATOM FORM FALSE>
149 [2 <OR T$LBIND FALSE>]
155 '<<PRIMTYPE TEMPLATE> ANY
157 <OR T$ATOM FORM FALSE>>>
158 <NEWTYPE GBIND T$GBIND>
159 <NEWTYPE LBIND T$LBIND>
160 <PUTPROP T$GBIND ALT-DECL GBIND>
161 <PUTPROP T$LBIND ALT-DECL LBIND>
163 <NEWTYPE T$FUNCTION LIST>
164 <NEWTYPE T$ADECL VECTOR>
165 <NEWTYPE ADECL VECTOR>
166 <NEWTYPE T$MCODE UVECTOR>
167 <NEWTYPE MCODE UVECTOR '<<PRIMTYPE UVECTOR> [REST FIX]>>
170 '<<PRIMTYPE VECTOR> MCODE T$ATOM LIST [REST ANY]>>
171 <NEWTYPE MSUBR VECTOR>
172 <NEWTYPE T$IMSUBR VECTOR>
173 <NEWTYPE IMSUBR VECTOR>
174 <NEWTYPE T$MACRO LIST>
176 <SETG POBL (<GET INITIAL OBLIST> <ROOT>)>
179 <COND (<OR <LENGTH? .STR 2>
180 <AND <==? <1 .STR> !\T>
182 <PARSE .STR 10 ,POBL>)
183 (T <PARSE <STRING "T$" .STR> 10 ,POBL>)>>
187 <DEFINE P-E (STR) <PARSE <STRING !\@ .STR> 10 ,POBL>>
189 <NEWTYPE T$UNBOUND FIX>
191 <PUTPROP ATOM DECL T$ATOM>
194 ; "Stuff for compiling BOOT i/o"
195 <SETG M$$CHAN 1> ;"channel identifier"
196 <SETG M$$MODE 2> ;"mode: PRINT, READ, etc."
197 <SETG M$$DEV 3> ;"device name"
198 <SETG M$$FNAM 4> ;"file name"
199 <SETG M$$HLEN 5> ;"horizontal line length"
200 <SETG M$$HPOS 6> ;"horizontal position"
201 <SETG M$$VLEN 7> ;"vertical length"
202 <SETG M$$VPOS 8> ;"vertical position"
203 <SETG M$$RADX 9> ;"radix"
204 <SETG M$$BUFF 10> ;"channel buffer"
205 <SETG M$$BUFL 11> ;"buffer valid length"
206 <SETG M$$BPOS 12> ;"buffer position"
207 <SETG M$$INTR 13> ;"internal: 0=normal, 1=PRINC, 2=UNPARSE"
208 <SETG M$$NXTC 14> ;"read ahead character (or FALSE CHARACTER)"
209 <SETG M$$FFRM 15> ;"Frame to go to in flatsize"
211 <MANIFEST M$$CHAN M$$MODE M$$DEV M$$FNAM M$$HLEN M$$HPOS M$$VLEN M$$VPOS
212 M$$RADX M$$BUFF M$$BUFL M$$BPOS M$$INTR M$$NXTC M$$FFRM>
215 <PUTPROP T$BCHANNEL DECL
216 '<<PRIMTYPE VECTOR> FIX [3 STRING] [5 FIX] STRING [3 FIX]>>
219 <NEWTYPE I$SDTABLE VECTOR
220 '!<<PRIMTYPE VECTOR> ATOM <OR FALSE ATOM <LIST [REST ATOM]>>
221 <LIST [REST ATOM <OR ATOM MSUBR FALSE>]>>>
223 <SETG I$SD-INHERIT 2>
225 <MANIFEST I$SDNAME I$SD-INHERIT I$SD-OPER>
227 <NEWTYPE I$DISK-CHANNEL VECTOR>
229 <GDECL (I$CHANNEL-TYPES) <LIST [REST ATOM I$SDTABLE]>>
230 <GDECL (T$DEVVEC) <VECTOR [REST FIX <OR ATOM VECTOR>]>>
234 <NEWTYPE T$CHANNEL VECTOR '!<<PRIMTYPE VECTOR>
242 <PUTPROP CHANNEL DECL '!<<PRIMTYPE VECTOR> ATOM
249 <SETG T$CHANNEL-TYPE 1> ;"Type of CHANNEL"
250 <SETG T$CHANNEL-SCRIPT 2> ;"Scripting CHANNEL"
251 <SETG T$CHANNEL-NAME 3> ;"Passed to CHANNEL-OPEN"
252 <SETG T$CHANNEL-OPEN? 4> ;"Is CHANNEL still open?"
253 <SETG T$CHANNEL-DATA 5> ;"Device-dependent stuff"
254 <SETG T$CHANNEL-USER 6> ;"Application-dependent stuff"
256 <MANIFEST T$CHANNEL-TYPE T$CHANNEL-SCRIPT T$CHANNEL-NAME T$CHANNEL-OPEN?
257 T$CHANNEL-DATA T$CHANNEL-USER>
259 <NEWTYPE T$MUD-CHAN VECTOR '!<<PRIMTYPE VECTOR>
265 <PUT MUD-CHAN DECL '!<<PRIMTYPE VECTOR>
283 <SETG T$BIT-ACCESS 1>
284 <SETG T$BIT-INTELLIGENT 2>
285 <MANIFEST T$MC-HLEN T$MC-HPOS T$MC-VLEN T$MC-VPOS T$MC-ORAD
286 T$MC-INTR T$MC-NCHR T$MC-FFRM T$MC-BITS T$MC-IRAD T$BIT-ACCESS
289 <SETG CHANNEL-TYPE 1>
290 <SETG CHANNEL-SCRIPT 2>
291 <SETG CHANNEL-NAME 3>
292 <SETG CHANNEL-OPEN? 4>
293 <SETG CHANNEL-DATA 5>
294 <SETG CHANNEL-USER 6>
295 <MANIFEST CHANNEL-TYPE CHANNEL-SCRIPT CHANNEL-NAME CHANNEL-OPEN?
296 CHANNEL-DATA CHANNEL-USER>
306 <SETG BIT-INTELLIGENT 2>
307 <MANIFEST MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-RADX BIT-ACCESS BIT-INTELLIGENT>
309 ;"Internal modes of a channel."
310 <SETG M$$PR-PRC 1> ; "Bit--on if PRINC"
311 <SETG M$$PR-UNP 2> ; "UNPARSE"
312 <SETG M$$PR-FLT 4> ; "FLATSIZE"
313 <MANIFEST M$$PR-PRC M$$PR-UNP M$$PR-FLT>
315 ;"Some globals used in PRINT."
316 <SETG M$$PR-MAX 10000000> ;"Maximum size of UNPARSE buffer."
317 <SETG M$$PR-TAB 8> ;"Maximum number of <SPACE>s in a <TAB>."
318 <SETG M$$PR-SIGD 10> ;"Number of significant digits in a FLOAT."
319 <SETG M$$PR-FRAD 2> ;"Number of decimal places in a FLOAT."
320 <SETG M$$PR-BUFL 64> ;"Size of temporary buffer."
322 <MANIFEST M$$PR-MAX M$$PR-TAB M$$PR-SIGD M$$PR-FRAD M$$PR-BUFL>
324 <GDECL (M$$PR-BUFS M$$PR-BREAKS M$$PR-BRACKS M$$PR-NUMBER) STRING
325 (M$$FLATCHAN M$$INTCHAN M$$OUTCHAN M$$INCHAN) T$CHANNEL
326 (M$$CHANLIST) <LIST [REST T$CHANNEL]>>
328 <GDECL (I$R?) ANY (BI$RADIX QWSIZ) FIX>
329 <GDECL (I$CHRSTR BREAKS BRACKS) STRING>
330 <GDECL (I$POWERS I$FLOAT-TABLE) <VECTOR [REST FLOAT]>>
331 <GDECL (BI$NCHR) <OR CHARACTER FALSE> (BI$STR) STRING>
333 ;"Offsets for FRAME."
335 ;"More cretinous offsets"
339 ;"The FRAME's MSUBR."
347 ;"Number of arguments"
355 ;"The previous FRAME"
363 ;"We will hide <ARGS .FRAME> here in simulation"
367 ;"The FRAME's BINDing."
371 ;"The FRAME's ACTIVATION."
373 <MANIFEST M$$FRM-MSUB
385 ;"ATOM - offset to LVAL binding"
389 ;"ATOM - offset to GVAL binding"
393 ;"ATOM - offset to PNAME string"
397 ;"ATOM - offset to OBLIST (primtype ATOM)"
401 ;"ATOM - valid type TYPE-C or FALSE"
405 ;"ATOM - length of block for atom"
407 <MANIFEST M$$LVAL M$$GVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML>
409 ;"Offsets for LBIND."
413 ;"BIND - value of this binding"
417 ;"BIND - ATOM that this binding represent"
421 ;"BIND - this binding's DECL or FALSE if none"
425 ;"BIND - closest previous binding block for any atom"
429 ;"BIND - closest previous binding block for this atom"
433 ;"BIND - unique bind id for this binding block"
437 ;"BIND - length of block for bind"
439 <MANIFEST M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL>
441 <SETG M$$T-FIX 0> ;"SAT code for FIX."
442 <SETG M$$T-LST 1> ;"SAT code for LIST."
443 <SETG M$$T-REC 2> ;"SAT code for RECORD."
444 <SETG M$$T-TEM 3> ;"SAT code for TEMPLATE."
445 <SETG M$$T-BYT 4> ;"SAT code for BYTES."
446 <SETG M$$T-STR 5> ;"SAT code for STRING."
447 <SETG M$$T-UVC 6> ;"SAT code for UVECTOR."
448 <SETG M$$T-VEC 7> ;"SAT code for VECTOR."
449 <SETG M$$T-UBK [,M$$T-BYT ,M$$T-STR ,M$$T-UVC ,M$$T-VEC]>
450 ;"SAT codes for UBLOCK types."
452 <MANIFEST M$$T-FIX M$$T-LST M$$T-REC M$$T-TEM M$$T-BYT M$$T-STR
453 M$$T-UVC M$$T-VEC M$$T-UBK>
455 <NEWTYPE T$TYPE-ENTRY
457 '<<PRIMTYPE VECTOR> T$ATOM
459 <OR APPLICABLE T$ATOM FALSE>
460 <OR APPLICABLE T$ATOM FALSE>
461 <OR APPLICABLE T$ATOM FALSE>
463 <OR FALSE T$ATOM FORM SEGMENT>>>
467 '<<PRIMTYPE VECTOR> ATOM
469 <OR APPLICABLE ATOM FALSE>
470 <OR APPLICABLE ATOM FALSE>
471 <OR APPLICABLE ATOM FALSE>
473 <OR FALSE ATOM FORM SEGMENT>>>
475 <SETG M$$NTYPE 1> ;"TYPE name."
476 <SETG M$$PTYPE 2> ;"PRIMTYPE name."
477 <SETG M$$APPLY 3> ;"Applicable for APPLYTYPE."
478 <SETG M$$NEVAL 4> ;"Applicable for EVALTYPE."
479 <SETG M$$PRINT 5> ;"Applicable for PRINTTYPE."
480 <SETG M$$TYWRD 6> ;"TYPE-WORD for this type."
481 <SETG M$$TDECL 7> ;"DECL for this type."
483 ;"Bit offset for TYPE-WORD slot."
485 <SETG M$$TYSAT 7> ;"The first three bits are used for SAT."
486 <SETG M$$TYOFF 6> ;"Amount to LSH to get offset."
488 <MANIFEST M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
491 ;"Definition for ADECL."
495 '!<<PRIMTYPE VECTOR> [2 ANY]>>
497 <SETG M$$ADCL-VAL 1> ;"The VALUE of the ADECL."
498 <SETG M$$ADCL-DCL 2> ;"The DECL of the ADECL."
500 ;"Definition for OFFSET."
504 '!<<PRIMTYPE VECTOR> FIX <OR T$ATOM FORM SEGMENT>
505 <OR T$ATOM FORM SEGMENT FALSE>>>
511 <MANIFEST M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT>
513 <GDECL (M$$TOPLEV-FRAME) T$FRAME (M$$INT-LEVEL) FIX
514 (M$$DECL-CHECK) <OR ATOM FALSE>
515 (I$INTCHAN) T$CHANNEL
516 (M$$PI/2 M$$LIMIT T$MINFL T$MAXFL I$PMINFL) FLOAT
517 (M$$OBLIST) <VECTOR [REST <LIST [REST <OR T$ATOM T$LINK>]>]>
518 (M$$OBLNAM) <LIST [REST T$OBLIST]> (M$$OBLSIZ) FIX
519 (M$$OBLSTK) <LIST [REST <LIST <OR T$OBLIST
520 <LIST [REST <OR T$OBLIST
522 (M$$TBIND) <OR T$LBIND FALSE> (M$$BINDID) FIX
523 (M$$OBLIST-ROOT M$$ONLIST-ERRORS M$$OBLIST-INTERRUPTS) T$OBLIST
524 (I$BREAKS I$BRACKS) STRING (I$POWERS) <VECTOR [REST FLOAT]>
525 (I$RDCHRSTR) <STRING CHARACTER>
526 (M$$TYPE-UNSTRUC) <VECTOR [REST ATOM]>
527 ;(M$$CHANLIST) ;<LIST [REST T$CHANNEL]>
528 (M$$GBIND) <LIST [REST T$GBIND]> (M$$UNBOUND) T$UNBOUND
529 (M$$TYP-COUNT) FIX (M$$TYP-NEW) STRING
530 (M$$TYP-GROUP) <VECTOR [REST ATOM]>
531 (M$$TYPE-INFO) <VECTOR [REST <OR T$TYPE-ENTRY FALSE>]>
532 (M$$PRINT-TYPES M$$NEVAL-TYPES M$$APPLY-TYPES M$$LOCATIVE
533 M$$STRUCTURED) <VECTOR [REST ATOM]>
535 <VECTOR [REST <VECTOR [2 STRING]
539 (M$$NEWTYPE?) <OR ATOM FALSE>
540 (M$$ALLTYPES) <VECTOR [REST T$ATOM]>
541 (M$$PRINT-TYPES M$$NEVAL-TYPES M$$APPLY-TYPES M$$LOCATIVE M$$STRUCTURED)
543 (M$$FREE-FRAMES M$$FRAMES) <LIST [REST T$FRAME]>
545 (M$$LBIND) <OR FALSE T$LBIND>
546 (M$$STRUCTURED) <VECTOR [REST ATOM]>
547 (M$$RHI M$$RLOW I$MINFX I$MAXFX) FIX>
549 ;"Manifest GVALs for APPLY"
551 <SETG M$$F-PROG 1> ;"For the SUBR PROG."
552 <SETG M$$F-BIND 2> ;"For the SUBR BIND."
553 <SETG M$$F-REPEAT 3> ;"For the SUBR REPEAT."
554 <SETG M$$F-APPLY 4> ;"For the SUBR APPLY."
555 <SETG M$$F-EVAL 5> ;"For functional calls."
557 <MANIFEST M$$F-PROG M$$F-BIND M$$F-REPEAT M$$F-APPLY M$$F-EVAL>
560 <SETG M$$TYPE-INFO-SIZE 1024>
562 <MANIFEST M$$TYPE-INFO-SIZE>
564 ;"Offsets for MSUBR."
566 <SETG M$$MSB-CODE 1> ;"Code for the T$MSUBR."
567 <SETG M$$MSB-NAME 2> ;"Name of the T$MSUBR."
568 <SETG M$$MSB-DECL 3> ;"Decl of the T$MSUBR."
570 <MANIFEST M$$MSB-CODE M$$MSB-NAME M$$MSB-DECL>
572 <GDECL (M$$INT-LEVEL) FIX
573 (M$$INT-CLASSES) <OR CLASS FALSE>>
577 '<<PRIMTYPE VECTOR> STRING
585 <SETG M$$C-HANDLER 3>
586 <SETG M$$C-CHANNEL 4>
587 <SETG M$$C-PRIORITY 5>
588 <MANIFEST M$$C-NAME M$$C-ENABLE M$$C-HANDLER M$$C-CHANNEL M$$C-PRIORITY>
592 <MANIFEST M$$INFINT M$$CONTINT>
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) 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 <PUTPROP PT-DECL DECL '<VECTOR TYPE-C [3 FIX]>>
641 '<VECTOR ATOM <OR ATOM FORM> [2 FIX] [OPTIONAL <OR FIX VECTOR>]>>
643 <PUTPROP TT-DECL DECL '<VECTOR ET-DECL [OPTIONAL PT-DECL PT-DECL]>>
645 <PUTPROP DT-DECL DECL '<VECTOR [2 FIX] [REST ET-DECL]>>
649 '<<PRIMTYPE VECTOR> ATOM FORM [3 FIX] VECTOR [REST DT-DECL]>>
651 ;"Table to store the TAT and TDT for all Templates."
652 <SETG M$$R-TAT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
653 <SETG M$$R-TDT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
655 <GDECL (M$$R-TAT) <VECTOR [REST <OR FALSE TAT>]>
656 (M$$R-TDT) <VECTOR [REST <OR FALSE UVECTOR>]>>
658 ;"Flags to indicate the type of template element."
659 <SETG M$$R-BOOLN 1> ;"Boolean - off:BOOLEAN"
660 <SETG M$$R-ENUMO 2> ;"Enumeration - off:(ENUM [obj])"
661 <SETG M$$R-ENUME 3> ;"Enumeration - off:(ENUM vec)"
662 <SETG M$$R-SUBRA 4> ;"Sub-range - off:(FIX prim-fix low-lim high-lim)"
663 <SETG M$$R-SUBSB 5> ;"Sub-range (S) - off:(SBOOL prim-fix low-lim high-lim)"
664 <SETG M$$R-UNSTR 6> ;"Unstruc - off:type"
665 <SETG M$$R-UNSSB 7> ;"Unstruc (S) - off:(SBOOL type)"
666 <SETG M$$R-STRUC 8> ;"Struc - off:struc"
667 <SETG M$$R-STRSB 9> ;"Struc (S) - off:(SBOOL struc)"
668 <SETG M$$R-STRLN 10> ;"Struc+lnt - off:(STRUC struc #-of-ele)"
669 <SETG M$$R-SLNSB 11> ;"Struc+lnt (S) - off:(SBOOL struc #-of-ele)"
670 <SETG M$$R-ANYOB 12> ;"Any - off:ANY"
672 <MANIFEST M$$R-BOOLN M$$R-ENUMO M$$R-ENUME M$$R-SUBRA M$$R-SUBSB M$$R-UNSTR
673 M$$R-UNSSB M$$R-STRUC M$$R-STRSB M$$R-STRLN M$$R-SLNSB M$$R-ANYOB>
675 ;"Offsets in the Template Access Table (TAT)."
676 <SETG M$$R-TNAM 1> ;"ATOM - Name of this template."
677 <SETG M$$R-TDCL 2> ;"FORM - Decl for this template."
678 <SETG M$$R-TTYP 3> ;"FIX - Offset of this template in the type table."
679 <SETG M$$R-TLNT 4> ;"FIX - Length info is stored here."
680 <SETG M$$R-TLOC 5> ;"FIX - Location of the discriminant type in record."
681 <SETG M$$R-TDIS 6> ;"VECTOR - Vector of discriminants."
682 <SETG M$$R-TSDT 6> ;"VECTOR - 1 word before start of discriminant field data."
683 <SETG M$$R-TDTA 7> ;"VECTOR - Beginning of each discriminant field data."
685 <MANIFEST M$$R-TNAM M$$R-TDCL M$$R-TTYP M$$R-TLNT M$$R-TLOC M$$R-TDIS
688 ;"Offsets in the Discriminant Table (DT)."
689 <SETG M$$R-DLNT 1> ;"FIX - Length of this discriminant type."
690 <SETG M$$R-DWRD 2> ;"FIX - Number of words required by this discriminant."
691 <SETG M$$R-DATA 2> ;"VECTOR - (start of discriminant element data) - 1."
693 <MANIFEST M$$R-DLNT M$$R-DWRD M$$R-DATA>
695 ;"Offsets in the Element Table (ET)."
696 <SETG M$$R-EOFF 1> ;"ATOM - Name of the offset for this element."
697 <SETG M$$R-EDCL 2> ;"<OR ATOM FORM> - Decl for this element."
698 <SETG M$$R-EFLG 3> ;"FIX - Flag to indicate what this element is."
699 <SETG M$$R-EELE 4> ;"FIX - Record offset for this element."
700 <SETG M$$R-ESBL 5> ;"FIX - Record offset for the SBOOL flag."
701 <SETG M$$R-ESLN 5> ;"FIX - Record offset for fix STRUCTURED length."
702 <SETG M$$R-EVEC 5> ;"VECTOR - Enumeration or Subrange information."
704 <MANIFEST M$$R-EOFF M$$R-EDCL M$$R-EFLG M$$R-EELE M$$R-ESBL M$$R-ESLN
707 ;"Offsets in the Position Table (PT)."
708 <SETG M$$R-PTYP 1> ;"TYPE-C - Type code for this element."
709 <SETG M$$R-PBIT 2> ;"FIX - Length of structured or position of bit."
710 <SETG M$$R-PLOC 3> ;"FIX - First half-word location of storage in template."
711 <SETG M$$R-PLNT 4> ;"FIX - Length (in half-words) of storage in template."
713 <MANIFEST M$$R-PTYP M$$R-PBIT M$$R-PLOC M$$R-PLNT>
715 ;"Number of half-words needed to store various MUDDLE objects."
716 <SETG M$$R-FCNT 1> ;"Half-words to store structured object length."
717 <SETG M$$R-FPTR 2> ;"Half-words to store object pointer or unstructured."
718 <SETG M$$R-STLN 3> ;"Half-words to store object pointer and length."
719 <SETG M$$R-FULL 4> ;"Half-words to store an ANY."
721 <MANIFEST M$$R-FCNT M$$R-FPTR M$$R-STLN M$$R-FULL>
723 ;"Number of bits in a byte, half-word and word. -- Replaced to be computed
725 ;<SETG M$$R-BQWD 9> ;"Number of bits in 1/4 of a word."
726 ;<SETG M$$R-BHWD 18> ;"Number of bits in a half-word."
727 ;<SETG M$$R-BWRD 36> ;"Number of bits in a word."
728 <GDECL (M$$R-BQWD M$$R-BHWD M$$R-BWRD M$$R-BQWD!-INTERNAL M$$R-BHWD!-INTERNAL
729 M$$R-BWRD!-INTERNAL) FIX>
730 ;<MANIFEST M$$R-BQWD M$$R-BHWD M$$R-BWRD>
731 <SETG M$$CHR-CHR 1> ;"Character to xlate to"
732 <SETG M$$CHR-ASC 2> ;"Code of character to act like"
733 <SETG M$$CHR-BRK 3> ;"True ==> break on this, else don't"
734 <SETG M$$CHR-APL 4> ;"Apply this to read object"
735 <SETG M$$CHR-PRE 5> ;"Pass previously read object"
737 <SETG M$$EXCALT *1033*> ;"!$"
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 [7 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 <PUTPROP READ-INFO DECL '<TUPLE <OR !<FALSE> VECTOR> FIX
783 T$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 <PUTPROP PCODE DECL '<<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 <PUTPROP GC-PARAMS DECL '<<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 <PUTPROP AREA DECL '<<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> '["WRITE" "SELECT" "READ" "WAIT" "SIGPAUSE"]>>
895 <FORM CALL SETS RUNINT -1>
896 <FORM SET VAL <FORM CALL SYSCALL .NAME !.STUFF>>
897 <FORM CALL SETS RUNINT 0>
899 (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSCALL>)>>
901 <DEFMAC M$$NO-SAVCHR () '<CHTYPE -1 CHARACTER>>
906 <FORM GETBITS .WD <FORM BITS 18 0>>)
908 <FORM GETBITS .WD <FORM BITS 16 0>>)>>
912 <FORM GETBITS .WD <FORM BITS 18 18>>)
914 <FORM GETBITS .WD <FORM BITS 16 16>>)>>
915 <DEFMAC PUTRHW ('WD 'NEW)
918 <FORM PUTBITS .WD <FORM BITS 18 0> .NEW>)
920 <FORM PUTBITS .WD <FORM BITS 16 0> .NEW>)>>
921 <DEFMAC PUTLHW ('WD 'NEW)
924 <FORM PUTBITS .WD <FORM BITS 18 18> .NEW>)
926 <FORM PUTBITS .WD <FORM BITS 16 16> .NEW>)>>
927 <DEFMAC PAGE-ADDRESS ('PAGENO)
930 <FORM * .PAGENO 512>)
932 <FORM LSH <FORM * .PAGENO 256> 2>)>>
933 <DEFMAC ADDRESS-PAGE ('ADDR)
938 <FORM LSH <FORM / .ADDR 256> -2>)>>