<mdl.int>/uuoh.mid.182

   1 TITLE UUO HANDLER FOR MUDDLE AND HYDRA
   2 RELOCATABLE
   3 .INSRT MUDDLE >
   4
   5 SYSQ
   6 XJRST=JRST 5,
   7 ;XBLT=123000,,[020000,,0]
   8
   9 IFE ITS,.INSRT STENEX >
  10
  11 ;GLOBALS FOR THIS PROGRAM
  12
  13 .GLOBAL BACKTR,PRINT,PDLBUF,TPGROW,SPECSTO,TIMOUT,AGC,VECBOT,VECTOP
  14 .GLOBAL BCKTRK,TPOVFL,.MONWR,.MONRD,.MONEX,MAKACT,IGVAL,ILVAL,BFRAME
  15 .GLOBAL FLGSET,QMPOPJ,SAVM,STBL,FMPOPJ,PVSTOR,SPSTOR,POPUNW,RMCALL
  16 .GLOBAL PURTOP,PURBOT,PLOAD,PURVEC,STOSTR,MSGTYP,UUOH,ILLUUO,RSTACK,IBLOCK
  17 .GLOBAL NFPOPJ,NSPOPJ,MULTSG,MLTUUP
  18 .GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
  19 .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
  20 .GLOBAL C%M20,C%M30,C%M40,C%M60
  21
  22 ;SETUP UUO DISPATCH TABLE HERE
  23 UUOLOC==40
  24 F==PVP
  25 G==F+1
  26
  27 UUOTBL: ILLUUO
  28
  29 IRP UUOS,,[[DP,DODP],[.MCALL,DMCALL],[.ACALL,DACALL],[.ECALL,DECALL],[.SAVAC,DSAVAC]
  30 [.FATAL,DFATAL],[.ERRUU,DOERR],[.POPUN,DPOPUN],[.LSAVA,DLSAVA]
  31 [SHRRM,DHRRM],[SHRLM,DHRLM],[SXBLT,DXBLT],[SMOVEM,DMOVEM],[SHLRZ,DHLRZ],[SSETZM,DSETZM],[SMOVE,DMOVE]]
  32 UUFOO==.IRPCNT+1
  33 IRP UUO,DISP,[UUOS]
  34 .GLOBAL UUO
  35 UUO=UUFOO_33
  36 SETZ DISP
  37 .ISTOP
  38 TERMIN
  39 TERMIN
  40
  41 ;SINCE CHECKING HAPPENS IN UUOH, NO LONGER NEED TABLE FULL OF ILLUUOS
  42 ;REPEAT 100-UUFOO,[ILLUUO
  43 ;]
  44
  45
  46 RMT [
  47 IMPURE
  48
  49 UUOH:
  50 LOC 41
  51         JSR     UUOH
  52 LOC UUOH
  53         0
  54 IFE ITS,[
  55         JRST    UUOPUR
  56 PURE
  57 UUOPUR:
  58 ]
  59         MOVEM   C,SAVEC
  60 ALLUUO: LDB     C,[331100,,UUOLOC]      ;GET OPCODE
  61         SKIPE   C
  62          CAILE  C,UUFOO
  63           CAIA                  ;SKIP IF ILLEGAL UUO
  64         JRST    @UUOTBL(C)      ;DISPATCH TO SUITABLE HANDLER
  65 IFN ITS,[
  66         .SUSET  [.RJPC,,SAVJPC]
  67 ]
  68         MOVE    C,SAVEC
  69 ILLUUO: FATAL ILLEGAL UUO
  70 ; THIS WILL LEAVE .JPC FOR DEBUGGING AND SUCH
  71 IFE ITS,[
  72 IMPURE
  73 ]
  74 SAVJPC: 0                       ; SAVE JPC IN CASE OF LOSS
  75 SAVEC:  0                       ; USED TO SAVE WORKING AC
  76 NOLINK: 0
  77 IFE ITS,[
  78 MLTUUP: 0                       ; HOLDS UUO (SWAPPED SORT OF)
  79 MLTPC:  0                       ; 23 BIT PC
  80 MLTEA:  0                       ; EFF ADDR OF UUO INSTRUCTION
  81 MLTUUH: FSEG,,MLTUOP            ; RUN IN "FSEG"
  82 ]
  83 PURE
  84 ]
  85
  86 ;SEPARATION OF PURE FROM IMPURE CODE HERE
  87
  88 ;UUOPUR:        MOVEM   C,SAVEC         ; SAVE AC
  89 ;       LDB     C,[330900,,UUOLOC]
  90 ;       JRST    @UUOTBL(C)      ;DISPATCH BASED ON THE UUO
  91 \f
  92 ; HANDLER FOR UUOS IN MULTI SEG MODE
  93 IFE ITS,[
  94 MLTUOP: MOVEM   C,SAVEC
  95         MOVE    C,MLTPC
  96         MOVEM   C,UUOH                  ; SO MANY THINGS WIN IMMEDIATE
  97         HRLZ    C,MLTUUP
  98         TLZ     C,37
  99         HRR     C,MLTEA
 100         MOVEM   C,UUOLOC                ; GET INS CODE
 101         JRST    ALLUUO
 102 ]
 103
 104
 105 \f;CALL HANDLER
 106
 107 IMQUOTE CALLER
 108 CALLER:
 109
 110 DMCALL":
 111         SETZB   D,R             ; FLAG NOT ENTRY CALL
 112         LDB     C,[270400,,UUOLOC]      ; GET AC FIELD OF UUO
 113 COMCAL: LSH     C,1             ; TIMES 2
 114         MOVN    AB,C            ; GET NEGATED # OF ARGS
 115         HRLI    C,(C)           ; TO BOTH SIDES
 116         SUBM    TP,C            ; NOW HAVE TP TO SAVE
 117         MOVEM   C,TPSAV(TB)     ; SAVE IT
 118         MOVSI   AB,(AB)         ; BUILD THE AB POINTER
 119         HRRI    AB,1(C)         ; POINT TO ARGS
 120         HRRZ    C,UUOH          ; GET PC OF CALL
 121         CAIL    C,HIBOT         ; SKIP IF NOT IN GC SPACE
 122         JRST    .+3
 123         SUBI    C,(M)           ; RELATIVIZE THE PC
 124         TLOA    C,400000+M      ; FOR RETURNER TO WIN
 125         TLO     C,400000
 126         SKIPE   SAVM
 127         MOVEI   C,(C)
 128         MOVEM   C,PCSAV(TB)
 129         MOVE    SP,SPSTOR+1
 130         MOVEM   SP,SPSAV(TB)    ; SAVE BINDING GOODIE
 131         MOVSI   C,TENTRY        ; SET UP ENTRY WORD
 132         HRR     C,UUOLOC        ; POINT TO CALLED SR
 133         ADD     TP,[FRAMLN,,FRAMLN]     ; ALLOCATE NEW FRAME
 134         JUMPGE  TP,TPLOSE
 135 CALDON: MOVEM   C,FSAV+1(TP)    ; CLOBBER THE FRAME
 136         MOVEM   TB,OTBSAV+1(TP)
 137         MOVEM   AB,ABSAV+1(TP)  ; FRAME BUILT
 138         MOVEM   P,PSAV(TB)
 139         HRRI    TB,(TP)         ; SETUP NEW TB
 140         MOVEI   C,(C)
 141         SETZB   M,SAVM          ; ZERO M AND SAVM FOR GC WINNAGE
 142         CAILE   C,HIBOT         ; SKIP IF RSUBR
 143         JRST    CALLS
 144         GETYP   A,(C)           ; GET CONTENTS OF SLOT
 145         JUMPN   D,EVCALL        ; EVAL CALLING ENTRY ?
 146         CAIE    A,TRSUBR        ; RSUBR CALLING RSUBR ?
 147         JRST    RCHECK          ; NO
 148         MOVE    R,(C)+1         ; YES, SETUP R
 149 CALLR0: HRRM    R,FSAV+1(TB)    ; FIXUP THE PROPER FSAV
 150
 151 CALLR1: SKIPL   M,(R)+1         ; SETUP M
 152         JRST    SETUPM          ; JUMP IF A PURE RSUBR IN QUESTION
 153 IFN ITS,        AOBJP   TB,.+1          ; GO TO CALLED RSUBR
 154 IFE ITS,[
 155         AOBJP   TB,MCHK
 156 ]
 157 MCHK1:  INTGO                   ; CHECK FOR INTERRUPTS
 158         JRST    (M)
 159
 160 IFE ITS,[
 161 MCHK:   SKIPE   MULTSG
 162          HRLI   TB,400000       ; KEEP TB NEGATIVE
 163         JRST    MCHK1
 164 ]
 165 CALLS:
 166 IFN ITS,        AOBJP   TB,.+1          ; GO TO CALLED SUBR
 167 IFE ITS,        AOBJP   TB,MCHK3
 168 MCHK4:  INTGO                   ; CHECK FOR INTERRUPTS
 169 IFE ITS,        SKIPN   MULTSG
 170          JRST   @C              ; WILL DO "RIGHT THING IN MULTI SEG"
 171 IFE ITS,[
 172         HRLI    C,FSEG
 173         JRST    (C)
 174
 175
 176 MCHK3:  SKIPE   MULTSG
 177          HRLI   TB,400000       ; KEEP TB NEGATIVE
 178         JRST    MCHK4
 179 ]
 180
 181
 182 \f
 183 ; HERE TO HANDLE A PURE RSUBR (LOAD IF PUNTED OR OTHERWISE FLUSHED)
 184
 185 SETUPM: MOVEI   C,0             ; OFFSET (FOR MAIN ENTRIES)
 186 STUPM1: MOVEI   D,(M)           ; GET OFFSET INTO  CODE
 187         HLRS    M               ; GET VECTOR OFFSET IN BOTH HALVES
 188         ADD     M,PURVEC+1      ; GET IT
 189         SKIPL   M
 190         FATAL   LOSING PURE RSUBR POINTER
 191         HLLM    TB,2(M)         ; MARK FOR LRU ALGORITHM
 192         SKIPN   M,1(M)          ; POINT TO CORE IF LOADED
 193         AOJA    TB,STUPM2       ; GO LOAD IT
 194 STUPM3: ADDI    M,(D)           ; POINT TO REAL THING
 195 IFN ITS,[
 196         HRLI    C,M
 197         AOBJP   TB,MCHK7
 198         INTGO
 199 MCHK7:  JRST    @C
 200 ]
 201 IFE ITS,[
 202         AOBJP   TB,MCHK7
 203 MCHK8:  INTGO
 204         ADD     C,M             ; POINT TO START PC
 205         SKIPE   MULTSG
 206          TLZ    C,777400        ; KILL COUNT
 207
 208         SKIPN   MULTSG
 209          JRST   (C)
 210         MOVEI   B,0             ; AVOID FLAG MUNG
 211         XJRST   B               ; EXTENDED JRST HACK
 212
 213 MCHK7:  SKIPE   MULTSG
 214          HRLI   TB,400000       ; KEEP TB NEGATIVE
 215         JRST    MCHK8
 216 ]
 217
 218 STUPM2: HLRZ    A,1(R)          ; SET UP TO CALL LOADER
 219         PUSH    P,D
 220         PUSH    P,C
 221         PUSHJ   P,PLOAD         ; LOAD IT
 222         JRST    PCANT1
 223         POP     P,C
 224         POP     P,D
 225         MOVE    M,B             ; GET LOCATION
 226         SOJA    TB,STUPM3
 227
 228 RCHECK: CAIN    A,TPCODE        ; PURE RSUBR?
 229         JRST    .+3
 230         CAIE    A,TCODE         ; EVALUATOR CALLING RSUBR ?
 231         JRST    SCHECK          ; NO
 232         MOVS    R,(C)           ; YES, SETUP R
 233         HRRI    R,(C)
 234         JRST    CALLR1          ; GO FINISH THE RSUBR CALL
 235
 236
 237 SCHECK: CAIE    A,TSUBR         ; RSUBR CALLING SUBR AS REFERENCE ?
 238         CAIN    A,TFSUBR
 239         SKIPA   C,(C)+1         ; SKIP AND GET ROUTINE'S ADDRESS
 240         JRST    ECHECK
 241         HRRM    C,FSAV+1(TB)    ; FIXUP THE PROPER FSAV
 242 IFE ITS,        SKIPN   MULTSG
 243          JRST   CALLS           ; GO FINISH THE SUBR CALL
 244 IFE ITS,[
 245         HRLI    C,FSEG          ; FOR SEG #1
 246         JRST    CALLS
 247 ]
 248 ECHECK: CAIE    A,TENTER        ; SKIP IF SUB ENTRY OF RSUBR
 249         JRST    ACHECK          ; COULD BE EVAL CALLING ONE
 250         MOVE    C,1(C)          ; POINT TO SUB ENTRY BLOCK
 251 ECHCK3: GETYP   A,(C)           ; SEE IF LINKED TO ITS MAIN ENTRY
 252         MOVE    B,1(C)
 253         CAIN    A,TRSUBR
 254         JRST    ECHCK2
 255
 256 ; CHECK IF CAN LINK ATOM
 257
 258         CAIE    A,TATOM
 259         JRST    BENTRY          ; LOSER , COMPLAIN
 260 ECHCK4: MOVE    B,1(C)          ; GET ATOM
 261         PUSH    TP,$TVEC
 262         PUSH    TP,C
 263         PUSHJ   P,IGVAL         ; TRY GLOBAL VALUE
 264         HRRZ    C,(TP)
 265         SUB     TP,C%22
 266         GETYP   0,A
 267         CAIN    0,TUNBOU
 268         JRST    BADVAL
 269         CAIE    0,TRSUBR        ; IS IT A WINNER
 270         JRST    BENTRY
 271         CAMGE   C,PURTOP        ; DONT TRY TO SMASH PURE
 272         SKIPE   NOLINK
 273         JRST    ECHCK2
 274         HLLM    A,(C)           ; FIXUP LINKAGE
 275         MOVEM   B,1(C)
 276         JRST    ECHCK2
 277
 278 EVCALL: CAIN    A,TATOM         ; EVAL CALLING ENTRY?
 279         JRST    ECHCK4          ; COULD BE MUST FIXUP
 280         CAIE    A,TRSUBR        ; YES THIS IS ONE
 281         JRST    BENTRY
 282         MOVE    B,1(C)
 283 ECHCK2: MOVE    R,B             ; SET UP R
 284         HRRM    C,FSAV+1(TB)    ; SET POINTER INTO FRAME
 285         HRRZ    C,2(C)          ; FIND OFFSET INTO SAME
 286         SKIPL   M,1(R)          ; POINT TO START OF RSUBR
 287         JRST    STUPM1          ; JUMP IF A LOSER
 288         ADDI    C,(M)
 289 IFE ITS,        SKIPN   MULTSG
 290          JRST   CALLS           ; GO TO SR
 291 IFE ITS,[
 292 CALLSX: HRLI    C,FSEG
 293         JRST    CALLS
 294 ]
 295 ACHECK: CAIE    A,TATOM         ; RSUBR CALLING THROUGH REFERENCE ATOM ?
 296         JRST    DOAPP3          ; TRY APPLYING IT
 297         MOVE    A,(C)
 298         MOVE    B,(C)+1
 299         PUSHJ   P,IGVAL
 300         HRRZ    C,UUOLOC        ; REGOBBLE POINTER TO SLOT
 301         GETYP   0,A             ; GET TYPE
 302         CAIN    0,TUNBOUND
 303         JRST    TRYLCL
 304 SAVEIT: CAIE    0,TRSUBR
 305         CAIN    0,TENTER
 306         JRST    SAVEI1          ; WINNER
 307         CAIE    0,TSUBR
 308         CAIN    0,TFSUBR
 309         JRST    SUBRIT
 310         JRST    BADVAL          ; SOMETHING STRANGE
 311 SAVEI1: CAMGE   C,PURTOP        ; SKIP IF PURE RSUBR VECTOR (NEVER LINKED)
 312         SKIPE   NOLINK
 313         JRST    .+3
 314         MOVEM   A,(C)           ; CLOBBER NEW VALUE
 315         MOVEM   B,(C)+1
 316         CAIN    0,TENTER
 317         JRST    ENTRIT          ; HACK ENTRY TO SUB RSUBR
 318         MOVE    R,B             ; SETUP R
 319         JRST    CALLR0          ; GO FINISH THE RSUBR CALL
 320
 321 ENTRIT: MOVE    C,B
 322         JRST    ECHCK3
 323
 324 SUBRIT: CAMGE   C,PURBOT
 325         SKIPE   NOLINK
 326         JRST    .+3
 327         MOVEM   A,(C)
 328         MOVEM   B,1(C)
 329         HRRM    B,FSAV+1(TB)    ; FIXUP THE PROPER FSAV
 330         MOVEI   C,(B)
 331 IFN ITS,        JRST    CALLS           ; GO FINISH THE SUBR CALL
 332 IFE ITS,        JRST    CALLSX
 333
 334 TRYLCL: MOVE    A,(C)
 335         MOVE    B,(C)+1
 336         PUSHJ   P,ILVAL
 337         GETYP   0,A
 338         CAIE    0,TUNBOUND
 339         JRST    SAVEIT
 340         SKIPA   D,EQUOTE UNBOUND-VARIABLE
 341 BADVAL: MOVEI   D,0
 342 ERCALX:
 343 IFN ITS,[
 344         AOBJP   TB,.+1          ; MAKE TB A LIGIT FRAME PNTR
 345 ]
 346 IFE ITS,[
 347         AOBJP   TB,MCHK5
 348 ]
 349 MCHK6:  MOVEI   E,CALLER
 350         HRRM    E,FSAV(TB)      ; SET A WINNING FSAV
 351         HRRZ    C,UUOLOC        ; REGOBBLE POINTER TO SLOT
 352         JUMPE   D,DOAPPL
 353         PUSH    TP,$TATOM
 354         PUSH    TP,D
 355         PUSH    TP,(C)
 356         PUSH    TP,(C)+1
 357         PUSH    TP,$TATOM
 358         PUSH    TP,IMQUOTE CALLER
 359         MCALL   3,ERROR
 360         GETYP   0,A
 361         MOVEI   C,-1
 362         SOJA    TB,SAVEIT
 363
 364 BENTRY: MOVE    D,EQUOTE BAD-ENTRY-BLOCK
 365         JRST    ERCALX
 366
 367 IFE ITS,[
 368 MCHK5:  SKIPN   MULTSG
 369          JRST   MCHK6
 370         HRLI    TB,400000       ; KEEP TB NEGATIVE
 371         JRST    MCHK6
 372 ]
 373
 374
 375 ;HANDLER FOR CALL WHERE SPECIFIES NUMBER OF ARGS
 376
 377 DACALL":
 378         LDB     C,[270400,,UUOLOC]      ; GOBBLE THE AC LOCN INTO C
 379         EXCH    C,SAVEC         ; C TO SAVE LOC RESTORE C
 380         MOVE    C,@SAVEC        ; C NOW HAS NUMBER OF ARGS
 381         MOVEI   D,0             ; FLAG NOT E CALL
 382         JRST    COMCAL          ; JOIN MCALL
 383
 384 ; CALL TO ENTRY FROM EVAL (LIKE ACALL)
 385
 386 DECALL:         LDB     C,[270400,,UUOLOC]      ; GET NAME OF AC
 387         EXCH    C,SAVEC         ; STORE NAME
 388         MOVE    C,@SAVEC        ; C NOW HAS NUM OF ARGS
 389         MOVEI   D,1             ; FLAG THIS
 390         JRST    COMCAL
 391
 392 ;HANDLE OVERFLOW IN THE TP
 393
 394 TPLOSE: PUSHJ   P,TPOVFL
 395         JRST    CALDON
 396
 397 ; RSUBR HAS POSSIBLY BEEN REPLACED BY A FUNCTION OR WHATEVER, DO AN APPLY
 398
 399 DOAPPL: PUSH    TP,A            ; PUSH THE THING TO APPLY
 400         PUSH    TP,B
 401         MOVEI   A,1
 402 DOAPP2: JUMPGE  AB,DOAPP1       ; ARGS DONE
 403
 404         PUSH    TP,(AB)
 405         PUSH    TP,1(AB)
 406         ADD     AB,C%22
 407         AOJA    A,DOAPP2
 408
 409 DOAPP1: ACALL   A,APPLY         ; APPLY THE LOSER
 410         JRST    FINIS
 411
 412 DOAPP3: MOVE    A,(C)           ; GET VAL
 413         MOVE    B,1(C)
 414         JRST    BADVAL          ; GET SETUP FOR APPLY CALL
 415 \f
 416 ; ENTRY TO BUILD A FRAME (USED BY SOME COMPILED PROG/REPEAT)
 417
 418 BFRAME: SKIPN   SAVM
 419         HRLI    A,400000+M      ; RELATIVIZE PC
 420         MOVEM   A,PCSAV(TB)     ; CLOBBER PC IN
 421         MOVEM   TP,TPSAV(TB)    ; SAVE STATE
 422         MOVE    SP,SPSTOR+1
 423         MOVEM   SP,SPSAV(TB)
 424         ADD     TP,[FRAMLN,,FRAMLN]
 425         SKIPL   TP
 426         PUSHJ   TPOVFL  ; HACK BLOWN PDL
 427         MOVSI   A,TCBLK         ; FUNNY FRAME
 428         HRRI    A,(R)
 429         MOVEM   A,FSAV+1(TP)    ; CLOBBER
 430         MOVEM   TB,OTBSAV+1(TP)
 431         MOVEM   AB,ABSAV+1(TP)
 432         POP     P,A             ; RET ADDR TO A
 433         MOVEM   P,PSAV(TB)
 434         HRRI    TB,(TP)
 435 IFN ITS,        AOBJN   TB,.+1
 436 IFE ITS,        AOBJP   TB,.+2
 437         JRST    (A)
 438
 439 IFE ITS,[
 440         SKIPN   MULTSG
 441          JRST   (A)
 442         HRLI    TB,400000       ; KEEP TB NEGATIVE
 443         JRST    (A)
 444 ]
 445
 446 \f;SUBROUTINE TERMINATION CODE (NOT A UUO BUT HERE FOR COMPLETENENSS)
 447
 448 FINIS:
 449 CNTIN1: HRRZS   C,OTBSAV(TB)    ; RESTORE BASE
 450         HRRI    TB,(C)
 451 CONTIN: MOVE    TP,TPSAV(TB)    ; START HERE FOR FUNNY RESTART
 452         MOVE    P,PSAV(TB)
 453         MOVE    SP,SPSTOR+1
 454         CAME    SP,SPSAV(TB)    ; ANY RESTORATION NEEDED
 455         PUSHJ   P,SPECSTO       ; YES, GO UNRAVEL THE WORLDS BINDINGS
 456         MOVE    AB,ABSAV(TB)    ; AND GET OLD ARG POINTER
 457         HRRZ    C,FSAV(TB)      ; CHECK FOR RSUBR
 458         MOVEI   M,0             ; UNSETUP M FOR GC WINNAGE
 459         CAILE   C,HIBOT         ; SKIP IF ANY FLAVOR OF RSUBR
 460 IFN ITS,        JRST    @PCSAV(TB)      ; AND RETURN
 461 IFE ITS,        JRST    MRET
 462         GETYP   0,(C)           ; RETURN TO MAIN OR SUB ENTRY?
 463         CAIN    0,TCODE
 464         JRST    .+3
 465         CAIE    0,TPCODE
 466         JRST    FINIS1
 467         MOVS    R,(C)
 468         HRRI    R,(C)           ; RESET R
 469         SKIPL   M,1(R)          ; GET LOC OF REAL SUBR
 470         JRST    FINIS2
 471
 472 ;HERE TO RETURN TO NBIN
 473
 474 RETNBI: HLRZ    0,PCSAV(TB)     ; GET FUNNY STUFF
 475         JUMPN   0,@PCSAV(TB)
 476         MOVEM   M,SAVM
 477         MOVEI   M,0
 478         JRST    @PCSAV(TB)
 479
 480 FINIS1: CAIE    0,TRSUBR
 481         JRST    FINISA          ; MAY HAVE BEEN PUT BACK TO ATOM
 482         MOVE    R,1(C)
 483 FINIS9: SKIPGE  M,1(R)
 484         JRST    RETNBI
 485
 486 FINIS2: MOVEI   C,(M)           ; COMPUTE REAL M FOR PURE RSUBR
 487         HLRS    M
 488         ADD     M,PURVEC+1
 489         SKIPN   M,1(M)          ; SKIP IF LOADED
 490         JRST    FINIS3
 491         ADDI    M,(C)           ; POINT TO SUB PART
 492 PCREST: HLRZ    0,PCSAV(TB)
 493 IFN ITS,        JUMPN   @PCSAV(TB)
 494 IFE ITS,[
 495         JUMPE   0,NOMULT
 496         SKIPN   MULTSG
 497          JRST   NOMULT
 498         HRRZ    G,PCSAV(TB)
 499         CAML    G,PURBOT
 500          JRST   MRET
 501         ADD     G,M
 502         TLZ     G,777400
 503         MOVEI   F,0
 504         XJRST   F
 505 NOMULT: JUMPN   0,MRET
 506 ]
 507         MOVEM   M,SAVM
 508         MOVEI   M,0
 509 IFN ITS,        JRST    @PCSAV(TB)
 510 IFE ITS,[
 511 MRET:   SKIPN   MULTSG
 512          JRST   @PCSAV(TB)
 513         MOVE    D,PCSAV(TB)
 514         HRLI    D,FSEG
 515         MOVEI   C,0
 516         XJRST   C
 517 ]
 518
 519 FINIS3: PUSH    TP,A
 520         PUSH    TP,B
 521         HLRZ    A,1(R)          ; RELOAD IT
 522         PUSHJ   P,PLOAD
 523         JRST    PCANT
 524         POP     TP,B
 525         POP     TP,A
 526         MOVE    M,1(R)
 527         JRST    FINIS2
 528
 529 FINISA: CAIE    0,TATOM
 530         JRST    BADENT
 531         PUSH    TP,A
 532         PUSH    TP,B
 533         PUSH    TP,$TENTER
 534         HRL     C,(C)
 535         PUSH    TP,C
 536         MOVE    B,1(C)          ; GET ATOM
 537         PUSHJ   P,IGVAL         ; GET VAL
 538         GETYP   0,A
 539         CAIE    0,TRSUBR
 540         JRST    BADENT
 541         HRRZ    C,(TP)
 542         MOVE    R,B
 543         CAMLE   C,PURTOP        ; SKIP IF CAN LINK UP
 544         JRST    .+3
 545         HLLM    A,(C)
 546         MOVEM   B,1(C)
 547         MOVE    A,-3(TP)
 548         MOVE    B,-2(TP)
 549         SUB     TP,C%44
 550         JRST    FINIS9
 551
 552 BADENT: ERRUUO  EQUOTE RSUBR-ENTRY-UNLINKED
 553
 554 PCANT1: ADD     TB,[1,,]
 555 PCANT:  ERRUUO  EQUOTE PURE-LOAD-FAILURE
 556
 557 REPEAT 0,[
 558 BCKTR1: PUSH    TP,A            ; SAVE VALUE TO BE RETURNED
 559         PUSH    TP,B            ; SAVE FRAME ON PP
 560         PUSHJ   P,BCKTRK
 561         POP     TP,B
 562         POP     TP,A
 563         JRST    CNTIN1
 564 ]
 565 \f
 566 ; SUBR TO ENABLE AND DISABLE LINKING OF RSUBRS AT RUN TIME
 567
 568 MFUNCTION %RLINK,SUBR,[RSUBR-LINK]
 569
 570         ENTRY
 571
 572         HRROI   E,NOLINK
 573         JRST    FLGSET
 574
 575 ;HANDLER FOR DEBUGGING CALL TO PRINT
 576
 577 DODP":
 578         PUSH    P,0
 579         MOVSI   0,7777400
 580         ANDCAM  0,UUOLOC
 581         PUSH    TP, @UUOLOC
 582         AOS     UUOLOC
 583         PUSH    TP,@UUOLOC
 584         PUSH    P,A
 585         PUSH    P,B
 586         PUSH    P,SAVEC
 587         PUSH    P,D
 588         PUSH    P,E
 589         PUSH    P,PVP
 590         PUSH    P,TVP
 591         PUSH    P,SP
 592         PUSH    P,UUOLOC
 593         PUSH    P,UUOH
 594         MCALL   1,PRINT
 595         POP     P,UUOH
 596         POP     P,UUOLOC
 597         POP     P,SP
 598         POP     P,TVP
 599         POP     P,PVP
 600         POP     P,E
 601         POP     P,D
 602         POP     P,C
 603         POP     P,B
 604         POP     P,A
 605         POP     P,0
 606         JRST    UUOH
 607
 608
 609 DFATAL:
 610 IFE ITS,[
 611         MOVEM   A,20
 612         HRRO    A,UUOLOC
 613         ESOUT
 614         HALTF
 615         MOVE    A,20
 616         MOVE    C,SAVEC
 617         JRST    @UUOH
 618 ]
 619 REPEAT 0,[
 620 ; QUICK CALL HANDLER
 621
 622 DQCALL: GETYP   C,@40           ; SEE IF THIS GUY IS A QRSUBR OR QENT
 623         CAIN    C,TQENT
 624         JRST    DQCALE
 625         CAIN    C,TQRSUB
 626         JRST    DQCALR
 627
 628 ; NOT A QENT OR QRSUBR, MAYBE AN ATOM THAT LINKS TO ONE
 629
 630         SKIPN   NOLINK
 631         CAIE    C,TATOM         ; SKIP IF ATOM
 632         JRST    DMCALL          ; PRETEND TO BE AN MCALL
 633
 634         MOVE    C,UUOH          ; GET PC OF CALL
 635         SUBI    C,(M)           ; RELATIVIZE
 636         PUSH    P,C             ; AND SAVE
 637         LDB     C,[270400,,40]  ; GET # OF ARGS
 638         PUSH    P,C
 639         HRRZ    C,40            ; POINT TO RSUBR SLOT
 640         MOVE    B,1(C)          ; GET ATOM
 641         SUBI    C,(R)           ; RELATIVIZE IT
 642         HRLI    C,(C)
 643         ADD     C,R             ; C IS NOW A VECTOR POINTER
 644         PUSH    TP,$TVEC
 645         PUSH    TP,C
 646         PUSH    TP,$TATOM
 647         PUSH    TP,B
 648         PUSHJ   P,IGVAL         ; SEE IF IT HAS A VALUE
 649         GETYP   0,A             ; IS IT A WINNER
 650         CAIE    0,TUNBOU
 651         JRST    DQCAL2
 652         MOVE    B,(TP)
 653         PUSHJ   P,ILVAL         ; LOCAL?
 654         GETYP   0,A
 655         CAIE    0,TUNBOU
 656         JRST    DQCAL2          ; MAY BE A WINNER
 657
 658         PUSH    TP,$TATOM
 659         PUSH    TP,EQUOTE UNBOUND-VARIABLE
 660         PUSH    TP,$TATOM
 661         PUSH    TP,-3(TP)
 662         PUSH    TP,$TATOM
 663         PUSH    TP,IMQUOTE CALLER
 664         MCALL   3,ERROR
 665         GETYP   0,A
 666 DQCAL2: PUSH    TP,$TENTE               ; IN CASE RSUBR ENTRY
 667         PUSH    TP,C%0
 668         CAIN    0,TRSUBR                ; RSUBR?
 669         JRST    DQRSB           ; YES, WIN
 670         CAIN    0,TENTER
 671         JRST    DQENT
 672
 673 DQMCAL: HRRZ    C,-6(TP)        ; PRETEND WE WERE AN MCALL
 674         HRRM    C,40
 675         POP     P,C
 676         DPB     C,[270400,,40]
 677         POP     P,C
 678         ADDI    C,(M)           ; AND PC
 679         MOVEM   C,UUOH
 680         SUB     TP,[10,,10]
 681         JRST    DMCALL          ; FALL INTO MCALL CODE
 682
 683 DQENT:  MOVEM   B,(TP)          ; SAVE IT
 684         GETYP   0,(B)           ; LINKED UP?
 685         MOVE    B,1(B)
 686         CAIN    0,TRSUBR
 687         JRST    DQENT1
 688 DQENT2: CAIE    0,TATOM         ; BETTER BE ATOM
 689         JRST    BENTRY
 690         PUSHJ   P,IGVAL         ; TRY TO LINK IT UP
 691         GETYP   0,A
 692         CAIE    0,TRSUBR
 693         JRST    BENTRY          ; LOSER!
 694         MOVE    C,(TP)
 695         HLLM    A,(C)
 696         MOVEM   B,1(C)
 697
 698 DQENT1:
 699 DQRSB:  PUSH    TP,$TRSUBR
 700         PUSH    TP,B
 701
 702         PUSH    TP,$TUVEC
 703         PUSH    TP,M
 704
 705         SKIPL   M,1(B)
 706         PUSHJ   P,DQCALQ        ; MAP ONE IN
 707
 708         MOVEI   E,0             ; GET OFFSET
 709         SKIPL   1(B)
 710         HLRZ    E,1(B)
 711         HLRE    B,M             ; FIND END OF CODE VECTOR
 712         SUBM    M,B
 713         MOVE    M,(TP)
 714         SUB     TP,C%22
 715         HLRZ    A,-1(B)         ; GET LENGTH OF ENTRY VECTOR
 716         HRRZ    C,-1(B)         ; GET LENGTH OF DDT SYMBOL TABLE
 717         ADDI    C,(A)           ; TOTAL LENGTH OF RANDOM CRUFT AT THE END OF CODE
 718         SUBI    B,1(C)          ; POINT TO FIRST ELEMENT IN ENTRY VECTOR
 719
 720 SL2:    HRRZ    D,(B)
 721         CAIL    D,(E)           ; IN RANGE?
 722         JRST    SL1
 723         ADDI    B,1
 724         SOJG    A,SL2
 725         JRST    DQMCAL
 726
 727 SL1:    HLRE    D,(B)           ; GET NEXT
 728         JUMPL   D,DQMCAL
 729         CAMN    D,(P)
 730         JRST    .+4
 731         ADDI    B,1
 732         SOJG    A,.-4
 733         JRST    DQMCAL
 734
 735         HRRZ    C,(B)           ; GET OFFSET
 736         MOVE    R,(TP)          ; SETUP R
 737         SKIPN   B,-2(TP)        ; SKIP IF RSUBR ENTRY
 738         JRST    DQRSB1
 739
 740         ADD     C,2(B)
 741         HRLI    C,TQENT
 742         JRST    DQMUNG
 743
 744 DQRSB1: MOVE    B,(TP)
 745         HRLI    C,TQRSUB
 746
 747 DQMUNG: HRRZ    D,-6(TP)        ; GET CALLING RVECTOR
 748         CAILE   D,@PURTOP       ; SMASHABLE?
 749         JRST    DQLOSS          ; NO LOSE
 750
 751         MOVEM   C,(D)           ; SMASH
 752         MOVEM   B,1(D)
 753
 754 DQLOSS: SUB     P,C%11
 755         POP     P,E             ; RESTORE PC
 756         ADDI    E,(M)
 757         MOVEM   E,UUOH
 758         SUB     TP,[10,,10]
 759         MOVEI   E,C
 760         JRST    DQCAL1
 761
 762 DQCALE: MOVE    E,40
 763         MOVE    B,1(E)          ; GET RSUBR ENTRY
 764         MOVE    R,1(B)
 765         JRST    DQCAL1
 766
 767 DQCALR: MOVE    E,40
 768         MOVE    B,1(E)
 769         MOVE    R,B
 770
 771 DQCAL1: HRRZ    E,(E)
 772         HRRZ    C,RSTACK(PVP)
 773         HRLI    C,(C)
 774         ADD     C,RSTACK+1(PVP)
 775         JUMPGE  C,QCOPY
 776         HRRZ    A,FSAV(TB)
 777         HRL     A,(A)
 778         MOVEM   A,(C)           ; SAVE IT
 779         AOS     C,RSTACK(PVP)
 780         HRRM    B,FSAV(TB)      ; FOR FUTURE MCALLS
 781         HRLI    C,-1(C)
 782         HRR     C,UUOH
 783         SUBI    C,(M)           ; RELATIVIZE
 784         PUSH    P,C             ; SAVE BOTH
 785         SKIPL   M,1(R)          ; MAYBE LINK UP?
 786         PUSHJ   P,DQCALP
 787         ADDI    E,1(M)
 788         JRST    (E)             ; GO
 789
 790 DQCALP: MOVE    B,R
 791 DQCALQ: HLRS    M               ; GET VECTOR OFFSET IN BOTH HALVES
 792         ADD     M,PURVEC+1      ; GET IT
 793         SKIPL   M
 794         FATAL   LOSING PURE RSUBR POINTER
 795         SKIPE   M,1(M)
 796         POPJ    P,
 797
 798 DQCLP1: PUSH    TP,$TRSUBR
 799         PUSH    TP,B
 800         PUSH    P,E
 801         HLRZ    A,1(B)          ; SET UP TO CALL LOADER
 802         PUSHJ   P,PLOAD         ; LOAD IT
 803         JRST    PCANT
 804         POP     P,E
 805         MOVE    M,B             ; GET LOCATION
 806         MOVE    B,(TP)
 807         SUB     TP,C%22
 808         POPJ    P,
 809
 810 QCOPY:  PUSH    TP,$TVEC
 811         PUSH    TP,B
 812         HRRZ    C,UUOH
 813         SUBI    C,(M)
 814         PUSH    P,C
 815         PUSH    P,E
 816         HLRE    A,RSTACK+1(PVP)
 817         MOVNS   A
 818         ADDI    A,100
 819         PUSHJ   P,IBLOCK        ; GET BLOCK
 820         MOVEI   A,.VECT.+TRSUBR
 821         HLRE    C,B
 822         SUBM    B,C
 823         MOVEM   A,(C)
 824         HRLZ    A,RSTACK+1(PVP)
 825         JUMPE   A,.+3
 826         HRRI    A,(B)
 827         BLT     A,-101(C)       ; COPY IT
 828         MOVEM   B,RSTACK+1(PVP)
 829         MOVE    B,(TP)
 830         SUB     TP,C%22
 831         POP     P,E
 832         POP     P,C
 833         ADDI    C,(M)
 834         HRRM    C,UUOH
 835         JRST    DQCAL1
 836
 837 QMPOPJ: SKIPL   E,(P)
 838         JRST    QFINIS
 839         SUBM    M,(P)
 840         POPJ    P,
 841
 842 QFINIS: POP     P,D
 843         HLRZS   D
 844         HRRM    D,RSTACK(PVP)
 845         ADD     D,RSTACK+1(PVP)
 846         MOVE    R,(D)           ; GET R OR WHATEVER
 847         HRRM    R,FSAV(TB)
 848         GETYP   0,(R)           ; TYPE
 849         CAIN    0,TRSUBR        ; RSUBR?
 850         MOVE    R,1(R)
 851         SKIPL   M,1(R)  ; RSUBR IN CORE ETC
 852         JRST    QRLD
 853
 854 QRLD2:  ADDI    E,(M)
 855         JRST    (E)
 856
 857 QRLD:   HLRS    M
 858         ADD     M,PURVEC+1
 859         SKIPE   M,1(M)          ; SKIP IF LOADED
 860         JRST    QRLD2
 861         PUSH    TP,A
 862         PUSH    TP,B
 863         HLRZ    A,1(R)          ; RELOAD IT
 864         PUSHJ   P,PLOAD
 865         JRST    PCANT
 866         POP     TP,B
 867         POP     TP,A
 868         MOVE    M,1(R)
 869         JRST    QRLD2
 870
 871 ]
 872 ; THIS IS A UUO TO CALL ERROR WITH ONE ARGUMENT
 873
 874 DOERR:  PUSH    P,UUOH
 875         PUSH    TP,$TATOM
 876         MOVSI   0,7777400
 877         ANDCAM  0,UUOLOC
 878         PUSH    TP,@UUOLOC
 879         JRST    CALER1
 880
 881 ; ROUTINE TO DO AN RCALL FOR SUBRIFIED GOODIES
 882
 883 RMCALL: MOVEM   M,SAVM                          ; SAVE M
 884         SUBM    M,(P)
 885         MOVEI   M,0
 886         PUSHJ   P,@0
 887         MOVE    M,SAVM
 888         SETZM   SAVM
 889         SUBM    M,(P)
 890         POPJ    P,
 891
 892
 893 ; ROUTINE USED BY COMPILED CODE TO SAVE ACS CALL AN INTERRUPT AND RESTORE ACS.
 894 ; THIS UUO TAKES A LOCATION FROM WHICH TO FIND A DESCRIPTION OF HOW ACS ARE TO
 895 ; BE SAVED.
 896 ; .SAVAC        LOC
 897 ; LOC POINTS TO A BLOCK WHICH CAN BE ONE OR MORE WORDS LONG DEPENDING ON BOTH
 898 ; THE NUMBER OF SCRATCH AC'S (CURRENTLY 5) AND THE NUMBER OF AC'S CONTAINING
 899 ; TEMPLATE TYPES.
 900 ; THE FIRST PART OF THE BLOCK CONTAINS THE AC DECRIPTIONS.  EACH AC IS DESCRIBED
 901 ; BY A SIX BIT FIELD WITH THE EXCEPTION OF AC'S CONTAINING TEMPLATES.
 902 ; THE SIX BIT FIELD CAN BE
 903 ;
 904 ; 0             EITHER A TYPE WORD OR NOTHING
 905 ; 1  ->  8      THE NUMBER OF THE AC CONTAINING THE TYPE
 906 ; 9  ->  62     THE SAT OF THE THING CONTAINED IN THE AC (+ 8)
 907 ; 63            A TEMPLATE LOOK AT THE BLOCK AFTER TO FIND A POINTER TO THE TYPE WORD
 908 ;
 909 ; TEMPLATE DESCRIPTIONS ARE FOUND AFTER THE AC DESCRIPTION BLOCK. THESE ARE FOUND
 910 ; IN SUCESSIVE WORDS CONTAINING POINTERS INTO THE R VECTOR
 911
 912 NOACS==10
 913 TMPPTR==2
 914
 915 ONOACS==5
 916 OTMPPT==1
 917
 918 DLSAVA: PUSH    P,[SETZ NOACS]
 919         PUSH    P,[SETZ TMPPTR]
 920         JRST    DSAVA1
 921
 922 DSAVAC: PUSH    P,[SETZ ONOACS]
 923         PUSH    P,[SETZ OTMPPT]
 924 DSAVA1:
 925 IFN ITS,        MOVE    0,UUOH          ; GET PC
 926 IFE ITS,[
 927         MOVE    0,UUOH
 928         SKIPE   MULTSG
 929          MOVE   0,MLTPC
 930         PUSH    P,0
 931         ANDI    0,-1
 932         PUSH    P,UUOLOC        ; SAVE UUO
 933         CAMG    0,PURTOP
 934         CAMGE   0,VECBOT
 935         JRST    DONREL
 936         SUBI    0,(M)           ; M IS BASE REG
 937 IFN ITS,        TLO     0,M             ; INDEX IT OFF M
 938 IFE ITS,[
 939         HRLI    0,400000+M
 940 ]
 941         MOVEM   0,-1(P)         ; AND RESTORE TO STACK
 942 ;       MOVE    0,UUOLOC        ; GET REL POINTER TO TBL - REDUNDANT
 943 ;       MOVEM   0,(P)           ; AND SAVE IT - REDUNDANT PTR ALREADY PUSHED
 944 DONREL: MOVE    C,SAVEC
 945         MOVE    0,[A,,ACSAV]
 946         BLT     0,ACSAV+NOACS-1
 947         HRRZ    0,-3(P)                 ; NUMBER OF ACS
 948 ;       MOVE    A,[440620,,UUOLOC]      ; BYTE POINTER INDIRECTED TO 40
 949 IFN ITS,[
 950         MOVE    A,UUOLOC                ; GET THE INSTRUCTION
 951         HRLI    A,440640                ; OR IN THE BYTE POINTER
 952 ]
 953 IFE ITS,[
 954         MOVSI   A,440640                ; OR IN THE BYTE POINTER
 955         SKIPN   MULTSG
 956          HRR    A,UUOLOC
 957         SKIPE   MULTSG
 958          MOVE   B,MLTEA
 959 ]
 960         MOVE    D,-2(P)                 ; POINTER TO TEMPLATE BLOCK
 961 IFN ITS,[
 962         MOVSI   C,7777400
 963         ANDCAM  C,UUOLOC
 964         ADD     D,UUOLOC        ; GET TO BLOCK
 965 ]
 966 IFE ITS,[
 967         SKIPE   MULTSG
 968          JRST   XXXYYY
 969         MOVSI   C,7777400
 970         ANDCAM  C,UUOLOC
 971         ADD     D,UUOLOC
 972         CAIA
 973
 974 XXXYYY: ADD     D,MLTEA
 975 ]
 976         HRROI   C,1
 977 LOPSAV: ILDB    E,A                     ; GET A DESCRIPTOR
 978         JUMPE   E,NOAC1                 ; ZERO==TYPE WORD
 979         CAIE    E,77                    ; IF 63. THEN TEMPLATE HANDLE SPECIALLY
 980         JRST    NOTEM                   ; NOT A TEMPLATE
 981         PUSH    TP,@(D)                 ; IT IS A TEMPLATE POINTER SO PUSH TYPE
 982         ADDI    D,1                     ; AOS B
 983 LOPPUS: PUSH    TP,ACSAV-1(C)           ; PUSH AC
 984 LPSVDN: ADDI    C,1
 985         SOJG    0,LOPSAV                ; LOOP BACK
 986         MOVE    0,[ACSAV,,A]
 987         BLT     0,NOACS
 988         JSR     LCKINT                  ; GO INTERRUPT
 989         HRRZ    B,-3(P)                 ; NUMBER OF ACS
 990 LOPPOP: POP     TP,ACSAV-1(B)
 991 LOPBAR: SUB     TP,C%11
 992 LOPFOO: SOJG    B,LOPPOP
 993         JUMPE   R,LOPBLT                ; OK, NOT RSUBR
 994         SKIPL   1(R)            ; NOT PURE RSUBR
 995          SKIPN  MULTSG
 996           JRST  LOPBLT
 997
 998         MOVE    B,M
 999         TLZ     B,77740
1000         MOVEI   A,0
1001         HRRI    B,LOPBLT
1002         XJRST   A
1003
1004 LOPBLT: MOVE    0,[ACSAV,,A]
1005         BLT     0,@-3(P)                ; RESTORE AC'S
1006         MOVE    0,-1(P)
1007         SUB     P,C%44          ; RETURN ADDRESS, (M)
1008         JRST    @0
1009
1010 NOTEM:  CAILE   E,8.                    ; SKIP IF AC IS TO BE PUSHED
1011         JRST    NOAC
1012 IFE ITS,        TLO     E,400000        ; MAKE LOCAL INDEX
1013         PUSH    TP,ACSAV-1(E)
1014         JRST    LOPPUS                  ; FINISH PUSHING
1015 NOAC:   SUBI    E,8                     ; COMPENSATE FOR ADDED AMOUNT
1016 NOAC1:
1017 IFE ITS,        TLO     E,400000        ; MAKE LOCAL INDEX
1018         MOVE    E,@STBL(E)
1019         HLRE    F,E                     ; GET NEGATIVE
1020         SUB     E,F
1021         HRLZ    E,(E)                   ; GET TYPE CODE
1022         TLZ     E,400000+<0,,<-1>#<TYPMSK>>             ; KILL SIGN BIT
1023         PUSH    TP,E                    ; PUSH TYPE
1024         JRST    LOPPUS                  ; FINISH PUSHING
1025
1026 FMPOPJ: MOVE    TP,FRM
1027         MOVE    FRM,(TP)
1028         HRLS    C,-1(TP)
1029         SUB     TP,C
1030         SUBM    M,(P)
1031         POPJ    P,
1032
1033
1034 NFPOPJ: MOVE    TP,FRM                  ; CLEAR OFF FRM
1035         MOVE    FRM,(TP)
1036         HRLS    C,-1(TP)
1037         SUB     TP,C
1038
1039 ; THIS WEIRD PIECE OF CODE IS USED TO DO AN MPOPJ IN SUBRIFIED CODE THAT
1040 ; DOES A SKIP/NON SKIP RETURN.
1041
1042 NSPOPJ: EXCH    (P)
1043         TLNE    37
1044         MOVNS   0
1045         EXCH    (P)
1046         POPJ    P,
1047
1048
1049 DPOPUN: PUSHJ   P,POPUNW
1050         JRST    @UUOH
1051
1052 ; HERE FOR MULTI SEG SIMULATION STUFF
1053
1054 DMOVE:  MOVSI   C,(MOVE)
1055         JRST    MEX
1056 DHRRM:  MOVSI   C,(HRRM)
1057         JRST    MEX
1058 DHRLM:  MOVSI   C,(HRLM)
1059         JRST    MEX
1060 DMOVEM: MOVSI   C,(MOVEM)
1061         JRST    MEX
1062 DHLRZ:  MOVSI   C,(HLRZ)
1063         JRST    MEX
1064 DSETZM: MOVSI   C,(SETZM)
1065         JRST    MEX
1066 DXBLT:  MOVE    C,[123000,,[020000,,]]
1067
1068 MEX:    MOVEM   A,20
1069         MOVE    A,UUOH                  ; GET LOC OF INS
1070         MOVE    A,-1(A)
1071         TLZ     A,777000
1072         IOR     A,C
1073         XJRST   .+1
1074                 0
1075                 FSEG,,.+1
1076         MOVE    C,SAVEC
1077         EXCH    A,20
1078         XCT     20
1079         XJRST   .+1
1080                 0
1081                 .+1
1082         JRST    @UUOH
1083
1084
1085 IMPURE
1086
1087 SAVM:   0                                       ; SAVED M FOR SUBRIFY HACKERS
1088
1089 ACSAV:  BLOCK   NOACS
1090
1091
1092 PURE
1093
1094 END
1095 \f