mim/development/mim/boot/boot.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$ATOM
  14 T$FRAME
  15 MUD-CHAN
  16 ADECL
  17 CLASS
  18 HANDLER
  19 READ-INFO
  20 PCODE
  21 ZONE
  22 AREA
  23 MSUBR
  24 MCODE
  25 IMSUBR
  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
  28 GCSBOT GCSMIN GCSMAX
  29 GCSFLG ABOT AMIN AMAX AFLGS AF-EXTRA AF-READ-ONLY CURRENT-ZONE
  30 RCL RCLV
  31 NEW-CHANNEL-TYPE
  32 M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
  33 M$$TYSAT M$$TYOFF
  34 M$$FRM-MSUB
  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
  39 M$$INFINT M$$CONTINT
  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
  43 DB-NAME DB-CHANNEL DB
  44 MIN-NEW-SPACE
  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
  49 <ENDBLOCK>
  50
  51 ; "Read character types"
  52 <SETG M$$R-BREAK 0>
  53 <SETG M$$R-ESCAPE 1>
  54 <SETG M$$R-MIN-BRACK 2>
  55 <SETG M$$R-PAREN 2>
  56 <SETG M$$R-ANGLE 3>
  57 <SETG M$$R-SQUARE 4>
  58 <SETG M$$R-DOUBLE 5>
  59 <SETG M$$R-SQUIGGLE 6>
  60 <SETG M$$R-ENDBR 7>
  61 <SETG M$$R-MAX-BRACK 7>
  62 <SETG M$$R-EXCL 8>
  63 <SETG M$$R-SEMI 9>
  64 <SETG M$$R-SHARP 10>
  65 <SETG M$$R-COMMA 11>
  66 <SETG M$$R-PERCENT 12>
  67 <SETG M$$R-QUOTE 13>
  68 <SETG M$$R-MAX-ATM-BRK 13>
  69 <SETG M$$R-VERT 14>
  70 <SETG M$$R-BACKS 15>
  71 <SETG M$$R-ALPHA 16>
  72 <SETG M$$R-MIN-NUM-PART 17>
  73 <SETG M$$R-E 17>
  74 <SETG M$$R-DOT 18>
  75 <SETG M$$R-DIGIT 19>
  76 <SETG M$$R-PLUS 20>
  77 <SETG M$$R-STAR 21>
  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>
  84
  85 <GDECL (I$TRANS-TABLE) BYTES>
  86
  87 ; "PRINT's magic finite-state machine for atoms"
  88
  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>
  95
  96 <BLOCK (<ROOT>)>
  97
  98 <COND (<NOT <GASSIGNED? NEW-CHANNEL-TYPE>>
  99        <DEFINE NEW-CHANNEL-TYPE ("TUPLE" FOO) T>)>
 100 <SETG T$NEW-CHANNEL-TYPE ,NEW-CHANNEL-TYPE>
 101
 102 <NEWTYPE T$BITS WORD>
 103
 104 <NEWTYPE T$ATOM TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
 105                                                <OR FALSE T$LBIND>
 106                                                STRING
 107                                                <OR T$OBLIST FALSE>
 108                                                <OR T$TYPE-C FALSE>>>
 109 <PUTPROP T$ATOM ALT-DECL ATOM>
 110
 111 <PUTPROP T$LINK ALT-DECL LINK>
 112
 113 <PUTPROP T$TYPE-C ALT-DECL TYPE-C>
 114
 115 <NEWTYPE LVAL TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
 116                                                <OR FALSE T$LBIND>
 117                                                STRING
 118                                                <OR T$OBLIST FALSE>
 119                                                <OR T$TYPE-C FALSE>>>
 120 <NEWTYPE T$LVAL T$ATOM>
 121 <NEWTYPE GVAL TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
 122                                                <OR FALSE T$LBIND>
 123                                                STRING
 124                                                <OR T$OBLIST FALSE>
 125                                                <OR T$TYPE-C FALSE>>>
 126 <NEWTYPE T$GVAL T$ATOM>
 127 <NEWTYPE T$OBLIST TEMPLATE '<<PRIMTYPE TEMPLATE> <OR FALSE T$GBIND>
 128                                                  <OR FALSE T$LBIND>
 129                                                  STRING
 130                                                  <OR T$OBLIST FALSE>
 131                                                  <OR T$TYPE-C FALSE>>>
 132 <NEWTYPE T$LINK TEMPLATE '<<PRIMTYPE TEMPLATE> T$GBIND
 133                                                  <OR FALSE T$LBIND>
 134                                                  STRING
 135                                                  <OR T$OBLIST FALSE>
 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>
 141 <NEWTYPE T$FRAME
 142          TEMPLATE
 143          '<<PRIMTYPE TEMPLATE> T$MSUBR>>
 144 <NEWTYPE T$LBIND
 145          TEMPLATE
 146          '<<PRIMTYPE TEMPLATE> ANY
 147                              <OR T$ATOM T$LINK>
 148                              <OR T$ATOM FORM FALSE>
 149                              [2 <OR T$LBIND FALSE>]
 150                              FIX>>
 151
 152
 153 <NEWTYPE T$GBIND
 154          TEMPLATE
 155          '<<PRIMTYPE TEMPLATE> ANY
 156                              <OR T$ATOM T$LINK>
 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>
 162
 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]>>
 168 <NEWTYPE T$MSUBR
 169          VECTOR
 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>
 175
 176 <SETG POBL (<GET INITIAL OBLIST> <ROOT>)>
 177
 178 <DEFINE P-R (STR)
 179         <COND (<OR <LENGTH? .STR 2>
 180                    <AND <==? <1 .STR> !\T>
 181                         <==? <2 .STR> !\$>>>
 182                <PARSE .STR 10 ,POBL>)
 183               (T <PARSE <STRING "T$" .STR> 10 ,POBL>)>>
 184
 185 <SETG P-I ,P-R>
 186
 187 <DEFINE P-E (STR) <PARSE <STRING !\@ .STR> 10 ,POBL>>
 188
 189 <NEWTYPE T$UNBOUND FIX>
 190
 191 <PUTPROP ATOM DECL T$ATOM>
 192
 193 <ENDBLOCK>
 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"
 210
 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>
 213
 214 <BLOCK (<ROOT>)>
 215 <PUTPROP T$BCHANNEL DECL
 216          '<<PRIMTYPE VECTOR> FIX [3 STRING] [5 FIX] STRING [3 FIX]>>
 217 <ENDBLOCK>
 218
 219 <NEWTYPE I$SDTABLE VECTOR
 220          '!<<PRIMTYPE VECTOR> ATOM <OR FALSE ATOM <LIST [REST ATOM]>>
 221                               <LIST [REST ATOM <OR ATOM MSUBR FALSE>]>>>
 222 <SETG I$SDNAME 1>
 223 <SETG I$SD-INHERIT 2>
 224 <SETG I$SD-OPER 3>
 225 <MANIFEST I$SDNAME I$SD-INHERIT I$SD-OPER>
 226
 227 <NEWTYPE I$DISK-CHANNEL VECTOR>
 228
 229 <GDECL (I$CHANNEL-TYPES) <LIST [REST ATOM I$SDTABLE]>>
 230 <GDECL (T$DEVVEC) <VECTOR [REST FIX <OR ATOM VECTOR>]>>
 231
 232 <BLOCK (<ROOT>)>
 233
 234 <NEWTYPE T$CHANNEL VECTOR '!<<PRIMTYPE VECTOR>
 235                              ATOM
 236                              <OR T$CHANNEL FALSE>
 237                              <OR STRING FALSE>
 238                              <OR ATOM FALSE>
 239                              ANY
 240                              ANY>>
 241
 242 <PUTPROP CHANNEL DECL '!<<PRIMTYPE VECTOR> ATOM
 243                                           <OR CHANNEL FALSE>
 244                                           <OR STRING FALSE>
 245                                           <OR ATOM FALSE>
 246                                           ANY
 247                                           ANY>>
 248
 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"
 255
 256 <MANIFEST T$CHANNEL-TYPE T$CHANNEL-SCRIPT T$CHANNEL-NAME T$CHANNEL-OPEN?
 257           T$CHANNEL-DATA T$CHANNEL-USER>
 258
 259 <NEWTYPE T$MUD-CHAN VECTOR '!<<PRIMTYPE VECTOR>
 260                              [6 FIX]
 261                              <OR CHARACTER FALSE>
 262                              <OR FALSE FRAME>
 263                              FIX
 264                              FIX>>
 265 <PUT MUD-CHAN DECL '!<<PRIMTYPE VECTOR>
 266                      [6 FIX]
 267                      <OR CHARACTER FALSE>
 268                      <OR FALSE FRAME>
 269                      FIX
 270                      FIX>>
 271
 272 <SETG T$MC-HLEN 1>
 273 <SETG T$MC-HPOS 2>
 274 <SETG T$MC-VLEN 3>
 275 <SETG T$MC-VPOS 4>
 276 <SETG T$MC-ORAD 5>
 277 <SETG T$MC-INTR 6>
 278 <SETG T$MC-NCHR 7>
 279 <SETG T$MC-FFRM 8>
 280 <SETG T$MC-BITS 9>
 281 <SETG T$MC-IRAD 10>
 282
 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
 287           T$BIT-INTELLIGENT>
 288
 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>
 297
 298 <SETG MC-HLEN 1>
 299 <SETG MC-HPOS 2>
 300 <SETG MC-VLEN 3>
 301 <SETG MC-VPOS 4>
 302 <SETG MC-ORAD 5>
 303 <SETG MC-BITS 9>
 304 <SETG MC-IRAD 10>
 305 <SETG BIT-ACCESS 1>
 306 <SETG BIT-INTELLIGENT 2>
 307 <MANIFEST MC-HLEN MC-HPOS MC-VLEN MC-VPOS MC-RADX BIT-ACCESS BIT-INTELLIGENT>
 308 <ENDBLOCK>
 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>
 314
 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."
 321
 322 <MANIFEST M$$PR-MAX M$$PR-TAB M$$PR-SIGD M$$PR-FRAD M$$PR-BUFL>
 323
 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]>>
 327
 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>
 332
 333 ;"Offsets for FRAME."
 334
 335 ;"More cretinous offsets"
 336
 337 <SETG M$$FRM-MSUB 1>
 338
 339 ;"The FRAME's MSUBR."
 340
 341 <SETG M$$FRM-PC 2>
 342
 343 ;"Unused - Saved PC"
 344
 345 <SETG M$$FRM-ARGN 3>
 346
 347 ;"Number of arguments"
 348
 349 <SETG M$$FRM-ID 4>
 350
 351 ;"FRAME Unique ID"
 352
 353 <SETG M$$FRM-PREV 5>
 354
 355 ;"The previous FRAME"
 356
 357 <SETG M$$FRM-TP 6>
 358
 359 ;"Unused - Saved TP"
 360
 361 <SETG M$$FRM-ARGS 6>
 362
 363 ;"We will hide <ARGS .FRAME> here in simulation"
 364
 365 <SETG M$$FRM-BIND 7>
 366
 367 ;"The FRAME's BINDing."
 368
 369 <SETG M$$FRM-ACTN 8>
 370
 371 ;"The FRAME's ACTIVATION."
 372
 373 <MANIFEST M$$FRM-MSUB
 374           M$$FRM-ARGN
 375           M$$FRM-ID
 376           M$$FRM-PREV
 377           M$$FRM-BIND
 378           M$$FRM-ARGS
 379           M$$FRM-ACTN
 380           M$$FRM-PC
 381           M$$FRM-TP>
 382
 383 <SETG M$$LVAL 2>
 384
 385 ;"ATOM - offset to LVAL binding"
 386
 387 <SETG M$$GVAL 1>
 388
 389 ;"ATOM - offset to GVAL binding"
 390
 391 <SETG M$$PNAM 3>
 392
 393 ;"ATOM - offset to PNAME string"
 394
 395 <SETG M$$OBLS 4>
 396
 397 ;"ATOM - offset to OBLIST (primtype ATOM)"
 398
 399 <SETG M$$TYPE 5>
 400
 401 ;"ATOM - valid type TYPE-C or FALSE"
 402
 403 <SETG M$$ATML 5>
 404
 405 ;"ATOM - length of block for atom"
 406
 407 <MANIFEST M$$LVAL M$$GVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML>
 408
 409 ;"Offsets for LBIND."
 410
 411 <SETG M$$VALU 1>
 412
 413 ;"BIND - value of this binding"
 414
 415 <SETG M$$ATOM 2>
 416
 417 ;"BIND - ATOM that this binding represent"
 418
 419 <SETG M$$DECL 3>
 420
 421 ;"BIND - this binding's DECL or FALSE if none"
 422
 423 <SETG M$$PBND 4>
 424
 425 ;"BIND - closest previous binding block for any atom"
 426
 427 <SETG M$$PATM 5>
 428
 429 ;"BIND - closest previous binding block for this atom"
 430
 431 <SETG M$$UBID 6>
 432
 433 ;"BIND - unique bind id for this binding block"
 434
 435 <SETG M$$BNDL 6>
 436
 437 ;"BIND - length of block for bind"
 438
 439 <MANIFEST M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL>
 440
 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."
 451
 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>
 454
 455 <NEWTYPE T$TYPE-ENTRY
 456          VECTOR
 457          '<<PRIMTYPE VECTOR> T$ATOM
 458                              T$ATOM
 459                              <OR APPLICABLE T$ATOM FALSE>
 460                              <OR APPLICABLE T$ATOM FALSE>
 461                              <OR APPLICABLE T$ATOM FALSE>
 462                              T$TYPE-C
 463                              <OR FALSE T$ATOM FORM SEGMENT>>>
 464
 465 <PUTPROP TYPE-ENTRY
 466          DECL
 467          '<<PRIMTYPE VECTOR> ATOM
 468                              ATOM
 469                              <OR APPLICABLE ATOM FALSE>
 470                              <OR APPLICABLE ATOM FALSE>
 471                              <OR APPLICABLE ATOM FALSE>
 472                              TYPE-C
 473                              <OR FALSE ATOM FORM SEGMENT>>>
 474
 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."
 482
 483 ;"Bit offset for TYPE-WORD slot."
 484
 485 <SETG M$$TYSAT 7>       ;"The first three bits are used for SAT."
 486 <SETG M$$TYOFF 6>       ;"Amount to LSH to get offset."
 487
 488 <MANIFEST M$$NTYPE M$$PTYPE M$$APPLY M$$NEVAL M$$PRINT M$$TYWRD M$$TDECL
 489           M$$TYSAT M$$TYOFF>
 490
 491 ;"Definition for ADECL."
 492
 493 <NEWTYPE ADECL
 494          VECTOR
 495          '!<<PRIMTYPE VECTOR> [2 ANY]>>
 496
 497 <SETG M$$ADCL-VAL 1>    ;"The VALUE of the ADECL."
 498 <SETG M$$ADCL-DCL 2>    ;"The DECL of the ADECL."
 499
 500 ;"Definition for OFFSET."
 501
 502 <NEWTYPE T$OFFSET
 503          VECTOR
 504          '!<<PRIMTYPE VECTOR> FIX <OR T$ATOM FORM SEGMENT>
 505                               <OR T$ATOM FORM SEGMENT FALSE>>>
 506
 507 <SETG M$$OFF-FIX 1>
 508 <SETG M$$OFF-DCL 2>
 509 <SETG M$$OFF-ELT 3>
 510
 511 <MANIFEST M$$OFF-FIX M$$OFF-DCL M$$OFF-ELT>
 512
 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
 521                                                          T$ATOM>]>>>]>
 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]>
 534        (M$$INITIAL-TYPES)
 535        <VECTOR [REST <VECTOR [2 STRING]
 536                              FIX
 537                              STRING
 538                              <OR FALSE FIX>>]>
 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)
 542        <VECTOR [REST ATOM]>
 543        (M$$FREE-FRAMES M$$FRAMES) <LIST [REST T$FRAME]>
 544        (M$$FRAME-ID) FIX
 545        (M$$LBIND) <OR FALSE T$LBIND>
 546        (M$$STRUCTURED) <VECTOR [REST ATOM]>
 547        (M$$RHI M$$RLOW I$MINFX I$MAXFX) FIX>
 548
 549 ;"Manifest GVALs for APPLY"
 550
 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."
 556
 557 <MANIFEST M$$F-PROG M$$F-BIND M$$F-REPEAT M$$F-APPLY M$$F-EVAL>
 558
 559
 560 <SETG M$$TYPE-INFO-SIZE 1024>
 561
 562 <MANIFEST M$$TYPE-INFO-SIZE>
 563
 564 ;"Offsets for MSUBR."
 565
 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."
 569
 570 <MANIFEST M$$MSB-CODE M$$MSB-NAME M$$MSB-DECL>
 571
 572 <GDECL (M$$INT-LEVEL) FIX
 573        (M$$INT-CLASSES) <OR CLASS FALSE>>
 574
 575 <NEWTYPE CLASS
 576          VECTOR
 577          '<<PRIMTYPE VECTOR> STRING
 578                              <OR T$ATOM FALSE>
 579                              <OR T$HANDLER FALSE>
 580                              <OR FIX FALSE>
 581                              FIX>>
 582
 583 <SETG M$$C-NAME 1>
 584 <SETG M$$C-ENABLE 2>
 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>
 589
 590 <SETG M$$INFINT 19>
 591 <SETG M$$CONTINT 35>
 592 <MANIFEST M$$INFINT M$$CONTINT>
 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) 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 <PUTPROP PT-DECL DECL '<VECTOR TYPE-C [3 FIX]>>
 638
 639 <PUTPROP ET-DECL
 640          DECL
 641          '<VECTOR ATOM <OR ATOM FORM> [2 FIX] [OPTIONAL <OR FIX VECTOR>]>>
 642
 643 <PUTPROP TT-DECL DECL '<VECTOR ET-DECL [OPTIONAL PT-DECL PT-DECL]>>
 644
 645 <PUTPROP DT-DECL DECL '<VECTOR [2 FIX] [REST ET-DECL]>>
 646
 647 <NEWTYPE TAT
 648          VECTOR
 649          '<<PRIMTYPE VECTOR> ATOM FORM [3 FIX] VECTOR [REST DT-DECL]>>
 650
 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 <>>>
 654
 655 <GDECL (M$$R-TAT) <VECTOR [REST <OR FALSE TAT>]>
 656        (M$$R-TDT) <VECTOR [REST <OR FALSE UVECTOR>]>>
 657
 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"
 671
 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>
 674
 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."
 684
 685 <MANIFEST M$$R-TNAM M$$R-TDCL M$$R-TTYP M$$R-TLNT M$$R-TLOC M$$R-TDIS
 686           M$$R-TSDT M$$R-TDTA>
 687
 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."
 692
 693 <MANIFEST M$$R-DLNT M$$R-DWRD M$$R-DATA>
 694
 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."
 703
 704 <MANIFEST M$$R-EOFF M$$R-EDCL M$$R-EFLG M$$R-EELE M$$R-ESBL M$$R-ESLN
 705           M$$R-EVEC>
 706
 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."
 712
 713 <MANIFEST M$$R-PTYP M$$R-PBIT M$$R-PLOC M$$R-PLNT>
 714
 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."
 720
 721 <MANIFEST M$$R-FCNT M$$R-FPTR M$$R-STLN M$$R-FULL>
 722
 723 ;"Number of bits in a byte, half-word and word. -- Replaced to be computed
 724         at run time"
 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"
 736
 737 <SETG M$$EXCALT *1033*> ;"!$"
 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 [7 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 <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>>>>
 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 <PUTPROP PCODE DECL '<<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 <PUTPROP ZONE DECL
 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 <PUTPROP GC-PARAMS DECL '<<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 <PUTPROP AREA DECL '<<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> '["WRITE" "SELECT" "READ" "WAIT" "SIGPAUSE"]>>
 894          <FORM BIND (VAL)
 895            <FORM CALL SETS RUNINT -1>
 896            <FORM SET VAL <FORM CALL SYSCALL .NAME !.STUFF>>
 897            <FORM CALL SETS RUNINT 0>
 898            '.VAL>)
 899         (<ERROR CANT-ENABLE-INTERRUPTS .NAME ISYSCALL>)>>
 900
 901 <DEFMAC M$$NO-SAVCHR () '<CHTYPE -1 CHARACTER>>
 902
 903 <DEFMAC RHW ('WD)
 904   <FORM
 905    IFSYS ("TOPS20"
 906           <FORM GETBITS .WD <FORM BITS 18 0>>)
 907          ("UNIX"
 908           <FORM GETBITS .WD <FORM BITS 16 0>>)>>
 909 <DEFMAC LHW ('WD)
 910   <FORM IFSYS
 911         ("TOPS20"
 912          <FORM GETBITS .WD <FORM BITS 18 18>>)
 913         ("UNIX"
 914          <FORM GETBITS .WD <FORM BITS 16 16>>)>>
 915 <DEFMAC PUTRHW ('WD 'NEW)
 916   <FORM IFSYS
 917         ("TOPS20"
 918          <FORM PUTBITS .WD <FORM BITS 18 0> .NEW>)
 919         ("UNIX"
 920          <FORM PUTBITS .WD <FORM BITS 16 0> .NEW>)>>
 921 <DEFMAC PUTLHW ('WD 'NEW)
 922   <FORM IFSYS
 923         ("TOPS20"
 924          <FORM PUTBITS .WD <FORM BITS 18 18> .NEW>)
 925         ("UNIX"
 926          <FORM PUTBITS .WD <FORM BITS 16 16> .NEW>)>>
 927 <DEFMAC PAGE-ADDRESS ('PAGENO)
 928   <FORM IFSYS
 929         ("TOPS20"
 930          <FORM * .PAGENO 512>)
 931         ("UNIX"
 932          <FORM LSH <FORM * .PAGENO 256> 2>)>>
 933 <DEFMAC ADDRESS-PAGE ('ADDR)
 934   <FORM IFSYS
 935         ("TOPS20"
 936          <FORM / .ADDR 512>)
 937         ("UNIX"
 938          <FORM LSH <FORM / .ADDR 256> -2>)>>