mim/development/mim/boot/nboot.compil

   1
   2 <BLOCK (<ROOT>)>
   3 PAGE-ADDRESS
   4 ADDRESS-PAGE
   5 LHW
   6 RHW
   7 PUTRHW
   8 PUTLHW
   9 ISYSOP
  10 ISYSCALL
  11 TYPE-ENTRY
  12 T$TYPE-ENTRY
  13 T$FRAME
  14 MUD-CHAN
  15 ADECL
  16 CLASS
  17 HANDLER
  18 READ-INFO
  19 PCODE
  20 ZONE
  21 AREA
  22 MSUBR
  23 MCODE
  24 IMSUBR
  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
  27 GCSBOT GCSMIN GCSMAX
  28 GCSFLG ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY CURRENT-ZONE
  29 RCL RCLV
  30 NEW-CHANNEL-TYPE
  31 M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
  32 M$$TYSAT M$$TYOFF
  33 M$$FRM-MSUB
  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
  39 M$$INT-QUEUE
  40 M$$INT-LEVEL M$$INT-CLASSES
  41 M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT
  42 DB-NAME DB-CHANNEL DB
  43 MIN-NEW-SPACE
  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
  48 <ENDBLOCK>
  49
  50 ; "Read character types"
  51 <SETG M$$R-BREAK 0>
  52 <SETG M$$R-ESCAPE 1>
  53 <SETG M$$R-MIN-BRACK 2>
  54 <SETG M$$R-PAREN 2>
  55 <SETG M$$R-ANGLE 3>
  56 <SETG M$$R-SQUARE 4>
  57 <SETG M$$R-DOUBLE 5>
  58 <SETG M$$R-SQUIGGLE 6>
  59 <SETG M$$R-ENDBR 7>
  60 <SETG M$$R-MAX-BRACK 7>
  61 <SETG M$$R-EXCL 8>
  62 <SETG M$$R-SEMI 9>
  63 <SETG M$$R-SHARP 10>
  64 <SETG M$$R-COMMA 11>
  65 <SETG M$$R-PERCENT 12>
  66 <SETG M$$R-QUOTE 13>
  67 <SETG M$$R-MAX-ATM-BRK 13>
  68 <SETG M$$R-VERT 14>
  69 <SETG M$$R-BACKS 15>
  70 <SETG M$$R-ALPHA 16>
  71 <SETG M$$R-MIN-NUM-PART 17>
  72 <SETG M$$R-E 17>
  73 <SETG M$$R-DOT 18>
  74 <SETG M$$R-DIGIT 19>
  75 <SETG M$$R-PLUS 20>
  76 <SETG M$$R-STAR 21>
  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>
  83
  84 <GDECL (I$TRANS-TABLE) BYTES>
  85
  86 ; "PRINT's magic finite-state machine for atoms"
  87
  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>
  94
  95 <BLOCK (<ROOT>)>
  96
  97 <COND (<NOT <GASSIGNED? NEW-CHANNEL-TYPE>>
  98        <DEFINE NEW-CHANNEL-TYPE ("TUPLE" FOO) T>)>
  99 <SETG T$NEW-CHANNEL-TYPE ,NEW-CHANNEL-TYPE>
 100
 101 <NEWTYPE T$BITS FIX>
 102
 103 <PUTPROP ATOM ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
 104                                          <OR !<FALSE!> LBIND>
 105                                          STRING
 106                                          <OR OBLIST !<FALSE!>>
 107                                          <OR TYPE-C !<FALSE!>>>>
 108
 109 <DEFINE MY-LINK (OBJ STR OBL)
 110         <COND (<LOOKUP .STR .OBL><REMOVE .STR .OBL>)>
 111         <LINK .OBJ .STR .OBL>>
 112
 113 <MY-LINK ATOM "T$ATOM" <ROOT>>
 114
 115 <PUTPROP T$TYPE-C ALT-DECL TYPE-C>
 116
 117 <MY-LINK OBLIST "T$OBLIST" <ROOT>>
 118
 119 <PUTPROP LVAL ALT-DECL '<<PRIMTYPE ATOM> <OR !<FALSE!> GBIND>
 120                                          <OR !<FALSE!> LBIND>
 121                                          STRING
 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>
 126                                          <OR !<FALSE!> LBIND>
 127                                          STRING
 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>
 132                                            <OR !<FALSE!> LBIND>
 133                                            STRING
 134                                            <OR OBLIST !<FALSE!>>
 135                                            <OR TYPE-C !<FALSE!>>>>
 136
 137
 138 <PUTPROP LINK ALT-DECL '<<PRIMTYPE ATOM> GBIND
 139                                          <OR !<FALSE!> LBIND>
 140                                          STRING
 141                                          <OR OBLIST !<FALSE!>>
 142                                          <OR TYPE-C !<FALSE!>>>>
 143
 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>>
 152
 153
 154 <MY-LINK GBIND "T$GBIND" <ROOT>>
 155 <PUTPROP GBIND ALT-DECL '<<PRIMTYPE GBIND> ANY
 156                                            <OR ATOM LINK>
 157                                            <OR ATOM FORM !<FALSE!>>>>
 158
 159 <PUTPROP LBIND ALT-DECL '<<PRIMTYPE LBIND> ANY
 160                                            <OR ATOM LINK>
 161                                            <OR ATOM FORM !<FALSE!>>
 162                                            [2 <OR LBIND !<FALSE!>>]
 163                                            FIX>>
 164
 165
 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]>>
 172 <NEWTYPE T$MSUBR
 173          VECTOR
 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>
 179
 180 <SETG POBL (<MOBLIST INITIAL> <ROOT>)>
 181
 182 <DEFINE P-R (STR)
 183         <COND (<OR <LENGTH? .STR 2>
 184                    <AND <==? <1 .STR> !\T>
 185                         <==? <2 .STR> !\$>>>
 186                <PARSE .STR 10 ,POBL>)
 187               (T <PARSE <STRING "T$" .STR> 10 ,POBL>)>>
 188
 189 <SETG P-I ,P-R>
 190
 191 <DEFINE P-E (STR) <PARSE <STRING !\@ .STR> 10 ,POBL>>
 192
 193 <NEWTYPE T$UNBOUND FIX>
 194
 195 <ENDBLOCK>
 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"
 212
 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>
 215
 216 <BLOCK (<ROOT>)>
 217 <PUT-DECL T$BCHANNEL
 218          '<<PRIMTYPE VECTOR> FIX [3 STRING] [5 FIX] STRING [3 FIX]>>
 219 <ENDBLOCK>
 220
 221 <NEWTYPE I$SDTABLE VECTOR
 222          '!<<PRIMTYPE VECTOR> ATOM <OR FALSE ATOM <LIST [REST ATOM]>>
 223                               <LIST [REST ATOM <OR ATOM MSUBR FALSE>]>>>
 224 <SETG I$SDNAME 1>
 225 <SETG I$SD-INHERIT 2>
 226 <SETG I$SD-OPER 3>
 227 <MANIFEST I$SDNAME I$SD-INHERIT I$SD-OPER>
 228
 229 <NEWTYPE I$DISK-CHANNEL VECTOR>
 230
 231 <GDECL (I$CHANNEL-TYPES) <LIST [REST ATOM I$SDTABLE]>>
 232 <GDECL (T$DEVVEC) <VECTOR [REST FIX <OR ATOM VECTOR>]>>
 233
 234 <BLOCK (<ROOT>)>
 235
 236
 237
 238 <PUT-DECL CHANNEL '!<<PRIMTYPE VECTOR> ATOM
 239                                           <OR CHANNEL FALSE>
 240                                           <OR STRING FALSE>
 241                                           <OR ATOM FALSE>
 242                                           ANY
 243                                           ANY>>
 244 <MY-LINK CHANNEL "T$CHANNEL" <ROOT>>
 245
 246
 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"
 253
 254 <MANIFEST T$CHANNEL-TYPE T$CHANNEL-SCRIPT T$CHANNEL-NAME T$CHANNEL-OPEN?
 255           T$CHANNEL-DATA T$CHANNEL-USER>
 256
 257 <NEWTYPE T$MUD-CHAN VECTOR '!<<PRIMTYPE VECTOR>
 258                              [6 FIX]
 259                              <OR CHARACTER FALSE>
 260                              <OR FALSE FRAME>
 261                              FIX
 262                              FIX>>
 263 <PUT-DECL MUD-CHAN '!<<PRIMTYPE VECTOR>
 264                      [6 FIX]
 265                      <OR CHARACTER FALSE>
 266                      <OR FALSE FRAME>
 267                      FIX
 268                      FIX>>
 269
 270 <SETG T$MC-HLEN 1>
 271 <SETG T$MC-HPOS 2>
 272 <SETG T$MC-VLEN 3>
 273 <SETG T$MC-VPOS 4>
 274 <SETG T$MC-ORAD 5>
 275 <SETG T$MC-INTR 6>
 276 <SETG T$MC-NCHR 7>
 277 <SETG T$MC-FFRM 8>
 278 <SETG T$MC-BITS 9>
 279 <SETG T$MC-IRAD 10>
 280
 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
 285           T$BIT-INTELLIGENT>
 286
 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>
 295
 296 <SETG MC-HLEN 1>
 297 <SETG MC-HPOS 2>
 298 <SETG MC-VLEN 3>
 299 <SETG MC-VPOS 4>
 300 <SETG MC-ORAD 5>
 301 <SETG MC-BITS 9>
 302 <SETG MC-IRAD 10>
 303 <SETG BIT-ACCESS 1>
 304 <SETG BIT-INTELLIGENT 2>
 305 <MANIFEST MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-RADX BIT-ACCESS BIT-INTELLIGENT>
 306 <ENDBLOCK>
 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>
 312
 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."
 319
 320 <MANIFEST M$$PR-MAX M$$PR-TAB M$$PR-SIGD M$$PR-FRAD M$$PR-BUFL>
 321
 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]>>
 325
 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>
 330
 331 ;"Offsets for FRAME."
 332
 333 ;"More cretinous offsets"
 334
 335 <SETG M$$FRM-MSUB 1>
 336
 337 ;"The FRAME's MSUBR."
 338
 339 <SETG M$$FRM-PC 2>
 340
 341 ;"Unused - Saved PC"
 342
 343 <SETG M$$FRM-ARGN 3>
 344
 345 ;"Number of arguments"
 346
 347 <SETG M$$FRM-ID 4>
 348
 349 ;"FRAME Unique ID"
 350
 351 <SETG M$$FRM-PREV 5>
 352
 353 ;"The previous FRAME"
 354
 355 <SETG M$$FRM-TP 6>
 356
 357 ;"Unused - Saved TP"
 358
 359 <SETG M$$FRM-ARGS 6>
 360
 361 ;"We will hide <ARGS .FRAME> here in simulation"
 362
 363 <SETG M$$FRM-BIND 7>
 364
 365 ;"The FRAME's BINDing."
 366
 367 <SETG M$$FRM-ACTN 8>
 368
 369 ;"The FRAME's ACTIVATION."
 370
 371 <MANIFEST M$$FRM-MSUB
 372           M$$FRM-ARGN
 373           M$$FRM-ID
 374           M$$FRM-PREV
 375           M$$FRM-BIND
 376           M$$FRM-ARGS
 377           M$$FRM-ACTN
 378           M$$FRM-PC
 379           M$$FRM-TP>
 380
 381 <SETG M$$LVAL 2>
 382
 383 ;"ATOM - offset to LVAL binding"
 384
 385 <SETG M$$GVAL 1>
 386
 387 ;"ATOM - offset to GVAL binding"
 388
 389 <SETG M$$PNAM 3>
 390
 391 ;"ATOM - offset to PNAME string"
 392
 393 <SETG M$$OBLS 4>
 394
 395 ;"ATOM - offset to OBLIST (primtype ATOM)"
 396
 397 <SETG M$$TYPE 5>
 398
 399 ;"ATOM - valid type TYPE-C or FALSE"
 400
 401 <SETG M$$ATML 5>
 402
 403 ;"ATOM - length of block for atom"
 404
 405 <MANIFEST M$$LVAL M$$GVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML>
 406
 407 ;"Offsets for LBIND."
 408
 409 <SETG M$$VALU 1>
 410
 411 ;"BIND - value of this binding"
 412
 413 <SETG M$$ATOM 2>
 414
 415 ;"BIND - ATOM that this binding represent"
 416
 417 <SETG M$$DECL 3>
 418
 419 ;"BIND - this binding's DECL or FALSE if none"
 420
 421 <SETG M$$PBND 4>
 422
 423 ;"BIND - closest previous binding block for any atom"
 424
 425 <SETG M$$PATM 5>
 426
 427 ;"BIND - closest previous binding block for this atom"
 428
 429 <SETG M$$UBID 6>
 430
 431 ;"BIND - unique bind id for this binding block"
 432
 433 <SETG M$$BNDL 6>
 434
 435 ;"BIND - length of block for bind"
 436
 437 <MANIFEST M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL>
 438
 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."
 449
 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>
 452
 453 <NEWTYPE T$TYPE-ENTRY
 454          VECTOR
 455          '<<PRIMTYPE VECTOR> T$ATOM
 456                              T$ATOM
 457                              <OR APPLICABLE T$ATOM FALSE>
 458                              <OR APPLICABLE T$ATOM FALSE>
 459                              <OR APPLICABLE T$ATOM FALSE>
 460                              T$TYPE-C
 461                              <OR FALSE T$ATOM FORM SEGMENT>>>
 462
 463 <PUT-DECL TYPE-ENTRY
 464           '<<PRIMTYPE VECTOR> ATOM
 465                              ATOM
 466                              <OR APPLICABLE ATOM FALSE>
 467                              <OR APPLICABLE ATOM FALSE>
 468                              <OR APPLICABLE ATOM FALSE>
 469                              TYPE-C
 470                              <OR FALSE ATOM FORM SEGMENT>>>
 471
 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."
 479
 480 ;"Bit offset for TYPE-WORD slot."
 481
 482 <SETG M$$TYSAT 7>       ;"The first three bits are used for SAT."
 483 <SETG M$$TYOFF 6>       ;"Amount to LSH to get offset."
 484
 485 <MANIFEST M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
 486           M$$TYSAT M$$TYOFF>
 487
 488 ;"Definition for ADECL."
 489
 490 <NEWTYPE ADECL
 491          VECTOR
 492          '!<<PRIMTYPE VECTOR> [2 ANY]>>
 493
 494 <SETG M$$ADCL-VAL 1>    ;"The VALUE of the ADECL."
 495 <SETG M$$ADCL-DCL 2>    ;"The DECL of the ADECL."
 496
 497 ;"Definition for OFFSET."
 498
 499 <NEWTYPE T$OFFSET
 500          VECTOR
 501          '!<<PRIMTYPE VECTOR> FIX <OR T$ATOM FORM SEGMENT>
 502                               <OR T$ATOM FORM SEGMENT FALSE>>>
 503
 504 <SETG M$$OFF-FIX 1>
 505 <SETG M$$OFF-DCL 2>
 506 <SETG M$$OFF-ELT 3>
 507
 508 <MANIFEST M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT>
 509
 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
 518                                                          T$ATOM>]>>>]>
 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]>
 531        (M$$INITIAL-TYPES)
 532        <VECTOR [REST <VECTOR [2 STRING]
 533                              FIX
 534                              STRING
 535                              <OR FALSE FIX>>]>
 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)
 539        <VECTOR [REST ATOM]>
 540        (M$$FREE-FRAMES M$$FRAMES) <LIST [REST T$FRAME]>
 541        (M$$FRAME-ID) FIX
 542        (M$$LBIND) <OR FALSE T$LBIND>
 543        (M$$STRUCTURED) <VECTOR [REST ATOM]>
 544        (M$$RHI M$$RLOW I$MINFX I$MAXFX) FIX>
 545
 546 ;"Manifest GVALs for APPLY"
 547
 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."
 553
 554 <MANIFEST M$$F-PROG M$$F-BIND M$$F-REPEAT M$$F-APPLY M$$F-EVAL>
 555
 556
 557 <SETG M$$TYPE-INFO-SIZE 1024>
 558
 559 <MANIFEST M$$TYPE-INFO-SIZE>
 560
 561 ;"Offsets for MSUBR."
 562
 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."
 566
 567 <MANIFEST M$$MSB-CODE M$$MSB-NAME M$$MSB-DECL>
 568
 569 <GDECL (M$$INT-LEVEL) FIX
 570        (M$$INT-CLASSES) <OR CLASS FALSE>>
 571
 572 <NEWTYPE CLASS
 573          VECTOR
 574          '<<PRIMTYPE VECTOR> STRING
 575                              <OR T$ATOM FALSE>
 576                              <OR T$HANDLER FALSE>
 577                              <OR FIX FALSE>
 578                              FIX>>
 579
 580 <SETG M$$C-NAME 1>
 581 <SETG M$$C-ENABLE 2>
 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>
 586
 587 <SETG M$$INFINT 19>
 588 <SETG M$$IOINT 32>
 589 <SETG M$$URGINT 33>
 590 <SETG M$$PIPEINT 34>
 591 <SETG M$$CONTINT 35>
 592 <MANIFEST M$$INFINT M$$CONTINT M$$PIPEINT M$$URGINT M$$IOINT>
 593
 594 <NEWTYPE T$HANDLER
 595          VECTOR
 596          '<<PRIMTYPE VECTOR> CLASS
 597                              <OR APPLICABLE T$FUNCTION>
 598                              FIX
 599                              ANY
 600                              <OR FALSE T$HANDLER>>>
 601
 602 <SETG M$$H-CLASS 1>
 603 <SETG M$$H-FUNCTION 2>
 604 <SETG M$$H-PRIORITY 3>
 605 <SETG M$$H-ARG 4>
 606 <SETG M$$H-NEXT 5>
 607
 608 <MANIFEST M$$H-CLASS M$$H-FUNCTION M$$H-PRIORITY M$$H-ARG M$$H-NEXT>
 609
 610 <GDECL (M$$INT-QUEUE) <LIST ATOM [REST FIX LIST LIST]>
 611        (M$$INT-CLASSES) <VECTOR [REST <OR FALSE CLASS>]>
 612        (M$$INT-LEVEL) FIX
 613        (M$$EVALCLASS M$$CREATECLASS) CLASS>
 614
 615 ;"Some offsets for ASSOCIATIONs."
 616 <SETG M$$AS-ITEM 1>
 617 <SETG M$$AS-INDIC 2>
 618 <SETG M$$AS-VALUE 3>
 619 <MANIFEST M$$AS-ITEM M$$AS-INDIC M$$AS-VALUE>
 620
 621 ;"***************************************************************
 622   *             Some OFFSETs used in TEMPLATE                   *
 623   ***************************************************************"
 624
 625 ;"NOTE: The following notation is used -
 626         TDT     - Template Data Table
 627         TAT     - Template Access Table
 628         DT      - Discriminant Table
 629         TT      - Temporary Table
 630         ET      - Element Table
 631         PT      - Position Table."
 632
 633 ;"ATOMs in <ROOT> that are used by TEMPLATE:
 634   ANY, BOOLEAN, ENUM, FIX, SBOOL, STRUC."
 635
 636 ;"Newtype for the Template Access Table (TAT)."
 637 <PUT-DECL PT-DECL '<VECTOR TYPE-C [3 FIX]>>
 638
 639 <PUT-DECL ET-DECL
 640          '<VECTOR ATOM <OR ATOM FORM> [2 FIX] [OPTIONAL <OR FIX VECTOR>]>>
 641
 642 <PUT-DECL TT-DECL '<VECTOR ET-DECL [OPTIONAL PT-DECL PT-DECL]>>
 643
 644 <PUT-DECL DT-DECL '<VECTOR [2 FIX] [REST ET-DECL]>>
 645
 646 <NEWTYPE TAT
 647          VECTOR
 648          '<<PRIMTYPE VECTOR> ATOM FORM [3 FIX] VECTOR [REST DT-DECL]>>
 649
 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 <>>>
 653
 654 <GDECL (M$$R-TAT) <VECTOR [REST <OR FALSE TAT>]>
 655        (M$$R-TDT) <VECTOR [REST <OR FALSE UVECTOR>]>>
 656
 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"
 670
 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>
 673
 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."
 683
 684 <MANIFEST M$$R-TNAM M$$R-TDCL M$$R-TTYP M$$R-TLNT M$$R-TLOC M$$R-TDIS
 685           M$$R-TSDT M$$R-TDTA>
 686
 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."
 691
 692 <MANIFEST M$$R-DLNT M$$R-DWRD M$$R-DATA>
 693
 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."
 702
 703 <MANIFEST M$$R-EOFF M$$R-EDCL M$$R-EFLG M$$R-EELE M$$R-ESBL M$$R-ESLN
 704           M$$R-EVEC>
 705
 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."
 711
 712 <MANIFEST M$$R-PTYP M$$R-PBIT M$$R-PLOC M$$R-PLNT>
 713
 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."
 719
 720 <MANIFEST M$$R-FCNT M$$R-FPTR M$$R-STLN M$$R-FULL>
 721
 722 ;"Number of bits in a byte, half-word and word. -- Replaced to be computed
 723         at run time"
 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"
 735
 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"
 739
 740 <MANIFEST M$$EXCALT M$$CNCLSQBK M$$CHR-CHR M$$CHR-ASC M$$CHR-BRK
 741           M$$CHR-APL M$$CHR-PRE>
 742
 743 '<GDECL (I$READ-TABLE) <OR FALSE <VECTOR [REST <OR FALSE VECTOR>]>>>
 744
 745 <GDECL (I$MACHINE-INFO) !<UVECTOR [10 FIX]>>
 746
 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"
 757
 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>
 761
 762 <PUTPROP I$SEG-EVAL FRAME T>
 763
 764 <PUTPROP T$EVAL FRAME T>
 765
 766 <PUTPROP T$PRINT-OUTPUT-BUFFER FRAME T>
 767
 768 <PUTPROP T$READ-INPUT-BUFFER FRAME T>
 769
 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"
 778 <SETG I$TBUFFER 9>
 779 <MANIFEST I$READ-TABLE I$RDCONT I$CHANNEL I$RADIX I$POINT
 780           I$RDBUFFER I$RDCT I$RDACC I$SAVCHR I$TBUFFER>
 781
 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>>>>
 786 <SETG RI-CHANNEL 3>
 787 <MANIFEST RI-CHANNEL>
 788
 789
 790 ; "Stuff for MAPPUR and friends"
 791
 792 <NEWTYPE T$PCODE UVECTOR '<<PRIMTYPE UVECTOR> [5 FIX]>>
 793 <PUT-DECL PCODE '<<PRIMTYPE UVECTOR> [5 FIX]>>
 794
 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
 803           M$$PC-ENTLEN>
 804
 805 ; "Needed here for BOOT to compile"
 806 <SETG DB-NAME 1>
 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>>>)>
 811
 812 <MANIFEST DB-NAME DB-CHANNEL>
 813
 814 <GDECL (T$PSIZE T$CHARS-WD T$BYTES-WD) FIX>
 815
 816 <BLOCK (<ROOT>)>
 817
 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]>>>>
 823 <PUT-DECL ZONE
 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]>>>>
 828 <SETG GC-PARAMS 1>
 829 <SETG GC-FCN 2>
 830 <SETG MOVE-FCN 3>
 831 <SETG GROW-FCN 4>
 832 <SETG ZONE-ID 5>
 833 <SETG ALL-SPACES 6>
 834 <SETG GC-CTL 7>
 835 <MANIFEST GC-PARAMS GC-FCN MOVE-FCN GROW-FCN ZONE-ID ALL-SPACES GC-CTL>
 836
 837 <SETG GCC-MIN-SPACE 1>
 838 <SETG GCC-MS-FREQ 2>
 839 <SETG GCC-MS-CT 3>
 840 <MANIFEST GCC-MIN-SPACE GCC-MS-FREQ GCC-MS-CT>
 841
 842 <NEWTYPE T$GC-PARAMS UVECTOR '<<PRIMTYPE UVECTOR> [16 FIX]>>
 843 <PUT-DECL GC-PARAMS '<<PRIMTYPE UVECTOR> [16 FIX] [REST FIX]>>
 844
 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>
 854
 855 <NEWTYPE T$AREA UVECTOR '<<PRIMTYPE UVECTOR> [4 FIX]>>
 856 <PUT-DECL AREA '<<PRIMTYPE UVECTOR> [4 FIX]>>
 857 <SETG ABOT 1>
 858 <SETG AMIN 2>
 859 <SETG AMAX 3>
 860 <SETG AFLGS 4>
 861 <SETG AF-EXTRA 1>
 862 <SETG AF-READ-ONLY 2>
 863 <MANIFEST ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY>
 864
 865 <GDECL (T$CURRENT-ZONE) T$ZONE (I$ZONE-LIST) <LIST [REST T$ZONE]>
 866        (I$ALL-ZONES) <VECTOR [REST <OR FALSE T$ZONE>]>>
 867
 868 <GDECL (I$LENGTH-GC-PARAMS I$LH-MASK I$RH-MASK T$MIN-NEW-SPACE
 869         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>
 872
 873
 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>
 880 <ENDBLOCK>
 881 <DEFMAC ISYSOP (NAME "ARGS" STUFF)
 882   <COND (<AND <TYPE? .NAME ATOM>
 883               <MEMBER <SPNAME .NAME> '["BIN" "WAIT" "DISMS"]>>
 884          <FORM BIND (VAL)
 885            <FORM CALL SETS RUNINT -1>
 886            <FORM SET VAL <FORM CALL SYSOP .NAME !.STUFF>>
 887            <FORM CALL SETS RUNINT 0>
 888            '.VAL>)
 889         (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSOP>)>>
 890
 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"]>>
 897          <FORM BIND (VAL)
 898            <FORM CALL SETS RUNINT -1>
 899            <FORM SET VAL <FORM CALL SYSCALL .NAME !.STUFF>>
 900            <FORM CALL SETS RUNINT 0>
 901            '.VAL>)
 902         (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSCALL>)>>
 903
 904 <DEFMAC M$$NO-SAVCHR () '<CHTYPE -1 CHARACTER>>
 905
 906 <DEFMAC RHW ('WD)
 907   <FORM
 908    IFSYS ("TOPS20"
 909           <FORM GETBITS .WD <FORM BITS 18 0>>)
 910          ("UNIX"
 911           <FORM GETBITS .WD <FORM BITS 16 0>>)>>
 912 <DEFMAC LHW ('WD)
 913   <FORM IFSYS
 914         ("TOPS20"
 915          <FORM GETBITS .WD <FORM BITS 18 18>>)
 916         ("UNIX"
 917          <FORM GETBITS .WD <FORM BITS 16 16>>)>>
 918 <DEFMAC PUTRHW ('WD 'NEW)
 919   <FORM IFSYS
 920         ("TOPS20"
 921          <FORM PUTBITS .WD <FORM BITS 18 0> .NEW>)
 922         ("UNIX"
 923          <FORM PUTBITS .WD <FORM BITS 16 0> .NEW>)>>
 924 <DEFMAC PUTLHW ('WD 'NEW)
 925   <FORM IFSYS
 926         ("TOPS20"
 927          <FORM PUTBITS .WD <FORM BITS 18 18> .NEW>)
 928         ("UNIX"
 929          <FORM PUTBITS .WD <FORM BITS 16 16> .NEW>)>>
 930 <DEFMAC PAGE-ADDRESS ('PAGENO)
 931   <FORM IFSYS
 932         ("TOPS20"
 933          <FORM * .PAGENO 512>)
 934         ("UNIX"
 935          <FORM * .PAGENO 1024>)>>
 936 <DEFMAC ADDRESS-PAGE ('ADDR)
 937   <FORM IFSYS
 938         ("TOPS20"
 939          <FORM LSH .ADDR -9>)
 940         ("UNIX"
 941          <FORM LSH .ADDR -10>)>>
 942 <GDECL (I$ATM-FSM) VECTOR>