<mdl.int>/uuoh.mid.179

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