<mdl.int>/muddle.mid.346

   1 ; THE FOLLOWING INFORMATION IS MEANT AS GUIDE TO THE CARE AND FEEDING
   2 ; OF MUDDLE.  IT ATTEMPTS TO SPECIFY PROGRAMMING CONVENTIONS AND
   3 ; SUPPLY SYMBOLS AND MACROS NEEDED BY ALL MODULES IN A MUDDLE.
   4
   5 ; FOR EFFICIENCY THE STANDARD MODE OF RUNNING IS UNINTERRUPTABLE.
   6 ; WITH EXPLICIT CHECKS FOR PENDING INTERRUPTS.  THE INTGO MACRO
   7 ; PERFORMS THE APPROPRIATE CHECK
   8
   9 ; FOR INTERRUPTS TO WORK IN INTERRUPTABLE CODE, IT MUST
  10 ; BE ABSOLUTELY PURE.  BETWEEN ANY TWO INSTRUCTIONS OF
  11 ; INTERRUPTABLE CODE THERE MAY BE AN INTERUPT IN WHICH
  12 ; A COMPACTING GARBAGE COLLECTION MAY OCCUR.
  13 ; NOTE:  A SCRATCH AC MAY CONTAIN POINTERS TO GC SPACE IN
  14 ; INTERRUPTABLE CODE OR DURING AN INTGO IF THE TYPE CODE FOR THAT AC'S
  15 ; SLOT IN THE PROCESS VECTOR IS SET TO REFLECT ITS CONTENTS.
  16
  17 ; ALL ATOM POINTERS WILL BE REFERRED TO IN ASSEMBLED CODE BY
  18 ; MQUOTE <PNAME> -- FOR NORMAL ATOMS
  19 ; EQUOTE <PNAME> -- FOR ERROR COMMENT ATOMS
  20
  21 ; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING:
  22
  23 ;       MCALL N,<PNAME> ;SEE MCALL MACRO
  24 ;       ACALL AC,<PNAME> ; SEE ACALL MACRO
  25
  26 ; UNLESS PNAME IS NOT A VALID MIDAS SYMBOL, IN WHICH CASE ANOTHER INTERNAL
  27 ; NAME WILL BE USED
  28
  29 ; WHEN CALLING A SUBR THROUGH AN INDEX OR INDIRECT, THE UUOS GENERATED
  30 ; BY THE MACROS SHOULLD BE USED.
  31 ; THESE ARE .MCALL AND .ACALL -- EXAMPLE:
  32 ;       .ACALL A,@(B)
  33
  34
  35
  36
  37
  38 \f; ORGANIZATION OF CORE STORAGE IN THE MUDDLE SYSTEM (ENVIRONMENT)
  39
  40 ;     20:       SPECIAL CODE FOR UUO AND INTERUPTS
  41
  42 ;CODBOT:        WORD CONTAINING LOCATION OF BOTTOMMOST WORD OF IMPURE CODE
  43
  44 ;               --IMPURE CODE--
  45
  46 ;CODTOP:        WORD CONTAINING LOCATION OFWORD AFTER LAST WORD OF CODE
  47
  48 ;PARBOT:        WORD CONTAINING LOCATION OFBOTTOMMOST LIST
  49
  50 ;               --PAIRSS--
  51
  52 ;PARTOP:        WORD CONTAINING LOCATION OFWORD AFTER LAST PAIR WORD
  53
  54 ;VECBOT:        WORD CONTAINING LOCATION OFFIRST WORD OF VECTORS
  55
  56 ;               --VECTORS--
  57
  58 ;VECTOP:        WORD CONTAINING LOCATION OFWORD AFTER TOPMOST VECTOR
  59 ;               THE WORD BEFORE VECTOP IS THE DOPE FOR THE LAST VECTOR
  60
  61 ;               --GC MARK PDL (SOMETIMES NOT THERE)--
  62
  63 ;CORTOP:        TOP OF LOW-SEGMENT/IMPURE CORE
  64
  65 ;600000:        START OF PURE CODE (SHARED ALSO)
  66
  67 ;               --PURE CODE--
  68
  69 ;
  70
  71
  72 \f; BASIC DATA TYPES PRE-DEFINED IN MUDDLE
  73
  74 ; PRIMITIVE DATA TYPES
  75 ; IF T IS A DATA TYPE THEN $T=[T,,0]
  76
  77 ; DATA TYPES ARE ASSIGNED BY THE TYPMAK MACRO IN SOME ARBITRARY ORDER
  78
  79
  80 ;TLOSE          ;ILLEGAL TYPE (USED PRIMARILY FOR ERRORS)
  81 ;TFIX           ;FIXED POINT
  82 ;TFLOAT         ;FLOATING POINT
  83 ;TCHRS          ;WORD OF UP TO 5 ASCII CHARACTERS
  84 ;TENTRY         ; MARKS BEGINNING OF A FRAME ON TP STACK
  85 ;TSUBR          ;BUILT IN FUNCTION WITH EVALUATED ARGS
  86 ;TFSUBR         ;BUILT IN FUNCTION WITH UN-EVALUATED ARGS
  87 ;TUNBOU         ;TYPE GIVEN TO UNBOUND OR UNASSIGNED ATOM
  88 ;TBIND          ;MARKS BEGINNING OF BINDING BLOCK ON TP STACK
  89 ;TILLEG         ;POINTER  PREVIOUSLY HERE NOW ILLEGAL
  90 ;TTIME          ;UNIQUE NUMBER (SEE FLOAD)
  91 ;TLIST          ;POINTER TO LIST ELEMENT
  92 ;TFORM          ;POINTER TO LIST ELEMENT BUT USED AS AN EXPRESSION
  93 ;TSEG           ;SAME AS FORM BUT VALUE IS MUST BE STRUCTURED AND IS USED
  94 ;               ;AS A SEGMENT
  95 ;TEXPR          ;POINTER TO LIST ELEMENT BUT USED AS AN INTERPRETIVE FUNCTION
  96 ;TFUNAR         ;LIKE TEXPR BUT HAS PARTIALLY EVALUATED ARGS
  97 ;TLOCL          ;LOCATIVE TO LIST ELEMENT (SEE AT,IN AND SETLOC)
  98 ;TFALSE         ;NOT TRUTH
  99 ;TDEFER         ;POINTER TO REAL VALUE (ONLY APPEARS AS CAR OF LIST)
 100 ;TUVEC          ;AOBJN POINTER TO UNIFORM VECTOR
 101 ;TOBLS          ;AOBJN TO UVEC OF LISTS OF ATOMS.  USED AS SYMBOL TABLE
 102 ;TVEC           ;VECTOR  (AOBJN POINTER TO GENERALIZED VECTOR)
 103 ;TCHAN          ;VECTOR OF INFO DESCRIBING AN I/O CHANNEL
 104 ;TLOCV          ;LOCATIVE TO GENERAL VECTOR  (SEE AT,IN AND SETLOC)
 105 ;TTVP           ;POINTER TO TRANSFER VECTOR
 106 ;TBVL           ;BEGINS A VECTOR BINDING ON THE TP STACK
 107 ;TTAG           ;VECTOR OF INFO SPECIFYING A GENERALIZED TAG
 108 ;TPVP           ;POINTER TO PROCESS VECTOR
 109 ;TLOCI          ;POINTER TO ATOM VALUE ON STACK (INTERNAL NOT SEEN BY USER)
 110 ;TTP            ;POINTER TO MAIN MARKED STACK
 111 ;TSP            ;POINTER TO CURRENT BINDINGS ON STACK
 112 ;TLOCS          ;LOCATIVE TO STACK (NOT CURRENTLY USED)
 113 ;TPP            ;POINTER TO PLANNER  PDL (NOT CURRENTLY USED)
 114 ;TPLD           ;POINTER TO P-STACK (UNMARKED)
 115 ;TARGS          ;POINTER TO AN ARG BLOCK (HAIRY KLUDGE)
 116 ;TAB            ;SAVED AB (NOT GIVEN TO USER)
 117 ;TTB            ;SAVED TB (NOT GIVEN TO USER)
 118 ;TFRAME         ;USER POINTER TO STACK FRAME
 119 ;TCHSTR         ;BYTE POINTER TO STRING OF CHARS (COUNT ALSO INCLUDED)
 120 ;TATOM          ;POINTER TO ATOM
 121 ;TLOCD          ;USER LOCATIVE TO ATOM VALUE
 122 ;TBYTE          :POINTER TO ARBITRARY BYTE STRING (NOT CURRENTLY USED)
 123 ;TENV           ;USER POINTER TO FRAME USED AS AN ENVIRONMENT
 124 ;TACT           ;USER POINTER TO FRAME FOR A NAMED ACTIVATION
 125 ;TASOC          ;ASSOCIATION TRIPLE
 126 ;TLOCU          ;LOCATIVE TO UVECTOR ELEMENT (SEE AT,IN AND SETLOC)
 127 ;TLOCS          ;LOCATIVE TO A BYTE IN A CHAR STRING (SEE AT,IN AND SETLOC)
 128 ;TLOCA          ;LOCATIVE TO ELEMENT IN ARG BLOCK
 129 ;TENTS          ;NOT USED
 130 ;TBS            ; ""
 131 ;TPLDS          ; ""
 132 ;TPC            ; ""
 133 ;TINFO          ;POINTER TO LIST ELEMENT USED WITH ARG POINTERS
 134 ;TNBS           ;NOT USED
 135 ;TBVLS          ;NOT USED
 136 ;TCSUBR         ;CARE SUBR (USED ONLY WITH CUDDLE SEE -- WJL)
 137 ;TWORD          ;36-BIT WORD
 138 ;TRSUBR         ;COMPILED PROGRAM (ACTUALLY A VECTOR POINTER)
 139 ;TCODE          ;UNIFORM VECTOR OF INSTRUCTIONS
 140 ;TCLIST         ;NOT USED
 141 ;TBITS          ;GENERAL BYTE POINTER
 142 ;TSTORA         ;POINTER TO NON GC IMPURE STUFF
 143 ;TPICTU         ;E&S CODE IN NON GC SPACE
 144 ;TSKIP          ;ENVIRONMENT SPLICE
 145 ;TLINK          ;LEXICAL LINK
 146 ;TINTH          ;INTERRUPT HEADER
 147 ;THAND          ;INTERRUPT HANDLER
 148 ;TLOCN          ;LOCATIVE TO ASSOCIATION
 149 ;TDECL          ;POINTER TO LIST OF ATOMS AND TYPE DECLARATIONS
 150 ;TDISMI         ;TYPE MEANING DONT RUN REST OF HANDLERS
 151 ;TDCLI          ; INTERNAL TYPE FOR SAVED FUNCTION BODY
 152 ;TMENT          ; POINTER TO MAIN ENTRY OF WHICH THIS IS PART
 153 ;TENTER         ; NON-MAIN ENTRY TO AN RSUBR
 154 ;TSPLICE        ; RETURN FROM READ MACRO MEANS SPLICE SUBELEMENTS IN
 155 ;TPCODE         ; PURE CODE POINTER IN FUNNY FORMAT
 156 ;TTYPEW         : TYPE WORD
 157 ;TTYPEC         ; TYPE CODE
 158 ;TGATOM         ; ATOM WITH GVALUE
 159 ;TREADA         ; READ ACTIVATION HACK
 160 ;TUNWIN         ; INTERNAL FOR UNWIND SPEC ON STACK
 161 ;TUBIND         ; BINDING OF UNSPECIAL ATOM
 162 ;TMACRO         ; EVAL MACRO
 163 ;TOFFS          ; OFFSET FOR NTHING AND PUTTING
 164 \f
 165 ; STORGE ALLOCATION TYPES.  ALLOCATED BY AN "IRP" LATER IN THIS FILE
 166
 167
 168 ;S1WORD         ;UNMARKED STUFF OF NO INTEREST TO AGC
 169 ;S2WORD         ;POINTERS TO ELEMENTS IN PAIR SPACE (LIST, FORM, EXPR ETC.)
 170 ;S2DEFR         ;DEFERRED LIST VALUES
 171 ;SNWORD         ;POINTERS TO UNIFORM VECTORS
 172 ;S2NWOR         ;POINTERS TO GENERAL VECTORS
 173 ;STPSTK         ;STACK POINTERS
 174 ;SPSTK          ;UNMARKED STACK POINTERS
 175 ;SARGS          ;POINTERS TO ARG BLOCKS (USER)
 176 ;SABASE         ;POINTER TO ARG BLOCK (INTERNAL)
 177 ;STBASE         ;POINTER TO FRAME (INTERNAL)
 178 ;SFRAME         ;POINTER TO FRAME (USER)
 179 ;SBYTE          ;GENERAL BYTE POINTER
 180 ;SATOM          ;POINTER TO ATOM
 181 ;SLOCID         ;POINTER TO VALUE CELL OF ATOM
 182 ;SPVP           ;PROCESS VECTORS
 183 ;SCHSTR         ;ASCII BYTE POINTER
 184 ;SASOC          ;POINTER TO ASSOCIATION BLOCK
 185 ;SINFO          ;LIST CELL CONTAINING EXTRA ARGBLOCK INFO
 186 ;SSTORE         ;NON GC STORGAGE POINTER
 187 ;SLOCA          ;ARG BLOCK LOCATIVE
 188 ;SLOCD          ;USER VALUE CELL LOCATIVE
 189 ;SLOCS          ;LOCATIVE TO STRING
 190 ;SLOCU          ;LOCATIVE TO UVECTOR
 191 ;SLOCV          ;LOCATIVE TO GENERAL VECTOR
 192 ;SLOCL          ;LOCATIVE TO LIST ELEENT
 193 ;SLOCN          ;LOCATIVE TO ASSOCIATION
 194 ;SGATOM         ;REALLY ATOM BUT SPECIAL GC HACK
 195 ;SOFFS          ;OFFSET (SAT BECAUSE LIST IN LH, FIX IN RH)
 196
 197 ;NOTE:  TO FIND OUT IF A GIVEN STORAGE ALLOCATION TYPE NEEDS TO BE DEFERRED, REFER TO
 198 ;LOCATION "MKTBS:" OFFSET BY THE STORAGE TYPE.  IF IT IS <0, THAT SAT NEEDS TO BE DEFERRED.
 199 ;
 200 ;ONE WAY TO DO THIS IS TO PUT A REAL TYPE CODE IN AC A AND PUHSJ P,NWORDT
 201 ; A WILL CONTAIN 1 IF NO DEFERRED NEEDED OR 2 IF DEFER IS NEEDED
 202
 203 \f; SOME MUDDLE DATA FORMATS
 204
 205 ; FORMAT OF LIST ELEMENT
 206
 207 ;       WORD 1: SIGN BIT, RESERVED FOR GARBAGE COLLECTOR
 208 ;                BITS 1-17 TYPE OF FIRST ELEMENT OF LIST
 209 ;                BITS 18-35 POINTS TO REST OF LIST (ALWAYS ANOTHER LIST OR 0)
 210 ;
 211 ;       WORD 2: DATUM OF FIRST ELEMENT OF LIST OF TYPE SPECIFIED
 212 ;
 213 ;       IF DATUM REQUIRES 54 BITS TO SPECIFY,  TYPE WILL BE "TDEFER" AND
 214 ;       VALUE WILL BE AN 18 BIT POINTER TO FULL 2 WORD PAIR
 215
 216
 217
 218 ;FORMAT OF GENERAL VECTOR (OF N ELEMENTS)
 219 ;POINTED INTO BY AOBJN POINTER
 220 ;A GENERAL VECTOR HAS FEWER THAN 2^16 ELEMENTS
 221
 222
 223 ;       TYPE<1> TYPE OF FIRST OBJECT (THE RIGHT HALF OF THE TYPE WORD MIGHT BE NONZERO)
 224 ;       OBJ<1>  OBJECT OF SPECIFIED TYPE
 225 ;       TYPE<2>
 226 ;       OBJ<2>
 227 ;       .
 228 ;       .
 229 ;       .
 230 ;       TYPE<N>
 231 ;       OBJ<N>
 232 ;       VD(1)-VECTOR DOPE--SIGN-NOT UNIFORM, BITS 1-17 TYPE,,18-35 GROWTH/SHRINKAGE
 233 ;       VD(2)-VECTOR DOPE--SIGN-G.C.; BITS 1-17 ARE 2*N+1,,18-35 G.C. RELOCATION EITHER UP OR DOWN
 234
 235
 236 \f;SPECIAL VECTORS IN THE INITIAL SYSTEM
 237
 238 ;THE SYSTEM KEEPS RELEVANT INFORMATION CONCERNING ALL TYPES
 239 ;IN A TYPE VECTOR, TYPVEC, WHICH MAY BE INDEXED BY THE TYPE NUMBER
 240 ;FOUND IN THE TYPE FIELD OF ANY GOODIE.  TABLES APLTYP AND EVLTYP ALSO EXIST
 241 ;THEY SPECIFY HOW DIFFERENT TYPES EVAL AND APPLY.
 242
 243 ;TYPE IN AC A, PUSHJ P,SAT RETURNS STORAGE TYPE IN A
 244
 245 ;TYPE TO NAME OF TYPE TRANSLATION TABLE
 246
 247 ;       TATOM,,<STORAGE ALLOCATION TYPE>+CHBIT+TMPLBT
 248
 249 ;       ATOMIC NAME
 250
 251 ; CHBIT ON MEANS YOU CANT RANDOMLY CHTYPE INTO THIS TYPE
 252 ; TMPLBT ON MEANS A TEMPLATE EXISTS DESCRIBING THIS
 253
 254 ;AN ATOM IS A BLOCK IN VECTOR SPACE WITH THE FOLLOWING FORMAT
 255
 256 ;       <TUNBOU OR TLOCI>,,<0 OR BINDID>        ; TLOCI MEANS VAL EXISTS.
 257                                                 ;  0 MEANS GLOBAL
 258 ;                                               ; BINDID SPECS ENV IN
 259                                                 ; WHICH LOCAL VAL EXISTS
 260 ;       <LOCATIVE TO VALUE OR 0>
 261 ;       <POINTER TO OBLIST OR 0>
 262 ;       <ASCII /PNAME/>
 263 ;       <400000+SATOM,,0>
 264 ;       <LNTH>,,0       (SIGN BIT FOR G.C. RH FOR G.C. RELOCATION)
 265
 266 ;POINTERS TO INITIAL STRUCTURES AND ATOMS NEEDED BY COMPILED CODE
 267 ;WILL BE POINTED TO BY THE TRANSFER VECTOR
 268 ;A POINTER TO THIS VECTOR ALWAYS EXISTS IN AC TVP
 269 ;THE FORMAT OF THIS VECTOR IS:
 270
 271 ;       TYPE,,0
 272 ;       VALUE
 273 ;       .
 274 ;       .
 275 ;       .
 276 ;       TV DOPE WORDS
 277
 278
 279 ;INFORMATION CONCERNING EACH PROCESS IS KEPT IN THE PROCESS VECTOR
 280 ;A POINTER TO THE CURRENT PROCESS ALWAYS EXISTS IN AC PVP
 281 ;THE FORMAT OF A PROCESS VECTOR IS:
 282
 283 ;       TFIX,,0
 284 ;       PROCID  ;UNIQUE ID OF THIS PROCESS
 285
 286 ;       20 ELEMENTS (I.E. 40 WORDS) CONTAINIG SAVED ACS
 287 ;       CAN BE REFERENCED SYMBOLICALLY USING SYMBOLS
 288 ;       OF THE FORM AC!STO(PVP)
 289
 290 ;       OTHER PROCESS LOCAL INFO LIKE LEXICAL STATE, PROCESS STATE,LAST RESUMER
 291 ;       .
 292 ;       .
 293 ;       .
 294 ;       PV DOPE WORDS
 295
 296
 297
 298
 299 ;FORMAT OF PUSH DOWN STACKS USED AND CONVENTIONS
 300
 301 \fIF1 [
 302 PRINTC /MUDDLE - INSERT FILE FOR ALL PROGRAMS
 303 /
 304 ]
 305
 306 IF2 [PRINTC /MUDDLE
 307 /
 308 ]
 309 ;AC ASSIGNMNETS
 310
 311 P"=17   ;THE UNMARKED PDL POINTER (USED BY THE OUTSIDE WORLD AND MUDDLE)
 312 R"=16   ;REFERENCE BASE FOR RSUBRS
 313 M"=15   ;CODE BASE FOR RSUBRS
 314 SP"=10  ;SPECIAL PDL (USED BY MUDDLE FOR VARIABLE BINDINGS)(SPECIAL PDL IS PART OF TP)
 315 TP"=13  ;MARKED PDL (USED BY MUDDLE FOR ARGS TO FUNCTIONS
 316         ;AND MARKED TEMPORARIES)
 317 TB"=12  ;MARKED PDL BASE POINTER AND CURRENT FRAME POINTER
 318 AB"=11  ;ARGUMENT PDL BASE (MARKED)
 319         ;AB IS AN AOBJN POINTER TO THE ARGUMENTS
 320 FRM"=14 ;FUNNY FRAME POINTER
 321 TVP"=7  ;TRANSFER VECTOR POINTER
 322 PVP"=6  ;PROCESS VECTOR POINTER
 323
 324 ;THE FOLLOWING ACS ARE 'SCRATCH' FOR MUDDLE
 325
 326 A"=1    ; A AND B CONTAIN TYPE AND VALUE UPON FUNCTION RETURNS
 327 B"=2
 328 C"=3
 329 D"=4
 330 E"=5
 331
 332 NIL"=0  ;END OF LIST MARKER
 333
 334 ;MACRO TO DEFINE MAIN IF NOT DEFINED
 335
 336 IF1 [
 337 DEFINE SYSQ
 338         ITS==0
 339 ;       IFE <<<.AFNM1>_-24.>-<SIXBIT /    T./>>,ITS==0
 340         IFN ITS,[PRINTC /ITS VERSION
 341 /]
 342         IFE ITS,[PRINTC /TENEX VERSION
 343 /]
 344
 345         TERMIN
 346
 347 ; SEGMENT INFO IF TOPS 20
 348
 349 FSEG==1
 350 MAXSEG==30
 351 GCSEG==36                       ; GC COPY SEGMENT
 352 STATM==40                       ; STORED IN GC DUMP BYTE POINTER TO SAY
 353                                 ; ITS AN ATOM (LH)
 354 DEFINE DEFMAI ARG,\D
 355         D==.TYPE ARG
 356         IFE <D-17>,ARG==0
 357         EXPUNGE D
 358         TERMIN
 359 ]
 360
 361 DEFMAI MAIN
 362 DEFMAI READER
 363
 364 IF2,EXPUNGE DEFMAI
 365
 366 \f;DEFINE TYPES AND $TYPES AND IF MAIN NOT 0, MAKE THE $TYPE WORDS
 367
 368
 369 IFN MAIN,NUMPRI==-1
 370
 371 IF1 [
 372 NUMPRI==-1      ;NUMBER OF PRIMITIVE TYPES
 373
 374 DEFINE TYPMAK  SAT,LIST
 375 IRP A,,[LIST]
 376 NUMPRI==NUMPRI+1
 377 IRP B,,[A]
 378 T!B==NUMPRI
 379 .GLOBAL $!T!B
 380 IFN MAIN,[$!T!B=[T!B,,0]
 381 ]
 382 .ISTOP
 383 TERMIN
 384 IFN MAIN,[
 385 RMT [ADDTYP SAT,A
 386 ]]
 387 TERMIN
 388 TERMIN
 389
 390 ;MACRO TO ADD STUFF TO TYPE VECTOR
 391
 392 IFN MAIN,[
 393 DEFINE ADDTYP SAT,TYPE,NAME,CHF,IMP,\CH
 394         IFSE [CHF],CH==0
 395         IFSN [CHF],CH==CHBIT
 396         IFSE [NAME]IN,CH==CHBIT
 397         TATOM,,CH+SAT
 398         IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL
 399                 IFSN [NAME]IN,[IFSE [IMP],MQUOTE [NAME]
 400                                IFSN [IMP],IMQUOTE [NAME]
 401                               ]
 402                 ]
 403         IFSE [NAME],[IFSE [IMP],MQUOTE TYPE
 404                      IFSN [IMP],IMQUOTE TYPE
 405                     ]
 406         TERMIN
 407 ]
 408 ]
 409 IF2 [IFE MAIN,[DEFINE TYPMAK SAT,LIST
 410         RMT [EXPUN [LIST]
 411 ]
 412         TERMIN
 413 ]
 414 ]
 415
 416 ;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD
 417
 418
 419 NUMSAT==0
 420 GENERAL==440000,,0      ;FLAG FOR BEING A GENERAL VECTOR
 421 .VECT.==40000
 422
 423 IF1 [
 424 DEFINE PRMACR HACKER
 425
 426 IRP A,,[1WORD,2WORD,2DEFRD,NWORD,2NWORD,TPSTK,PSTK,ARGS
 427 ABASE,TBASE,FRAME,BYTE,ATOM,LOCID,PVP,CHSTR,ASOC,INFO,STORE
 428 LOCA,LOCD,LOCS,LOCU,LOCV,LOCL,LOCN,GATOM,LOCR,LOCT,RDTB,LOCB
 429 DEFQ,OFFS]
 430
 431 HACKER A
 432
 433 TERMIN
 434 TERMIN
 435
 436
 437
 438 DEFINE DEFINR B
 439         NUMSAT==NUMSAT+1
 440         S!B==NUMSAT
 441         TERMIN
 442 ]
 443
 444 PRMACR DEFINR
 445
 446 STMPLT==NUMSAT+1
 447
 448 ;MACRO FOR SAVING STUFF TO DO LATER
 449
 450 .GSSET 4
 451
 452 DEFINE HERE G00002,G00003
 453 G00002!G00003!TERMIN
 454
 455 IF1 [
 456 DEFINE RMT A
 457 HERE [DEFINE HERE G00002,G00003
 458 G00002!][A!G00003!TERMIN]
 459 TERMIN
 460 ]
 461
 462
 463 RMT [EXPUNGE GENERAL,NUMSTA
 464 ]
 465
 466 DEFINE XPUNGR A
 467         EXPUNGE S!A
 468         TERMIN
 469
 470 IFE MAIN,[
 471 RMT [PRMACR XPUNGR
 472 ]
 473 ]
 474
 475 C.BUF==1
 476 C.PRIN==2
 477 C.BIN==4
 478 C.OPN==10
 479 C.READ==40
 480 C.LAST==100
 481 C.INTL==200                     ; INTERRUPT ON LINE FEEDS
 482 C.ASCII==400
 483 C.DISK==1000
 484 C.RAND==2000
 485 C.TTY==4000
 486
 487 ; FLAG INDICATING VECTOR FOR GCHACK
 488
 489 .VECT.==40000
 490
 491 ; DEFINE SYMBLOS FOR VARIOUS OBLISTS
 492
 493 SYSTEM==0       ;MAIN SYSTEM OBLIST
 494 ERRORS==1       ;ERROR COMMENT OBLIST
 495 INTRUP==2       ;INERRUPT OBLIST
 496 MUDDLE==3       ;MUDDLE GLOBAL SYMBOLS (ADDRESSES)
 497
 498 RMT [EXPUNGE SYSTEM,ERRORS,INTRUP
 499 ]
 500 ; DEFINE SYMBOLS FOR PROCESS STATES
 501
 502 RUNABL==1
 503 RESMBL==2
 504 RUNING==3
 505 DEAD==4
 506 BLOCKED==5
 507
 508 IFE MAIN,[RMT [EXPUNGE RESMBL,RUNABL,RUNING,DEAD,BLOCKED
 509 ]
 510 ]\f;BUILD THE TYPE CODES AND ADD STUFF TO TYPVEC AND DEFINE $!TYPE)
 511
 512 IFN MAIN,[RMT [SAVE==.
 513         LOC TYPVLC
 514         ]
 515         ]
 516
 517
 518 TYPMAK S1WORD,[[LOSE],[FIX,,,1],[FLOAT,,,1],[CHRS,CHARACTER,,1],[ENTRY,IN],[SUBR,,1]]
 519 TYPMAK S1WORD,[[FSUBR,,1]]
 520 TYPMAK S1WORD,[[UNBOUND,,1],[BIND,IN],[ILLEGAL,,1],TIME]
 521 TYPMAK S2WORD,[[LIST,,,1],[FORM,,,1],[SEG,SEGMENT,,1],[EXPR,FUNCTION,,1]]
 522 TYPMAK S2WORD,[[FUNARG,CLOSURE]]
 523 TYPMAK SLOCL,[[LOCL,,,1]]
 524 TYPMAK S2WORD,[[FALSE,,,1]]
 525 TYPMAK S2DEFRD,[[DEFER,IN]]
 526 TYPMAK SNWORD,[[UVEC,UVECTOR,,1],[OBLS,OBLIST,1,1]]
 527 TYPMAK S2NWORD,[[VEC,VECTOR,,1],[CHAN,CHANNEL,1,1]]
 528 TYPMAK SLOCV,[[LOCV,,,1]]
 529 TYPMAK S2NWORD,[[TVP,IN],[BVL,IN],[TAG,,1]]
 530 TYPMAK SPVP,[[PVP,PROCESS]]
 531 TYPMAK STPSTK,[[LOCI,IN],[TP,IN],[SP,IN],[LOCS,IN]]
 532 TYPMAK S2WORD,[[MACRO]]
 533 TYPMAK SPSTK,[[PDL,IN]]
 534 TYPMAK SARGS,[[ARGS,TUPLE,1,1]]
 535 TYPMAK SABASE,[[AB,IN]]
 536 TYPMAK STBASE,[[TB,IN]]
 537 TYPMAK SFRAME,[[FRAME,,,1]]
 538 TYPMAK SCHSTR,[[CHSTR,STRING,,1]]
 539 TYPMAK SATOM,[[ATOM,,,1]]
 540 TYPMAK SLOCID,[[LOCD,,,1]]
 541 TYPMAK SBYTE,[[BYTE,BYTES]]
 542 TYPMAK SFRAME,[[ENV,ENVIRONMENT],[ACT,ACTIVATION,1,1]]
 543 TYPMAK SASOC,[ASOC]
 544 TYPMAK SLOCU,[[LOCU,,,1]]
 545 TYPMAK SLOCS,[[LOCS,,,1]]
 546 TYPMAK SLOCA,[[LOCA,,,1]]
 547 TYPMAK S1WORD,[[CBLK,IN]]
 548 TYPMAK STMPLT,[[TMPLT,TEMPLATE,1,1]]
 549 TYPMAK SLOCT,[[LOCT]]
 550 TYPMAK SLOCR,[[LOCR,,,1]]
 551 TYPMAK SINFO,[[INFO,IN]]
 552 TYPMAK S2NWORD,[[QRSUBR,QUICK-RSUBR,1],[QENT,QUICK-ENTRY,1]]
 553 TYPMAK SRDTB,[[RDTB,IN]]
 554
 555 TYPMAK S1WORD,[[WORD,,,1]]
 556 TYPMAK S2NWORD,[[RSUBR,,,1]]
 557 TYPMAK SNWORD,[[CODE,,,1]]
 558 TYPMAK S1WORD,[[SATC,PRIMTYPE-C,1]]
 559 TYPMAK S1WORD,[[BITS]]
 560 TYPMAK SSTORE,[[STORAGE,,,1],PICTURE]
 561 TYPMAK STPSTK,[[SKIP,IN]]
 562 TYPMAK SATOM,[[LINK,,1]]
 563 TYPMAK S2NWORD,[[INTH,IHEADER,1],[HAND,HANDLER,1]]
 564 TYPMAK SLOCN,[[LOCN,LOCAS,,1]]
 565 TYPMAK S2WORD,[[DECL,,,1]]
 566 TYPMAK SATOM,[DISMISS]
 567 TYPMAK S2WORD,[[DCLI,IN]]
 568 TYPMAK S2NWORD,[[ENTER,RSUBR-ENTRY,1,1]]
 569 TYPMAK S2WORD,[SPLICE]
 570 TYPMAK S1WORD,[[PCODE,PCODE,1],[TYPEW,TYPE-W,1],[TYPEC,TYPE-C,1]]
 571 TYPMAK SGATOM,[[GATOM,IN]]
 572 TYPMAK SFRAME,[[READA,,1]]
 573 TYPMAK STBASE,[[UNWIN,IN]]
 574 TYPMAK S1WORD,[[UBIND,IN]]
 575 TYPMAK SLOCB,[LOCB]
 576 TYPMAK SDEFQ,[[DEFQ,IN]]
 577 TYPMAK SOFFS,[[OFFS,OFFSET]]
 578 IFN MAIN,[RMT [LOC SAVE
 579         ]
 580         ]
 581 IF2,EXPUNGE TYPMAK,DOTYPS
 582 \f
 583 RMT [EQUALS XP EXPUNGE
 584 IF2,XP STMPLT
 585 ]
 586 IF1 [
 587
 588 DEFINE EXPUN LIST
 589         IRP A,,[LIST]
 590         IRP B,,[A]
 591         EXPUNGE T!B
 592         .ISTOP
 593         TERMIN
 594         TERMIN
 595         TERMIN
 596 ]
 597
 598
 599 TYPMSK==17777
 600 MONMSK==TYPMSK#777777
 601 SATMSK==777
 602 CHBIT==1000
 603 TMPLBT==2000
 604
 605 IF1 [
 606 DEFINE GETYP AC,ADR
 607         LDB AC,[221500,,ADR]
 608         TERMIN
 609
 610 DEFINE PUTYP AC,ADR
 611         DPB AC,[221500,,ADR]
 612         TERMIN
 613
 614 DEFINE GETYPF AC,ADR
 615         LDB AC,[003700,,ADR]
 616         TERMIN
 617
 618 DEFINE MONITO
 619         .WRMON==200000
 620         .RDMON==100000
 621         .EXMON== 40000
 622         .GLOBAL .MONWR,.MONRD,.MONEX
 623         RMT [IF2 IFE MAIN, XP .WRMON,.RDMON,.EXMON
 624 ]
 625         TERMIN
 626 ]
 627
 628 IFN MAIN,MONITO
 629
 630 IFE MAIN,[RMT [XP SATMSK,TYPMSK,MONMSK,CHBIT
 631 ]
 632 ]
 633 \f;MUDDLE WIDE GLOBALS
 634
 635 ;DEFINE ENTRIES IN PROCESS VECTOR AS BEING GLOBAL
 636
 637 IF1 [
 638 IRP A,,[0,A,B,C,D,E,PVP,TVP,TP,TB,AB,P,PB,SP,M,R,FRM]
 639 .GLOBAL A!STO
 640 TERMIN
 641
 642 .GLOBAL CALER1,FINIS,VECTOP,VECBOT,INTFLG
 643
 644 ;GLOBALS FOR MACROS IN VECTOR AND PAIR SPACE
 645
 646 .GLOBAL VECLOC,PARLOC,TVBASE,TVLOC,PVLOC,PVBASE,SQUTBL,SQULOC
 647 .GLOBAL PARTOP,CODTOP,HITOP,HIBOT,SPECBIND,LCKINT
 648 .GLOBAL GETWNA,WNA,TFA,TMA,WRONGT,WTYP,WTYP1,WTYP2,WTYP3,CALER,CALER1
 649 ]
 650
 651
 652 ;STORAGE ALLOCATIN SPECIFICATION GLOBALS
 653
 654 NSUBRS==600.            ; ESTIMATE OF # OF SUBRS IN WOLD
 655 TPLNT"==2000    ;TEMP PDL LENGTHH
 656 GSPLNT==2000    ;INITIAL GLOBAL SP
 657 GCPLNT"==100.   ;GARBAGE COLLECTOR'S PDL LENGTH
 658 PVLNT"==100     ;LENGTH OF INITIAL PROCESS VECTOR
 659 TVLNT"==6000    ;MAX TRANSFER VECTOR
 660 ITPLNT"==100    ;TP FOR GC
 661 PLNT"==1000     ;PDL FOR USER PROCESS
 662
 663 ;LOCATIONS OF VARIOUS STORAGE AREAS
 664
 665 PARBASE"==32000 ;START OF PAIR SPACE
 666 VECBASE"==44000 ;START OF VECTOR SPACE
 667 IFN MAIN,[PARLOC"==PARBASE
 668 VECLOC"==VECBASE
 669 ]
 670 \f
 671 ;INITIAL MACROS
 672
 673 ;SYMBLOS ASSOCIATED WITH STACK FRAMES
 674 ;TB POINTS TO CURRENT FRAME,  THE SYMBOLS BELOW ARE OFFSETS ON TB
 675
 676 FRAMLN==7       ;LENGTH OF A FRAME
 677 FSAV==-7        ;POINT TO CALLED FUNCTION
 678 OTBSAV==-6      ;POINT TO PREVIOUS FRAME AND CONTAINS TIME
 679 ABSAV==-5       ;ARGUMENT POINTER
 680 SPSAV==-4       ;BINDING POINTER
 681 PSAV==-3        ;SAVED P-STACK
 682 TPSAV==-2       ;TOP OF STACK POINTER
 683 PCSAV==-1       ;PCWORD
 684
 685 RMT [EXPUNGE FRAMLN
 686 ]
 687 IFE MAIN,[RMT [EXPUNGE PCSAV TPSAV SPSAV PSAV ABSAV FSAV OTBSAV
 688 ]
 689 ]
 690
 691 ;CALL MACRO
 692 ; ARGS ARE PUSHED ON THE STACK AS TYPE VALUE PAIRS
 693
 694 .GLOBAL .MCALL,.ACALL,FINIS,CONTIN,.ECALL,FATINS,.ERRUU
 695
 696 ; CALL WITH AN ASSEMBLE TIME KNOWN NUMBER OF ARGUMENTS
 697
 698 IF1 [
 699 DEFINE ERRUUO X
 700         .ERRUU X
 701         TERMIN
 702
 703 DEFINE MCALL N,F
 704         .GLOBAL F
 705         IFGE <17-N>,.MCALL N,F
 706         IFL <17-N>,[PRINTC /LOSSAGE AT MCALL - TOO MANY ARGS
 707 /
 708         .MCALL F
 709         ]
 710         TERMIN
 711
 712 ; CALL WITH RUN TIME KNOWN NUMBER OF ARGS IN AC SPECIFIED BY N
 713
 714 DEFINE ACALL N,F
 715         .GLOBAL F
 716         .ACALL N,F
 717         TERMIN
 718
 719 ; STANDARD SUBROUTINE RETURN
 720
 721 ;       JRST FINIS
 722
 723 ; ARGUMENTS WILL NO LONGER BE ON THE STACK WHEN RETURN HAS HAPPENED
 724 ; VALUE SHOULD BE IN A AND B
 725
 726 ;CHECK THAT THE ENTRY POINT WAS CALLED WITH N ARGUMENTS
 727
 728 DEFINE ENTRY N
 729         IFSN N,,[
 730                 HLRZ A,AB
 731                 CAIE A,-2*N
 732                 JSP  E,GETWNA]
 733 TERMIN
 734 \f
 735
 736 ; MACROS ASSOCIATED WIT INTERRUPT PROCESSING
 737 ;INTERRUPT IF THERE IS A WAITING INTERRUPT
 738
 739 DEFINE INTGO
 740         SKIPGE INTFLG
 741         JSR LCKINT
 742 TERMIN
 743
 744 ;TO BECOME INTERRUPTABLE
 745
 746 DEFINE ENABLE
 747         AOSN INTFLG
 748         JSR LCKINT
 749 TERMIN
 750
 751 ;TO BECOME UNITERRUPTABLE
 752
 753 DEFINE DISABLE
 754         SETZM INTFLG
 755 TERMIN
 756 ]
 757 \fIF1 [
 758 ;MACRO TO BUILD TYPE DISPATCH TABLES EASILY
 759
 760 DEFINE TBLDIS NAME,DEFAULT,LIST,LNTH,LH,\NN,FLG
 761
 762 NN==0
 763
 764 NAME:
 765         REPEAT LNTH+1,[
 766         FLG==0
 767         IRP A,,[LIST]
 768                 IRP TYPE,LOCN,[A]
 769                 IFE <NN-TYPE>,[FLG==1
 770                 IFE LH,<LOCN>
 771                 IFN LH,<LH,,LOCN>
 772 ]
 773                 .ISTOP
 774                 TERMIN
 775         TERMIN
 776         IFE FLG,[
 777                 IFE LH,<DEFAULT>
 778                 IFN LH,<LH,,DEFAULT>
 779                 ]
 780         NN==NN+1
 781 ]       LOC NAME+LNTH+1
 782 TERMIN
 783
 784 ; DISPATCH FOR NUMPRI GOODIES
 785
 786 DEFINE DISTBL NAME,DEFAULT,LIST
 787         TBLDIS NAME,DEFAULT,[LIST]NUMPRI,0
 788         TERMIN
 789
 790 DEFINE DISTBS NAME,DEFAULT,LIST
 791         TBLDIS NAME,DEFAULT,[LIST]NUMSAT,0
 792         TERMIN
 793
 794 DEFINE DISTB2 NAME,DEFAULT,LIST
 795         TBLDIS NAME,DEFAULT,[LIST]NUMSAT,400000
 796         TERMIN
 797 ]
 798 \f
 799
 800 VECFLG==0
 801 PARFLG==0
 802
 803 ;MACROS FOR INITIIAL MUDDLE LIST STRUCTURE
 804
 805 ;CHAR STRING MAKER, RETURNS POINTER AND TYPE
 806
 807 IF1 [
 808 DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST
 809                 TYPE==TCHSTR
 810                 VECTGO WHERE
 811                 LNT==.LENGTH \NAME!\
 812                 ASCII \NAME!\
 813                 LAST==$."
 814                 TCHRS,,0
 815                 $."-WHERE+1,,0
 816                 VAL==LNT,,WHERE
 817                 VECRET
 818
 819 TERMIN
 820 ;MACRO TO DEFINE ATOMS
 821
 822 DEFINE MAKAT NAME,TYAT,VALU,OBLIS,REFER,LOCN,\TVENT,FIRST
 823         FIRST==.
 824         TYAT,,OBLIS
 825         VALU
 826         0
 827         ASCII \NAME!\
 828         400000+SATOM,,0
 829         .-FIRST+1,,0
 830         TVENT==FIRST-.+2,,FIRST
 831         IFSN [LOCN],LOCN==TVENT
 832         ADDTV TATOM,TVENT,REFER
 833         TERMIN
 834
 835
 836
 837 \f;MACROS TO SWITCH BACK AND FORTH INTO AND OUT OF VECTOR AND PAIR SPACE
 838 ;GENERAL SWITCHER
 839
 840 DEFINE LOCSET LOCN,RETNAM,NEWLOC,OTHLOC,F1,F2,TOPWRD,\SAVE,SAVEF1,SAVEF2,NEW
 841
 842         IFE F1,[SAVE==.
 843                 LOC NEWLOC
 844                 SAVEF2==F2
 845                 IFN F2,OTHLOC==SAVE
 846                 F2==0
 847                 DEFINE RETNAM
 848                         F1==F1-1
 849                         IFE F1,[NEWLOC==.
 850                         F2==SAVEF2
 851                         LOC TOPWRD
 852                         NEWLOC
 853                         LOC SAVE
 854                         ]
 855                         TERMIN
 856                 ]
 857
 858         IFN F1,[F1==F1+1
 859                 ]
 860
 861         IFSN LOCN,,LOCN==.
 862         IFE F1,F1==1
 863
 864 TERMIN
 865
 866
 867 DEFINE VECTGO LOCN
 868         LOCSET LOCN,VECRET,VECLOC,PARLOC,VECFLG,PARFLG,VECTOP
 869         TERMIN
 870
 871 DEFINE PARGO LOCN
 872         LOCSET LOCN,PARRET,PARLOC,VECLOC,PARFLG,VECFLG,PARTOP
 873         TERMIN
 874
 875 DEFINE ADDSQU NAME,\SAVE
 876         SAVE==.
 877         LOC SQULOC
 878         SQUOZE 0,NAME
 879         NAME
 880         SQULOC==.
 881         LOC SAVE
 882         TERMIN
 883
 884 DEFINE ADDTV TYPE,GOODIE,REFER,\SAVE
 885         SAVE==.
 886         LOC TVLOC
 887         TVOFF==.-TVBASE+1
 888         TYPE,,REFER
 889         GOODIE
 890         TVLOC==.
 891         LOC SAVE
 892         TERMIN
 893
 894 ;MACRO TO ADD TO PROCESS VECTOR
 895
 896 DEFINE ADDPV TYPE,GOODIE,OFFS,\SAVE
 897         SAVE==.
 898         LOC PVLOC
 899         PVOFF==.-PVBASE
 900         IFSN OFFS,,OFFS==PVOFF
 901         TYPE,,0
 902         GOODIE
 903         PVLOC==.
 904         LOC SAVE
 905         TERMIN
 906
 907
 908
 909
 910 \f
 911 ;MACRO TO DEFINE A FUNCTION ATOM
 912
 913 DEFINE MFUNCTION NAME,TYPE,PNAME
 914         XMFUNCTION NAME,TYPE,PNAME,0
 915         TERMIN
 916
 917 DEFINE IMFUNCTION NAME,TYPE,PNAME
 918         XMFUNCTION NAME,TYPE,PNAME,400000
 919         TERMIN
 920
 921 DEFINE XMFUNCTION NAME,TYPE,PNAME,IMP
 922         (TVP)
 923 NAME":
 924         VECTGO DUMMY1
 925         ADDSQU NAME
 926         IFSE [PNAME],MAKAT NAME,T!TYPE+IMP,NAME,SYSTEM,<NAME-1>
 927         IFSN [PNAME],MAKAT [PNAME]T!TYPE+IMP,NAME,SYSTEM,<NAME-1>
 928         VECRET
 929         TERMIN
 930
 931 ; VERSION OF MQUOTE WITH IMPURE BIT ON
 932
 933 DEFINE IMQUOTE ARG,PNAME,OBLIS,\LOCN
 934         (TVP)
 935
 936         LOCN==.-1
 937         VECTGO DUMMY1
 938         IFSE [PNAME],MAKAT [ARG]<400000+TUNBOU>,0,OBLIS,LOCN
 939
 940         IFSN [PNAME],MAKAT [PNAME]<400000+TUNBOU>,0,OBLIS,LOCN
 941         VECRET
 942         TERMIN
 943
 944 ;MACRO TO DEFINE QUOTED GOODIE
 945
 946 DEFINE MQUOTE ARG,PNAME,OBLIS,\LOCN
 947         (TVP)
 948
 949         LOCN==.-1
 950         VECTGO DUMMY1
 951         IFSE [PNAME],MAKAT [ARG]TUNBOU,0,OBLIS,LOCN
 952         IFSN [PNAME],MAKAT [PNAME]TUNBOU,0,OBLIS,LOCN
 953         VECRET
 954         TERMIN
 955
 956
 957
 958
 959 DEFINE CHQUOTE NAME,\LOCN,TYP,VAL
 960         (TVP)
 961         LOCN==.-1
 962         MACHAR [NAME]TYP,VAL
 963         ADDTV TYP,VAL,LOCN
 964
 965         TERMIN
 966
 967
 968 ; SPECIAL ERROR MQUOTE
 969
 970 DEFINE EQUOTE ARG,PNAME
 971         MQUOTE ARG,[PNAME]ERRORS TERMIN
 972
 973
 974 ; MACRO DO .CALL UUOS
 975
 976 DEFINE DOTCAL NM,LIST,\LOCN
 977         .CALL LOCN
 978         RMT [LOCN==.
 979                 SETZ
 980                 SIXBIT /NM/
 981                 IRP Q,R,[LIST]
 982                         IFSN [R][][Q
 983                         ]
 984
 985                         IFSE [R][][<SETZ>\<Q>
 986                         ]
 987                 TERMIN
 988                 ]
 989 TERMIN
 990
 991 ; MACRO TO HANDLE FATAL ERRORS
 992
 993 DEFINE FATAL MSG/
 994         FATINS  [ASCIZ /:\e FATAL ERROR MSG \e\r/]
 995         TERMIN
 996 ]
 997 \f
 998 CHRWD==5
 999
