mirror of
https://github.com/PDP-10/its.git
synced 2026-03-22 09:03:20 +00:00
1101 lines
21 KiB
Plaintext
1101 lines
21 KiB
Plaintext
TITLE UUO HANDLER FOR MUDDLE AND HYDRA
|
||
RELOCATABLE
|
||
.INSRT MUDDLE >
|
||
|
||
SYSQ
|
||
XJRST=JRST 5,
|
||
;XBLT=123000,,[020000,,0]
|
||
|
||
IFE ITS,.INSRT STENEX >
|
||
|
||
;GLOBALS FOR THIS PROGRAM
|
||
|
||
.GLOBAL BACKTR,PRINT,PDLBUF,TPGROW,SPECSTO,TIMOUT,AGC,VECBOT,VECTOP
|
||
.GLOBAL BCKTRK,TPOVFL,.MONWR,.MONRD,.MONEX,MAKACT,IGVAL,ILVAL,BFRAME
|
||
.GLOBAL FLGSET,QMPOPJ,SAVM,STBL,FMPOPJ,PVSTOR,SPSTOR,POPUNW,RMCALL
|
||
.GLOBAL PURTOP,PURBOT,PLOAD,PURVEC,STOSTR,MSGTYP,UUOH,ILLUUO,RSTACK,IBLOCK
|
||
.GLOBAL NFPOPJ,NSPOPJ,MULTSG,MLTUUP
|
||
.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
|
||
.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
|
||
.GLOBAL C%M20,C%M30,C%M40,C%M60
|
||
|
||
;SETUP UUO DISPATCH TABLE HERE
|
||
UUOLOC==40
|
||
F==PVP
|
||
G==F+1
|
||
|
||
UUOTBL: ILLUUO
|
||
|
||
EXPUNG .FATAL
|
||
|
||
IRP UUOS,,[[DP,DODP],[.MCALL,DMCALL],[.ACALL,DACALL],[.ECALL,DECALL],[.SAVAC,DSAVAC]
|
||
[.FATAL,DFATAL],[.ERRUU,DOERR],[.POPUN,DPOPUN],[.LSAVA,DLSAVA]
|
||
[SHRRM,DHRRM],[SHRLM,DHRLM],[SXBLT,DXBLT],[SMOVEM,DMOVMX],[SHLRZ,DHLRZ],[SSETZM,DSETZM],[SMOVE,DMOVEX]]
|
||
UUFOO==.IRPCNT+1
|
||
IRP UUO,DISP,[UUOS]
|
||
.GLOBAL UUO
|
||
UUO=UUFOO_33
|
||
SETZ DISP
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
;SINCE CHECKING HAPPENS IN UUOH, NO LONGER NEED TABLE FULL OF ILLUUOS
|
||
;REPEAT 100-UUFOO,[ILLUUO
|
||
;]
|
||
|
||
|
||
RMT [
|
||
IMPURE
|
||
|
||
UUOH:
|
||
LOC 41
|
||
JSR UUOH
|
||
LOC UUOH
|
||
0
|
||
IFE ITS,[
|
||
JRST UUOPUR
|
||
PURE
|
||
UUOPUR:
|
||
]
|
||
MOVEM C,SAVEC
|
||
ALLUUO: LDB C,[331100,,UUOLOC] ;GET OPCODE
|
||
SKIPE C
|
||
CAILE C,UUFOO
|
||
CAIA ;SKIP IF ILLEGAL UUO
|
||
JRST @UUOTBL(C) ;DISPATCH TO SUITABLE HANDLER
|
||
IFN ITS,[
|
||
.SUSET [.RJPC,,SAVJPC]
|
||
]
|
||
MOVE C,SAVEC
|
||
ILLUUO: FATAL ILLEGAL UUO
|
||
; THIS WILL LEAVE .JPC FOR DEBUGGING AND SUCH
|
||
IFE ITS,[
|
||
IMPURE
|
||
]
|
||
SAVJPC: 0 ; SAVE JPC IN CASE OF LOSS
|
||
SAVEC: 0 ; USED TO SAVE WORKING AC
|
||
NOLINK: 0
|
||
IFE ITS,[
|
||
MLTUUP: 0 ; HOLDS UUO (SWAPPED SORT OF)
|
||
MLTPC: 0 ; 23 BIT PC
|
||
MLTEA: 0 ; EFF ADDR OF UUO INSTRUCTION
|
||
MLTUUH: FSEG,,MLTUOP ; RUN IN "FSEG"
|
||
]
|
||
PURE
|
||
]
|
||
|
||
;SEPARATION OF PURE FROM IMPURE CODE HERE
|
||
|
||
;UUOPUR: MOVEM C,SAVEC ; SAVE AC
|
||
; LDB C,[330900,,UUOLOC]
|
||
; JRST @UUOTBL(C) ;DISPATCH BASED ON THE UUO
|
||
|
||
; HANDLER FOR UUOS IN MULTI SEG MODE
|
||
IFE ITS,[
|
||
MLTUOP: MOVEM C,SAVEC
|
||
MOVE C,MLTPC
|
||
MOVEM C,UUOH ; SO MANY THINGS WIN IMMEDIATE
|
||
HRLZ C,MLTUUP
|
||
TLZ C,37
|
||
HRR C,MLTEA
|
||
MOVEM C,UUOLOC ; GET INS CODE
|
||
JRST ALLUUO
|
||
]
|
||
|
||
|
||
;CALL HANDLER
|
||
|
||
IMQUOTE CALLER
|
||
CALLER:
|
||
|
||
DMCALL":
|
||
SETZB D,R ; FLAG NOT ENTRY CALL
|
||
LDB C,[270400,,UUOLOC] ; GET AC FIELD OF UUO
|
||
COMCAL: LSH C,1 ; TIMES 2
|
||
MOVN AB,C ; GET NEGATED # OF ARGS
|
||
HRLI C,(C) ; TO BOTH SIDES
|
||
SUBM TP,C ; NOW HAVE TP TO SAVE
|
||
MOVEM C,TPSAV(TB) ; SAVE IT
|
||
MOVSI AB,(AB) ; BUILD THE AB POINTER
|
||
HRRI AB,1(C) ; POINT TO ARGS
|
||
HRRZ C,UUOH ; GET PC OF CALL
|
||
CAIL C,HIBOT ; SKIP IF NOT IN GC SPACE
|
||
JRST .+3
|
||
SUBI C,(M) ; RELATIVIZE THE PC
|
||
TLOA C,400000+M ; FOR RETURNER TO WIN
|
||
TLO C,400000
|
||
SKIPE SAVM
|
||
MOVEI C,(C)
|
||
MOVEM C,PCSAV(TB)
|
||
MOVE SP,SPSTOR+1
|
||
MOVEM SP,SPSAV(TB) ; SAVE BINDING GOODIE
|
||
MOVSI C,TENTRY ; SET UP ENTRY WORD
|
||
HRR C,UUOLOC ; POINT TO CALLED SR
|
||
ADD TP,[FRAMLN,,FRAMLN] ; ALLOCATE NEW FRAME
|
||
JUMPGE TP,TPLOSE
|
||
CALDON: MOVEM C,FSAV+1(TP) ; CLOBBER THE FRAME
|
||
MOVEM TB,OTBSAV+1(TP)
|
||
MOVEM AB,ABSAV+1(TP) ; FRAME BUILT
|
||
MOVEM P,PSAV(TB)
|
||
HRRI TB,(TP) ; SETUP NEW TB
|
||
MOVEI C,(C)
|
||
SETZB M,SAVM ; ZERO M AND SAVM FOR GC WINNAGE
|
||
CAILE C,HIBOT ; SKIP IF RSUBR
|
||
JRST CALLS
|
||
GETYP A,(C) ; GET CONTENTS OF SLOT
|
||
JUMPN D,EVCALL ; EVAL CALLING ENTRY ?
|
||
CAIE A,TRSUBR ; RSUBR CALLING RSUBR ?
|
||
JRST RCHECK ; NO
|
||
MOVE R,(C)+1 ; YES, SETUP R
|
||
CALLR0: HRRM R,FSAV+1(TB) ; FIXUP THE PROPER FSAV
|
||
|
||
CALLR1: SKIPL M,(R)+1 ; SETUP M
|
||
JRST SETUPM ; JUMP IF A PURE RSUBR IN QUESTION
|
||
IFN ITS, AOBJP TB,.+1 ; GO TO CALLED RSUBR
|
||
IFE ITS,[
|
||
AOBJP TB,MCHK
|
||
]
|
||
MCHK1: INTGO ; CHECK FOR INTERRUPTS
|
||
JRST (M)
|
||
|
||
IFE ITS,[
|
||
MCHK: SKIPE MULTSG
|
||
HRLI TB,400000 ; KEEP TB NEGATIVE
|
||
JRST MCHK1
|
||
]
|
||
CALLS:
|
||
IFN ITS, AOBJP TB,.+1 ; GO TO CALLED SUBR
|
||
IFE ITS, AOBJP TB,MCHK3
|
||
MCHK4: INTGO ; CHECK FOR INTERRUPTS
|
||
IFE ITS, SKIPN MULTSG
|
||
JRST @C ; WILL DO "RIGHT THING IN MULTI SEG"
|
||
IFE ITS,[
|
||
HRLI C,FSEG
|
||
JRST (C)
|
||
|
||
|
||
MCHK3: SKIPE MULTSG
|
||
HRLI TB,400000 ; KEEP TB NEGATIVE
|
||
JRST MCHK4
|
||
]
|
||
|
||
|
||
|
||
; HERE TO HANDLE A PURE RSUBR (LOAD IF PUNTED OR OTHERWISE FLUSHED)
|
||
|
||
SETUPM: MOVEI C,0 ; OFFSET (FOR MAIN ENTRIES)
|
||
STUPM1: MOVEI D,(M) ; GET OFFSET INTO CODE
|
||
HLRS M ; GET VECTOR OFFSET IN BOTH HALVES
|
||
ADD M,PURVEC+1 ; GET IT
|
||
SKIPL M
|
||
FATAL LOSING PURE RSUBR POINTER
|
||
HLLM TB,2(M) ; MARK FOR LRU ALGORITHM
|
||
SKIPN M,1(M) ; POINT TO CORE IF LOADED
|
||
AOJA TB,STUPM2 ; GO LOAD IT
|
||
STUPM3: ADDI M,(D) ; POINT TO REAL THING
|
||
IFN ITS,[
|
||
HRLI C,M
|
||
AOBJP TB,MCHK7
|
||
INTGO
|
||
MCHK7: JRST @C
|
||
]
|
||
IFE ITS,[
|
||
AOBJP TB,MCHK7
|
||
MCHK8: INTGO
|
||
ADD C,M ; POINT TO START PC
|
||
SKIPE MULTSG
|
||
TLZ C,777400 ; KILL COUNT
|
||
|
||
SKIPN MULTSG
|
||
JRST (C)
|
||
MOVEI B,0 ; AVOID FLAG MUNG
|
||
XJRST B ; EXTENDED JRST HACK
|
||
|
||
MCHK7: SKIPE MULTSG
|
||
HRLI TB,400000 ; KEEP TB NEGATIVE
|
||
JRST MCHK8
|
||
]
|
||
|
||
STUPM2: HLRZ A,1(R) ; SET UP TO CALL LOADER
|
||
PUSH P,D
|
||
PUSH P,C
|
||
PUSHJ P,PLOAD ; LOAD IT
|
||
JRST PCANT1
|
||
POP P,C
|
||
POP P,D
|
||
MOVE M,B ; GET LOCATION
|
||
SOJA TB,STUPM3
|
||
|
||
RCHECK: CAIN A,TPCODE ; PURE RSUBR?
|
||
JRST .+3
|
||
CAIE A,TCODE ; EVALUATOR CALLING RSUBR ?
|
||
JRST SCHECK ; NO
|
||
MOVS R,(C) ; YES, SETUP R
|
||
HRRI R,(C)
|
||
JRST CALLR1 ; GO FINISH THE RSUBR CALL
|
||
|
||
|
||
SCHECK: CAIE A,TSUBR ; RSUBR CALLING SUBR AS REFERENCE ?
|
||
CAIN A,TFSUBR
|
||
SKIPA C,(C)+1 ; SKIP AND GET ROUTINE'S ADDRESS
|
||
JRST ECHECK
|
||
HRRM C,FSAV+1(TB) ; FIXUP THE PROPER FSAV
|
||
IFE ITS, SKIPN MULTSG
|
||
JRST CALLS ; GO FINISH THE SUBR CALL
|
||
IFE ITS,[
|
||
HRLI C,FSEG ; FOR SEG #1
|
||
JRST CALLS
|
||
]
|
||
ECHECK: CAIE A,TENTER ; SKIP IF SUB ENTRY OF RSUBR
|
||
JRST ACHECK ; COULD BE EVAL CALLING ONE
|
||
MOVE C,1(C) ; POINT TO SUB ENTRY BLOCK
|
||
ECHCK3: GETYP A,(C) ; SEE IF LINKED TO ITS MAIN ENTRY
|
||
MOVE B,1(C)
|
||
CAIN A,TRSUBR
|
||
JRST ECHCK2
|
||
|
||
; CHECK IF CAN LINK ATOM
|
||
|
||
CAIE A,TATOM
|
||
JRST BENTRY ; LOSER , COMPLAIN
|
||
ECHCK4: MOVE B,1(C) ; GET ATOM
|
||
PUSH TP,$TVEC
|
||
PUSH TP,C
|
||
PUSHJ P,IGVAL ; TRY GLOBAL VALUE
|
||
HRRZ C,(TP)
|
||
SUB TP,C%22
|
||
GETYP 0,A
|
||
CAIN 0,TUNBOU
|
||
JRST BADVAL
|
||
CAIE 0,TRSUBR ; IS IT A WINNER
|
||
JRST BENTRY
|
||
CAMGE C,PURTOP ; DONT TRY TO SMASH PURE
|
||
SKIPE NOLINK
|
||
JRST ECHCK2
|
||
HLLM A,(C) ; FIXUP LINKAGE
|
||
MOVEM B,1(C)
|
||
JRST ECHCK2
|
||
|
||
EVCALL: CAIN A,TATOM ; EVAL CALLING ENTRY?
|
||
JRST ECHCK4 ; COULD BE MUST FIXUP
|
||
CAIE A,TRSUBR ; YES THIS IS ONE
|
||
JRST BENTRY
|
||
MOVE B,1(C)
|
||
ECHCK2: MOVE R,B ; SET UP R
|
||
HRRM C,FSAV+1(TB) ; SET POINTER INTO FRAME
|
||
HRRZ C,2(C) ; FIND OFFSET INTO SAME
|
||
SKIPL M,1(R) ; POINT TO START OF RSUBR
|
||
JRST STUPM1 ; JUMP IF A LOSER
|
||
ADDI C,(M)
|
||
IFE ITS, SKIPN MULTSG
|
||
JRST CALLS ; GO TO SR
|
||
IFE ITS,[
|
||
CALLSX: HRLI C,FSEG
|
||
JRST CALLS
|
||
]
|
||
ACHECK: CAIE A,TATOM ; RSUBR CALLING THROUGH REFERENCE ATOM ?
|
||
JRST DOAPP3 ; TRY APPLYING IT
|
||
MOVE A,(C)
|
||
MOVE B,(C)+1
|
||
PUSHJ P,IGVAL
|
||
HRRZ C,UUOLOC ; REGOBBLE POINTER TO SLOT
|
||
GETYP 0,A ; GET TYPE
|
||
CAIN 0,TUNBOUND
|
||
JRST TRYLCL
|
||
SAVEIT: CAIE 0,TRSUBR
|
||
CAIN 0,TENTER
|
||
JRST SAVEI1 ; WINNER
|
||
CAIE 0,TSUBR
|
||
CAIN 0,TFSUBR
|
||
JRST SUBRIT
|
||
JRST BADVAL ; SOMETHING STRANGE
|
||
SAVEI1: CAMGE C,PURTOP ; SKIP IF PURE RSUBR VECTOR (NEVER LINKED)
|
||
SKIPE NOLINK
|
||
JRST .+3
|
||
MOVEM A,(C) ; CLOBBER NEW VALUE
|
||
MOVEM B,(C)+1
|
||
CAIN 0,TENTER
|
||
JRST ENTRIT ; HACK ENTRY TO SUB RSUBR
|
||
MOVE R,B ; SETUP R
|
||
JRST CALLR0 ; GO FINISH THE RSUBR CALL
|
||
|
||
ENTRIT: MOVE C,B
|
||
JRST ECHCK3
|
||
|
||
SUBRIT: CAMGE C,PURBOT
|
||
SKIPE NOLINK
|
||
JRST .+3
|
||
MOVEM A,(C)
|
||
MOVEM B,1(C)
|
||
HRRM B,FSAV+1(TB) ; FIXUP THE PROPER FSAV
|
||
MOVEI C,(B)
|
||
IFN ITS, JRST CALLS ; GO FINISH THE SUBR CALL
|
||
IFE ITS, JRST CALLSX
|
||
|
||
TRYLCL: MOVE A,(C)
|
||
MOVE B,(C)+1
|
||
PUSHJ P,ILVAL
|
||
GETYP 0,A
|
||
CAIE 0,TUNBOUND
|
||
JRST SAVEIT
|
||
SKIPA D,EQUOTE UNBOUND-VARIABLE
|
||
BADVAL: MOVEI D,0
|
||
ERCALX:
|
||
IFN ITS,[
|
||
AOBJP TB,.+1 ; MAKE TB A LIGIT FRAME PNTR
|
||
]
|
||
IFE ITS,[
|
||
AOBJP TB,MCHK5
|
||
]
|
||
MCHK6: MOVEI E,CALLER
|
||
HRRM E,FSAV(TB) ; SET A WINNING FSAV
|
||
HRRZ C,UUOLOC ; REGOBBLE POINTER TO SLOT
|
||
JUMPE D,DOAPPL
|
||
PUSH TP,$TATOM
|
||
PUSH TP,D
|
||
PUSH TP,(C)
|
||
PUSH TP,(C)+1
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE CALLER
|
||
MCALL 3,ERROR
|
||
GETYP 0,A
|
||
MOVEI C,-1
|
||
SOJA TB,SAVEIT
|
||
|
||
BENTRY: MOVE D,EQUOTE BAD-ENTRY-BLOCK
|
||
JRST ERCALX
|
||
|
||
IFE ITS,[
|
||
MCHK5: SKIPN MULTSG
|
||
JRST MCHK6
|
||
HRLI TB,400000 ; KEEP TB NEGATIVE
|
||
JRST MCHK6
|
||
]
|
||
|
||
|
||
;HANDLER FOR CALL WHERE SPECIFIES NUMBER OF ARGS
|
||
|
||
DACALL":
|
||
LDB C,[270400,,UUOLOC] ; GOBBLE THE AC LOCN INTO C
|
||
EXCH C,SAVEC ; C TO SAVE LOC RESTORE C
|
||
MOVE C,@SAVEC ; C NOW HAS NUMBER OF ARGS
|
||
MOVEI D,0 ; FLAG NOT E CALL
|
||
JRST COMCAL ; JOIN MCALL
|
||
|
||
; CALL TO ENTRY FROM EVAL (LIKE ACALL)
|
||
|
||
DECALL: LDB C,[270400,,UUOLOC] ; GET NAME OF AC
|
||
EXCH C,SAVEC ; STORE NAME
|
||
MOVE C,@SAVEC ; C NOW HAS NUM OF ARGS
|
||
MOVEI D,1 ; FLAG THIS
|
||
JRST COMCAL
|
||
|
||
;HANDLE OVERFLOW IN THE TP
|
||
|
||
TPLOSE: PUSHJ P,TPOVFL
|
||
JRST CALDON
|
||
|
||
; RSUBR HAS POSSIBLY BEEN REPLACED BY A FUNCTION OR WHATEVER, DO AN APPLY
|
||
|
||
DOAPPL: PUSH TP,A ; PUSH THE THING TO APPLY
|
||
PUSH TP,B
|
||
MOVEI A,1
|
||
DOAPP2: JUMPGE AB,DOAPP1 ; ARGS DONE
|
||
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB)
|
||
ADD AB,C%22
|
||
AOJA A,DOAPP2
|
||
|
||
DOAPP1: ACALL A,APPLY ; APPLY THE LOSER
|
||
JRST FINIS
|
||
|
||
DOAPP3: MOVE A,(C) ; GET VAL
|
||
MOVE B,1(C)
|
||
JRST BADVAL ; GET SETUP FOR APPLY CALL
|
||
|
||
; ENTRY TO BUILD A FRAME (USED BY SOME COMPILED PROG/REPEAT)
|
||
|
||
BFRAME: SKIPN SAVM
|
||
HRLI A,400000+M ; RELATIVIZE PC
|
||
MOVEM A,PCSAV(TB) ; CLOBBER PC IN
|
||
MOVEM TP,TPSAV(TB) ; SAVE STATE
|
||
MOVE SP,SPSTOR+1
|
||
MOVEM SP,SPSAV(TB)
|
||
ADD TP,[FRAMLN,,FRAMLN]
|
||
SKIPL TP
|
||
PUSHJ TPOVFL ; HACK BLOWN PDL
|
||
MOVSI A,TCBLK ; FUNNY FRAME
|
||
HRRI A,(R)
|
||
MOVEM A,FSAV+1(TP) ; CLOBBER
|
||
MOVEM TB,OTBSAV+1(TP)
|
||
MOVEM AB,ABSAV+1(TP)
|
||
POP P,A ; RET ADDR TO A
|
||
MOVEM P,PSAV(TB)
|
||
HRRI TB,(TP)
|
||
IFN ITS, AOBJN TB,.+1
|
||
IFE ITS, AOBJP TB,.+2
|
||
JRST (A)
|
||
|
||
IFE ITS,[
|
||
SKIPN MULTSG
|
||
JRST (A)
|
||
HRLI TB,400000 ; KEEP TB NEGATIVE
|
||
JRST (A)
|
||
]
|
||
|
||
;SUBROUTINE TERMINATION CODE (NOT A UUO BUT HERE FOR COMPLETENENSS)
|
||
|
||
FINIS:
|
||
CNTIN1: HRRZS C,OTBSAV(TB) ; RESTORE BASE
|
||
HRRI TB,(C)
|
||
CONTIN: MOVE TP,TPSAV(TB) ; START HERE FOR FUNNY RESTART
|
||
MOVE P,PSAV(TB)
|
||
MOVE SP,SPSTOR+1
|
||
CAME SP,SPSAV(TB) ; ANY RESTORATION NEEDED
|
||
PUSHJ P,SPECSTO ; YES, GO UNRAVEL THE WORLDS BINDINGS
|
||
MOVE AB,ABSAV(TB) ; AND GET OLD ARG POINTER
|
||
HRRZ C,FSAV(TB) ; CHECK FOR RSUBR
|
||
MOVEI M,0 ; UNSETUP M FOR GC WINNAGE
|
||
CAILE C,HIBOT ; SKIP IF ANY FLAVOR OF RSUBR
|
||
IFN ITS, JRST @PCSAV(TB) ; AND RETURN
|
||
IFE ITS, JRST MRET
|
||
GETYP 0,(C) ; RETURN TO MAIN OR SUB ENTRY?
|
||
CAIN 0,TCODE
|
||
JRST .+3
|
||
CAIE 0,TPCODE
|
||
JRST FINIS1
|
||
MOVS R,(C)
|
||
HRRI R,(C) ; RESET R
|
||
SKIPL M,1(R) ; GET LOC OF REAL SUBR
|
||
JRST FINIS2
|
||
|
||
;HERE TO RETURN TO NBIN
|
||
|
||
RETNBI: HLRZ 0,PCSAV(TB) ; GET FUNNY STUFF
|
||
JUMPN 0,@PCSAV(TB)
|
||
MOVEM M,SAVM
|
||
MOVEI M,0
|
||
JRST @PCSAV(TB)
|
||
|
||
FINIS1: CAIE 0,TRSUBR
|
||
JRST FINISA ; MAY HAVE BEEN PUT BACK TO ATOM
|
||
MOVE R,1(C)
|
||
FINIS9: SKIPGE M,1(R)
|
||
JRST RETNBI
|
||
|
||
FINIS2: MOVEI C,(M) ; COMPUTE REAL M FOR PURE RSUBR
|
||
HLRS M
|
||
ADD M,PURVEC+1
|
||
SKIPN M,1(M) ; SKIP IF LOADED
|
||
JRST FINIS3
|
||
ADDI M,(C) ; POINT TO SUB PART
|
||
PCREST: HLRZ 0,PCSAV(TB)
|
||
IFN ITS, JUMPN @PCSAV(TB)
|
||
IFE ITS,[
|
||
JUMPE 0,NOMULT
|
||
SKIPN MULTSG
|
||
JRST NOMULT
|
||
HRRZ G,PCSAV(TB)
|
||
CAML G,PURBOT
|
||
JRST MRET
|
||
ADD G,M
|
||
TLZ G,777400
|
||
MOVEI F,0
|
||
XJRST F
|
||
NOMULT: JUMPN 0,MRET
|
||
]
|
||
MOVEM M,SAVM
|
||
MOVEI M,0
|
||
IFN ITS, JRST @PCSAV(TB)
|
||
IFE ITS,[
|
||
MRET: SKIPN MULTSG
|
||
JRST @PCSAV(TB)
|
||
MOVE D,PCSAV(TB)
|
||
HRLI D,FSEG
|
||
MOVEI C,0
|
||
XJRST C
|
||
]
|
||
|
||
FINIS3: PUSH TP,A
|
||
PUSH TP,B
|
||
HLRZ A,1(R) ; RELOAD IT
|
||
PUSHJ P,PLOAD
|
||
JRST PCANT
|
||
POP TP,B
|
||
POP TP,A
|
||
MOVE M,1(R)
|
||
JRST FINIS2
|
||
|
||
FINISA: CAIE 0,TATOM
|
||
JRST BADENT
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,$TENTER
|
||
HRL C,(C)
|
||
PUSH TP,C
|
||
MOVE B,1(C) ; GET ATOM
|
||
PUSHJ P,IGVAL ; GET VAL
|
||
GETYP 0,A
|
||
CAIE 0,TRSUBR
|
||
JRST BADENT
|
||
HRRZ C,(TP)
|
||
MOVE R,B
|
||
CAMLE C,PURTOP ; SKIP IF CAN LINK UP
|
||
JRST .+3
|
||
HLLM A,(C)
|
||
MOVEM B,1(C)
|
||
MOVE A,-3(TP)
|
||
MOVE B,-2(TP)
|
||
SUB TP,C%44
|
||
JRST FINIS9
|
||
|
||
BADENT: ERRUUO EQUOTE RSUBR-ENTRY-UNLINKED
|
||
|
||
PCANT1: ADD TB,[1,,]
|
||
PCANT: ERRUUO EQUOTE PURE-LOAD-FAILURE
|
||
|
||
REPEAT 0,[
|
||
BCKTR1: PUSH TP,A ; SAVE VALUE TO BE RETURNED
|
||
PUSH TP,B ; SAVE FRAME ON PP
|
||
PUSHJ P,BCKTRK
|
||
POP TP,B
|
||
POP TP,A
|
||
JRST CNTIN1
|
||
]
|
||
|
||
; SUBR TO ENABLE AND DISABLE LINKING OF RSUBRS AT RUN TIME
|
||
|
||
MFUNCTION %RLINK,SUBR,[RSUBR-LINK]
|
||
|
||
ENTRY
|
||
|
||
HRROI E,NOLINK
|
||
JRST FLGSET
|
||
|
||
;HANDLER FOR DEBUGGING CALL TO PRINT
|
||
|
||
DODP":
|
||
PUSH P,0
|
||
MOVSI 0,7777400
|
||
ANDCAM 0,UUOLOC
|
||
PUSH TP, @UUOLOC
|
||
AOS UUOLOC
|
||
PUSH TP,@UUOLOC
|
||
PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,SAVEC
|
||
PUSH P,D
|
||
PUSH P,E
|
||
PUSH P,PVP
|
||
PUSH P,TVP
|
||
PUSH P,SP
|
||
PUSH P,UUOLOC
|
||
PUSH P,UUOH
|
||
MCALL 1,PRINT
|
||
POP P,UUOH
|
||
POP P,UUOLOC
|
||
POP P,SP
|
||
POP P,TVP
|
||
POP P,PVP
|
||
POP P,E
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POP P,0
|
||
JRST UUOH
|
||
|
||
|
||
DFATAL:
|
||
IFE ITS,[
|
||
MOVEM A,20
|
||
HRRO A,UUOLOC
|
||
ESOUT
|
||
HALTF
|
||
MOVE A,20
|
||
MOVE C,SAVEC
|
||
JRST @UUOH
|
||
]
|
||
REPEAT 0,[
|
||
; QUICK CALL HANDLER
|
||
|
||
DQCALL: GETYP C,@40 ; SEE IF THIS GUY IS A QRSUBR OR QENT
|
||
CAIN C,TQENT
|
||
JRST DQCALE
|
||
CAIN C,TQRSUB
|
||
JRST DQCALR
|
||
|
||
; NOT A QENT OR QRSUBR, MAYBE AN ATOM THAT LINKS TO ONE
|
||
|
||
SKIPN NOLINK
|
||
CAIE C,TATOM ; SKIP IF ATOM
|
||
JRST DMCALL ; PRETEND TO BE AN MCALL
|
||
|
||
MOVE C,UUOH ; GET PC OF CALL
|
||
SUBI C,(M) ; RELATIVIZE
|
||
PUSH P,C ; AND SAVE
|
||
LDB C,[270400,,40] ; GET # OF ARGS
|
||
PUSH P,C
|
||
HRRZ C,40 ; POINT TO RSUBR SLOT
|
||
MOVE B,1(C) ; GET ATOM
|
||
SUBI C,(R) ; RELATIVIZE IT
|
||
HRLI C,(C)
|
||
ADD C,R ; C IS NOW A VECTOR POINTER
|
||
PUSH TP,$TVEC
|
||
PUSH TP,C
|
||
PUSH TP,$TATOM
|
||
PUSH TP,B
|
||
PUSHJ P,IGVAL ; SEE IF IT HAS A VALUE
|
||
GETYP 0,A ; IS IT A WINNER
|
||
CAIE 0,TUNBOU
|
||
JRST DQCAL2
|
||
MOVE B,(TP)
|
||
PUSHJ P,ILVAL ; LOCAL?
|
||
GETYP 0,A
|
||
CAIE 0,TUNBOU
|
||
JRST DQCAL2 ; MAY BE A WINNER
|
||
|
||
PUSH TP,$TATOM
|
||
PUSH TP,EQUOTE UNBOUND-VARIABLE
|
||
PUSH TP,$TATOM
|
||
PUSH TP,-3(TP)
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE CALLER
|
||
MCALL 3,ERROR
|
||
GETYP 0,A
|
||
DQCAL2: PUSH TP,$TENTE ; IN CASE RSUBR ENTRY
|
||
PUSH TP,C%0
|
||
CAIN 0,TRSUBR ; RSUBR?
|
||
JRST DQRSB ; YES, WIN
|
||
CAIN 0,TENTER
|
||
JRST DQENT
|
||
|
||
DQMCAL: HRRZ C,-6(TP) ; PRETEND WE WERE AN MCALL
|
||
HRRM C,40
|
||
POP P,C
|
||
DPB C,[270400,,40]
|
||
POP P,C
|
||
ADDI C,(M) ; AND PC
|
||
MOVEM C,UUOH
|
||
SUB TP,[10,,10]
|
||
JRST DMCALL ; FALL INTO MCALL CODE
|
||
|
||
DQENT: MOVEM B,(TP) ; SAVE IT
|
||
GETYP 0,(B) ; LINKED UP?
|
||
MOVE B,1(B)
|
||
CAIN 0,TRSUBR
|
||
JRST DQENT1
|
||
DQENT2: CAIE 0,TATOM ; BETTER BE ATOM
|
||
JRST BENTRY
|
||
PUSHJ P,IGVAL ; TRY TO LINK IT UP
|
||
GETYP 0,A
|
||
CAIE 0,TRSUBR
|
||
JRST BENTRY ; LOSER!
|
||
MOVE C,(TP)
|
||
HLLM A,(C)
|
||
MOVEM B,1(C)
|
||
|
||
DQENT1:
|
||
DQRSB: PUSH TP,$TRSUBR
|
||
PUSH TP,B
|
||
|
||
PUSH TP,$TUVEC
|
||
PUSH TP,M
|
||
|
||
SKIPL M,1(B)
|
||
PUSHJ P,DQCALQ ; MAP ONE IN
|
||
|
||
MOVEI E,0 ; GET OFFSET
|
||
SKIPL 1(B)
|
||
HLRZ E,1(B)
|
||
HLRE B,M ; FIND END OF CODE VECTOR
|
||
SUBM M,B
|
||
MOVE M,(TP)
|
||
SUB TP,C%22
|
||
HLRZ A,-1(B) ; GET LENGTH OF ENTRY VECTOR
|
||
HRRZ C,-1(B) ; GET LENGTH OF DDT SYMBOL TABLE
|
||
ADDI C,(A) ; TOTAL LENGTH OF RANDOM CRUFT AT THE END OF CODE
|
||
SUBI B,1(C) ; POINT TO FIRST ELEMENT IN ENTRY VECTOR
|
||
|
||
SL2: HRRZ D,(B)
|
||
CAIL D,(E) ; IN RANGE?
|
||
JRST SL1
|
||
ADDI B,1
|
||
SOJG A,SL2
|
||
JRST DQMCAL
|
||
|
||
SL1: HLRE D,(B) ; GET NEXT
|
||
JUMPL D,DQMCAL
|
||
CAMN D,(P)
|
||
JRST .+4
|
||
ADDI B,1
|
||
SOJG A,.-4
|
||
JRST DQMCAL
|
||
|
||
HRRZ C,(B) ; GET OFFSET
|
||
MOVE R,(TP) ; SETUP R
|
||
SKIPN B,-2(TP) ; SKIP IF RSUBR ENTRY
|
||
JRST DQRSB1
|
||
|
||
ADD C,2(B)
|
||
HRLI C,TQENT
|
||
JRST DQMUNG
|
||
|
||
DQRSB1: MOVE B,(TP)
|
||
HRLI C,TQRSUB
|
||
|
||
DQMUNG: HRRZ D,-6(TP) ; GET CALLING RVECTOR
|
||
CAILE D,@PURTOP ; SMASHABLE?
|
||
JRST DQLOSS ; NO LOSE
|
||
|
||
MOVEM C,(D) ; SMASH
|
||
MOVEM B,1(D)
|
||
|
||
DQLOSS: SUB P,C%11
|
||
POP P,E ; RESTORE PC
|
||
ADDI E,(M)
|
||
MOVEM E,UUOH
|
||
SUB TP,[10,,10]
|
||
MOVEI E,C
|
||
JRST DQCAL1
|
||
|
||
DQCALE: MOVE E,40
|
||
MOVE B,1(E) ; GET RSUBR ENTRY
|
||
MOVE R,1(B)
|
||
JRST DQCAL1
|
||
|
||
DQCALR: MOVE E,40
|
||
MOVE B,1(E)
|
||
MOVE R,B
|
||
|
||
DQCAL1: HRRZ E,(E)
|
||
HRRZ C,RSTACK(PVP)
|
||
HRLI C,(C)
|
||
ADD C,RSTACK+1(PVP)
|
||
JUMPGE C,QCOPY
|
||
HRRZ A,FSAV(TB)
|
||
HRL A,(A)
|
||
MOVEM A,(C) ; SAVE IT
|
||
AOS C,RSTACK(PVP)
|
||
HRRM B,FSAV(TB) ; FOR FUTURE MCALLS
|
||
HRLI C,-1(C)
|
||
HRR C,UUOH
|
||
SUBI C,(M) ; RELATIVIZE
|
||
PUSH P,C ; SAVE BOTH
|
||
SKIPL M,1(R) ; MAYBE LINK UP?
|
||
PUSHJ P,DQCALP
|
||
ADDI E,1(M)
|
||
JRST (E) ; GO
|
||
|
||
DQCALP: MOVE B,R
|
||
DQCALQ: HLRS M ; GET VECTOR OFFSET IN BOTH HALVES
|
||
ADD M,PURVEC+1 ; GET IT
|
||
SKIPL M
|
||
FATAL LOSING PURE RSUBR POINTER
|
||
SKIPE M,1(M)
|
||
POPJ P,
|
||
|
||
DQCLP1: PUSH TP,$TRSUBR
|
||
PUSH TP,B
|
||
PUSH P,E
|
||
HLRZ A,1(B) ; SET UP TO CALL LOADER
|
||
PUSHJ P,PLOAD ; LOAD IT
|
||
JRST PCANT
|
||
POP P,E
|
||
MOVE M,B ; GET LOCATION
|
||
MOVE B,(TP)
|
||
SUB TP,C%22
|
||
POPJ P,
|
||
|
||
QCOPY: PUSH TP,$TVEC
|
||
PUSH TP,B
|
||
HRRZ C,UUOH
|
||
SUBI C,(M)
|
||
PUSH P,C
|
||
PUSH P,E
|
||
HLRE A,RSTACK+1(PVP)
|
||
MOVNS A
|
||
ADDI A,100
|
||
PUSHJ P,IBLOCK ; GET BLOCK
|
||
MOVEI A,.VECT.+TRSUBR
|
||
HLRE C,B
|
||
SUBM B,C
|
||
MOVEM A,(C)
|
||
HRLZ A,RSTACK+1(PVP)
|
||
JUMPE A,.+3
|
||
HRRI A,(B)
|
||
BLT A,-101(C) ; COPY IT
|
||
MOVEM B,RSTACK+1(PVP)
|
||
MOVE B,(TP)
|
||
SUB TP,C%22
|
||
POP P,E
|
||
POP P,C
|
||
ADDI C,(M)
|
||
HRRM C,UUOH
|
||
JRST DQCAL1
|
||
|
||
QMPOPJ: SKIPL E,(P)
|
||
JRST QFINIS
|
||
SUBM M,(P)
|
||
POPJ P,
|
||
|
||
QFINIS: POP P,D
|
||
HLRZS D
|
||
HRRM D,RSTACK(PVP)
|
||
ADD D,RSTACK+1(PVP)
|
||
MOVE R,(D) ; GET R OR WHATEVER
|
||
HRRM R,FSAV(TB)
|
||
GETYP 0,(R) ; TYPE
|
||
CAIN 0,TRSUBR ; RSUBR?
|
||
MOVE R,1(R)
|
||
SKIPL M,1(R) ; RSUBR IN CORE ETC
|
||
JRST QRLD
|
||
|
||
QRLD2: ADDI E,(M)
|
||
JRST (E)
|
||
|
||
QRLD: HLRS M
|
||
ADD M,PURVEC+1
|
||
SKIPE M,1(M) ; SKIP IF LOADED
|
||
JRST QRLD2
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
HLRZ A,1(R) ; RELOAD IT
|
||
PUSHJ P,PLOAD
|
||
JRST PCANT
|
||
POP TP,B
|
||
POP TP,A
|
||
MOVE M,1(R)
|
||
JRST QRLD2
|
||
|
||
]
|
||
; THIS IS A UUO TO CALL ERROR WITH ONE ARGUMENT
|
||
|
||
DOERR: PUSH P,UUOH
|
||
PUSH TP,$TATOM
|
||
MOVSI 0,7777400
|
||
ANDCAM 0,UUOLOC
|
||
PUSH TP,@UUOLOC
|
||
JRST CALER1
|
||
|
||
; ROUTINE TO DO AN RCALL FOR SUBRIFIED GOODIES
|
||
|
||
RMCALL: MOVEM M,SAVM ; SAVE M
|
||
SUBM M,(P)
|
||
MOVEI M,0
|
||
PUSHJ P,@0
|
||
MOVE M,SAVM
|
||
SETZM SAVM
|
||
SUBM M,(P)
|
||
POPJ P,
|
||
|
||
|
||
; ROUTINE USED BY COMPILED CODE TO SAVE ACS CALL AN INTERRUPT AND RESTORE ACS.
|
||
; THIS UUO TAKES A LOCATION FROM WHICH TO FIND A DESCRIPTION OF HOW ACS ARE TO
|
||
; BE SAVED.
|
||
; .SAVAC LOC
|
||
; LOC POINTS TO A BLOCK WHICH CAN BE ONE OR MORE WORDS LONG DEPENDING ON BOTH
|
||
; THE NUMBER OF SCRATCH AC'S (CURRENTLY 5) AND THE NUMBER OF AC'S CONTAINING
|
||
; TEMPLATE TYPES.
|
||
; THE FIRST PART OF THE BLOCK CONTAINS THE AC DECRIPTIONS. EACH AC IS DESCRIBED
|
||
; BY A SIX BIT FIELD WITH THE EXCEPTION OF AC'S CONTAINING TEMPLATES.
|
||
; THE SIX BIT FIELD CAN BE
|
||
;
|
||
; 0 EITHER A TYPE WORD OR NOTHING
|
||
; 1 -> 8 THE NUMBER OF THE AC CONTAINING THE TYPE
|
||
; 9 -> 62 THE SAT OF THE THING CONTAINED IN THE AC (+ 8)
|
||
; 63 A TEMPLATE LOOK AT THE BLOCK AFTER TO FIND A POINTER TO THE TYPE WORD
|
||
;
|
||
; TEMPLATE DESCRIPTIONS ARE FOUND AFTER THE AC DESCRIPTION BLOCK. THESE ARE FOUND
|
||
; IN SUCESSIVE WORDS CONTAINING POINTERS INTO THE R VECTOR
|
||
|
||
NOACS==10
|
||
TMPPTR==2
|
||
|
||
ONOACS==5
|
||
OTMPPT==1
|
||
|
||
DLSAVA: PUSH P,[SETZ NOACS]
|
||
PUSH P,[SETZ TMPPTR]
|
||
JRST DSAVA1
|
||
|
||
DSAVAC: PUSH P,[SETZ ONOACS]
|
||
PUSH P,[SETZ OTMPPT]
|
||
DSAVA1:
|
||
IFN ITS, MOVE 0,UUOH ; GET PC
|
||
IFE ITS,[
|
||
MOVE 0,UUOH
|
||
SKIPE MULTSG
|
||
MOVE 0,MLTPC
|
||
]
|
||
PUSH P,0
|
||
ANDI 0,-1
|
||
PUSH P,UUOLOC ; SAVE UUO
|
||
CAMG 0,PURTOP
|
||
CAMGE 0,VECBOT
|
||
JRST DONREL
|
||
SUBI 0,(M) ; M IS BASE REG
|
||
IFN ITS, TLO 0,M ; INDEX IT OFF M
|
||
IFE ITS,[
|
||
HRLI 0,400000+M
|
||
]
|
||
MOVEM 0,-1(P) ; AND RESTORE TO STACK
|
||
; MOVE 0,UUOLOC ; GET REL POINTER TO TBL - REDUNDANT
|
||
; MOVEM 0,(P) ; AND SAVE IT - REDUNDANT PTR ALREADY PUSHED
|
||
DONREL: MOVE C,SAVEC
|
||
MOVE 0,[A,,ACSAV]
|
||
BLT 0,ACSAV+NOACS-1
|
||
HRRZ 0,-3(P) ; NUMBER OF ACS
|
||
; MOVE A,[440620,,UUOLOC] ; BYTE POINTER INDIRECTED TO 40
|
||
IFN ITS,[
|
||
MOVE A,UUOLOC ; GET THE INSTRUCTION
|
||
HRLI A,440640 ; OR IN THE BYTE POINTER
|
||
]
|
||
IFE ITS,[
|
||
MOVSI A,440600+B ; OR IN THE BYTE POINTER
|
||
SKIPN MULTSG
|
||
HRRZ B,UUOLOC
|
||
SKIPE MULTSG
|
||
MOVE B,MLTEA
|
||
]
|
||
MOVE D,-2(P) ; POINTER TO TEMPLATE BLOCK
|
||
IFN ITS,[
|
||
MOVSI C,7777400
|
||
ANDCAM C,UUOLOC
|
||
ADD D,UUOLOC ; GET TO BLOCK
|
||
]
|
||
IFE ITS,[
|
||
SKIPE MULTSG
|
||
JRST XXXYYY
|
||
MOVSI C,7777400
|
||
ANDCAM C,UUOLOC
|
||
ADD D,UUOLOC
|
||
CAIA
|
||
|
||
XXXYYY: ADD D,MLTEA
|
||
]
|
||
HRROI C,1
|
||
LOPSAV: ILDB E,A ; GET A DESCRIPTOR
|
||
JUMPE E,NOAC1 ; ZERO==TYPE WORD
|
||
CAIE E,77 ; IF 63. THEN TEMPLATE HANDLE SPECIALLY
|
||
JRST NOTEM ; NOT A TEMPLATE
|
||
PUSH TP,@(D) ; IT IS A TEMPLATE POINTER SO PUSH TYPE
|
||
ADDI D,1 ; AOS B
|
||
LOPPUS: PUSH TP,ACSAV-1(C) ; PUSH AC
|
||
LPSVDN: ADDI C,1
|
||
SOJG 0,LOPSAV ; LOOP BACK
|
||
MOVE 0,[ACSAV,,A]
|
||
BLT 0,NOACS
|
||
JSR LCKINT ; GO INTERRUPT
|
||
HRRZ B,-3(P) ; NUMBER OF ACS
|
||
LOPPOP: POP TP,ACSAV-1(B)
|
||
LOPBAR: SUB TP,C%11
|
||
LOPFOO: SOJG B,LOPPOP
|
||
JUMPE R,LOPBLT ; OK, NOT RSUBR
|
||
IFE ITS,[
|
||
SKIPL 1(R) ; NOT PURE RSUBR
|
||
SKIPN MULTSG
|
||
]
|
||
IFN ITS, SKIPN 1(R) ; NOT PURE RSUBR
|
||
JRST LOPBLT
|
||
|
||
MOVE B,M
|
||
TLZ B,77740
|
||
MOVEI A,0
|
||
HRRI B,LOPBLT
|
||
XJRST A
|
||
|
||
LOPBLT: MOVE 0,[ACSAV,,A]
|
||
BLT 0,@-3(P) ; RESTORE AC'S
|
||
MOVE 0,-1(P)
|
||
SUB P,C%44 ; RETURN ADDRESS, (M)
|
||
JRST @0
|
||
|
||
NOTEM: CAILE E,8. ; SKIP IF AC IS TO BE PUSHED
|
||
JRST NOAC
|
||
IFE ITS, TLO E,400000 ; MAKE LOCAL INDEX
|
||
PUSH TP,ACSAV-1(E)
|
||
JRST LOPPUS ; FINISH PUSHING
|
||
NOAC: SUBI E,8 ; COMPENSATE FOR ADDED AMOUNT
|
||
NOAC1:
|
||
IFE ITS, TLO E,400000 ; MAKE LOCAL INDEX
|
||
MOVE E,@STBL(E)
|
||
HLRE F,E ; GET NEGATIVE
|
||
SUB E,F
|
||
HRLZ E,(E) ; GET TYPE CODE
|
||
TLZ E,400000+<0,,<-1>#<TYPMSK>> ; KILL SIGN BIT
|
||
PUSH TP,E ; PUSH TYPE
|
||
JRST LOPPUS ; FINISH PUSHING
|
||
|
||
FMPOPJ: MOVE TP,FRM
|
||
MOVE FRM,(TP)
|
||
HRLS C,-1(TP)
|
||
SUB TP,C
|
||
SUBM M,(P)
|
||
POPJ P,
|
||
|
||
|
||
NFPOPJ: MOVE TP,FRM ; CLEAR OFF FRM
|
||
MOVE FRM,(TP)
|
||
HRLS C,-1(TP)
|
||
SUB TP,C
|
||
|
||
; THIS WEIRD PIECE OF CODE IS USED TO DO AN MPOPJ IN SUBRIFIED CODE THAT
|
||
; DOES A SKIP/NON SKIP RETURN.
|
||
|
||
NSPOPJ: EXCH (P)
|
||
TLNE 37
|
||
MOVNS 0
|
||
EXCH (P)
|
||
POPJ P,
|
||
|
||
|
||
DPOPUN: PUSHJ P,POPUNW
|
||
JRST @UUOH
|
||
|
||
; HERE FOR MULTI SEG SIMULATION STUFF
|
||
|
||
DMOVEX: MOVSI C,(MOVE)
|
||
JRST MEX
|
||
DHRRM: MOVSI C,(HRRM)
|
||
JRST MEX
|
||
DHRLM: MOVSI C,(HRLM)
|
||
JRST MEX
|
||
DMOVMX: MOVSI C,(MOVEM)
|
||
JRST MEX
|
||
DHLRZ: MOVSI C,(HLRZ)
|
||
JRST MEX
|
||
DSETZM: MOVSI C,(SETZM)
|
||
JRST MEX
|
||
DXBLT: MOVE C,[123000,,[020000,,]]
|
||
|
||
MEX: MOVEM A,20
|
||
MOVE A,UUOH ; GET LOC OF INS
|
||
MOVE A,-1(A)
|
||
TLZ A,777000
|
||
IOR A,C
|
||
XJRST .+1
|
||
0
|
||
FSEG,,.+1
|
||
MOVE C,SAVEC
|
||
EXCH A,20
|
||
XCT 20
|
||
XJRST .+1
|
||
0
|
||
.+1
|
||
JRST @UUOH
|
||
|
||
|
||
IMPURE
|
||
|
||
SAVM: 0 ; SAVED M FOR SUBRIFY HACKERS
|
||
|
||
ACSAV: BLOCK NOACS
|
||
|
||
|
||
PURE
|
||
|
||
END
|
||
|