1 TITLE UUO HANDLER FOR MUDDLE AND HYDRA
7 ;XBLT=123000,,[020000,,0]
9 IFE ITS,.INSRT STENEX >
11 ;GLOBALS FOR THIS PROGRAM
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
22 ;SETUP UUO DISPATCH TABLE HERE
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]]
42 ;SINCE CHECKING HAPPENS IN UUOH, NO LONGER NEED TABLE FULL OF ILLUUOS
43 ;REPEAT 100-UUFOO,[ILLUUO
61 ALLUUO: LDB C,[331100,,UUOLOC] ;GET OPCODE
64 CAIA ;SKIP IF ILLEGAL UUO
65 JRST @UUOTBL(C) ;DISPATCH TO SUITABLE HANDLER
67 .SUSET [.RJPC,,SAVJPC]
70 ILLUUO: FATAL ILLEGAL UUO
71 ; THIS WILL LEAVE .JPC FOR DEBUGGING AND SUCH
75 SAVJPC: 0 ; SAVE JPC IN CASE OF LOSS
76 SAVEC: 0 ; USED TO SAVE WORKING AC
79 MLTUUP: 0 ; HOLDS UUO (SWAPPED SORT OF)
81 MLTEA: 0 ; EFF ADDR OF UUO INSTRUCTION
82 MLTUUH: FSEG,,MLTUOP ; RUN IN "FSEG"
87 ;SEPARATION OF PURE FROM IMPURE CODE HERE
89 ;UUOPUR: MOVEM C,SAVEC ; SAVE AC
90 ; LDB C,[330900,,UUOLOC]
91 ; JRST @UUOTBL(C) ;DISPATCH BASED ON THE UUO
93 ; HANDLER FOR UUOS IN MULTI SEG MODE
97 MOVEM C,UUOH ; SO MANY THINGS WIN IMMEDIATE
101 MOVEM C,UUOLOC ; GET INS CODE
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
124 SUBI C,(M) ; RELATIVIZE THE PC
125 TLOA C,400000+M ; FOR RETURNER TO WIN
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
136 CALDON: MOVEM C,FSAV+1(TP) ; CLOBBER THE FRAME
137 MOVEM TB,OTBSAV+1(TP)
138 MOVEM AB,ABSAV+1(TP) ; FRAME BUILT
140 HRRI TB,(TP) ; SETUP NEW TB
142 SETZB M,SAVM ; ZERO M AND SAVM FOR GC WINNAGE
143 CAILE C,HIBOT ; SKIP IF RSUBR
145 GETYP A,(C) ; GET CONTENTS OF SLOT
146 JUMPN D,EVCALL ; EVAL CALLING ENTRY ?
147 CAIE A,TRSUBR ; RSUBR CALLING RSUBR ?
149 MOVE R,(C)+1 ; YES, SETUP R
150 CALLR0: HRRM R,FSAV+1(TB) ; FIXUP THE PROPER FSAV
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
158 MCHK1: INTGO ; CHECK FOR INTERRUPTS
163 HRLI TB,400000 ; KEEP TB NEGATIVE
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"
178 HRLI TB,400000 ; KEEP TB NEGATIVE
184 ; HERE TO HANDLE A PURE RSUBR (LOAD IF PUNTED OR OTHERWISE FLUSHED)
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
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
205 ADD C,M ; POINT TO START PC
207 TLZ C,777400 ; KILL COUNT
211 MOVEI B,0 ; AVOID FLAG MUNG
212 XJRST B ; EXTENDED JRST HACK
215 HRLI TB,400000 ; KEEP TB NEGATIVE
219 STUPM2: HLRZ A,1(R) ; SET UP TO CALL LOADER
222 PUSHJ P,PLOAD ; LOAD IT
226 MOVE M,B ; GET LOCATION
229 RCHECK: CAIN A,TPCODE ; PURE RSUBR?
231 CAIE A,TCODE ; EVALUATOR CALLING RSUBR ?
233 MOVS R,(C) ; YES, SETUP R
235 JRST CALLR1 ; GO FINISH THE RSUBR CALL
238 SCHECK: CAIE A,TSUBR ; RSUBR CALLING SUBR AS REFERENCE ?
240 SKIPA C,(C)+1 ; SKIP AND GET ROUTINE'S ADDRESS
242 HRRM C,FSAV+1(TB) ; FIXUP THE PROPER FSAV
243 IFE ITS, SKIPN MULTSG
244 JRST CALLS ; GO FINISH THE SUBR CALL
246 HRLI C,FSEG ; FOR SEG #1
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
257 ; CHECK IF CAN LINK ATOM
260 JRST BENTRY ; LOSER , COMPLAIN
261 ECHCK4: MOVE B,1(C) ; GET ATOM
264 PUSHJ P,IGVAL ; TRY GLOBAL VALUE
270 CAIE 0,TRSUBR ; IS IT A WINNER
272 CAMGE C,PURTOP ; DONT TRY TO SMASH PURE
275 HLLM A,(C) ; FIXUP LINKAGE
279 EVCALL: CAIN A,TATOM ; EVAL CALLING ENTRY?
280 JRST ECHCK4 ; COULD BE MUST FIXUP
281 CAIE A,TRSUBR ; YES THIS IS ONE
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
290 IFE ITS, SKIPN MULTSG
291 JRST CALLS ; GO TO SR
296 ACHECK: CAIE A,TATOM ; RSUBR CALLING THROUGH REFERENCE ATOM ?
297 JRST DOAPP3 ; TRY APPLYING IT
301 HRRZ C,UUOLOC ; REGOBBLE POINTER TO SLOT
305 SAVEIT: CAIE 0,TRSUBR
311 JRST BADVAL ; SOMETHING STRANGE
312 SAVEI1: CAMGE C,PURTOP ; SKIP IF PURE RSUBR VECTOR (NEVER LINKED)
315 MOVEM A,(C) ; CLOBBER NEW VALUE
318 JRST ENTRIT ; HACK ENTRY TO SUB RSUBR
320 JRST CALLR0 ; GO FINISH THE RSUBR CALL
325 SUBRIT: CAMGE C,PURBOT
330 HRRM B,FSAV+1(TB) ; FIXUP THE PROPER FSAV
332 IFN ITS, JRST CALLS ; GO FINISH THE SUBR CALL
341 SKIPA D,EQUOTE UNBOUND-VARIABLE
345 AOBJP TB,.+1 ; MAKE TB A LIGIT FRAME PNTR
350 MCHK6: MOVEI E,CALLER
351 HRRM E,FSAV(TB) ; SET A WINNING FSAV
352 HRRZ C,UUOLOC ; REGOBBLE POINTER TO SLOT
359 PUSH TP,IMQUOTE CALLER
365 BENTRY: MOVE D,EQUOTE BAD-ENTRY-BLOCK
371 HRLI TB,400000 ; KEEP TB NEGATIVE
376 ;HANDLER FOR CALL WHERE SPECIFIES NUMBER OF ARGS
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
385 ; CALL TO ENTRY FROM EVAL (LIKE ACALL)
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
393 ;HANDLE OVERFLOW IN THE TP
395 TPLOSE: PUSHJ P,TPOVFL
398 ; RSUBR HAS POSSIBLY BEEN REPLACED BY A FUNCTION OR WHATEVER, DO AN APPLY
400 DOAPPL: PUSH TP,A ; PUSH THE THING TO APPLY
403 DOAPP2: JUMPGE AB,DOAPP1 ; ARGS DONE
410 DOAPP1: ACALL A,APPLY ; APPLY THE LOSER
413 DOAPP3: MOVE A,(C) ; GET VAL
415 JRST BADVAL ; GET SETUP FOR APPLY CALL
417 ; ENTRY TO BUILD A FRAME (USED BY SOME COMPILED PROG/REPEAT)
420 HRLI A,400000+M ; RELATIVIZE PC
421 MOVEM A,PCSAV(TB) ; CLOBBER PC IN
422 MOVEM TP,TPSAV(TB) ; SAVE STATE
425 ADD TP,[FRAMLN,,FRAMLN]
427 PUSHJ TPOVFL ; HACK BLOWN PDL
428 MOVSI A,TCBLK ; FUNNY FRAME
430 MOVEM A,FSAV+1(TP) ; CLOBBER
431 MOVEM TB,OTBSAV+1(TP)
433 POP P,A ; RET ADDR TO A
436 IFN ITS, AOBJN TB,.+1
437 IFE ITS, AOBJP TB,.+2
443 HRLI TB,400000 ; KEEP TB NEGATIVE
447 \f;SUBROUTINE TERMINATION CODE (NOT A UUO BUT HERE FOR COMPLETENENSS)
450 CNTIN1: HRRZS C,OTBSAV(TB) ; RESTORE BASE
452 CONTIN: MOVE TP,TPSAV(TB) ; START HERE FOR FUNNY RESTART
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
463 GETYP 0,(C) ; RETURN TO MAIN OR SUB ENTRY?
470 SKIPL M,1(R) ; GET LOC OF REAL SUBR
473 ;HERE TO RETURN TO NBIN
475 RETNBI: HLRZ 0,PCSAV(TB) ; GET FUNNY STUFF
481 FINIS1: CAIE 0,TRSUBR
482 JRST FINISA ; MAY HAVE BEEN PUT BACK TO ATOM
484 FINIS9: SKIPGE M,1(R)
487 FINIS2: MOVEI C,(M) ; COMPUTE REAL M FOR PURE RSUBR
490 SKIPN M,1(M) ; SKIP IF LOADED
492 ADDI M,(C) ; POINT TO SUB PART
493 PCREST: HLRZ 0,PCSAV(TB)
494 IFN ITS, JUMPN @PCSAV(TB)
510 IFN ITS, JRST @PCSAV(TB)
522 HLRZ A,1(R) ; RELOAD IT
537 MOVE B,1(C) ; GET ATOM
538 PUSHJ P,IGVAL ; GET VAL
544 CAMLE C,PURTOP ; SKIP IF CAN LINK UP
553 BADENT: ERRUUO EQUOTE RSUBR-ENTRY-UNLINKED
556 PCANT: ERRUUO EQUOTE PURE-LOAD-FAILURE
559 BCKTR1: PUSH TP,A ; SAVE VALUE TO BE RETURNED
560 PUSH TP,B ; SAVE FRAME ON PP
567 ; SUBR TO ENABLE AND DISABLE LINKING OF RSUBRS AT RUN TIME
569 MFUNCTION %RLINK,SUBR,[RSUBR-LINK]
576 ;HANDLER FOR DEBUGGING CALL TO PRINT
623 DQCALL: GETYP C,@40 ; SEE IF THIS GUY IS A QRSUBR OR QENT
629 ; NOT A QENT OR QRSUBR, MAYBE AN ATOM THAT LINKS TO ONE
632 CAIE C,TATOM ; SKIP IF ATOM
633 JRST DMCALL ; PRETEND TO BE AN MCALL
635 MOVE C,UUOH ; GET PC OF CALL
636 SUBI C,(M) ; RELATIVIZE
638 LDB C,[270400,,40] ; GET # OF ARGS
640 HRRZ C,40 ; POINT TO RSUBR SLOT
641 MOVE B,1(C) ; GET ATOM
642 SUBI C,(R) ; RELATIVIZE IT
644 ADD C,R ; C IS NOW A VECTOR POINTER
649 PUSHJ P,IGVAL ; SEE IF IT HAS A VALUE
650 GETYP 0,A ; IS IT A WINNER
654 PUSHJ P,ILVAL ; LOCAL?
657 JRST DQCAL2 ; MAY BE A WINNER
660 PUSH TP,EQUOTE UNBOUND-VARIABLE
664 PUSH TP,IMQUOTE CALLER
667 DQCAL2: PUSH TP,$TENTE ; IN CASE RSUBR ENTRY
669 CAIN 0,TRSUBR ; RSUBR?
670 JRST DQRSB ; YES, WIN
674 DQMCAL: HRRZ C,-6(TP) ; PRETEND WE WERE AN MCALL
682 JRST DMCALL ; FALL INTO MCALL CODE
684 DQENT: MOVEM B,(TP) ; SAVE IT
685 GETYP 0,(B) ; LINKED UP?
689 DQENT2: CAIE 0,TATOM ; BETTER BE ATOM
691 PUSHJ P,IGVAL ; TRY TO LINK IT UP
700 DQRSB: PUSH TP,$TRSUBR
707 PUSHJ P,DQCALQ ; MAP ONE IN
709 MOVEI E,0 ; GET OFFSET
712 HLRE B,M ; FIND END OF CODE VECTOR
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
722 CAIL D,(E) ; IN RANGE?
728 SL1: HLRE D,(B) ; GET NEXT
736 HRRZ C,(B) ; GET OFFSET
737 MOVE R,(TP) ; SETUP R
738 SKIPN B,-2(TP) ; SKIP IF RSUBR ENTRY
748 DQMUNG: HRRZ D,-6(TP) ; GET CALLING RVECTOR
749 CAILE D,@PURTOP ; SMASHABLE?
750 JRST DQLOSS ; NO LOSE
764 MOVE B,1(E) ; GET RSUBR ENTRY
779 MOVEM A,(C) ; SAVE IT
781 HRRM B,FSAV(TB) ; FOR FUTURE MCALLS
784 SUBI C,(M) ; RELATIVIZE
786 SKIPL M,1(R) ; MAYBE LINK UP?
792 DQCALQ: HLRS M ; GET VECTOR OFFSET IN BOTH HALVES
793 ADD M,PURVEC+1 ; GET IT
795 FATAL LOSING PURE RSUBR POINTER
799 DQCLP1: PUSH TP,$TRSUBR
802 HLRZ A,1(B) ; SET UP TO CALL LOADER
803 PUSHJ P,PLOAD ; LOAD IT
806 MOVE M,B ; GET LOCATION
820 PUSHJ P,IBLOCK ; GET BLOCK
821 MOVEI A,.VECT.+TRSUBR
828 BLT A,-101(C) ; COPY IT
829 MOVEM B,RSTACK+1(PVP)
847 MOVE R,(D) ; GET R OR WHATEVER
850 CAIN 0,TRSUBR ; RSUBR?
852 SKIPL M,1(R) ; RSUBR IN CORE ETC
860 SKIPE M,1(M) ; SKIP IF LOADED
864 HLRZ A,1(R) ; RELOAD IT
873 ; THIS IS A UUO TO CALL ERROR WITH ONE ARGUMENT
882 ; ROUTINE TO DO AN RCALL FOR SUBRIFIED GOODIES
884 RMCALL: MOVEM M,SAVM ; SAVE M
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
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
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
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
910 ; TEMPLATE DESCRIPTIONS ARE FOUND AFTER THE AC DESCRIPTION BLOCK. THESE ARE FOUND
911 ; IN SUCESSIVE WORDS CONTAINING POINTERS INTO THE R VECTOR
919 DLSAVA: PUSH P,[SETZ NOACS]
923 DSAVAC: PUSH P,[SETZ ONOACS]
926 IFN ITS, MOVE 0,UUOH ; GET PC
934 PUSH P,UUOLOC ; SAVE UUO
938 SUBI 0,(M) ; M IS BASE REG
939 IFN ITS, TLO 0,M ; INDEX IT OFF M
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
949 HRRZ 0,-3(P) ; NUMBER OF ACS
950 ; MOVE A,[440620,,UUOLOC] ; BYTE POINTER INDIRECTED TO 40
952 MOVE A,UUOLOC ; GET THE INSTRUCTION
953 HRLI A,440640 ; OR IN THE BYTE POINTER
956 MOVSI A,440600+B ; OR IN THE BYTE POINTER
962 MOVE D,-2(P) ; POINTER TO TEMPLATE BLOCK
966 ADD D,UUOLOC ; GET TO BLOCK
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
985 LOPPUS: PUSH TP,ACSAV-1(C) ; PUSH AC
987 SOJG 0,LOPSAV ; LOOP BACK
990 JSR LCKINT ; GO INTERRUPT
991 HRRZ B,-3(P) ; NUMBER OF ACS
992 LOPPOP: POP TP,ACSAV-1(B)
994 LOPFOO: SOJG B,LOPPOP
995 JUMPE R,LOPBLT ; OK, NOT RSUBR
997 SKIPL 1(R) ; NOT PURE RSUBR
1000 IFN ITS, SKIPN 1(R) ; NOT PURE RSUBR
1009 LOPBLT: MOVE 0,[ACSAV,,A]
1010 BLT 0,@-3(P) ; RESTORE AC'S
1012 SUB P,C%44 ; RETURN ADDRESS, (M)
1015 NOTEM: CAILE E,8. ; SKIP IF AC IS TO BE PUSHED
1017 IFE ITS, TLO E,400000 ; MAKE LOCAL INDEX
1019 JRST LOPPUS ; FINISH PUSHING
1020 NOAC: SUBI E,8 ; COMPENSATE FOR ADDED AMOUNT
1022 IFE ITS, TLO E,400000 ; MAKE LOCAL INDEX
1024 HLRE F,E ; GET NEGATIVE
1026 HRLZ E,(E) ; GET TYPE CODE
1027 TLZ E,400000+<0,,<-1>#<TYPMSK>> ; KILL SIGN BIT
1028 PUSH TP,E ; PUSH TYPE
1029 JRST LOPPUS ; FINISH PUSHING
1039 NFPOPJ: MOVE TP,FRM ; CLEAR OFF FRM
1044 ; THIS WEIRD PIECE OF CODE IS USED TO DO AN MPOPJ IN SUBRIFIED CODE THAT
1045 ; DOES A SKIP/NON SKIP RETURN.
1054 DPOPUN: PUSHJ P,POPUNW
1057 ; HERE FOR MULTI SEG SIMULATION STUFF
1061 DMOVE: MOVSI C,(MOVE)
1063 DHRRM: MOVSI C,(HRRM)
1065 DHRLM: MOVSI C,(HRLM)
1067 DMOVEM: MOVSI C,(MOVEM)
1069 DHLRZ: MOVSI C,(HLRZ)
1071 DSETZM: MOVSI C,(SETZM)
1073 DXBLT: MOVE C,[123000,,[020000,,]]
1076 MOVE A,UUOH ; GET LOC OF INS
1094 SAVM: 0 ; SAVED M FOR SUBRIFY HACKERS