sumex/muddle.mcr291

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