X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fuuoh.mid.182;fp=%3Cmdl.int%3E%2Fuuoh.mid.182;h=ee49582facf15c3e5b5ec9618e8bfe7213ef9ade;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//uuoh.mid.182 b//uuoh.mid.182 new file mode 100644 index 0000000..ee49582 --- /dev/null +++ b//uuoh.mid.182 @@ -0,0 +1,1095 @@ +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 + +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,DMOVEM],[SHLRZ,DHLRZ],[SSETZM,DSETZM],[SMOVE,DMOVE]] +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,440640 ; OR IN THE BYTE POINTER + SKIPN MULTSG + HRR A,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 + SKIPL 1(R) ; NOT PURE RSUBR + SKIPN MULTSG + 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>#> ; 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 + +DMOVE: MOVSI C,(MOVE) + JRST MEX +DHRRM: MOVSI C,(HRRM) + JRST MEX +DHRLM: MOVSI C,(HRLM) + JRST MEX +DMOVEM: 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 + \ No newline at end of file