<mdl.int>/uuoh.184

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