1000 IFN READER,[
1001 NCHARS==377
1002 ;CHARACTER TABLE GENERATING MACROS
1003
1004 DEFINE SETSYM WRDL,BYTL,COD
1005         WRD!WRDL==<WRD!WRDL>&<MSK!BYTL>
1006         WRD!WRDL==<WRD!WRDL>\<<COD&177>_<<4-BYTL>*7+1>>
1007         TERMIN
1008
1009 DEFINE INIWRD N,INIT
1010         WRD!N==INIT
1011         TERMIN
1012
1013 DEFINE OUTWRD N
1014         WRD!N
1015         TERMIN
1016
1017 ;MACRO TO KILL THESE SYMBOLS LATER
1018
1019 DEFINE KILLWD N
1020         EXPUNGE WRD!N
1021         TERMIN
1022 DEFINE SETMSK N
1023         MSK!N==<177_<<4-N>*7+1>>#<-1>
1024         TERMIN
1025
1026 ;MACRO TO KILL MASKS LATER
1027
1028 DEFINE KILMSK N
1029         EXPUNGE MSK!N
1030         TERMIN
1031
1032 NWRDS==<NCHARS+CHRWD-1>/CHRWD
1033
1034 REPEAT CHRWD,SETMSK \.RPCNT
1035
1036 REPEAT NWRDS,INIWRD \.RPCNT,004020100402
1037
1038 DEFINE OUTTBL
1039         REPEAT NWRDS,OUTWRD \.RPCNT
1040         TERMIN
1041
1042
1043 ;MACRO TO GENERATE THE DUMMIES EASLILIER
1044
1045 DEFINE INITCH \DUM1,DUM2,DUM3
1046
1047
1048 DEFINE SETCOD  COD,LIST
1049         IRP CHAR,,[LIST]
1050         DUM1==<CHAR+CHROFF>/5
1051         DUM2==CHROFF+CHAR-DUM1*5
1052         SETSYM \DUM1,\DUM2,COD
1053         IFE CHROFF,[DUM1==<CHAR+200>/5
1054                     DUM2==<CHAR+200-<DUM1*5>>
1055                     SETSYM \DUM1,\DUM2,COD
1056                    ]
1057         TERMIN
1058         TERMIN
1059
1060 DEFINE SETCHR COD,LIST
1061         IRPC CHAR,,[LIST]
1062         DUM3==<"CHAR>+CHROFF
1063         DUM1==DUM3/5
1064         DUM2==DUM3-DUM1*5
1065         SETSYM \DUM1,\DUM2,COD
1066         IFE CHROFF,[DUM3==DUM3+200
1067                     DUM1==DUM3/5
1068                     DUM2==DUM3-DUM1*5
1069                     SETSYM \DUM1,\DUM2,COD
1070                     ]
1071         TERMIN
1072         TERMIN
1073
1074 DEFINE INCRCO OCOD,LIST
1075         IRP CHAR,,[LIST]
1076         DUM1==<CHAR+CHROFF>/5
1077         DUM2==CHROFF+CHAR-DUM1*5
1078         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
1079         IFE CHROFF,[DUM1==<CHAR+200>/5
1080                     DUM2==<CHAR+200-<DUM1*5>>
1081                     SETSYM \DUM1,\DUM2,<OCOD.IRPCN>
1082                    ]
1083         TERMIN
1084         TERMIN
1085
1086 DEFINE INCRCH OCOD,LIST
1087         IRPC CHAR,,[LIST]
1088         DUM3==<"CHAR>+CHROFF
1089         DUM1==DUM3/5
1090         DUM2==DUM3-DUM1*5
1091         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
1092         IFE CHROFF,[DUM3==DUM3+200
1093                     DUM1==DUM3/5
1094                     DUM2==DUM3-DUM1*5
1095                     SETSYM \DUM1,\DUM2,<OCOD+.IRPCN>
1096                     ]
1097         TERMIN
1098         TERMIN
1099         RMT [EXPUNGE DUM1,DUM2,DUM3
1100         REPEAT NWRDS,KILLWD \.RPCNT
1101         REPEAT CHRWD,KILMSK \.RPCNT
1102 ]
1103
1104 TERMIN
1105
1106 INITCH
1107 ]
1108 \f
1109 ;REDEFINE END DO ALL THE REMOTES (ON LAST PASS ONLY)
1110
1111 EQUALS E.END END
1112 EXPUNG END
1113
1114 DEFINE END ARG
1115         EQUALS END E.END
1116         CONSTANTS
1117
1118         IMPURE
1119         VARIABLES
1120         PURE
1121         HERE
1122         .LNKOT
1123         IF2 GEXPUN
1124         CONSTANTS
1125         IMPURE
1126         VARIABLES
1127         CODEND==.
1128         LOC CODTOP
1129         CODEND
1130         LOC CODEND
1131         PURE
1132         CODEND==.
1133         LOC HITOP
1134         CODEND
1135         LOC CODEND
1136         IF2 EXPUNGE PARFLG,VECFLG,CHRWD,NN,NUMPRI,PURITY,EAD,ACD,PUSHED
1137         IF2 EXPUNGE INSTNT,DUMMY1,PRIM,PPLNT,GSPLNT,MEDIAT
1138         END ARG
1139         TERMIN
1140
1141
1142 ;MACROS TO PRINT VERSIONS OF PROGRAMS DURING ASSEMBLY
1143
1144 IF1 [
1145 DEFINE NUMGEN SYM,\REST,N
1146         NN==NN-1
1147         N==<SYM_-30.>&77
1148         REST==<SYM_6>
1149         IFN N,IFGE <31-N>,IFGE <N-20>,TOTAL==TOTAL*10.+<N-20>
1150         IFN NN,NUMGEN REST
1151         EXPUNGE N,REST
1152         TERMIN
1153
1154 DEFINE VERSIO N
1155         PRINTC /VERSION = N
1156 /
1157         TERMIN
1158 ]
1159
1160 TOTAL==0
1161 NN==7
1162
1163 NUMGEN .FNAM2
1164
1165 IF1 [
1166 RADIX 10.
1167
1168 VERSIO \TOTAL
1169
1170 RADIX 8
1171 PROGVN==TOTAL
1172
1173
1174 DEFINE VATOM SYM,\LOCN,TV,A,B
1175         VECTGO
1176         LOCN==.
1177         TFIX,,MUDDLE
1178         PROGVN
1179         0
1180         A==<<<<SYM_-30.>&77>+40>_29.>
1181         B==<<SYM_-24.>&77>
1182         IFN B,A==A+<<B+40>_22.>
1183         B==<<SYM_-18.>&77>
1184         IFN B,A==A+<<B+40>_15.>
1185         B==<<SYM_-12.>&77>
1186         IFN B,A==A+<<B+40>_8.>
1187         B==<<SYM_-6.>&77>
1188         IFN B,A==A+<<B+40>_1.>
1189         A
1190         IFN <SYM&77>,<<SYM&77>+40>_29.
1191         400000+SATOM,,
1192         .-LOCN+1,,0
1193         TV==LOCN-.+2,,LOCN
1194         ADDTV TATOM,TV,0
1195         VECRET
1196         TERMIN
1197
1198 ;VATOM .FNAM1                   ;"HACK REMOVED FOR EFFICIENCY"
1199
1200
1201 ;MACRO TO REMMVE SYMBOLS OF THE FORM "GXXXXX"
1202
1203 DEFINE GEXPUN \SYM
1204         NN==7
1205         TOTAL==0
1206         NUMGEN \<SIXBIT /SYM!/>
1207         RADIX 10.
1208         .GSSET 0
1209         REPEAT TOTAL,XXP
1210         RADIX 8
1211 TERMIN
1212
1213 DEFINE XXP \A
1214         EXPUNGE A
1215         TERMIN
1216
1217
1218 DEFINE ..LOC NEW,OLD
1219         .LIFS .LPUR"+.LIMPU"
1220         OLD!"==$."
1221         LOC NEW!"
1222         .ELDC
1223         .LIFS -.LPUR"
1224         LOC $."
1225         .ELDC
1226         .LIFS -.LIMPU
1227         LOC $."
1228         .ELDC
1229         TERMIN
1230
1231
1232 ; PURE - MACRO TO SWITCH LOADING TO PURE CORE.
1233
1234 DEFINE PURE
1235         IFE PURITY-1, ..LOC .LPUR,.LIMPU
1236         PURITY==0
1237         TERMIN
1238
1239 ; IMPURE - MACRO TO SWITCH LOADING TO IMPURE CORE.
1240
1241 DEFINE IMPURE
1242         IFE PURITY, ..LOC .LIMPU,.LPUR
1243         PURITY==1
1244         TERMIN
1245 ]
1246 PURITY==0
1247 ; BLOCK MACRO
1248
1249 DEFINE SPBLOK N
1250         OFFSET 0
1251         LOC .+N
1252         OFFSET OFFS
1253         TERMIN
1254