From: Adam Sampson Date: Wed, 11 Apr 2018 21:12:40 +0000 (+0100) Subject: More fixes for ITS. X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=commitdiff_plain;h=70f21077cc31399527eb374809ce1079258cfb62 More fixes for ITS. The latest version of each of the source files now assembles with MIDAS 458, although no version of STINK wants to load the result for anything that included MUDDLE >. --- diff --git a//amsgc.111 b//amsgc.111 new file mode 100644 index 0000000..301e825 --- /dev/null +++ b//amsgc.111 @@ -0,0 +1,887 @@ +TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR + +RELOCATABLE + +.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS +.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO +.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC +.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS +.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC +.GLOBAL RSLENG + +GCST=$. + +LOC REALGC+RLENGC + +OFFS=AGCLD-$. +OFFSET OFFS + +.INSRT MUDDLE > + +TYPNT==AB +F==PVP + + +; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING +; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. +; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE +; GARBAGE COLLECT + + +; FIRST INITIALIZE VARIABLES + +IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE + SETZM RCLV ; CLEAR VECTOR RECYCLE + SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE + SETOM GCFLG ; A GC HAS HAPPENED + SETZM TOTCNT + HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE + +; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER + + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE ACS + MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING + SKIPE GCMONF + PUSHJ P,MSGTYP + HRRZ C,(P) ; GET CAUSE INDICATOR + ADDI B,1 ; AOS TO GET REAL CAUS + MOVEM B,GCCAUS + SKIPN GCMONF + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL + SKIPN GCMONF ; PRINT IF GCMON IS ON + JRST NOMON3 + MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] + POP P,B ; RESTORE ACS + POP P,A + +; MOVE ACS INTO THE PVP + + EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR + + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVEM AC,AC!STO+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP + MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP + MOVE 0,DSTORE ; SAVE D'S TYPE + MOVEM 0,DSTO(PVP) + MOVEM PVP,PVSTOR+1 + +; SET UP TYPNT TO POINT TO TYPE VECTOR + + GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR + CAIE E,TVEC + FATAL TYPE VECTOR NOT OF TYPE VECTOR + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) + +; NOW SET UP GCPDL AND FENCE POST PDL'S + + MOVEI A,(TB) + MOVE D,P ; SAVE P POINTER + PUSHJ P,FRMUNG + MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL + MOVEI A,(TB) ; FIXUP TOP FRAME + SETOM 1(TP) ; FENCEPOST TP + SETOM 1(D) ; FENCEPOST P + +; NOW SETUP AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; FIRST CHANNEL SLOT +CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL + SETZM (A) ; CLEAR UP TYPE SLOT + ADDI A,2 + SOJG 0,CHNCLR + +; NOW DO MARK AND SWEEP PHASES + + MOVSI D,400000 ; MARK BIT + MOVEI B,TPVP ; GET TYPE + MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR + PUSHJ P,MARK + MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR + MOVE A,MAINPR + PUSHJ P,MARK ; MARK + PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING + PUSHJ P,CHFIX + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + PUSHJ P,SWEEP ; SWEEP WORLD + +; PRINT GOUT + + MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING + SKIPE GCMONF + PUSHJ P,MSGTYP + +; RESTORE ACS + + MOVE PVP,PVSTOR+1 ; GET PVP + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; PRINT TIME + + PUSH P,A ; SAVE ACS + PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,CTIME ; GET CURRENT CPU TIME + FSBR B,GCTIM ; COMPUTE TIME ELAPSED + MOVEM B,GCTIM ; SAVE TIME AWAY + SKIPN GCMONF ; PRINT IT OUT? + JRST GCCONT + PUSHJ P,FIXSEN + MOVEI A,15 ; OUTPUT CR/LF + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: POP P,D ; RESTORE ACS + POP P,C + POP P,B + POP P,A + SETZM GCFLG + SETOM GCHAPN + SETOM INTFLG + PUSHJ P,RBLDM + JRST FNMSGC ; DONE + + +; THIS IS THE MARK PHASE + +; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS +; /A POINTER TO GOODIE +; /B TYPE OF GOODIE +; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK + +MARK2S: +MARK2: HLRZ B,(C) ; TYPE +MARK1: MOVE A,1(C) ; VALUE +MARK: JUMPE A,CPOPJ ; DONE IF ZERO + MOVEI 0,1(A) ; SEE IF PURE + CAML 0,PURBOT + JRST CPOPJ + ANDI B,TYPMSK ; FLUSH MONITORS + HRLM C,(P) + CAIG B,NUMPRI ; IS A BASIC TYPE + JRST @MTYTBS(B) ; TYPE DISPATCH + LSH B,1 ; NOW GET PRIMTYPE + HRRZ B,@TYPNT ; GET PRIMTYPE + ANDI B,SATMSK ; FLUSH DOWN TO SAT + CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST @MSATBS(B) ; JUMP OFF SAT TABLE + JRST TD.MK + +GCRET: HLRZ C,(P) ; GET SAVED C +CPOPJ: POPJ P, + +; TYPE DISPATCH TABLE +MTYTBS: + +OFFSET 0 + +DUM1: + +IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] +[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] +[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] +[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] +[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] +[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] +[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] +[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK] +[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] +[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] +[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] +[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] +[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] +[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] +[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] + IRP A,B,[XX] + LOC DUM1+A + SETZ B + .ISTOP + TERMIN +TERMIN + +LOC DUM1+NUMPRI+1 + +OFFSET OFFS + +; SAT DISPATCH TABLE + +MSATBS: + +OFFSET 0 + +DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] +[STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] +[SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] +[SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] +[SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] +[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; ROUTINE TO MARK PAIRS + +PAIRMK: MOVEI C,(A) +PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE + CAIGE C,STOSTR + JRST BADPTR ; FATAL ERROR + HLRE B,(C) ; SKIP IF NOT MARKED + JUMPL B,GCRET + IORM D,(C) ; MARK IT + PUSHJ P,MARK1 ; MARK THE ITEM + HRRZ C,(C) ; GET NEXT ELEMENT OF LIST + JUMPE C,GCRET + CAML C,PURBOT + JRST GCRET + JRST PAIRM1 + +; ROUTINE TO MARK DEFERS + +DEFMK: HLRE B,(A) + JUMPL B,GCRET + MOVEI C,(A) + IORM D,(C) + PUSHJ P,MARK1 + JRST GCRET + +; ROUTINE TO MARK POSSIBLE DEFERS DEF? + +DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT + LSH B,1 ; COMPUTE THE SAT + HRRZ B,@TYPNT + ANDI B,SATMSK + SKIPL MKTBS(B) ; SKIP IF NOT DEFERED + JRST PAIRMK + JRST DEFMK ; GO TO DEFMK + + +; ROUTINE TO MARK VECTORS + +VECMK: HLRE B,A ; GET LENGTH + SUB A,B + MOVEI C,1(A) ; POINT TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE B,(C) + JUMPL B,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(B) ; GET TO BEGINNING +VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD + JUMPL B,GCRET ; DONE + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; NEXT ELEMENT + JRST VECMK1 + +; ROUTINE TO MARK UVECTORS + +UVMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE F,(C) ; GET LENGTH + JUMPL F,GCRET + IORM D,(C) ; MARK IT + GETYP B,-1(C) ; GET TYPE + MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION + LSH B,1 + HRRZ B,@TYPNT ; GET SAT + ANDI B,SATMSK + MOVEI B,@MSATBS(B) ; GET JUMP LOCATION + CAIN B,GCRET + JRST GCRET + SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR + SUBI F,2 + JUMPE F,GCRET + PUSH P,F ; SAVE LENGTH + PUSH P,E +UNLOOP: MOVE B,(P) + MOVE A,1(C) ; GET VALUE POINTER + PUSHJ P,MARK + SOSE -1(P) ; SKIP IF NON-ZERO + AOJA C,UNLOOP ; GO BACK AGAIN + SUB P,[2,,2] ; CLEAN OFF STACK + JRST GCRET + +; ROUTINE TO INDICATE A BAD POINTER + +BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE + JRST GCRET + + +; ROUTINE TO MARK A TPSTACK + +TPMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE A,(C) + JUMPL A,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(A) ; GO TO BEGINNING + +TPLP: HLRE B,(C) ; GET TYPE AND MARKING + JUMPL B,GCRET ; EXIT ON FENCE-POST + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK ; CHECK FOR FRAME + CAIN B,TENTRY + JRST MFRAME ; MARK THE FRAME + CAIE B,TUBIND ; BINDING BLOCK + CAIN B,TBIND + JRST MBIND + PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT + ADDI C,2 ; POINT TO NEXT OBJECT + JRST TPLP ; MARK IT + +; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] + +MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION + HRRZ A,1(C) ; GET POINTER + CAIL A,STOSTR ; SEE IF IN GC SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] + PUSHJ P,MARK +MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK + MOVEI B,TPDL + PUSHJ P,MARK + HRROI C,-FSAV+1(C) ; POINT PAST FRAME + JRST TPLP ; GO BACK TO START OF LOOP + +; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] + +MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; POINT TO VALUE SLOT + PUSHJ P,MARK2 ; MARK THE VALUE + ADDI C,2 ; POINT TO DECL AND PREV BINDING + MOVEI B,TLIST ; MARK DECL + HLRZ A,(C) + PUSHJ P,MARK + SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING + JRST NOTLCI + MOVEI B,TLOCI ; GET TYPE + PUSHJ P,MARK +NOTLCI: ADDI C,2 ; POINT PAST BINDING + JRST TPLP + + +PMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + IORM D,(C) ; MARK IT + JRST GCRET + +; ROUTINE TO MARK TB POINTER + +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET + MOVE A,TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK AB POINTERS + +ABMK: HLRE B,A ; GET TO FRAME + SUB A,B + MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK FRAME POINTERS + +FRMK: HRLZ B,A ; GET THE TIME + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAIE B,(F) ; SKIP IF TIMES AGREE + JRST GCRET ; IGNORE POINTER IF THEY DONT + HRRZ A,(C) ; GET POINTER TO PROCESS + SUBI A,1 ; FUDGE FOR VECTOR MARKING + MOVEI B,TPVP ; TYPE WORD + PUSHJ P,MARK + HRRZ A,1(C) ; GET POINTER TO FRAME + JRST TBMK ; MARK IT + +; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] + +ARGMK: HLRE B,A ; GET LENGTH + SUB A,B ; POINT PAST BLOCK + CAIL A,STOSTR + CAMLE A,GCSTOP ; SEE IF IN GCSPACE + JRST GCRET + HRLZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,TENTRY + CAIN 0,TCBLK + JRST ARGMK1 ; AT FRAME + CAIE 0,TINFO ; AT FRAME + JRST GCRET ; NOT A LEGAL TYPE GO AWAY + HRRZ A,1(A) ; POINTING TO FRAME + HRL A,(C) ; GET TIME + JRST TBMK +ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER + HRL A,(C) ; GET TIME + JRST TBMK + + +; ROUTINE TO MARK GLOBAL SLOTS + +GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,ATOMK ; NONE GO TO MARK ATOM + CAIN B,-1 ; SKIP IF NOT MANIFEST + JRST ATOMK + PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA + MOVEI C,(A) + MOVEI A,(B) + MOVEI B,TLIST ; TYPE WORD LIST + PUSHJ P,MARK ; MARK IT + POP P,A + JRST ATOMK5 + +ATOMK: +ATOMK5: HLRE B,A + SUB A,B ; A POINTS TO DOPE WORD + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET ; EXIT IF MARKED + HLRZ B,1(A) + SUBI B,3 + HRLI B,1(B) + MOVEI C,-1(A) + SUB C,B ; IN CASE WAS DW + IORM D,1(A) ; MARK IT + HRRZ A,2(C) ; MARK OBLIST + CAMG A,VECBOT + JRST NOOBL ; NO IMPURE OBLIST + HRLI A,-1 + MOVEI B,TOBLS ; MARK THE OBLIST + PUSHJ P,MARK +NOOBL: HLRZ A,2(C) ; GET NEXT ATOM + MOVEI B,TATOM + PUSHJ P,MARK + HLRZ B,(C) ; GET VALUE SLOT + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B ; SEE IF 0 + CAIN B,TUNBOUN ; SEE IF UNBOUND + JRST GCRET + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 ; SKIP IF VECTOR + MOVEI B,TTP ; IT IS A TP POINTER + PUSHJ P,MARK1 ; GO MARK IT + JRST GCRET + +; ROUTINE TO MARK BYTE AND STRING POINTERS + +BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A + HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] + ANDI F,SATMSK ; GET SAT + CAIN F,SATOM + JRST ATMSET ; IT IS AN ATOM + IORM D,(A) ; MARK IT + JRST GCRET + +ATMSET: HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT + MOVNI B,-2(B) ; GENERATE AOBJN POINTER + ADDI A,-1(B) ; GET BACK TO BEGINNING + HRLI A,(B) ; PUT IN LEFT HALF + MOVEI B,TATOM ; MARK AS AN ATOM + PUSHJ P,MARK ; GO MARK + JRST GCRET + +; MARK LOCID GOODIES + +LOCMK: HRRZ B,(C) ; CHECK FOR TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + JRST GCRET + MOVEI B,TTP + PUSHJ P,MARK1 + JRST GCRET +LOCMK1: MOVEI B,TVEC ; GLOBAL + PUSHJ P,MARK1 ; MARK VALUE + JRST GCRET + +; MARK ASSOCIATION BLOCK + +ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION + ADDI A,ASOLNT ; POINT TO DOPE WORD + HLRE B,1(A) ; GET SECOND D.W. + JUMPL B,GCRET ; MARKED SO LEAVE + IORM D,1(A) ; MARK ASSOCATION + PUSHJ P,MARK2 ; MARK ITEM + MOVEI C,INDIC(C) + PUSHJ P,MARK2 + MOVEI C,VAL-INDIC(C) + PUSHJ P,MARK2 + HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN + JUMPN A,ASMK ; GO MARK IT + JRST GCRET + +; MARK OFFSETS + +OFFSMK: PUSH P,$TLIST + HLRZ 0,1(C) ; PICK UP LIST POINTER + PUSH P,0 + MOVEI C,-1(P) + PUSHJ P,MARK2 ; MARK THE LIST + SUB P,[2,,2] + JRST GCRET ; AND RETURN + +; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + SKIPL 1(A) ; SEE IF MARKED + JRST GCRET ; IF MARKED LEAVE + IORM D,1(A) + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-3(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-4(P) ; SAVE ELMENT # + SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-3(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-4(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + EXCH A,B ; REARRANGE + HLRZS B + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: SUB P,[5,,5] + JRST GCRET + +USRAGC: XCT (E) ; MARK THE TEMPLATE + JRST GCRET + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE + HLRE B,A ; GET TO DOPE WORD + SUB A,B + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET + IORM D,1(A) ; MARK THE CHOMPER!!! + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRET + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 + + +; ROUTINE TO FIX UP CHANNELS + +CHNFLS: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SET UP POINTER +CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL + JRST CHFL2 ; NO CHANNEL LOOP TO NEXT + HLRE C,B ; POINT TO DOPE WORD OF CHANNEL + SUBI B,(C) + MOVEI F,TCHAN + HRLM F,(A) ; PUT TYPE BACK + SKIPL 1(B) ; SKIP IF MARKED + JRST FLSCH ; FLUSH THE CHANNEL + MOVEI F,1 ; MARK THE CHANNEL AS GOOD + HRRM F,(A) ; SMASH IT IN +CHFL2: ADDI A,2 + SOJG 0,CHFL1 + POPJ P, ; EXIT +FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE + JRST CHFL2 + + +; THIS ROUTINE MARKS ALL THE CHANNELS + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + +DHNFL2: SKIPN 1(A) + JRST DHNFL1 + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + MOVEI C,(A) + MOVE A,1(A) + MOVEI B,TCHAN + PUSHJ P,MARK + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + + +; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + +; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE +; RCL LIST, VECTORS ON THE RCLV LIST. + +SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE + SUBI C,1 ; POINT TO FIRST OBJECT + SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH +LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT + JRST ESWEEP ; DONE + HLRE A,-1(C) ; SEE IF LIST OR VECTOR + TRNE A,UBIT ; SKIP IF LIST + JRST VSWEEP ; IT IS A VECTOR + JUMPGE A,LSWP1 ; JUMP IF NOT MARKED + ANDCAM D,-1(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT + SUBI C,2 ; SKIP OVER LIST + JRST LSWEEP +LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT + JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS + MOVEI E,(C) ; GET ADDRESS +LSWP2: SUBI C,2 + JRST LSWEEP + +VSWEEP: HLRE A,(C) ; GET LENGTH + JUMPGE A,VSWP1 ; SKIP IF MARKED + ANDCAM D,(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS + ANDI A,377777 ; GET LENGTH PART + SUBI C,(A) ; GO PAST VECTOR + JRST LSWEEP +VSWP1: ADDI F,(A) ; ADD LENGTH + JUMPN E,VSWP2 + MOVEI E,(C) ; GET NEW OBJECT LOCATION +VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR + JRST LSWEEP + +ESWEEP: +SWCONS: JUMPE E,CPOPJ + ADDM F,TOTCNT ; HACK TOTCNT + CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM + MOVEM F,MAXLEN + CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG + FATAL SWEEP FAILURE + CAIN F,2 + JRST LCONS + SETZM (E) + MOVEI 0,(E) + SUBI 0,-1(F) + SETZM @0 + HRLS 0 + ADDI 0,1 + BLT 0,-2(E) + HRRZ 0,RCLV ; GET VECTOR RECYCLE + HRRM 0,(E) ; SMASH INTO LINKING SLOT + HRRZM E,RCLV ; NEW RECYCLE SLOT + HRLM F,(E) + MOVSI F,UBIT + MOVEM F,-1(E) + SETZB E,F + POPJ P, ; DONE +LCONS: SETZM (E) + SUBI E,1 + HRRZ 0,RCL ; GET RECYCLE LIST + HRRZM 0,(E) ; SMASH IN + HRRZM E,RCL + SETZB E,F + POPJ P, + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + +OFFSET OFFS + +MRKPDL==.-1 + +ENDGC: + +OFFSET 0 + +ZZ2==ENDGC-AGCLD + +.LOP ZZ2 <,-10.> +SLENGC==.LVAL1 +.LOP SLENGC <10.> +RSLENG==.LVAL1 +LOC GCST + +.LPUR=$. + +END diff --git a//atomhk.151 b//atomhk.151 new file mode 100644 index 0000000..069ad4a --- /dev/null +++ b//atomhk.151 @@ -0,0 +1,1199 @@ + +TITLE ATOMHACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > +.GLOBAL RLOOKU,CHMAK,OBLNT,ROOT,INTOBL,ERROBL,IFALSE,PVSTOR,SPSTOR +.GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB +.GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT +.GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX +.GLOBAL NOATMS + +LPVP==SP +TYPNT==AB +LNKBIT==200000 + +; FUNCTION TO GENERATE AN EMPTY OBLIST + +MFUNCTION MOBLIST,SUBR + + ENTRY + CAMGE AB,[-5,,0] ;CHECK NUMBER OF ARGS + JRST TMA + JUMPGE AB,MOBL2 ; NO ARGS + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSHJ P,IGET ; CHECK IF IT EXISTS ALREADY + CAMN A,$TOBLS + JRST FINIS +MOBL2: + MOVEI A,1 + PUSHJ P,IBLOCK ;GET A UNIFORM VECTOR + MOVSI C,TLIST+.VECT. ;IT IS OF TYPE LIST + HLRE D,B ;-LENGTH TO D + SUBM B,D ;D POINTS TO DOPE WORD + MOVEM C,(D) ;CLOBBER TYPE IN + MOVSI A,TOBLS + JUMPGE AB,FINIS ; IF NO ARGS, DONE + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVSI A,TOBLS + PUSH TP,$TOBLS + PUSH TP,B + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; PUT THE NAME ON THE OBLIST + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(TB) + PUSH TP,1(TB) + PUSHJ P,IPUT ; PUT THE OBLIST ON THE NAME + + POP TP,B + POP TP,A + JRST FINIS + +MFUNCTION GROOT,SUBR,ROOT + ENTRY 0 + MOVE A,ROOT + MOVE B,ROOT+1 + JRST FINIS + +MFUNCTION GINTS,SUBR,INTERRUPTS + ENTRY 0 + MOVE A,INTOBL + MOVE B,INTOBL+1 + JRST FINIS + +MFUNCTION GERRS,SUBR,ERRORS + ENTRY 0 + MOVE A,ERROBL + MOVE B,ERROBL+1 + JRST FINIS + + +COBLQ: SKIPN B,2(B) ; SKIP IF EXISTS + JRST IFLS + MOVSI A,TOBLS + + ANDI B,-1 + CAMG B,VECBOT ; TVP IS IN FROZEN SPACE, NEVER OBLISTS + MOVE B,(B) + HRLI B,-1 + +CPOPJ1: AOS (P) + POPJ P, + +IFLS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +MFUNCTION OBLQ,SUBR,[OBLIST?] + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,COBLQ + JFCL + JRST FINIS + + ; FUNCTION TO FIND AN ATOM ON A GIVEN OBLIST WITH A GIVEN PNAME + +MFUNCTION LOOKUP,SUBR + + ENTRY 2 + PUSHJ P,ILOOKU ;CALL INTERNAL ROUTINE + JRST FINIS + +CLOOKU: SUBM M,(P) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + PUSHJ P,CSTAK + MOVE B,(TP) + MOVSI A,TOBLS ; THIS IS AN OBLIST + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + SKIPE B + SOS (P) + SUB TP,[4,,4] + JRST MPOPJ + +ILOOKU: PUSHJ P,ARGCHK ;CHECK ARGS + PUSHJ P,CSTACK ;PUT CHARACTERS ON THE STACK + +CALLIT: MOVE B,3(AB) ;GET OBLIST + MOVSI A,TOBLS +ILOOKC: PUSHJ P,ILOOK ;LOOK IT UP + POP P,D ;RESTORE COUNT + HRLI D,(D) ;TO BOTH SIDES + SUB P,D + POPJ P, + +;THIS ROUTINE CHECKS ARG TYPES + +ARGCHK: GETYP A,(AB) ;GET TYPES + GETYP C,2(AB) + CAIE A,TCHRS ;IS IT EITHER CHAR STRING + CAIN A,TCHSTR + CAIE C,TOBLS ;IS 2ND AN OBLIST + JRST WRONGT ;TYPES ARE WRONG + POPJ P, + +;THIS SUBROUTINE PUTS CHARACTERS ON THE STACK (P WILL BE CHANGED) + + +CSTACK: MOVEI B,(AB) +CSTAK: POP P,D ;RETURN ADDRESS TO D + CAIE A,TCHRS ;IMMEDIATE? + JRST NOTIMM ;NO, HAIR + MOVE A,1(B) ; GET CHAR + LSH A,29. ; POSITION + PUSH P,A ;ONTO P + PUSH P,[1] ;WITH NUMBER + JRST (D) ;GO CALL SEARCHER + +NOTIMM: MOVEI A,1 ; CLEAR CHAR COUNT + MOVE C,(B) ; GET COUNT OF CHARS + TRNN C,-1 + JRST NULST ; FLUSH NULL STRING + MOVE PVP,PVSTOR+1 + MOVEM C,BSTO(PVP) + ANDI C,-1 + MOVE B,1(B) ;GET BYTE POINTER + +CLOOP1: PUSH P,[0] ; STORE CHARS ON STACK + MOVSI E,(<440700,,(P)>) ; SETUP BYTE POINTER +CLOOP: SKIPL INTFLG ; SO CAN WIN WITH INTERRUPTS + JRST CLOOP2 + MOVE PVP,PVSTOR+1 + HRRM C,BSTO(PVP) ;SAVE STRING LENGTH + JSR LCKINT +CLOOP2: ILDB 0,B ;GET A CHARACTER + IDPB 0,E ;STORE IT + SOJE C,CDONE ; ANY MORE? + TLNE E,760000 ; WORD FULL + JRST CLOOP ;NO CONTINUE + AOJA A,CLOOP1 ;AND CONTINUE + +CDONE: +CDONE1: MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + PUSH P,A ;AND NUMBER OF WORDS + JRST (D) ;RETURN + + +NULST: ERRUUO EQUOTE NULL-STRING + ; THIS FUNCTION LOOKS FOR ATOMS. CALLED BY PUSHJ P,ILOOK +; A,B/ OBLIST POINTER (CAN BE LIST OF SAME) +; -1(P)/ LENGTH IN WORDS OF CHARACTER BLOCK +; CHAR STRING IS ON THE STACK +; IF ATOM EXISTS RETURNS: +; B/ THE ATOM +; C/ THE BUCKET +; 0/ THE PREVIOUS BUCKET +; +; IF NOT +; B/ 0 +; 0/ PREV IF ONE WITH SAME PNAME, ELSE 0 +; C/ BUCKET + +ILOOK: PUSH TP,A + PUSH TP,B + + MOVN A,-1(P) ;GET -LENGTH + HRLI A,-1(A) ;<-LENGTH-1>,,-LENGTH + PUSH TP,$TFIX ;SAVE + PUSH TP,A + ADDI A,-1(P) ;HAVE AOBJN POINTER TO CHARS + MOVE 0,[202622077324] ;HASH WORD + ROT 0,1 + TSC 0,(A) + AOBJN A,.-2 ;XOR THEM ALL TOGETHER + HLRE A,HASHTB+1 + MOVNS A + MOVMS 0 ; MAKE SURE + HASH CODE + IDIVI 0,(A) ;DIVIDE + HRLI A,(A) ;TO BOTH HALVES + ADD A,HASHTB+1 + + MOVE C,A + HRRZ A,(A) ; POINT TO FIRST ATOM + SETZB E,0 ; INDICATE NO ATOM + + JUMPE A,NOTFND +LOOK2: HLRZ E,1(A) ; PREPARE TO BUILD AOBJN + ANDI E,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI E,2 + HRLS E + SUBB A,E + + ADD A,[3,,3] ;POINT TO ATOMS PNAME + MOVE D,(TP) ;GET PSEUDO AOBJN POINTER TO CHARS + ADDI D,-1(P) ;NOW ITS A REAL AOBJN POINTER + JUMPE D,CHECK0 ;ONE IS EMPTY +LOOK1: + MOVE SP,(D) + CAME SP,(A) + + JRST NEXT1 ;THIS ONE DOESN'T MATCH + AOBJP D,CHECK ;ONE RAN OUT + AOBJN A,LOOK1 ;JUMP IF STILL MIGHT WIN + +NEXT1: HRRZ A,-1(TP) ; SEE IF WE'VE ALREADY SEEN THIS NAME + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS + CAIN D,TLIST + JUMPN A,CHECK3 ; DON'T LOOK FURTHER + JUMPN A,NOTFND +NEXT: + MOVE 0,E + HLRZ A,2(E) ; NEXT ATOM + JUMPN A,LOOK2 + HRRZ A,-1(TP) + JUMPN A,NEXT1 + + SETZB E,0 + +NOTFND: + MOVEI B,0 + MOVSI A,TFALSE +CPOPJT: + + SUB TP,[4,,4] + POPJ P, + +CHECK0: JUMPN A,NEXT1 ;JUMP IF NOT ALSO EMPTY + SKIPA +CHECK: AOBJN A,NEXT1 ;JUMP IF NO MATCH + +CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY? + SKIPN A + MOVE B,0 ; REMEMBER ATOM FOR FALL BACK + HLLOS -1(TP) ; INDICATE NAME MATCH HAS OCCURRED + HRRZ A,2(E) ; COMPUTE OBLIST POINTER + CAMGE A,VECBOT + MOVE A,(A) + HRROS A + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS OR + CAIE D,TOBLS + JRST CHECK1 + CAME A,-2(TP) ; DO OBLISTS MATCH? + JRST NEXT + +CHECK2: MOVE B,E ; RETURN ATOM + HLRE A,B + SUBM B,A + MOVE A,(A) + TRNE A,LNKBIT + SKIPA A,$TLINK + MOVSI A,TATOM + JRST CPOPJT + +CHECK1: MOVE D,-2(TP) ; ANY LEFT? + CAMN A,1(D) ; MATCH + JRST CHECK2 + JRST NEXT + +CHECK3: MOVE D,-2(TP) + HRRZ D,(D) + MOVEM D,-2(TP) + JUMPE D,NOTFND + JUMPE B,CHECK6 + HLRZ E,2(B) +CHECK7: HLRZ A,1(E) + ANDI A,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI A,2 + HRLS A + SUBB E,A + JRST CHECK5 + +CHECK6: HRRZ E,(C) + JRST CHECK7 + + ; FUNCTION TO INSERT AN ATOM ON AN OBLIST + +MFUNCTION INSERT,SUBR + + ENTRY 2 + GETYP A,2(AB) + CAIE A,TOBLS + JRST WTYP2 + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,3(AB) + PUSHJ P,IINSRT + JRST FINIS + +CINSER: SUBM M,(P) + PUSHJ P,IINSRT + JRST MPOPJ + +IINSRT: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + CAIN A,TATOM + JRST INSRT0 + +;INSERT WITH A GIVEN PNAME + + CAIE A,TCHRS + CAIN A,TCHSTR + JRST .+2 + JRST WTYP1 + + PUSH TP,$TFIX ;FLAG CALL + PUSH TP,[0] + MOVEI B,-5(TP) + PUSHJ P,CSTAK ;COPY ONTO STACK + MOVE B,-2(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK ;LOOK IT UP (BUCKET RETURNS IN C) + SETZM -4(TP) + SETZM -5(TP) ; KILL STRING POINTER TO KEEP FROM CONFUSING GC + JUMPN B,ALRDY ;EXISTS, LOSE + MOVE D,-2(TP) ; GET OBLIST BACK +INSRT1: PUSH TP,$TATOM + PUSH TP,0 ; PREV ATOM + PUSH TP,$TUVEC ;SAVE BUCKET POINTER + PUSH TP,C + PUSH TP,$TOBLS + PUSH TP,D ; SAVE OBLIST +INSRT3: PUSHJ P,IATOM ; MAKE AN ATOM + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + SKIPN E,-4(TP) ; AFTER AN ATOM? + JRST INSRT7 ; NO, FIRST IN BUCKET + MOVEI 0,(E) ; CHECK IF PURE + CAIG 0,HIBOT + JRST INSRNP + PUSH TP,$TATOM ; SAVE NEW ATOM + PUSH TP,B + MOVE B,E + PUSHJ P,IMPURIF + MOVE B,(TP) + MOVE E,-6(TP) + SUB TP,[2,,2] + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + +INSRNP: HLRZ 0,2(E) ; NEXT + HRLM A,2(E) ; SPLICE + HRLM 0,2(B) + JRST INSRT8 + +INSRT7: MOVE E,-2(TP) + EXCH A,(E) + HRLM A,2(B) ; IN CASE OLD ONE + +INSRT8: MOVE E,(TP) ; GET OBLIST + HRRM E,2(B) ; STORE OBLIST + MOVE E,(E) ; POINT TO LIST OF ATOMS + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE E,(TP) + HRRM B,(E) ;INTO NEW BUCKET + MOVSI A,TATOM + MOVE B,1(B) ;GET ATOM BACK + MOVE C,-6(TP) ;GET FLAG + SUB TP,[8,,8] ;POP STACK + JUMPN C,(C) + SUB TP,[4,,4] + POPJ P, + +;INSERT WITH GIVEN ATOM +INSRT0: MOVE A,-2(TP) ;GOBBLE PNAME + SKIPE 2(A) ; SKIP IF NOT ON AN OBLIST + JRST ONOBL + ADD A,[3,,3] + HLRE C,A + MOVNS C + PUSH P,(A) ;FLUSH PNAME ONTO P STACK + AOBJN A,.-1 + PUSH P,C + MOVE B,(TP) ; GET OBLIST FOR LOOKUP + MOVSI A,TOBLS + PUSHJ P,ILOOK ;ALREADY THERE? + JUMPN B,ALRDY + MOVE D,-2(TP) + + HLRE A,-2(TP) ; FIND DOPE WORD + SUBM D,A ; TO A + JUMPE 0,INSRT9 ; NO CURRENT ATOM + MOVE E,0 + MOVEI 0,(E) + CAIGE 0,HIBOT ; PURE? + JRST INSRPN + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,$TATOM + PUSH TP,D + MOVE B,E + PUSHJ P,IMPURIF + MOVE D,(TP) + MOVE E,-2(TP) + SUB TP,[4,,4] + HLRE A,D + SUBM D,A + + +INSRPN: HLRZ 0,2(E) ; POINT TO NEXT + HRLM A,2(E) ; CLOBBER NEW GUY IN + HRLM 0,2(D) ; FINISH SLPICE + JRST INSRT6 + +INSRT9: ANDI A,-1 + EXCH A,(C) ; INTO BUCKET + HRLM A,2(D) + +INSRT6: HRRZ E,(TP) + HRRZ E,(E) + MOVE B,D + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE C,(TP) ;RESTORE OBLIST + HRRZM B,(C) + MOVE B,-2(TP) ; GET BACK ATOM + HRRM C,2(B) ; CLOBBER OBLIST IN + MOVSI A,TATOM + SUB TP,[4,,4] + POP P,C + HRLI C,(C) + SUB P,C + POPJ P, + +LINKCK: HRRZ C,FSAV(TB) ;CALLER'S NAME + MOVE D,B + CAIE C,LINK + SKIPA C,$TATOM ;LET US INSERT A LINK INSTEAD OF AN ATOM + SKIPA C,$TLINK ;GET REAL ATOM FOR CALL TO ICONS + POPJ P, + HLRE A,D + SUBM D,A + MOVEI B,LNKBIT + IORM B,(A) + POPJ P, + + +ALRDY: ERRUUO EQUOTE ATOM-ALREADY-THERE + +ONOBL: ERRUUO EQUOTE ON-AN-OBLIST-ALREADY + +; INTERNAL INSERT CALL + +INSRTX: POP P,0 ; GET RET ADDR + PUSH TP,$TFIX + PUSH TP,0 + PUSH TP,$TATOM + PUSH TP,[0] + PUSH TP,$TUVEC + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,B + MOVSI A,TOBLS + PUSHJ P,ILOOK + JUMPN B,INSRXT + MOVEM 0,-4(TP) + MOVEM C,-2(TP) + JRST INSRT3 ; INTO INSERT CODE + +INSRXT: PUSH P,-4(TP) + SUB TP,[6,,6] + POPJ P, + JRST IATM1 + +; FUNCTION TO REMOVE AN ATOM FROM AN OBLIST + +MFUNCTION REMOVE,SUBR + + ENTRY + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + MOVEI C,0 + CAML AB,[-3,,] ; SKIP IF OBLIST GIVEN + JRST .+5 + GETYP 0,2(AB) + CAIE 0,TOBLS + JRST WTYP2 + MOVE C,3(AB) + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IRMV + JRST FINIS + +CIRMV: SUBM M,(P) + PUSHJ P,IRMV + JRST MPOPJ + +IRMV: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C +IRMV1: GETYP 0,A ; CHECK 1ST ARG + CAIN 0,TLINK + JRST .+3 + CAIE 0,TATOM ; ATOM, TREAT ACCORDINGLY + JRST RMV1 + + HRRZ D,2(B) ; SKIP IF ON OBLIST AND GET SAME + JUMPE D,RMVDON + CAMG D,VECBOT ; SKIP IF REAL OBLIST + HRRZ D,(D) ; NO, REF, GET IT + + JUMPGE C,GOTOBL + CAIE D,(C) ; BETTER BE THE SAME + JRST ONOTH + +GOTOBL: ADD B,[3,,3] ; POINT TO PNAME + HLRE A,B + MOVNS A + PUSH P,(B) ; PUSH PNAME + AOBJN B,.-1 + PUSH P,A + HRROM D,(TP) ; SAVE OBLIST + JRST RMV3 + +RMV1: JUMPGE C,TFA + CAIE 0,TCHRS + CAIN 0,TCHSTR + SKIPA A,0 + JRST WTYP1 + MOVEI B,-3(TP) + PUSHJ P,CSTAK +RMV3: MOVE B,(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + JUMPE B,RMVDON + + MOVEI A,(B) + CAIGE A,HIBOT ; SKIP IF PURE + JRST RMV2 + PUSH TP,$TATOM + PUSH TP,0 + PUSHJ P,IMPURIFY + MOVE 0,(TP) + SUB TP,[2,,2] + MOVE A,-3(TP) + MOVE B,-2(TP) + MOVE C,(TP) + JRST IRMV1 + +RMV2: JUMPN 0,RMV9 ; JUMP IF FIRST NOT IN BUCKET + HLRZ 0,2(B) ; POINT TO NEXT + MOVEM 0,(C) + JRST RMV8 + +RMV9: MOVE C,0 ; C IS PREV ATOM + HLRZ 0,2(B) ; NEXT + HRLM 0,2(C) + +RMV8: SETZM 2(B) ; CLOBBER OBLIST SLOT + MOVE C,(TP) ; GET OBLIST FOR SPLICE OUT + MOVEI 0,-1 + HRRZ E,(C) + +RMV7: JUMPE E,RMVDON + CAMN B,1(E) ; SEARCH OBLIST + JRST RMV6 + MOVE C,E + HRRZ E,(C) + SOJG 0,RMV7 + +RMVDON: SUB TP,[4,,4] + MOVSI A,TATOM + POPJ P, + +RMV6: HRRZ E,(E) + HRRM E,(C) ; SMASH IN + JRST RMVDON + + +;INTERNAL CALL FROM THE READER + +RLOOKU: PUSH TP,$TFIX ;PUSH A FLAG + POP P,C ;POP OFF RET ADR + PUSH TP,C ;AND USE AS A FLAG FOR INTERNAL + MOVE C,(P) ; CHANGE CHAR COUNT TO WORD + ADDI C,4 + IDIVI C,5 + MOVEM C,(P) + GETYP D,A + + CAIN D,TOBLS ;IS IT ONE OBLIST? + JRST .+3 + CAIE D,TLIST ;IS IT A LIST + JRST BADOBL + + JUMPE B,BADLST + PUSH TP,$TUVEC ; SLOT FOR REMEBERIG + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,[0] + PUSH TP,A + PUSH TP,B + CAIE D,TLIST + JRST RLOOK1 + + PUSH TP,$TLIST + PUSH TP,B +RLOOK2: GETYP A,(B) ;CHECK THIS IS AN OBLIST + CAIE A,TOBLS + JRST DEFALT + + SKIPE -4(TP) ; SKIP IF DEFAULT NOT STORED + JRST RLOOK4 + MOVE D,1(B) ; OBLIST + MOVEM D,-4(TP) +RLOOK4: INTGO + HRRZ B,@(TP) ;CDR THE LIST + HRRZM B,(TP) + JUMPN B,RLOOK2 + SUB TP,[2,,2] + JRST .+3 + +RLOOK1: MOVE B,(TP) + MOVEM B,-2(TP) + MOVE A,-1(TP) + MOVE B,(TP) + PUSHJ P,ILOOK + JUMPN B,RLOOK3 + SKIPN D,-2(TP) ; RESTORE FOR INSERT + JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION + SUB TP,[6,,6] ; FLUSH CRAP + SKIPN NOATMS + JRST INSRT1 + JRST INSRT1 + +DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN + ; SPECIFIED +DEFALT: MOVE 0,1(B) + CAIN A,TATOM ;SPECIAL DEFAULT INDICATING ATOM ? + CAME 0,MQUOTE DEFAULT + JRST BADDEF ;NO, LOSE + MOVEI A,DEFFLG + XORB A,-11(TP) ;SET AND TEST FLAG + TRNN A,DEFFLG ; HAVE WE BEEN HERE BEFORE ? + JRST BADDEF ; YES, LOSE + SETZM -6(TP) ;ZERO OUT PREVIOUS DEFAULT + SETZM -4(TP) + JRST RLOOK4 ;CONTINUE + + +INSRT2: JRST .+2 ; +RLOOK3: SUB TP,[6,,6] ;POP OFF LOSSAGE + PUSHJ P,ILINK ;IF THIS IS A LINK FOLLOW IT + PUSH P,(TP) ;GET BACK RET ADR + SUB TP,[2,,2] ;POP TP + JRST IATM1 ;AND RETURN + + +BADOBL: ERRUUO EQUOTE BAD-OBLIST-OR-LIST-THEREOF + +BADDEF: ERRUUO EQUOTE BAD-DEFAULT-OBLIST-SPECIFICATION + +ONOTH: ERRUUO EQUOTE ATOM-ON-DIFFERENT-OBLIST + ;SUBROUTINE TO MAKE AN ATOM + +IMFUNCTION ATOM,SUBR + + ENTRY 1 + + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IATOMI + JRST FINIS + +CATOM: SUBM M,(P) + PUSHJ P,IATOMI + JRST MPOPJ + +IATOMI: GETYP 0,A ;CHECK ARG TYPE + CAIE 0,TCHRS + CAIN 0,TCHSTR + JRST .+2 ;JUMP IF WINNERS + JRST WTYP1 + + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + MOVE A,0 + PUSHJ P,CSTAK ;COPY ONTO STACK + PUSHJ P,IATOM ;NOW MAKE THE ATOM + SUB TP,[2,,2] + POPJ P, + +;INTERNAL ATOM MAKER + +IATOM: MOVE A,-1(P) ;GET WORDS IN PNAME + ADDI A,3 ;FOR VALUE CELL + PUSHJ P,IBLOCK ; GET BLOCK + MOVSI C,<(GENERAL)>+SATOM ;FOR TYPE FIELD + MOVE D,-1(P) ;RE-GOBBLE LENGTH + ADDI D,3(B) ;POINT TO DOPE WORD + MOVEM C,(D) + SKIPG -1(P) ;EMPTY PNAME ? + JRST IATM0 ;YES, NO CHARACTERS TO MOVE + MOVE E,B ;COPY ATOM POINTER + ADD E,[3,,3] ;POINT TO PNAME AREA + MOVEI C,-1(P) + SUB C,-1(P) ;POINT TO STRING ON STACK + MOVE D,(C) ;GET SOME CHARS + MOVEM D,(E) ;AND COPY THEM + ADDI C,1 + AOBJN E,.-3 +IATM0: MOVSI A,TATOM ;TYPE TO ATOM +IATM1: POP P,D ;RETURN ADR + POP P,C + HRLI C,(C) + SUB P,C + JRST (D) ;RETURN + + ;SUBROUTINE TO GET AN ATOM'S PNAME + +MFUNCTION PNAME,SUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM ;CHECK TYPE IS ATOM + JRST WTYP1 + MOVE A,1(AB) + PUSHJ P,IPNAME + JRST FINIS + +CIPNAM: SUBM M,(P) + PUSHJ P,IPNAME + JRST MPOPJ + +IPNAME: ADD A,[3,,3] + HLRE B,A + MOVM B,B + PUSH P,(A) ;FLUSH PNAME ONTO P + AOBJN A,.-1 + MOVE 0,(P) ; LAST WORD + PUSHJ P,PNMCNT + PUSH P,B + PUSHJ P,CHMAK ;MAKE A STRING + POPJ P, + +PNMCNT: IMULI B,5 ; CHARS TO B + MOVE A,0 + SUBI A,1 ; FIND LAST 1 + ANDCM 0,A ; 0 HAS 1ST 1 + JFFO 0,.+1 + HRREI 0,-34.(A) ; FIND HOW MUCH TO ADD + IDIVI 0,7 + ADD B,0 + POPJ P, + +MFUNCTION SPNAME,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,CSPNAM + JRST FINIS + +CSPNAM: ADD B,[3,,3] + MOVEI D,(B) + HLRE A,B + SUBM B,A + MOVE 0,-1(A) + HLRES B + MOVMS B + PUSHJ P,PNMCNT + MOVSI A,TCHSTR + HRRI A,(B) + MOVSI B,010700 + HRRI B,-1(D) + POPJ P, + + ; BLOCK STRUCTURE SUBROUTINES FOR MUDDLE + +IMFUNCTION BLK,SUBR,BLOCK + + ENTRY 1 + + GETYP A,(AB) ;CHECK TYPE OF ARG + CAIE A,TOBLS ;IS IT AN OBLIST + CAIN A,TLIST ;OR A LIAT + JRST .+2 + JRST WTYP1 + MOVSI A,TATOM ;LOOK UP OBLIST + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL ;GET VALUE + PUSH TP,A + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,.BLOCK(PVP) ;HACK THE LIST + PUSH TP,.BLOCK+1(PVP) + MCALL 2,CONS ;CONS THE LIST + MOVE PVP,PVSTOR+1 + MOVEM A,.BLOCK(PVP) ;STORE IT BACK + MOVEM B,.BLOCK+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SET ;SET OBLIST TO ARG + JRST FINIS + +MFUNCTION ENDBLOCK,SUBR + + ENTRY 0 + + MOVE PVP,PVSTOR+1 + SKIPN B,.BLOCK+1(PVP) ;IS THE LIST NIL? + JRST BLKERR ;YES, LOSE + HRRZ C,(B) ;CDR THE LIST + HRRZM C,.BLOCK+1(PVP) + PUSH TP,$TATOM ;NOW RESET OBLIST + PUSH TP,IMQUOTE OBLIST + HLLZ A,(B) ;PUSH THE TYPE OF THE CAR + PUSH TP,A + PUSH TP,1(B) ;AND VALUE OF CAR + MCALL 2,SET + JRST FINIS + +BLKERR: ERRUUO EQUOTE UNMATCHED + +BADLST: ERRUUO EQUOTE NIL-LIST-OF-OBLISTS + ;SUBROUTINE TO CREATE CHARACTER STRING GOODIE + +CHMAK: MOVE A,-1(P) + ADDI A,4 + IDIVI A,5 + PUSHJ P,IBLOCK + MOVEI C,-1(P) ;FIND START OF CHARS + HLRE E,B ; - LENGTH + ADD C,E ;C POINTS TO START + MOVE D,B ;COPY VECTOR RESULT + JUMPGE D,NULLST ;JUMP IF EMPTY + MOVE A,(C) ;GET ONE + MOVEM A,(D) + ADDI C,1 ;BUMP POINTER + AOBJN D,.-3 ;COPY +NULLST: MOVSI C,TCHRS+.VECT. ;GET TYPE + MOVEM C,(D) ;CLOBBER IT IN + MOVE A,-1(P) ; # WORDS + HRLI A,TCHSTR + HRLI B,010700 + MOVMM E,-1(P) ; SO IATM1 WORKS + SOJA B,IATM1 ;RETURN + +; SUBROUTINE TO READ FIVE CHARS FROM STRING. +; TWO CALLS, ONE WITH A POINTING TO LIST ELEMENT, +; THE OTHER WITH B POINTING TO PAIR. SKIPS IF WINNER, ELSE DOESNT + +NXTDCL: GETYP B,(A) ;CHECK TYPE + CAIE B,TDEFER ;LOSE IF NOT DEFERRED + POPJ P, + + MOVE B,1(A) ;GET REAL BYTE POINTER +CHRWRD: PUSH P,C + GETYP C,(B) ;CHECK IT IS CHSTR + CAIE C,TCHSTR + JRST CPOPJC ;NO, QUIT + PUSH P,D + PUSH P,E + PUSH P,0 + MOVEI E,0 ;INITIALIZE DESTINATION + HRRZ C,(B) ; GET CHAR COUNT + JUMPE C,GOTDCL ; NULL, FINISHED + MOVE B,1(B) ;GET BYTE POINTER + MOVE D,[440700,,E] ;BYTE POINT TO E +CHLOOP: ILDB 0,B ; GET A CHR + IDPB 0,D ;CLOBBER AWAY + SOJE C,GOTDCL ; JUMP IF DONE + TLNE D,760000 ; SKIP IF WORD FULL + JRST CHLOOP ; MORE THAN 5 CHARS + TRO E,1 ; TURN ON FLAG + +GOTDCL: MOVE B,E ;RESULT TO B + AOS -4(P) ;SKIP RETURN +CPOPJ0: POP P,0 + POP P,E + POP P,D +CPOPJC: POP P,C + POPJ P, + + ;ROUTINES TO DEFINE AND HANDLE LINKS + +MFUNCTION LINK,SUBR + ENTRY + CAML AB,[-6,,0] ;NO MORE THAN 3 ARGS + CAML AB,[-2,,0] ;NO LESS THAN 2 ARGS + JRST WNA + CAML AB,[-4,,0] ;ONLY TWO ARGS SUPPLIED ? + JRST GETOB ;YES, GET OBLIST FROM CURRENT PATH + MOVE A,2(AB) + MOVE B,3(AB) + MOVE C,5(AB) + JRST LINKIN +GETOB: MOVSI A,TATOM + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL + CAMN A,$TOBLS + JRST LINKP + CAME A,$TLIST + JRST BADOBL + JUMPE B,BADLST + GETYPF A,(B) + MOVE B,(B)+1 +LINKP: MOVE C,B + MOVE A,2(AB) + MOVE B,3(AB) +LINKIN: PUSHJ P,IINSRT + CAMN A,$TFALSE ;LINK NAME ALREADY USED ? + JRST ALRDY ;YES, LOSE + MOVE C,B + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,CSETG + JRST FINIS + + +ILINK: HLRE A,B + SUBM B,A ;FOUND A LINK ? + MOVE A,(A) + TRNE A,LNKBIT + JRST .+3 + MOVSI A,TATOM + POPJ P, ;NO, FINISHED + MOVSI A,TATOM + PUSHJ P,IGVAL ;GET THE LINK'S DESTINATION + CAME A,$TUNBOUND ;WELL FORMED LINK ? + POPJ P, ;YES + ERRUUO EQUOTE BAD-LINK + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPURIFY: + PUSH TP,$TATOM + PUSH TP,B + MOVE C,B + MOVEI 0,(C) + CAIGE 0,HIBOT + JRST RTNATM ; NOT PURE, RETURN + JRST IMPURX + +; ROUTINE PASSED TO GCHACK + +ATFIX: CAME D,(TP) + CAMN D,-2(TP) + JRST .+2 + POPJ P, + + ASH C,1 + ADD C,TYPVEC+1 ; COMPUTE SAT + HRRZ C,(C) + ANDI C,SATMSK + CAIE C,SATOM +CPOPJ: POPJ P, + + SUB D,-2(TP) + ADD D,-4(TP) + SKIPE B + MOVEM D,1(B) + POPJ P, + + +; SUBROUTINE TO FIND A BYTE STRINGS DOPE WORD +; RECEIVES POINTER TO PAIR CONNTAINIGN CHSTR IN C, RETURNS DOPE WORD IN A + +BYTDOP: PUSH P,B ; SAVE SOME ACS + PUSH P,D + PUSH P,E + MOVE B,1(C) ; GET BYTE POINTER + LDB D,[360600,,B] ; POSITION TO D + LDB E,[300600,,B] ; AND BYTE SIZE + MOVEI A,(E) ; A COPY IN A + IDIVI D,(E) ; D=> # OF BYTES IN WORD 1 + HRRZ E,(C) ; GET LENGTH + SUBM E,D ; # OF BYTES IN OTHER WORDS + JUMPL D,BYTDO1 ; NEAR DOPE WORD + MOVEI B,36. ; COMPUTE BYTES PER WORD + IDIVM B,A + ADDI D,-1(A) ; NOW COMPUTE WORDS + IDIVI D,(A) ; D/ # NO. OF WORDS PAST 1ST + ADD D,1(C) ; D POINTS TO DOPE WORD + MOVEI A,2(D) + +BYTDO2: POP P,E + POP P,D + POP P,B + POPJ P, +BYTDO1: MOVEI A,2(B) + JRST BYTDO2 + +; 1) IMPURIFY ITS OBLIST LIST + +IMPURX: HRRZ B,2(C) ; PICKUP OBLIST IF IT EXISTS + JUMPE B,IMPUR0 ; NOT ON ONE, IGNORE THIS CODE + + HRRO E,(B) + PUSH TP,$TOBLS ; SAVE BUCKET + PUSH TP,E + + MOVE B,(E) ; GET NEXT ONE +IMPUR4: MOVEI 0,(B) + MOVE D,1(B) + CAME D,-2(TP) + JRST .+3 + SKIPE GPURFL ; IF PURIFY SMASH THE OBLIST SLOT TO PROTECT + ; ATOM + HRRM D,1(B) + CAIGE 0,HIBOT ; SKIP IF PURE + JRST IMPUR3 ; FOUND IMPURE NESS, SKIP IT + HLLZ C,(B) ; SET UP ICONS CALL + HRRZ E,(B) +IMPR1: PUSHJ P,ICONS ; CONS IT UP +IMPR2: HRRZ E,(TP) ; RETRV PREV + HRRM B,(E) ; AND CLOBBER +IMPUR3: MOVE D,1(B) + CAMN D,-2(TP) ; HAVE GOTTEN TO OUR SLOT? + JRST IMPPR3 + MOVSI 0,TLIST + MOVEM 0,-1(TP) ; FIX TYPE + HRRZM B,(TP) ; STORE GOODIE + HRRZ B,(B) ; CDR IT + JUMPN B,IMPUR4 ; LOOP +IMPPR3: SUB TP,[2,,2] ; FLUSH TP CRUFT + +; 1.5) IMPURIFY GLOBAL HASH BUCKET, A REAL PAIN + +IMPUR0: MOVE C,(TP) ; GET ATOM + + HRRZ B,2(C) + MOVE B,(B) + ADD C,[3,,3] ; POINT TO PNAME + HLRE A,C ; GET LNTH IN WORDS OF PNAME + MOVNS A +; PUSH P,[SETZ IMPUR2] ; FAKE OUT ILOOKC + XMOVEI 0,IMPUR2 + PUSH P,0 + PUSH P,(C) ; PUSH UP THE PNAME + AOBJN C,.-1 + PUSH P,A ; NOW THE COUNT + MOVSI A,TOBLS + JRST ILOOKC ; GO FIND BUCKET + +IMPUR2: JUMPE B,IMPUR1 + JUMPE 0,IMPUR1 ; YUP, DONE + HRRZ C,0 + CAIG C,HIBOT ; SKIP IF PREV IS PURE + JRST IMPUR1 + + MOVE B,0 + PUSH P,GPURFL ; PRERTEND OUT OF PURIFY + HLRE C,B + SUBM B,C + HRRZ C,(C) ; ARE WE ON PURIFY LIST + CAIG C,HIBOT ; IF SO, WE ARE STILL PURIFY + SETZM GPURFL + PUSHJ P,IMPURIF ; RECURSE + POP P,GPURFL + MOVE B,(TP) ; AND RETURN ORIGINAL + +; 2) GENERATE A DUPLICATE ATOM + +IMPUR1: SKIPE GPURFL ; SEE IF IN PURIFY + JRST IMPUR7 + HLRE A,(TP) ; GET LNTH OF ATOM + MOVNS A + PUSH P,A + PUSHJ P,IBLOCK ; GET NEW BLOCK FOR ATOM + PUSH TP,$TATOM + PUSH TP,B + HRL B,-2(TP) ; SETUP BLT + POP P,A + ADDI A,(B) ; END OF BLT + BLT B,(A) ; CLOBBER NEW ATOM + MOVSI B,.VECT. ; TURN ON BIT FOR GCHACK + IORM B,(A) + +; 3) NOW COPY GLOBAL VALUE + +IMPUR7: MOVE B,(TP) ; ATOM BACK + GETYP 0,(B) + SKIPE A,1(B) ; NON-ZER POINTER? + CAIN 0,TUNBOU ; BOUND? + JRST IMPUR5 ; NO, DONT COPY GLOB VAL + PUSH TP,(A) + PUSH TP,1(A) + PUSH TP,$TATOM + PUSH TP,B + SETZM (B) + SETZM 1(B) + SKIPN GPURFL ; HERE IS SOME CODE NEEDED FOR PURIFY + JRST IMPUR8 + PUSH P,LPVP + MOVE PVP,PVSTOR+1 + PUSH P,AB ; GET AB BACK + MOVE AB,ABSTO+1(PVP) +IMPUR8: PUSHJ P,BSETG ; SETG IT + SKIPN GPURFL + JRST .+3 ; RESTORE SP AND AB FOR PURIFY + POP P,TYPNT + POP P,SP + SUB TP,[2,,2] ; KILL ATOM SLOTS ON TP + POP TP,C ;POP OFF VALUE SLOTS + POP TP,A + MOVEM A,(B) ; FILL IN SLOTS ON GLOBAL STACK + MOVEM C,1(B) +IMPUR5: SKIPE GPURFL ; FINISH OFF DIFFERENTLY FOR PURIFY + JRST IMPUR9 + + PUSH TP,$TFIX ;SAVE OLD ATOM WITH FUNNY TYPE TO AVOID LOSSAGE + PUSH TP,-3(TP) + PUSH TP,$TFIX ; OTHER KIND OF POINTER ALSO + HLRE 0,-1(TP) + HRRZ A,-1(TP) + SUB A,0 + PUSH TP,A + +; 4) UPDATE ALL POINTERS TO THIS ATOM + + MOVE A,[PUSHJ P,ATFIX] ; INS TO PASS TO GCHACK + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[6,,6] + +RTNATM: POP TP,B + POP TP,A + POPJ P, + +IMPUR9: SUB TP,[2,,2] + POPJ P, ; RESTORE AND GO + + + +END diff --git a//const.6 b//const.6 new file mode 100644 index 0000000..5bd23ce --- /dev/null +++ b//const.6 @@ -0,0 +1,24 @@ +TITLE CONSTS + +RELOCA + +DEFINE C%MAKE A,B + .GLOBAL A + + IRP LH,RH,[B] + A==[LH,,RH] + .ISTOP + TERMIN +TERMIN + +IRP X,,[[C%11,1,1],[C%22,2,2],[C%33,3,3],[C%44,4,4],[C%55,5,5],[C%66,6,6] +[C%0,0,0],[C%1,0,1],[C%2,0,2],[C%3,0,3],[C%M1,-1,-1],[C%M2,-1,-2] +[C%M10,-1,0],[C%M20,-2,0],[C%M30,-3,0],[C%M40,-4,0],[C%M60,-6,0]] + + IRP A,B,[X] + C%MAKE A,[B] + .ISTOP + TERMIN + +TERMIN +END diff --git a//fopen.63 b//fopen.63 index af6e1a5..48fa169 100644 --- a//fopen.63 +++ b//fopen.63 @@ -4475,7 +4475,7 @@ GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B PUSH P,0 PUSH TP,$TCHAN PUSH TP,B - MCALL 1,INTFCN-1(B) + .MCALL 1,INTFCN-1(B) GETYP A,A CAIE A,TCHRS JRST BADRET @@ -4506,7 +4506,7 @@ PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B PUSH TP,A ;PUSH THE CHAR PUSH TP,$TCHAN ;PUSH THE CHANNEL PUSH TP,B - MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + .MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR JRST INTRET diff --git a//interr.426 b//interr.426 new file mode 100644 index 0000000..14ffb4f --- /dev/null +++ b//interr.426 @@ -0,0 +1,2901 @@ + +TITLE INTERRUPT HANDLER FOR MUDDLE + +RELOCATABLE + +.SYMTAB 3337. + +;C. REEVE APRIL 1971 + +.INSRT MUDDLE > + +SYSQ +XJRST=JRST 5, + +F==PVP +G==TVP + +IF1,[ +IFE ITS,.INSRT STENEX > +] + +PDLGRO==10000 ;AMOUNT TO GROW A PDL THAT LOSES +NINT==72. ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE + +IFN ITS,[ +;SET UP LOCATION 42 TO POINT TO TSINT + +RMT [ + +ZZZ==$. ;SAVE CURRENT LOCATION + +LOC 42 + + JSR MTSINT ;GO TO HANDLER + +LOC ZZZ +] +] + +; GLOBALS NEEDED BY INTERRUPT HANDLER + +.GLOBAL ONINT ; FUDGE INS EXECUTED IF NON ZERO AT START OF INTERRUPT +.GLOBAL INTBCK ; "PC-LOSER HACK " +.GLOBA GCFLG ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING +.GLOBAL GCFLCH ; FLUSH CHARS IMMEDIATE SO GC CAN SEE THEM +.GLOBAL CORTOP ; TOP OF CORE +.GLOBA GCINT ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT +.GLOBAL INTNUM,INTVEC ;TV ENTRIES CONCERNING INTERRUPTS +.GLOBAL AGC ;CALL THE GARBAGE COLLECTOR +.GLOBAL VECNEW,PARNEW,GETNUM ;GC PSEUDO ARGS +.GLOBAL GCPDL ;GARBAGE COLLECTORS PDL +.GLOBAL VECTOP,VECBOT ;DELIMIT VECTOR SPACE +.GLOBAL PURTOP,CISTNG,SAGC +.GLOBAL PDLBUF ;AMOUNT OF PDL GROWTH +.GLOBAL PGROW ;POINTS TO DOPE WORD OF NEXT PDL TO GROW +.GLOBAL TPGROW ;POINTS TO NEXT MUDDLE PDL TO GROW +.GLOBAL TOPLEV,ERROR%,N.CHNS,CHNL1 +.GLOBAL BUFRIN,CHNL0,SYSCHR ;CHANNEL GLOBALS +.GLOBAL IFALSE,TPOVFL,1STEPR,INTOBL,INCHAR,CURPRI,RDEVIC,RDIREC,GFALS,STATUS +.GLOBAL PSTAT,NOTRES,IOIN2,INAME,INTFCN,CHNCNT,CHANNO,GIBLOK,ICONS,INCONS +.GLOBAL IEVECT,INSRTX,ILOOKC,IPUT,IREMAS,IGET,CSTAK,EMERGE,CHFSWP +.GLOBAL MTSINT ;BEGINNING OF INTERRUPT HANDLER +.GLOBAL INTINT ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS +.GLOBAL FRMSTK,APPLY,CHUNW,TGFALS +.GLOBAL IPCGOT,DIRQ ;HANDLE BRANCHING OFF TO IPC KLUDGERY +.GLOBAL MULTSG + +; GLOBALS FOR GC +.GLOBAL GCTIM,GCCAUS,GCCALL,GPDLOV + +; GLOBALS FOR MONITOR ROUTINES + +.GLOBAL MONCH,MONCH0,RMONCH,RMONC0,LOCQ,SMON,BAPT,APLQ,MAKACT,NAPT +.GLOBAL PURERR,BUFRIN,INSTAT,REALTV,DSTORE + +MONITOR + +.GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED +.GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN +.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG,PLODR + +; GLOBALS FOR PRE-AGC INTERRUPT + +.GLOBAL FRETOP,GCSTOP,FREMIN,CORTOP,P.CORE,PURBOT,GETNUM,GCKNUM,GCHPN,INTAGC +.GLOBAL SPECBIND,SSPEC1,ILVAL + + +; GLOBALS FOR COPY/WRITE HACK FOR GCDUMP AND PURIFY + +.GLOBAL GCDFLG,%CWINF,BUFGC,WNDBOT,WIND,WNDP,%SHWND,GPURFL,%FDBUF,PURMNG,RPURBT +.GLOBAL NPWRIT,PVSTOR,SPSTOR,OPSYS + + + +;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE) + + +;***** TEMP FUDGE ******* + +QUEUES==INTVEC + + +; DECLARATIONS ASSOCIATED WITH INTERRUPT HANDERS AND HEADERS + +; SPECIAL TABLES + +SPECIN: IRP A,,[CHAR,CLOCK,MPV,ILOPR,WRITE,READ,IOC,PURE,SYSDOWN,INFERIOR,RUNT,REALT +PARITY] + MQUOTE A,[A]INTRUP + TERMIN +SPECLN==.-SPECIN + +; TABLE OF SPECIAL FINDING ROUTINES + +FNDTBL: IRP A,,[GETCHN,0,0,0,LOCGET,LOCGET,0,0,0,0,0,0,0] + A + TERMIN + +; TABLE OF SPECIAL SETUP ROUTINES + +INTBL: IRP A,,[S.CHAR,S.CLOK,S.MPV,S.ILOP,S.WMON,S.RMON,S.IOC,S.PURE,S.DOWN,S.INF +S.RUNT,S.REAL,S.PAR] + A + S!A==.IRPCNT + TERMIN + +IFN ITS,[ + +; EXTERNAL INTERRUPT TABLE + +EXTINT: REPEAT NINT-36.,0 + REPEAT 16.,HCHAR + 0 + 0 + REPEAT 8.,HINF + REPEAT NINT-62.,0 +EXTIND: + +IRP A,,[[HCLOCK,13.],[HMPV,14.],[HILOPR,6],[HIOC,9],[HPURE,26.],[HDOWN,7],[HREAL,35.] +[HRUNT,34.],[HPAR,28.]] + IRP B,C,[A] + LOC EXTINT+C + B + .ISTOP + TERMIN +TERMIN + + +LOC EXTIND +] + +IFE ITS,[ + +; TABLES FOR TENEX INTERRUPT SYSTEM + +LEVTAB: P1 ; POINTS TO INT PC HOLDERS FOR LEVS 1,2 AND 3 + P2 + P3 + +CHNMSK==700000,,7 ; WILL BE MASK WORD FOR INT SET UP +MFORK==400000 +NNETS==7 ; ALLOW 7 NETWRK INTERRUPTS +UINTS==4 +NETCHN==36.-NNETS-UINTS-1 +NCHRS==6 +RLCHN==36.-NNETS-UINTS + +RMT [ +IMPURE ; IMPURE BECAUSE IT CHANGES IN MULTI-SECTION MODE +CHNTAB: ; LOCATION OF INT ROUTINES FOR VARIOUS "CHANNELS" + +REPEAT NCHRS, 1,,INTCHR+3*.RPCNT + BLOCK 36.-NNETS-NCHRS-UINTS-1 ; THERE ARE 36. TENEX INT CHANNELS + +REPEAT NNETS+UINTS, 1,,INTNET+3*.RPCNT + +IRP A,,[[9.,TNXPDL],[17.,PWRIT],[10.,TNXEOF],[11.,TNXIOC],[12.,TNXFUL] +[RLCHN,TNXRLT],[19.,TNXINF]] + IRP B,C,[A] + LOC CHNTAB+B + 1,,C + CHNMSK==CHNMSK+<1_<35.-B>> + .ISTOP + TERMIN +TERMIN +LOC CHNTAB+36. +PURE +] +EXTINT: +BLOCK 36. +REPEAT NCHRS,SETZ HCHAR +BLOCK NINT-NNETS-NCHRS-UINTS-36.-1 +REPEAT NNETS,SETZ HNET +REPEAT UINTS,SETZ USRINT +LOC EXTINT+NINT-11. +REPEAT 3,SETZ HIOC +LOC EXTINT+NINT-RLCHN-1 +SETZ HREAL +LOC EXTINT+NINT-19.-1 +SETZ HINF +LOC EXTINT+NINT +] + + +; HANDLER/HEADER PARAMETERS + +; HEADER BLOCKS + +IHDRLN==4 ; LENGTH OF HEADER BLOCK + +INAME==0 ; NAME OF INTERRUPT +ISTATE==2 ; CURRENT STATE +IHNDLR==4 ; POINTS TO LIST OF HANDLERS +INTPRI==6 ; CONTAINS PRIORITY OF INTERRUPT + +IHANDL==4 ; LENGTH OF A HANDLER BLOCK + +INXT==0 ; POINTS TO NEXTIN CHAIN +IPREV==2 ; POINTS TO PREV IN CHAIN +INTFCN==4 ; FUNCTION ASSOCIATED WITH THIS HANDLER +INTPRO==6 ; PROCESS TO RUN INT IN + +IFN ITS,[ +RMT [ +IMPURE +TSINT: +MTSINT: 0 ;INTERRUPT BITS GET STORED HERE +TSINTR: 0 ;INTERRUPT PC WORD STORED HERE + JRST TSINTP ;GO TO PURE CODE + +; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE + +LCKINT: 0 + JRST DOINT + +PURE +] +] +IFE ITS,[ +RMT [ +; JSR HERE FOR SOFTWARE INTERNAL INTERRUPTS + +IMPURE +LCKINT: 0 + JRST DOINT +PURE +] +] + + +IFN ITS,[ + +;THE REST OF THIS CODE IS PURE + +TSINTP: SOSGE INTFLG ; SKIP IF ENABLED + SETOM INTFLG ;DONT GET LESS THAN -1 + + SKIPE INTBCK ; ANY INT HACKS? + JRST PCLOSR ; DO A PC-LOSR ON THE PROGRAM + MOVEM A,TSAVA ;SAVE TWO ACS + MOVEM B,TSAVB + MOVE A,TSINT ;PICK UP INT BIT PATTERN + JUMPL A,2NDWORD ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON + + TRZE A,200000 ;IS THIS A PDL OVERFLOW? + JRST IPDLOV ;YES, GO HANDLE IT FIRST + +IMPCH: MOVEI B,0 + TRNE A,20000 ;IS IT A MEMORY PROTECTION VIOLATION? + MOVEI B,1 ; FLAG SAME + + TRNE A,40 ;ILLEGAL OP CODE? + MOVEI B,2 ; ALSO FLAG + TRNN A,400 ; IOC? + JRST .+3 + SOS TSINTR + MOVEI B,3 + TLNE A,200 ; PURE? + JRST GCPWRT ; CHECK FOR PURE WRITE FOR POSSIBLE C/W +NOPUGC: SOJGE B,DO.NOW ; CANT WAIT AROUND + +;DECODE THE REST OF THE INTERRUPTS USING A TABLE + +2NDWORD: + JUMPL A,GC2 ;2ND WORD? + IORM A,PIRQ ;NO, INTO WORD 1 + JRST GCQUIT ;AND DISMISS INT + +GC2: TLZ A,400000 ;TURN OFF SIGN BIT + IORM A,PIRQ2 + TRNE A,177777 ;CHECK FOR CHANNELS + JRST CHNACT ;GO IF CHANNEL ACTIVITY +] +GCQUIT: SKIPGE INTFLG ;SKIP IF INTERRUPTS ENABLED + JRST INTDON ;NO, DEFER REAL HANDLING UNTIL LATER + + MOVE A,TSINTR ;PICKUP RETURN WORD +IFE ITS,[ + SKIPE MULTSG + JRST MLTEX + TLON A,10000 ; EXEC PC? + SOJA A,MLTEX1 ; YES FIXUP PC +MLTEX: TLON A,10000 + SOS TSINTR+1 + MOVEM A,TSINTR + MOVE A,TSINTR+1 +] +MLTEX1: MOVEM A,LCKINT ;STORE ELSEWHERE + MOVEI A,DOINTE ;CAUSE DISMISS TO HANDLER +IFN ITS, HRRM A,TSINTR ;STORE IN INT RETURN +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] + PUSH P,INTFLG ;SAVE INT FLAG + SETOM INTFLG ;AND DISABLE + + +INTDON: MOVE A,TSAVA ;RESTORE ACS + MOVE B,TSAVB +IFN ITS, .DISMISS TSINTR ;AND DISMISS THE INTERRUPT +IFE ITS, DEBRK + +IFN ITS,[ +PCLOSR: MOVEM A,TSAVA + HRRZ A,TSINTR ; WHERE FROM + CAIG A,INTBCK + CAILE A,INTBEN ; AVOID TIMING ERRORS + JRST .+2 + JRST INTDON + + SOS A,INTBCK + MOVEM A,TSINTR + SETZM INTBCK + SETZM INTFLG + AOS INTFLG + MOVE TP,TPSAV(TB) + MOVE P,PSAV(TB) + MOVE A,TSAVA + JRST TSINTP +] +DO.NOW: SKIPN GPURFL + SKIPE GCFLG + JRST DLOSER ; HANDLE FATAL GC ERRORS + MOVSI B,1 + SKIPGE INTFLG ; IF NOT ENABLED + MOVEM B,INTFLG ; PRETEND IT IS +IFN ITS, JRST 2NDWORD +IFE ITS, JRST GCQUIT + +IFE ITS,[ + +; HERE FOR TENEX PDL OVER FLOW INTERRUPT + +TNXPDL: SOSGE INTFLG + SETOM INTFLG + MOVEM A,TSAVA + MOVEM B,TSAVB + JRST IPDLOV ; GO TO COMMON HANDLER + +; HERE FOR REAL TIMER + +TNXRLT: MOVEM A,TSAVA +IFG , MOVEI A,<1_<35.->> +IFLE MOVSI A,(<1_<35.->>) + + JRST CNTSG + +; HERE FOR TENEX ^G AND ^S INTERRUPTS + +INTCHR: +REPEAT NCHRS,[ + MOVEM A,TSAVA + MOVEI A,<1_<.RPCNT>> + JRST CNTSG +] +CNTSG: MOVEM B,TSAVB + IORM A,PIRQ2 ; SAY FOR MUDDLE LEVEL + SOSGE INTFLG + SETOM INTFLG + JRST GCQUIT +INTNET: +REPEAT NNETS+UINTS,[ + MOVEM A,TSAVA + MOVE A,[1_<.RPCNT+NETCHN>] + JRST CNTSG +] +TNXINF: MOVEM A,TSAVA + MOVEI A,<1_<35.-19.>> + JRST TNXCHN + +; LOW LEVEL HANDLERS FOR 10X IOC INTERRUPTS + +TNXEOF: MOVEM A,TSAVA + MOVSI A,(1_<35.-10.>) + JRST TNXCHN + +TNXIOC: MOVEM A,TSAVA + MOVSI A,(1_<35.-11.>) + JRST TNXCHN + +TNXFUL: MOVEM A,TSAVA + SKIPN PLODR + JRST TNXFU1 + FATAL DISK FULL IN PURE FIXUP, CONTINUE TO RETRY + JRST INTDON + +TNXFU1: MOVSI A,(1_<35.-12.>) + +TNXCHN: IORM A,PIRQ2 + MOVEM B,TSAVB + HRRZ A,TSAVA ; ASSUME JFN IS IN A (PRETTY FLAKEY BUT ...) + MOVEM A,IOCLOS + JRST DO.NOW +] + +; HERE TO PROCESS INTERRUPTS + +DOINT: SKIPE INTHLD ; GLOBAL LOCK ON INTS + JRST @LCKINT + SETOM INTHLD ; DONT LET IT HAPPEN AGAIN + PUSH P,INTFLG +DOINTE: SKIPE ONINT ; ANY FUDGE? + XCT ONINT ; YEAH, TRY ONE + PUSH P,ONINT + SETZM ONINT + EXCH 0,LCKINT ; RELATIVIZE PC IF FROM RSUBR +IFE ITS, TLZ 0,777740 ; KILL EXCESS BITS + PUSH P,0 ; AND SAVE + ANDI 0,-1 + CAMG 0,PURTOP + CAMGE 0,VECBOT + JRST DONREL + SUBI 0,(M) ; M IS BASE REG +IFN ITS, TLO 0,400000+M ; INDEX IT OFF M +IFE ITS,[ + TLO 0,400000+M + SKIPN MULTSG + JRST .+3 + HLL 0,(P) + TLO 0,400000 +] + EXCH 0,(P) ; AND RESTORE TO STACK +DONREL: EXCH 0,LCKINT ; GET BACK SAVED 0 + SETZM INTFLG ;DISABLE + AOS -2(P) ;INCR SAVED FLAG + +;NOW SAVE WORKING ACS + + PUSHJ P,SAVACS + HLRZ A,-2(P) ; HACK FUNNYNESS FOR MPV/ILOPR + SKIPE A + SETZM -2(P) ; REALLY DISABLED + +DIRQ: MOVE A,PIRQ ;NOW SATRT PROCESSING + JFFO A,FIRQ ;COUNT BITS AND GO + MOVE A,PIRQ2 ;1ST DONE, LOOK AT 2ND + JFFO A,FIRQ2 + +INTDN1: SKIPN GCHAPN ; SKIP IF MUST DO GC INT + JRST .+3 + SETZM GCHAPN + PUSHJ P,INTOGC ; AND INTERRUPT + + PUSHJ P,RESTAC + +IFN ITS,[ + .SUSET [.SPICLR,,[0]] ; DISABLE INTS +] + POP P,LCKINT + POP P,ONINT + POP P,INTFLG + SETZM INTHLD ; RE-ENABLE THE WORLD +IFN ITS,[ + EXCH 0,LCKINT + HRRI 0,@0 ; EFFECTIVIZE THE ADDRESS + TLZ 0,37 ; KILL IND AND INDEX + EXCH 0,LCKINT + .DISMIS LCKINT +] +IFE ITS,[ + SKIPN MULTSG + JRST @LCKINT + XJRST .+1 ; MAKE SURE OUT OF SECTION 0 + 0 + FSEG,,.+1 + EXCH 0,LCKINT + TLZE 0,400000 + ADDI 0,(M) + EXCH 0,LCKINT + JRST @LCKINT +] +FIRQ: PUSHJ P,GETBIT ;SET UP THE BIT TO CLOBBER IN PIRQ + ANDCAM A,PIRQ ;CLOBBER IT + ADDI B,36. ;OFSET INTO TABLE + JRST XIRQ ;GO EXECUTE + +FIRQ2: PUSHJ P,GETBIT ;PREPARE TO CLOBBER BIT + ANDCAM A,PIRQ2 ;CLOBBER IT + ADDI B,71. ;AGAIN OFFSET INTO TABLE +XIRQ: + CAIE B,21 ;PDL OVERFLOW? + JRST FHAND ;YES, HACK APPROPRIATELY + +PDL2: JSP E,PDL3 + JRST DIRQ + +PDL3: SKIPN A,PGROW + SKIPE A,TPGROW + JRST .+2 + JRST (E) ; NOTHING GROWING, FALSE ALARM + MOVEI B,PDLGRO_-6 ;GET GROWTH SPEC + DPB B,[111100,,-1(A)] ;STORE GROWTH SPEC +REAGC: MOVE C,[10.,,1] ; INDICATOR FOR AGC + SKIPE PGROW ; P IS GROWING + ADDI C,6 + SKIPE TPGROW ; TP IS GROWING + ADDI C,1 + PUSHJ P,AGC ;COLLECT GARBAGE + SETZM PGROW + SETZM TPGROW + AOJL A,REAGC ; IF NO CORE, RETRY + JRST (E) + +SAVACS: + PUSH P,PVP + MOVE PVP,PVSTOR+1 +IRP A,,[0,A,B,C,D,E,TVP,SP] + PUSH TP,A!STO(PVP) + SETZM A!STO(PVP) ;NOW ZERO TYPE + PUSH TP,A + TERMIN + PUSH TP,$TLOSE + PUSH TP,DSTORE + MOVE D,PVP + POP P,PVP + PUSH TP,PVPSTO(D) + PUSH TP,PVP + SKIPE D,DSTORE + MOVEM D,-13(TP) ; USE AS DSTO + SETZM DSTORE + POPJ P, + +RESTAC: POP TP,PVP + PUSH P,PVP + MOVE PVP,PVSTOR+1 + POP TP,PVPSTO(PVP) + POP TP,DSTORE + SUB TP,[1,,1] +IRP A,,[SP,TVP,E,D,C,B,A,0] + POP TP,A + POP TP,A!STO(PVP) + TERMIN + SKIPE DSTORE + SETZM DSTO(PVP) + POP P,PVP + POPJ P, + +; HERE TO DO GC INTERRUPT AND CLOSE ANY DEAD CHANNELS + +INTOGC: PUSH P,[N.CHNS-1] + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + MOVEI A,CHNL1 + SUBI A,(TVP) + HRLS A + ADD A,TVP + PUSH TP,$TVEC + PUSH TP,A + +INTGC1: MOVE A,(TP) ; GET POINTER + SKIPN B,1(A) ; ANY CHANNEL? + JRST INTGC2 + HRRE 0,(A) ; INDICATOR + JUMPGE 0,INTGC2 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE + + MOVE A,(TP) + +INTGC2: HLLZS (A) + ADD A,[2,,2] + MOVEM A,(TP) + SOSE (P) + JRST INTGC1 + + SUB P,[1,,1] + SUB TP,[2,,2] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE GC + PUSH TP,$TFLOAT ; PUSH ON TIME ARGUMENT + PUSH TP,GCTIM + PUSH TP,$TFIX ; PUSH ON THE CAUSE ARGUMENT + PUSH TP,GCCAUS + PUSH TP,$TATOM ; PUSH ON THE CALL ARGUMENT + MOVE A,GCCALL + PUSH TP,@GCALLR(A) + MCALL 4,INTERR + POPJ P, + +; PRE AGC INTERRUPT. CAUSED WHEN FREE STORAGE REQUEST CAN BE SATISFIED BY +; EXTENDING CORE. IT IS CALLED "AGC" AND THE HANDLER IS PASSED THE CALLER, +; AND THE PENDING REQUEST. + + +INTAGC: MOVE A,GETNUM + MOVEM A,GCKNUM ; SET UP TO CAUSE INTERRUPT + PUSH P,C ; SAVE ARGS TO GC + MOVEI A,2000 ; GET WORKING SPACE + PUSHJ P,INTCOR ; GET IT + MOVSI A,TATOM ; EXAMINE BINDING OF FLAG + MOVE B,IMQUOTE AGC-FLAG + PUSHJ P,ILVAL + CAME A,$TUNBOUND + JRST INAGCO ; JUMP TO GET CORE FOR INTERRUPT + MOVE A,GETNUM + ADD A,P.TOP ; SEE IF WE CAN POSSIBLY WIN + ADD A,FREMIN + CAML A,PURBOT + JRST AGCCAU ; WORLD IS IN BAD SHAPE, CALL AGC + PUSH TP,$TTP ; BIND FLAG + PUSH TP,TP ; FOR UNBINDING PURPOSES + PUSH TP,[TATOM,,-1] ; SPECBINDS ARGS + PUSH TP,IMQUOTE AGC-FLAG + PUSH TP,$TFIX + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIND + +; SET UP CALL TO HANDLER + + PUSH TP,$TCHSTR ; STRING INDICATING INTERRUPT + PUSH TP,CHQUOTE DIVERT-AGC + PUSH TP,$TFIX ; PENDING REQUEST + PUSH TP,GETNUM + HLRZ C,(P) + PUSH TP,$TATOM + PUSH TP,@GCALLR(C) + SETZM GCHPN + MCALL 3,INTERR ; ENABLE INTERRUPT + GETYP A,A ; CHECK TO SEE IF INTERRUPT WAS ENABLED + HRRZ E,-6(TP) ; GET ARG FOR UNBINDING + PUSHJ P,SSPEC1 + SUB TP,[8,,8] ; CLEAN OFF STACK + CAIE A,TFALSE ; SKIP IF NOT + JRST CHKWIN + +; CAUSE AN AGC TO HAPPEN + +AGCCAU: MOVE C,(P) ; INDICATOR + PUSHJ P,SAGC ; CALL AGC + JRST FINAGC + +; SEE WHETHER ENOUGH CORE WAS ALLOCATED +CHKWIN: MOVE A,FRETOP + SUB A,GCSTOP + SUB A,GCKNUM ; AMOUNT NEEDED OR IN EXCESS + JUMPGE A,FINAGC ; JUMP IF DONE + MOVE A,GCKNUM + MOVEM A,GETNUM ; SET UP REQUEST + MOVE C,(P) + JRST AGCCAU +FINAGC: SETZM GETNUM + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO HANDLE INTERRUPT WHILE INTERRUPT IS RUNNING +; IT TRIES TO ALLOCATE FOR REQUEST+ AT LEAST ONE CORE BLOCK + +INAGCO: MOVE A,GETNUM ; GET REQUEST + SUB A,GCKNUM ; CALCULATE REAL CURRENT REQUEST + ADDI A,1777 + ANDCMI A,1777 ; AMOUNT WANTED + PUSHJ P,INTCOR ; GET IT + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO GET CORE FOR PRE-AGC INTERRUPT. REQUEST IN A + + +INTCOR: ADD A,P.TOP ; ADD TOP TO REQUEST + CAML A,PURBOT ; SKIP IF BELOW PURE + JRST AGCCA1 ; LOSE + MOVEM A,CORTOP ; STORE POSSIBLE CORE TOP + ASH A,-10. ; TO PAGES + PUSHJ P,P.CORE ; GET THE CORE + JRST AGCCA1 ; LOSE,LOSE,LOSE + PUSH P,B + MOVE B,FRETOP + SUBI B,2000 + MOVE A,FRETOP + SETZM (B) + HRLI B,(B) + ADDI B,1 + BLT B,-1(A) + POP P,B + MOVEM A,FRETOP + POPJ P, ; EXIT +AGCCA1: MOVE C,-1(P) ; GET ARGS FOR AGC + SUB P,[1,,1] ; FLUSH RETURN ADDRESS + JRST AGCCAU+1 + + + +GCALLR: MQUOTE GC-READ + MQUOTE BLOAT + MQUOTE GROW + IMQUOTE LIST + IMQUOTE VECTOR + IMQUOTE SET + IMQUOTE SETG + MQUOTE FREEZE + MQUOTE PURE-PAGE-LOADER + MQUOTE GC + MQUOTE INTERRUPT-HANDLER + MQUOTE NEWTYPE + MQUOTE PURIFY + + ; OLD "ON" SETS UP EVENT AND HANDLER + +MFUNCTION ON,SUBR + + ENTRY + + HLRE 0,AB ; 0=> -2*NUM OF ARGS + ASH 0,-1 ; TO -NUM + CAME 0,[-5] + JRST .+3 + MOVEI B,10(AB) ; LAST MUST BE CHAN OR LOC + PUSHJ P,CHNORL + ADDI 0,3 + JUMPG 0,TFA ; AT LEAST 3 + MOVEI A,0 ; SET UP IN CASE NO PROC + AOJG 0,ONPROC ; JUMP IF NONE + GETYP C,6(AB) ; CHECK IT + CAIE C,TPVP + JRST TRYFIX + MOVE A,7(AB) ; GET IT +ONPROC: PUSH P,A ; SAVE AS A FLAG + GETYP A,(AB) ; CHECK PREV EXISTANCE + PUSH P,0 + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + MOVEI B,(AB) ; FIND IT + PUSHJ P,FNDINT + POP P,0 ; REST NUM OF ARGS + JUMPN B,ON3 ; ALREADY THERE + SKIPE C ; SKIP IF NOTHING TO FLUSH + SUB TP,[2,,2] + PUSH TP,(AB) ; GET NAME + PUSH TP,1(AB) + PUSH TP,4(AB) + PUSH TP,5(AB) + MOVEI A,2 ; # OF ARGS TO EVENT + AOJG 0,ON1 ; JUMP IF NO LAST ARG + PUSH TP,10(AB) + PUSH TP,11(AB) + ADDI A,1 +ON1: ACALL A,EVENT + +ON3: PUSH TP,A + PUSH TP,B + PUSH TP,2(AB) ; NOW FCN + PUSH TP,3(AB) + MOVEI A,3 ; NUM OF ARGS + SKIPN (P) + SOJA A,ON2 ; NO PROC + PUSH TP,$TPVP + PUSH TP,7(AB) +ON2: ACALL A,HANDLER + JRST FINIS + + +TRYFIX: SKIPN A,7(AB) + CAIE C,TFIX + JRST WRONGT + JRST ONPROC + +; ROUTINE TO BUILD AN EVENT + +MFUNCTION EVENT,SUBR + + ENTRY + + HLRZ 0,AB + CAIN 0,-2 ; IF JUST 1 + JRST RE.EVN ; COULD BE EVENT + CAIL 0,-3 ; MUST BE AT LEAST 2 ARGS + JRST TFA + GETYP A,2(AB) ; 2ND ARG MUST BE FIXED POINT PRIORITY + CAIE A,TFIX + JRST WTYP2 + GETYP A,(AB) ; FIRST ARG SHOULD BE CHSTR + CAIN A,TATOM ; ALLOW ACTUAL ATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + CAIL 0,-5 + JRST GOTRGS + CAIG 0,-7 + JRST TMA + MOVEI B,4(AB) + PUSHJ P,CHNORL ; CHANNEL OR LOCATIVE (PUT ON STACK) + +GOTRGS: MOVEI B,(AB) ; NOW TRY TO FIND HEADER FOR THIS INTERRUPT + PUSHJ P,FNDINT ; CALL INTERNAL HACKER + JUMPN B,FINIS ; ALREADY ONE OF THIS NAME + PUSH P,C + JUMPE C,.+3 ; GET IT OFF STACK + POP TP,B + POP TP,A + PUSHJ P,MAKINT ; MAKE ONE FOR ME + MOVSI 0,TFIX + MOVEM 0,INTPRI(B) ; SET UP PRIORITY + MOVE 0,3(AB) + MOVEM 0,INTPRI+1(B) +CH.SPC: POP P,C ; GET CODE BACK + SKIPGE C + PUSHJ P,DO.SPC ; DO ANY SPECIAL HACKS + JRST FINIS + +RE.EVN: GETYP 0,(AB) + CAIE 0,TINTH + JRST TFA ; ELSE SAY NOT ENOUGH + MOVE B,1(AB) ; GET IT + SETZM ISTATE+1(B) ; MAKE SURE ENABLED + SETZB D,C + GETYP A,INAME(B) ; CHECK FOR CHANNEL + CAIN A,TCHAN ; SKIP IF NOT + HRROI C,SS.CHA ; SET UP CHANNEL HACK + HRLZ E,INTPRI(B) ; GET POSSIBLE READ/WRITE BITS + TLNE E,.WRMON+.RDMON ; SKIP IF NOT MONITORS + PUSHJ P,GETNM1 + JUMPL C,RE.EV1 + MOVE B,INAME+1(B) ; CHECK FOR SPEC + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER +RE.EV1: PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + PUSH P,C + MOVSI C,TATOM + PUSH TP,$TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + PUSH TP,D + MOVE A,INAME(B) + MOVE B,INAME+1(B) ; GET IT + PUSHJ P,IGET ; LOOK FOR IT + JUMPN B,FINIS ; RETURN IT + MOVE A,(TB) + MOVE B,1(TB) + POP TP,D + POP TP,C + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; REESTABLISH IT + MOVE A,(AB) + MOVE B,1(AB) + JRST CH.SPC + + +; FUNCTION TO GENERATE A HANDLER FOR A GIVEN INTERRUPT + +MFUNCTION HANDLER,SUBR + + ENTRY + + HLRZ 0,AB + CAIL 0,-2 ; MUST BE 2 OR MORE ARGS + JRST TFA + GETYP A,(AB) + CAIE A,TINTH ; EVENT? + JRST WTYP1 + GETYP A,2(AB) + CAIN 0,-4 ; IF EXACTLY 2 + CAIE A,THAND ; COULD BE HANDLER + JRST CHEVNT + + MOVE B,3(AB) ; GET IT + SKIPN IPREV+1(B) ; SKIP IF ALREADY IN USE + JRST HNDOK + MOVE D,1(AB) ; GET EVENT + SKIPN D,IHNDLR+1(D) ; GET FIRST HANDLER + JRST BADHND + CAMN D,B ; IS THIS IT? + JRST HFINIS ; YES, ALREADY "HANDLED" + MOVE D,INXT+1(D) ; GO TO NEXT HANDLER + JUMPN D,.-3 +BADHND: ERRUUO EQUOTE HANDLER-ALREADY-IN-USE + +CHEVNT: CAIG 0,-7 ; SKIP IF LESS THAN 4 + JRST TMA + PUSH TP,$TPVP ; SLOT FOR PROCESS + PUSH TP,[0] + CAIE 0,-6 ; IF 3, LOOK FOR PROC + JRST NOPROC + GETYP 0,4(AB) + CAIE 0,TPVP + JRST WTYP3 + MOVE 0,5(AB) + MOVEM 0,(TP) + +NOPROC: PUSHJ P,APLQ + JRST NAPT + PUSHJ P,MHAND ; MAKE THE HANDLER + MOVE 0,1(TB) ; GET PROCESS + MOVEM 0,INTPRO+1(B) ; AND PUT IT INTO HANDLER + MOVSI 0,TPVP ; SET UP TYPE + MOVEM 0,INTPRO(B) + MOVE 0,2(AB) ; SET UP FUNCTION + MOVEM 0,INTFCN(B) + MOVE 0,3(AB) + MOVEM 0,INTFCN+1(B) + +HNDOK: MOVE D,1(AB) ; PICK UP EVEENT + MOVE E,IHNDLR+1(D) ; GET POINTER TO HANDLERS + MOVEM B,IHNDLR+1(D) ; PUT NEW ONE IN + MOVSI 0,TINTH ; GET INT HDR TYPE + MOVEM 0,IPREV(B) ; INTO BACK POINTER + MOVEM D,IPREV+1(B) ; AND POINTER ITSELF + MOVEM E,INXT+1(B) ; NOW NEXT POINTER + MOVSI 0,THAND ; NOW HANDLER TYPE + MOVEM 0,IHNDLR(D) ; SET TYPE IN HEADER + MOVEM 0,INXT(B) + JUMPE E,HFINIS ; JUMP IF HEADER WAS EMPTY + MOVEM 0,IPREV(E) ; FIX UP ITS PREV + MOVEM B,IPREV+1(E) +HFINIS: MOVSI A,THAND + JRST FINIS + + + +; FUNCTIONS TO SET TIME LIMITS FOR REALTIME AND RUNTIME INTS + +IFN ITS,[ + +MFUNCTION RUNTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RNTLFT + GETYP 0,(AB) + JFCL 10,.+1 + MOVE A,1(AB) + CAIE 0,TFIX + JRST RUNT1 + IMUL A,[245761.] + JRST RUNT2 + +RUNT1: CAIE 0,TFLOAT + JRST WTYP1 + FMPR A,[245760.62] + MULI A,400 ; FIX IT + TSC A,A + ASH B,(A)-243 + MOVE A,B +RUNT2: JUMPL A,OUTRNG ; NOT FOR NEG # + JFCL 10,OUTRNG + .SUSET [.SRTMR,,A] + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS +RNTLFT: .SUSET [.RRTMR,,B] + JUMPL B,IFALSE ; RETURN FALSE IF NONE SET + IDIV B,[245761.] ; TO SECONDS + MOVSI A,TFIX + JRST FINIS + +] +.TIMAL==5 +.TIMEL==1 + +MFUNCTION REALTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RLTPER + JFCL 10,.+1 + GETYP 0,(AB) + MOVE A,1(AB) + CAIE 0,TFIX + JRST REALT1 +IFN ITS, IMULI A,60. ; TO 60THS OF SEC +IFE ITS, IMULI A,1000. ; TO MILLI + JRST REALT2 + +REALT1: CAIE 0,TFLOAT + JRST WTYP1 +IFN ITS, FMPRI A,(60.0) +IFE ITS, FMPRI A,(1000.0) + MULI A,400 + TSC A,A + ASH B,(A)-243 + MOVE A,B + +REALT2: JUMPL A,OUTRNG + JFCL 10,OUTRNG + MOVEM A,RLTSAV +IFN ITS,[ + MOVE B,[200000,,A] + SKIPN A + MOVSI B,400000 + .REALT B, + JFCL +] +IFE ITS,[ + MOVE A,[MFORK,,.TIMAL] ; FLUSH CURRENT FIRST + TIMER + JRST TIMERR + SKIPN B,RLTSAV + JRST RETRLT + HRRI A,.TIMEL + MOVEI C,RLCHN + TIMER + JRST TIMERR +RETRLT: MOVE A,(AB) + MOVE B,1(AB) +] + JRST FINIS + +TIMERR: MOVNI A,1 + PUSHJ P,TGFALS + JRST FINIS + +RLTPER: SKIPGE B,RLTSAV + JRST IFALSE +IFN ITS, IDIVI B,60. ; BACK TO SECONDS +IFE ITS, IDIVI B,1000. + MOVSI A,TFIX + JRST FINIS + + +; FUNCTIONS TO ENABLE AND DISABLE INTERRUPTS + +MFUNCTION %ENABL,SUBR,ENABLE + + PUSHJ P,GTEVNT + SETZM ISTATE+1(B) + JRST FINIS + +MFUNCTION %DISABL,SUBR,DISABLE + + + PUSHJ P,GTEVNT + SETOM ISTATE+1(B) + JRST FINIS + +GTEVNT: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TINTH + JRST WTYP1 + MOVE A,(AB) + MOVE B,1(AB) + POPJ P, + +DO.SPC: HRRO C,INTBL(C) ; POINT TO SPECIAL CODE + HLRZ 0,AB ; - TWO TIMES NUM ARGS + PUSHJ P,(C) ; CALL ROUTINE + JUMPE E,CPOPJ ; NO BITS TO ENABLE, LEAVE +IFE ITS,[ + PUSH TP,A + PUSH TP,B + MOVE B,1(TB) ; CHANNEL + MOVE 0,CHANNO(B) + MOVEM 0,(E) ; SAVE IN TABLE + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVE A,0 ; SETUP FOR MTOPR + MOVEI B,24 + MOVSI C,(E) + TLO C,770000 ; DONT SETUP INR/INS + MTOPR + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + IORM 0,MASK1 + MOVE B,MASK1 + MOVEI A,MFORK + AIC + + POP TP,B + POP TP,A + POPJ P, ; ***** TEMP ****** +] +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD BIT + JRST SETW2 + LSH 0,-1(E) + + IORM 0,MASK1 ; STORE IN PROTOTYPE MASK + .SUSET [.SMASK,,MASK1] + POPJ P, + +SETW2: LSH 0,-36.(E) + IORM 0,MASK2 ; SET UP PROTO MASK2 + .SUSET [.SMSK2,,MASK2] + POPJ P, +] + +; ROUTINE TO CHECK FOR CHANNEL OR LOCATIVE + +CHNORL: GETYP A,(B) ; GET TYPE + CAIN A,TCHAN ; IF CHANNEL + JRST CHNWIN + PUSH P,0 + PUSHJ P,LOCQ ; ELSE LOOCATIVE + JRST WRONGT + POP P,0 +CHNWIN: PUSH TP,(B) + PUSH TP,1(B) + POPJ P, + +; SUBROUTINE TO FIND A HANDLER OF A GIVEN NAME + +FNDINT: PUSHJ P,FNDNM + JUMPE B,CPOPJ + PUSHJ P,SPEC1 ; COULD BE FUNNY + +INTASO: PUSH P,C ; C<0 IF SPECIAL + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + SKIPN D ; COULD BE CHANGED FOR MONITOR + MOVE D,MQUOTE INTERRUPT + PUSH TP,C + PUSH TP,D + PUSHJ P,IGET + MOVE D,(TP) + SUB TP,[2,,2] + POP P,C ; AND RESTOR SPECIAL INDICATOR + SKIPE B ; IF FOUND + SUB TP,[2,,2] ; REMOVE CRUFT +CPOPJ: POPJ P, ; AND RETURN + +; CHECK FOR SPECIAL INTERNAL INTERRUPT HACK + +SPEC1: MOVSI C,-SPECLN ; BUILD AOBJN PNTR +SPCLOP: CAME B,@SPECIN(C) ; SKIP IF SPECIAL + AOBJN C,.-1 ; UNTIL EXHAUSTED + JUMPGE C,.+3 + SKIPE E,FNDTBL(C) + JRST (E) + MOVEI 0,-1(TB) ; SEE IF OK + CAIE 0,(TP) + JRST TMA + POPJ P, + +; ROUTINE TO CREATE A NEW INTERRUPT (INTERNAL ONLY--NOT ITS FLAVOR) + +MAKINT: JUMPN C,GOTATM ; ALREADY HAVE NAME, GET THING + MOVEI B,(AB) ; POINT TO STRING + PUSHJ P,CSTAK ; CHARS TO STAKC + MOVE B,INTOBL+1 + PUSHJ P,INSRTX + MOVE D,MQUOTE INTERRUPT +GOTATM: PUSH TP,$TINTH ; MAKE SLOT FOR HEADER BLOCK + PUSH TP,[0] + PUSH TP,A + PUSH TP,B ; SAVE ATOM + PUSH TP,$TATOM + PUSH TP,D + MOVEI A,IHDRLN*2 + PUSHJ P,GIBLOK + MOVE A,-3(TP) ; GET NAME AND STORE SAME + MOVEM A,INAME(B) + MOVE A,-2(TP) + MOVEM A,INAME+1(B) + SETZM ISTATE+1(B) + MOVEM B,-4(TP) ; STASH HEADER + POP TP,D + POP TP,C + EXCH B,(TP) + MOVSI A,TINTH + EXCH A,-1(TP) ; INTERNAL PUT CALL + PUSHJ P,IPUT + POP TP,B + POP TP,A + POPJ P, + +; FIND NAME OF INTERRUPT + +FNDNM: GETYP A,(B) ; TYPE + CAIE A,TCHSTR ; IF STRING + JRST FNDATM ; DONT HAVE ATOM, OTHERWISE DO + PUSHJ P,IILOOK + JRST .+2 +FNDATM: MOVE B,1(B) + SETZB C,D ; PREVENT LOSSAGE LATER + MOVSI A,TATOM + +; THE NEXT 2 INSTRUCTIONS ARE A KLUDGE TO GET THE RIGHT ERROR ATOM + + CAMN B,IMQUOTE ERROR + MOVE B,MQUOTE ERROR,ERROR,INTRUP + POPJ P, + +IILOOK: PUSHJ P,CSTAK ; PUT CHRS ON STACK + MOVSI A,TOBLS + MOVE B,INTOBL+1 + JRST ILOOKC ; LOOK IT UP + +; ROUTINE TO MAKE A HANDLER BLOCK + +MHAND: MOVEI A,IHANDL*2 + JRST GIBLOK ; GET BLOCK + +; HERE TO GET CHANNEL FOR "CHAR" INTERRUPT + +GETCHN: GETYP 0,(TB) ; GET TYPE + CAIE 0,TCHAN ; CHANNL IS WINNER + JRST WRONGT + MOVE A,(TB) ; USE THE CHANNEL TO NAME THE INTERRUPT + MOVE B,1(TB) + SKIPN CHANNO(B) ; SKIP IF WINNING CHANNEL + JRST CBDCHN ; LOSER + POPJ P, + +LOCGET: GETYP 0,(TB) ; TYPE + CAIN 0,TCHAN ; SKIP IF LOCATIVE + JRST WRONGT + MOVE D,B + MOVE A,(TB) + MOVE B,1(TB) ; GET LOCATIVE + POPJ P, + +; FINAL MONITOR SETUP ROUTINES + +S.RMON: SKIPA E,[.RDMON,,] +S.WMON: MOVSI E,.WRMON + PUSH TP,A + PUSH TP,B + HLRM E,INTPRI(B) ; SAVE BITS + MOVEI B,(TB) ; POINT TO LOCATIVE + HRRZ A,FSAV(TB) + CAIN A,OFF + MOVSI D,(ANDCAM E,) ; KILL INST + CAIN A,EVENT + MOVSI D,(IORM E,) + PUSHJ P,SMON ; GO DO IT + POP TP,B + POP TP,A + MOVEI E,0 + POPJ P, + + +; SPECIAL SETUP ROUTINES FOR INITIAL INTERRUPTS + +IFN ITS,[ +S.CHAR: MOVE E,1(TB) ; GET CHANNEL + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR TO 0 + CAIE 0,"T ; TTY + JRST .+3 ; NO + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE E,CHANNO(E) + ADDI E,36. ; GET CORRECT MASK BIT +ONEBIT: MOVEI 0,1 ; BIT FOR INT TO RET + POPJ P, +] +IFE ITS,[ +S.CHAR: MOVE E,1(TB) + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR + PUSH P,A + CAIE 0,"N ; NET ? + JRST S.CHA1 + + MOVEI A,0 + HRRZ 0,CHANNO(E) + MOVE E,[-NNETS,,NETJFN] + CAMN 0,(E) + JRST S.CHA2 + SKIPN (E) + MOVE A,E ; REMEMBER WHERE + AOBJN E,.-4 + TLNN A,-1 + FATAL NO MORE NETWORK + SKIPA E,A +S.CHA1: MOVEI E,0 +S.CHA2: POP P,A + POPJ P, +] + + +; SPECIAL FOR CLOCK +IFN ITS,[ +S.DOWN: SKIPA E,[7] +S.CLOK: MOVEI E,13. ; FOR NOW JUST GET BIT # + JRST ONEBIT + +S.PAR: MOVEI E,28. + JRST ONEBIT + +; RUNTIME AND REALTIME INTERRUPTS + +S.RUNT: SKIPA E,[34.] +S.REAL: MOVEI E,35. + JRST ONEBIT + +S.IOC: SKIPA E,[9.] ; IO CHANNEL ERROR +S.PURE: MOVEI E,26. + JRST ONEBIT + +; MPV AND ILOPR + +S.MPV: SKIPA E,[14.] ; BIT POS +S.ILOP: MOVEI E,6 + JRST ONEBIT + +; HERE TO TURN ALL INFERIOR INTS + +S.INF: MOVEI E,36.+16.+2 ; START OF BITS + MOVEI 0,37 ; 8 BITS WORTH + POPJ P, +] +IFE ITS,[ +S.PURE: +S.MPV: +S.ILOP: +S.DOWN: +S.CLOK: +S.PAR: + + +S.RUNT: ERRUUO EQUOTE INTERRUPT-UNAVAILABLE-ON-TENEX +S.IOC: MOVEI 0,7 ; 3 BITS FOR EOF/FULL/ERROR + MOVEI E,10. + POPJ P, + +S.INF: +S.REAL: MOVEI E,0 + POPJ P, +] + + +; HERE TO HANDLE ITS INTERRUPTS + +FHAND: SKIPN D,EXTINT(B) ; SKIP IF HANDLERS ARE POSSIBLE + JRST DIRQ + JRST (D) + +IFN ITS,[ +; SPECIAL CHARACTER HANDLERS + +HCHAR: MOVEI D,CHNL0+1 + ADDI D,(B) ; POINT TO CHANNEL SLOT + ADDI D,(B) + SKIPN D,-72.(D) ; PICK UP CHANNEL + JRST IPCGOT ;WELL, IT GOTTA BEE THE THE IPC THEN + PUSH TP,$TCHAN + PUSH TP,D + LDB 0,[600,,STATUS(D)] ; GET DEVICE CODE + CAILE 0,2 ; SKIP IF A TTY + JRST HNET ; MAYBE NETWORK CHANNEL + HRRZ 0,-2(D) + TRNN 0,C.READ + JRST HMORE + CAMN D,TTICHN+1 + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST .+3 + SKIPN NOTTY + JRST HCHR11 + MOVE B,D ; CHAN TO B + PUSH P,A + PUSHJ P,TTYOP2 ; RE-GOBBLE TTY + POP P,A + MOVE D,(TP) +HCHR11: MOVE D,CHANNO(D) ; GET ITS CHANNEL + PUSH P,D ; AND SAVE IT + .CALL HOWMNY ; GET # OF CHARS + MOVEI B,0 ; IF TTY GONE, NO CHARS +RECHR: ADDI B,1 ; BUMP BY ONE FOR SOSG + MOVEM B,CHNCNT(D) ; AND SAVE + IORM A,PIRQ2 ; LEAVE THE INT ON + +CHRLOO: MOVE D,(P) ; GET CHNNAEL NO. + SOSG CHNCNT(D) ; GET COUNT + JRST CHRDON + + MOVE B,(TP) + MOVE D,BUFRIN(B) ; GET EXTRA BUFFER + XCT IOIN2(D) ; READ CHAR + JUMPL A,CHRDON ; NO CHAR THERE, FORGET IT + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,$TCHRS ; SAVE CHAR FOR CALL + PUSH TP,A + PUSH TP,$TCHAN ; SAVE CHANNEL + PUSH TP,B + PUSHJ P,INCHAR ; PUT CHAR IN USERS BUFFER + MCALL 3,INTERRUPT ; RUN THE HANDLERS + JRST CHRLOO ; AND LOOP + +CHRDON: .CALL HOWMNY + MOVEI B,0 + MOVEI A,1 ; SET FOR PI WORD CLOBBER + LSH A,(D) + JUMPG B,RECHR ; ANY MORE? + ANDCAM A,PIRQ2 + SUB P,[1,,1] + SUB TP,[2,,2] + JRST DIRQ + + + +; HERE FOR NET CHANNEL INTERRUPT + +HNET: CAIE 0,26 ; NETWORK? + JRST HSTYET ; HANDLE PSEUDO TTY ETC. + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(D) + PUSH TP,$TCHAN + PUSH TP,D + MOVE B,D ; CHAN TO B + PUSHJ P,INSTAT ; UPDATE THE NETWRK STATE + MCALL 3,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +HMORE: +HSTYET: PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHAN + PUSH TP,D + MCALL 2,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +] +CBDCHN: ERRUUO EQUOTE BAD-CHANNEL + +IFN ITS,[ + +HCLOCK: PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CLOCK + MCALL 1,INTERRUPT + JRST DIRQ + +HRUNT: PUSH TP,$TATOM + PUSH TP,MQUOTE RUNT,RUNT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +] +HREAL: PUSH TP,$TATOM + PUSH TP,MQUOTE REALT,REALT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +IFN ITS,[ +HPAR: MOVE A,MQUOTE PARITY,PARITY,INTRUP + JRST HMPV1 + +HMPV: MOVE A,MQUOTE MPV,MPV,INTRUP + JRST HMPV1 + +HILOPR: MOVE A,MQUOTE ILOPR,ILOPR,INTRUP + JRST HMPV1 + +HPURE: MOVE A,MQUOTE PURE,PURE,INTRUP +HMPV1: PUSH TP,$TATOM + PUSH TP,A + PUSH P,LCKINT ; SAVE LOCN + PUSH TP,$TATOM + PUSH TP,A + PUSH TP,$TWORD + PUSH TP,LCKINT + MCALL 2,EMERGENCY + POP P,A + MOVE C,(TP) + SUB TP,[2,,2] + JUMPN B,DIRQ + + PUSH TP,$TATOM + PUSH TP,EQUOTE DANGEROUS-INTERRUPT-NOT-HANDLED + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,$TWORD + PUSH TP,A + MCALL 3,ERROR + JRST DIRQ + + + +; HERE TO HANDLE SYS DOWN INTERRUPT + +HDOWN: PUSH TP,$TATOM + PUSH TP,MQUOTE SYSDOWN,SYSDOWN,INTRUP + .DIETI A, ; HOW LONG? + PUSH TP,$TFIX + PUSH TP,A + PUSH P,A ; FOR MESSAGE + MCALL 2,INTERRUPT + POP P,A + JUMPN B,DIRQ + .SUSET [.RTTY,,B] ; DO WE NOW HAVE A TTY AT ALL? + JUMPL B,DIRQ ; DONT HANG AROUND + PUSH P,A + MOVEI B,[ASCIZ / +Excuse me, SYSTEM going down in /] + SKIPG (P) ; SKIP IF REALLY GOING DOWN + MOVEI B,[ASCIZ / +Excuse me, SYSTEM has been REVIVED! +/] + PUSHJ P,MSGTYP + POP P,B + JUMPE B,DIRQ + IDIVI B,30. ; TO SECONDS + IDIVI B,60. ; A/ SECONDS B/ MINUTES + JUMPE B,NOMIN + PUSH P,C + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / minutes /] + PUSHJ P,MSGTYP + POP P,B + JRST .+2 +NOMIN: MOVEI B,(C) + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / seconds. +/] + PUSHJ P,MSGTYP + JRST DIRQ + +; TWO DIGIT DEC OUT FROM B/ + +DECOUT: IDIVI B,10. + JUMPE B,DECOU1 ; NO TEN + MOVEI A,60(B) + PUSHJ P,MTYO +DECOU1: MOVEI A,60(C) + JRST MTYO +] + +; HERE TO HANDLE I/O CHANNEL ERRORS + +HIOC: +IFN ITS,[ + .SUSET [.RAPRC,,A] ; CONTAINS CHANNEL OF MOST RECENT LOSSAGE + LDB A,[330400,,A] ; GET CHAN # + MOVEI C,(A) ; COPY +] + PUSH TP,$TATOM ; PUSH ERROR + PUSH TP,EQUOTE FILE-SYSTEM-ERROR +IFE ITS, MOVE C,IOCLOS ; GET JFN + PUSH TP,$TCHAN + ASH C,1 ; GET CHANNEL + ADDI C,CHNL0+1 ; GET CHANNEL VECTOR + PUSH TP,(C) +IFN ITS,[ + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A +] +IFE ITS,[ + MOVNI A,1 ; GET "MOST RECENT ERROR" +] + MOVE B,(TP) +IFN ITS, PUSHJ P,GFALS ; GEN NAMED FALSE +IFE ITS, PUSHJ P,TGFALS + PUSH TP,A + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE IOC,IOC,INTRUP + + PUSH TP,A + PUSH TP,B + PUSH TP,-7(TP) + PUSH TP,-7(TP) + MCALL 3,EMERGENCY + JUMPN B,DIRQ1 ; JUMP IF HANDLED + MCALL 3,ERROR + JRST DIRQ + +DIRQ1: SUB TP,[6,,6] + JRST DIRQ + +; HANDLE INFERIOR KNOCKING AT THE DOOR + +HINF: +IFN ITS, SUBI B,36.+16.+2 ; CONVERT TO INF # +IFE ITS, MOVEI B,0 + PUSH TP,$TATOM + PUSH TP,MQUOTE INFERIOR,INFERIOR,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ + +IFE ITS,[ + +; HERE FOR TENEX INTS (FIRST CUT) + +MFUNCTION %ACCHRS,SUBR,[ACTIVATE-CHARS] + + ENTRY + + JUMPGE AB,RETCHR + CAMGE AB,[-3,,] + JRST TMA + + GETYP A,(AB) + CAIE A,TCHSTR + JRST WTYP1 + HRRZ D,(AB) ; CHECK LENGTH + MOVEI C,0 ; SEE IF ANY NET CHANS IN USE + MOVE A,[-NNETS,,NETJFN] + SKIPE (A) + SUBI C,1 + AOBJN A,.-2 + + CAILE D,NCHRS+NNETS(C) + JRST WTYP1 + + MOVEI 0,(D) ; CHECK THEM + MOVE B,1(AB) + + JUMPE 0,.+4 + ILDB C,B + CAILE C,32 + JRST WTYP1 + SOJG 0,.-3 + + MOVSI E,- ; ZAP CURRENT + HRRZ A,CHRS(E) + DTI + SETZM CHRS(E) + AOBJN E,.-3 + + MOVE A,[-NNETS,,NETJFN] ; IN CASE USED NET INTS FOR CHARS + + SKIPGE (A) + SETZM (A) + AOBJN A,.-2 + + MOVE E,1(AB) + SETZB C,F ; C WILL BE MASK, F OFFSET INTO TABLE + MOVSI 0,400000 ; 0 WILL BE THE BIT FOR INT MASK OR'ING + JUMPE D,ALP1 ; JUMP IF NONE + MOVNS D ; BUILD AOBJN POINTER TO CHRS TABLE + MOVSI D,(D) + MOVEI B,0 ; B COUNTS NUMBER DONE + +ALP: ILDB A,E ; GET CHR + IOR C,0 + LSH 0,-1 + HRROM A,CHRS(D) + MOVSS A + HRRI A,(D) + ADDI A,(F) ; POSSIBLE OFFSET FOR MORE CHANS + ATI + ADDI B,1 + CAIGE B,NCHRS + JRST ALP2 + + SKIPE NETJFN-NCHRS(B) + AOJA B,.-1 + + MOVEI F,36.-NNETS-UINTS-NCHRS(B) + MOVN G,F + MOVSI 0,400000 + LSH 0,(G) ;NEW MASK FOR INT MASKS + SUBI F,1(D) + +ALP2: AOBJN D,ALP + +ALP1: IORM C,MASK1 + MOVEI A,MFORK + MOVE B,MASK1 ; SET UP FOR INT BITS + AIC ; TURN THEM ON + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +RETCHR: MOVE C,[-NCHRS-NNETS,,CHRS] + MOVEI A,0 + +RETCH1: SKIPN D,(C) + JRST RETDON + PUSH TP,$TCHRS + ANDI D,177 + PUSH TP,D + ADDI A,1 + AOBJN C,RETCH1 + +RETDON: PUSHJ P,CISTNG + JRST FINIS + +HCHAR: HRRZ A,CHRS-36.(B) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHRS + PUSH TP,A + PUSH TP,$TCHAN + PUSH TP,TTICHN+1 + MCALL 3,INTERRUPT + JRST DIRQ + +HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS+1(B) + JRST HNET1 + SUBI B,36.-NNETS-UINTS-NCHRS + JUMPE A,DIRQ + JRST HCHAR +HNET1: ASH A,1 + ADDI A,CHNL0+1 + MOVE B,(A) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(B) + PUSH TP,$TCHAN + PUSH TP,B + PUSHJ P,INSTAT + MCALL 3,INTERRUPT + JRST DIRQ + +USRINT: SUBI B,36. + PUSH TP,$TATOM + PUSH TP,MQUOTE USERINT,USERINT,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ +] + + +MFUNCTION OFF,SUBR + ENTRY + + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ; ARG TYPE + MOVE B,1(AB) ; AND VALUE + CAIN A,TINTH ; HEADER, GO HACK + JRST OFFHD ; QUEEN OF HEARTS + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST TRYHAN ; MAYBE INDIVIDUAL HANDLER + CAIN 0,-2 ; MORE THAN 1 ARG? + JRST OFFAC1 ; NO, GO ON + CAIG 0,-5 ; CANT BE MORE THAN 2 + JRST TMA + MOVEI B,2(AB) ; POINT TO 2D + PUSHJ P,CHNORL +OFFAC1: MOVEI B,(AB) + PUSHJ P,FNDINT + JUMPGE B,NOHAN1 ; NOT HANDLED + +OFFH1: PUSH P,C ; SAVE C FOR BIT CLOBBER + MOVSI C,TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + MOVE A,INAME(B) + MOVE B,INAME+1(B) + PUSHJ P,IREMAS + SKIPE B ; IF NO ASSOC, DONT SMASH + SETOM ISTATE+1(B) ; DISABLE IN CASE QUEUED + POP P,C ; SPECIAL? + JUMPGE C,FINIS ; NO, DONE + + HRRZ C,INTBL(C) ; POINT TO SPECIAL CODE + PUSHJ P,(C) ; GO TO SAME + JUMPE E,OFINIS ; DONE +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD + JRST CLRW2 ; CLOBBER 2D WORD BIT + LSH 0,-1(E) ; POSITION BIT + ANDCAM 0,MASK1 ; KILL BIT + .SUSET [.SMASK,,MASK1] +] +IFE ITS,[ + MOVE D,B + SETZM (E) + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + ANDCAM 0,MASK1 + MOVEI A,MFORK + SETCM B,MASK1 + DIC + ANDCAM 0,PIRQ ; JUST IN CASE + MOVE B,D +] +OFINIS: MOVSI A,TINTH + JRST FINIS + +IFN ITS,[ +CLRW2: LSH 0,-36.(E) ; POS BIT FOR 2D WORD + ANDCAM 0,MASK2 + .SUSET [.SMSK2,,MASK2] + JRST OFINIS +] + +TRYHAN: CAIE A,THAND ; HANDLER? + JRST WTYP1 + CAIE 0,-2 + JRST TMA + GETYP 0,IPREV(B) ; GET TYPE OF PREV + MOVE A,INXT+1(B) + SKIPN C,IPREV+1(B) ; dont act silly if already off! (TT) + JRST HFINIS + MOVE D,IPREV(B) + CAIE 0,THAND + JRST DOHEAD ; PREV HUST BE HDR + MOVEM A,INXT+1(C) + JRST .+2 +DOHEAD: MOVEM A,IHNDLR+1(C) ; INTO HDR + JUMPE A,OFFINI + MOVEM D,IPREV(A) + MOVEM C,IPREV+1(A) +OFFINI: SETZM IPREV+1(B) ; Leave NXT slot intact for RUNINT (BKD) + MOVSI A,THAND + JRST FINIS + +OFFHD: CAIE 0,-2 + JRST TMA + PUSHJ P,GETNMS ; GET INFOR ABOUT INT + JUMPE C,OFFH1 + PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + JRST OFFH1 + +GETNMS: GETYP A,INAME(B) ; CHECK FOR SPECIAL + SETZB C,D + CAIN A,TCHAN + HRROI C,SS.CHA + PUSHJ P,LOCQ ; LOCATIVE? + JRST CHGTNM + + MOVEI B,INAME(B) ; POINT TO LOCATIVE + MOVSI D,(MOVE E,) + PUSHJ P,SMON ; GET MONITOR + MOVE B,1(AB) +GETNM1: HRROI C,SS.WMO ; ASSUME WRITE + TLNN E,.WRMON + HRROI C,SS.RMO + MOVE D,MQUOTE WRITE,WRITE,INTRUP + TLNN E,.WRMON + MOVE D,MQUOTE READ,READ,INTRUP + POPJ P, + +CHGTNM: JUMPL C,CPOPJ + MOVE B,INAME+1(B) + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER + POPJ P, + +; EMERGENCY, CANT DEFER ME!! + +MQUOTE INTERRUPT + +EMERGENCY: + PUSH P,. + JRST INTERR+1 + +MFUNCTION INTERRUPT,SUBR + + PUSH P,[0] + + ENTRY + + SETZM INTHLD ; RE-ENABLE THE WORLD + JUMPGE AB,TFA + MOVE B,1(AB) ; GET HANDLER/NAME + GETYP A,(AB) ; CAN BE HEADER OR NAME + CAIN A,TINTH ; SKIP IF NOT HEADER + JRST GTHEAD + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR ; SKIP IF CHAR STRING + JRST WTYP1 + MOVEI B,(AB) ; LOOK UP NAME + PUSHJ P,FNDNM ; GET NAME + JUMPE B,IFALSE + MOVEI D,0 + CAMN B,MQUOTE CHAR,CHAR,INTRUP + PUSHJ P,CHNGT1 + CAME B,MQUOTE READ,READ,INTRUP + CAMN B,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,GTLOC1 + PUSHJ P,INTASO + JUMPE B,IFALSE + +GTHEAD: SKIPE ISTATE+1(B) ; ENABLED? + JRST IFALSE ; IGNORE COMPLETELY + MOVE A,INTPRI+1(B) ; GET PRIORITY OF INTERRUPT + CAMLE A,CURPRI ; SEE IF MUST QUEU + JRST SETPRI ; MAY RUN NOW + SKIPE (P) ; SKIP IF DEFER OK + JRST DEFERR + MOVEM A,(P) + PUSH TP,$TINTH ; SAVE HEADER + PUSH TP,B + MOVEI A,1 ; SAVE OTHER ARGS +PSHARG: ADD AB,[2,,2] + JUMPGE AB,QUEU1 ; GO MAKE QUEU ENTRY + PUSH TP,(AB) + PUSH TP,1(AB) + AOJA A,PSHARG +QUEU1: PUSHJ P,IEVECT ; GET VECTOR + PUSH TP,$TVEC + PUSH TP,[0] ; WILL HOLD QUEUE HEADER + PUSH TP,A + PUSH TP,B + + POP P,A ; RESTORE PRIORITY + + MOVE B,QUEUES+1 ; GET INTERRUPT QUEUES + MOVEI D,0 + JUMPGE B,GQUEU ; MAKE A QUEUE HDR + +NXTQU: CAMN A,1(B) ; GOT PRIORITY? + JRST ADDQU ; YES, ADD TO THE QUEU + CAML A,1(B) ; SKIP IF SPOT NOT FOUND + JRST GQUEU + MOVE D,B + MOVE B,3(B) ; GO TO NXT QUEUE + JUMPL B,NXTQU + +GQUEU: PUSH TP,$TVEC ; SAVE NEXT POINTER + PUSH TP,D + PUSH TP,$TFIX + PUSH TP,A ; SAVE PRIORITY + PUSH TP,$TVEC + PUSH TP,B + PUSH TP,$TLIST + PUSH TP,[0] + PUSH TP,$TLIST + PUSH TP,[0] + MOVEI A,4 + PUSHJ P,IEVECT + MOVE D,(TP) ; NOW SPLICE + SUB TP,[2,,2] + JUMPN D,GQUEU1 + MOVEM B,QUEUES+1 + JRST .+2 +GQUEU1: MOVEM B,3(D) + +ADDQU: MOVEM B,-2(TP) ; SAVE QUEU HDR + POP TP,D + POP TP,C + PUSHJ P,INCONS ; CONS IT + MOVE C,(TP) ;GET QUEUE HEADER + SKIPE D,7(C) ; IF END EXISTS + HRRM B,(D) ; SPLICE + MOVEM B,7(C) + SKIPN 5(C) ; SKIP IF START EXISTS + MOVEM B,5(C) + +IFINI: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +SETPRI: EXCH A,CURPRI + MOVEM A,(P) + + PUSH TP,$TAB ; PASS AB TO HANDLERS + PUSH TP,AB + + PUSHJ P,RUNINT ; RUN THE HANDLERS + POP P,A ; UNQUEU ANY WAITERS + PUSHJ P,UNQUEU + + JRST IFINI + +; HERE TO UNQUEUE WAITING INTERRUPTS + +UNQUEU: PUSH P,A ; SAVE NEW LEVEL + +UNQUE1: MOVE A,(P) ; TARGET LEVEL + CAMLE A,CURPRI ; CHECK RUG NOT PULLED OUT + JRST UNDONE + SKIPE B,QUEUES+1 + CAML A,1(B) ; RIGHT LEVEL? + JRST UNDONE ; FINISHED + + SKIPN C,5(B) ; ON QUEUEU? + JRST UNXQ + HRRZ D,(C) ; CDR THE LIST + MOVEM D,5(B) + SKIPN D ; SKIP IF NOT LAST + SETZM 7(B) ; CLOBBER END POINTER + MOVE A,1(B) ; GET THIS PRIORITY LEVEL + MOVEM A,CURPRI ; MAKE IT THE CURRENT ONE + MOVE D,1(C) ; GET SAVED VECTOR OF INF + + MOVE B,1(D) ; INT HEADER + PUSH TP,$TVEC + PUSH TP,D ; AND ARGS + + PUSHJ P,RUNINT ; RUN THEM + JRST UNQUE1 + +UNDONE: POP P,CURPRI ; SET CURRENT LEVEL + MOVE A,CURPRI + POPJ P, + +UNXQ: MOVE B,3(B) ; GO TO NEXT QUEUE + MOVEM B,QUEUES+1 + JRST UNQUE1 + + + +; SUBR TO CHANGE INTERRUPT LEVEL + +MFUNCTION INTLEV,SUBR,[INT-LEVEL] + ENTRY + JUMPGE AB,RETLEV ; JUST RETURN CURRENT + GETYP A,(AB) + CAIE A,TFIX + JRST WTYP1 ; LEVEL IS FIXED + SKIPGE A,1(AB) + JRST OUTRNG" + CAMN A,CURPRI ; DIFFERENT? + JRST RETLEV ; NO RETURN + PUSH P,CURPRI + CAMG A,CURPRI ; SKIP IF NO UNQUEUE NEEDED + PUSHJ P,UNQUEU + MOVEM A,CURPRI ; SAVE + POP P,A + SKIPA B,A +RETLEV: MOVE B,CURPRI + MOVSI A,TFIX + JRST FINIS + +RUNINT: PUSH TP,$THAND ; SAVE HANDLERS LIST + PUSH TP,IHNDLR+1(B) + + SKIPN ISTATE+1(B) ; SKIP IF DISABLED + SKIPN B,(TP) + JRST SUBTP4 +NXHND: MOVEM B,(TP) ; SAVE CURRENT HDR + MOVE A,-2(TP) ; SAVE ARG POINTER + PUSHJ P,CHSWAP ; SEE IF MUST SWAP + PUSH TP,[0] + PUSH TP,[0] + MOVEI C,1 ; COUNT ARGS + PUSH TP,SPSTOR ; SAVE INITIAL BINDING POINTER + PUSH TP,SPSTOR+1 + MOVE D,PVSTOR+1 + ADD D,[1STEPR,,1STEPR] + PUSH TP,BNDV + PUSH TP,D + PUSH TP,$TPVP + PUSH TP,[0] + MOVE E,TP +NBIND: PUSH TP,INTFCN(B) + PUSH TP,INTFCN+1(B) + ADD A,[2,,2] + JUMPGE A,DO.HND + PUSH TP,(A) + PUSH TP,1(A) + AOJA C,.-4 +DO.HND: MOVE PVP,PVSTOR+1 + SKIPN 1STEPR+1(PVP) ; NECESSARY TO DO 1STEP BINDING ? + JRST NBIND1 ; NO, DON'T BOTHER + PUSH P,C + PUSHJ P,SPECBE ; BIND 1 STEP FLAG + POP P,C +NBIND1: ACALL C,INTAPL ; RUN HAND WITH POSSIBLY BOUND 1STEP FLAG + MOVE SP,SPSTOR+1 ; GET CURRENT BINDING POINTER + CAMN SP,-4(TP) ; SAME AS SAVED BINDING POINTER ? + JRST NBIND2 ; YES, 1STEP FLAG NOT BOUND + MOVE C,(TP) ; RESET 1 STEP + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; RESTORE SAVED BINDING POINTER + MOVEM SP,SPSTOR+1 +NBIND2: SUB TP,[6,,6] + PUSHJ P,CHUNSW + CAMN E,PVSTOR+1 + SUB TP,[4,,4] ; NO PROCESS CHANGE, POP JUNK + CAMN E,PVSTOR+1 + JRST .+4 + MOVE D,TPSTO+1(E) + SUB D,[4,,4] + MOVEM D,TPSTO+1(E) ; FIXUP HIS STACK +DO.H1: GETYP A,A ; CHECK FOR A DISMISS + CAIN A,TDISMI + JRST SUBTP4 + MOVE B,(TP) ; TRY FOR NEXT HANDLER + SKIPE B,INXT+1(B) + JRST NXHND +SUBTP4: SUB TP,[4,,4] + POPJ P, + +MFUNCTION INTAPL,SUBR,[RUNINT] + JRST APPLY + + +NOHAND: JUMPE C,NOHAN1 + PUSH TP,$TATOM + PUSH TP,EQUOTE INTERNAL-INTERRUPT +NOHAN1: PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NOT-HANDLED + SKIPE A,C + MOVEI A,1 + ADDI A,2 + JRST CALER + +DEFERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT + PUSH TP,$TINTH + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE INTERRUPT + MCALL 3,RERR ; FORCE REAL ERROR + JRST FINIS + +; FUNCTION TO DISMISS AN INTERRUPT TO AN ARBITRARY ACTIVATION + +MFUNCTION DISMISS,SUBR + + HLRZ 0,AB + JUMPGE AB,TFA + CAIGE 0,-6 + JRST TMA + MOVNI D,1 + CAIE 0,-6 + JRST DISMI3 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + SKIPGE D,5(AB) + JRST OUTRNG + +DISMI3: MOVEI A,(TB) + +DISMI0: HRRZ B,FSAV(A) + HRRZ C,PCSAV(A) + CAIE B,INTAPL + JRST DISMI1 + + MOVE E,OTBSAV(A) + MOVEI 0,(A) ; SAVE FRAME + MOVEI A,DISMI2 + HRRM A,PCSAV(E) ; GET IT BACK HERE + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,TPSAV(E) + MOVEM A,-7(C) + MOVEM B,-6(C) + MOVEI C,0 + CAMGE AB,[-3,,] + MOVEI C,2(AB) + MOVE B,0 ; DEST FRAME + JUMPL D,.+3 + MOVE A,PSAV(E) ; NOW MUNG SAVED INT LEVEL + MOVEM D,-1(A) ; ZAP YOUR MUNGED + PUSHJ P,CHUNW ; CHECK ON UNWINDERS + JRST FINIS ; FALL DOWN + +DISMI1: MOVEI E,(A) + HRRZ A,OTBSAV(A) + JUMPN A,DISMI0 + + MOVE A,(AB) + MOVE B,1(AB) + + PUSH TP,A + PUSH TP,B + SKIPGE A,D + JRST .+4 + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + CAML AB,[-3,,] + JRST .+5 + PUSH TP,2(AB) + PUSH TP,3(AB) + MCALL 2,ERRET + JRST FINIS + + POP TP,B + POP TP,A + JRST FINIS + +DISMI2: CAMN SP,-4(TP) ; 1STEP FLAG BEEN BOUND ? + JRST NDISMI ; NO + MOVE C,(TP) + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) +NDISMI: SUB TP,[6,,6] + PUSHJ P,CHUNSW ; UNDO ANY PROCESS HACKING + MOVE C,TP + CAME E,PVSTOR+1 ; SWAPED? + MOVE C,TPSTO+1(E) + MOVE D,-1(C) + MOVE 0,(C) + SUB TP,[4,,4] + SUB C,[4,,4] ; MAYBE FIXUP OTHER STACK + CAME E,PVSTOR+1 + MOVEM C,TPSTO+1(E) + PUSH TP,D + PUSH TP,0 + PUSH TP,A + PUSH TP,B + MOVE A,-1(P) ; SAVED PRIORITY + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + SKIPN -1(TP) + JRST .+3 + MCALL 2,ERRET + JRST FINIS + + SUB TP,[4,,4] + MOVSI A,TDISMI + MOVE B,IMQUOTE T + JRST DO.H1 + +CHNGT1: HLRE B,AB + SUBM AB,B + GETYP 0,-2(B) + CAIE 0,TCHAN + JRST WTYP3 + MOVE B,-1(B) + MOVSI A,TCHAN + POPJ P, + +GTLOC1: GETYP A,2(AB) + PUSHJ P,LOCQ + JRST WTYP2 + MOVE D,B ; RET ATOM FOR ASSOC + MOVE A,2(AB) + MOVE B,3(AB) + POPJ P, + ; MONITOR CHECKERS + +MONCH0: HLLZ 0,(B) ; POTENTIAL MONITORS +MONCH: TLZ 0,TYPMSK ; KILL TYPE + IOR C,0 ; IN NEW TYPE + PUSH P,0 + MOVEI 0,(B) + CAIL 0,HIBOT + JRST PURERR + POP P,0 + TLNN 0,.WRMON ; SKIP IF WRITE MONIT + POPJ P, + +; MONITOR IS ON, INVOKE HANDLER + + PUSH TP,A ; SAVE OBJ + PUSH TP,B + PUSH TP,C + PUSH TP,D ; SAVE DATUM + MOVSI C,TATOM ; PREPARE TO FIND IT + MOVE D,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,IGET + JUMPE B,MONCH1 ; NOT FOUND IGNORE FOR NOW + PUSH TP,A ; START SETTING UP CALL + PUSH TP,B + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STAKC + MCALL 4,EMERGE ; DO IT +MONCH1: POP TP,D + POP TP,C + POP TP,B + POP TP,A + HLLZ 0,(B) ; UPDATE MONITORS + TLZ 0,TYPMSK + IOR C,0 + POPJ P, + +; NOW FOR READ MONITORS + +RMONC0: HLLZ 0,(B) +RMONCH: TLNN 0,.RDMON + POPJ P, + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + MOVE D,MQUOTE READ,READ,INTRUP + PUSHJ P,IGET + JUMPE B,RMONC1 + PUSH TP,A + PUSH TP,B + PUSH TP,-3(TP) + PUSH TP,-3(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STACK + MCALL 3,EMERGE +RMONC1: POP TP,B + POP TP,A + POPJ P, + +; PUT THE CURRENT FRAME ON THE STACK + +FRMSTK: PUSHJ P,MAKACT + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B + POPJ P, + +; HERE TO COMPLAIN ABOUT ATTEMPTS TO MUNG PURE CODE + +PURERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-MUNG-PURE-STRUCTURE + PUSH TP,A + PUSH TP,B + MOVEI A,2 + JRST CALER + +; PROCESS SWAPPING CODE + +CHSWAP: MOVE E,PVSTOR+1 ; GET CURRENT + POP P,0 + SKIPE D,INTPRO+1(B) ; SKIP IF NO PROCESS GIVEN + CAMN D,PVSTOR+1 ; SKIP IF DIFFERENT + JRST PSHPRO + + PUSHJ P,SWAPIT ; DO SWAP + +PSHPRO: PUSH TP,$TPVP + PUSH TP,E + JRST @0 + +CHUNSW: MOVE E,PVSTOR+1 ; RET OLD PROC + MOVE D,-2(TP) ; GET SAVED PROC + CAMN D,PVSTOR+1 ; SWAPPED? + POPJ P, + +SWAPIT: PUSH P,0 + MOVE 0,PSTAT+1(D) ; CHECK STATE + CAIE 0,RESMBL + JRST NOTRES + MOVE PVP,PVSTOR+1 + MOVEM 0,PSTAT+1(PVP) + MOVEI 0,RUNING + MOVEM 0,PSTAT+1(D) ; SAVE NEW STATE + POP P,0 + POP P,C + JRST SWAP" + + +;SUBROUTINE TO GET BIT FOR CLOBBERAGE + +GETBIT: MOVNS B ;NEGATE + MOVSI A,400000 ;GET THE BIT + LSH A,(B) ;SHIFT TO POSITION + POPJ P, ;AND RETURN + +; HERE TO HANDLE PURE WRITE AND CHECK FOR POSSIBLE C/W + +IFN ITS,[ +GCPWRT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE NPWRIT + JRST .+3 + MOVEI B,4 ; INDICATE PURE WRITE + JRST NOPUGC ; CONTINUE + TLZ A,200 + MOVEM A,TSINT ; SVE A + MOVE A,TSAVA + SOS TSINTR + .SUSET [.RMPVA,,A] + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + JUMPL B,GCPW1 ; JUMP IF WINDOW IS BUFFER + EXCH P,GCPDL + PUSHJ P,%CWINF ; GO DO COPY/WRITE +GCPW2: EXCH P,GCPDL + MOVE A,TSINT ; RESTORE A + JRST 2NDWORD ; CONTINUE +GCPW1: EXCH P,GCPDL + MOVEI B,WIND ; START OF BUFFER + PUSHJ P,%CWINF ; C/W + MOVEI B,WNDP ; RESTORE WINDOW + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST GCPW2 +] +IFE ITS,[ + +; HERE TO HANDLE BUFFERING FOR GC-DUMP AND PURIFY FOR TENEX + +PWRIT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE GPURFL + SKIPA + FATAL IMW + EXCH P,GCPDL ; GET A GOOD PDL + MOVEM A,TSAVA ; SAVE AC'S + MOVEM B,TSAVB + MOVEI A,MFORK ; FOR TWENEX THIS IS A MOVEI + SKIPE OPSYS ; SKIP IF TOPS20 + MOVSI A,MFORK ; FOR A TENEX IT SHOULD BE A MOVSI + GTRPW ; GET TRAP WORDS + PUSH P,A ; SAVE ADDRESS AND WORD + PUSH P,B + ANDI A,-1 + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + ANDCMI A,1777 ; TO PAGE BOUNDRY + JUMPL B,PWRIT2 ; USE WINDOW AS BUFFER +PWRIT3: PUSHJ P,%CWINF ; FIX UP +PWRIT4: POP P,B ; RESTORE AC'S + POP P,A + TLNN A,10 ; SEE IF R/W CYCLE + MOVEM B,(A) ; FINISH WRITE + EXCH P,GCPDL + JRST INTDON +PWRIT2: MOVEI B,WIND + PUSHJ P,%CWINF ; GO TRY TO WIN + MOVEI B,WNDP + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST PWRIT4 +] + +;HERE TO HANDLE PDL OVERFLOW. ASK FOR A GC + +IPDLOV: +IFN ITS,[ + MOVEM A,TSINT ;SAVE INT WORD +] + + SKIPE GCFLG ;IS GC RUNNING? + JRST GCPLOV ;YES, COMPLAIN GROSSLY + + MOVEI A,200000 ;GET BIT TO CLOBBER + IORM A,PIRQ ;LEAVE A MESSAGE FOR HIGHER LEVEL + + EXCH P,GCPDL ;GET A WINNING PDL + HRRZ B,TSINTR ;GET POINTER TO LOSING INSTRUCTION +IFE ITS,[ + SKIPE MULTSG + MOVE B,TSINTR+1 +] + SKIPG GCPDL ; SKIP IF NOT P + LDB B,[270400,,-1(B)] ;GET AC FIELD + SKIPL GCPDL ; SKIP IF P + MOVEI B,P + MOVEI A,(B) ;COPY IT + LSH A,1 ;TIMES 2 + EXCH PVP,PVSTOR+1 + ADDI A,0STO(PVP) ;POINT TO THIS ACS CURRENT TYPE + EXCH PVP,PVSTOR+1 + HLRZ A,(A) ;GET THAT TYPE INTO A + CAIN B,P ;IS IT P + MOVEI B,GCPDL ;POINT TO SAVED P + + CAIN B,B ;OR IS IT B ITSELF + MOVEI B,TSAVB + CAIN B,A ;OR A + MOVEI B,TSAVA + + CAIN B,C ;OR C + MOVEI B,1(P) ;C WILL BE ON THE STACK + + PUSH P,C + PUSH P,A + + MOVE A,(B) ;GET THE LOSING POINTER + MOVEI C,(A) ;AND ISOLATE RH + + CAMG C,VECTOP ;CHECK IF IN GC SPACE + CAMG C,VECBOT + JRST NOGROW ;NO, COMPLAIN + +; FALL THROUGH + + + HLRZ C,A ;GET -LENGTH + SUBI A,-1(C) ;POINT TO A DOPE WORD + POP P,C ;RESTORE TYPE INTO C + PUSH P,D ; SAVE FOR GROWTH HACKER + MOVEI D,0 + CAIN C,TPDL ; POINT TD TO APPROPRIATE DOPE WORD + MOVEI D,PGROW + CAIN C,TTP + MOVEI D,TPGROW + JUMPE D,BADPDL ; IF D STILL 0, THIS PDL IS WEIRD + MOVEI A,PDLBUF(A) ; POINT TO ALLEGED REAL DOPE WORD + SKIPN (D) ; SKIP IF PREVIOUSLY BLOWN + MOVEM A,(D) ; CLOBBER IN + CAME A,(D) ; MAKE SURE IT IS THE SAME + JRST PDLOSS + POP P,D ; RESTORE D + + +PNTRHK: MOVE C,(B) ;RESTORE PDL POINTER + SUB C,[PDLBUF,,0] ;FUDGE THE POINTER + MOVEM C,(B) ;AND STORE IT + + POP P,C ;RESTORE THE WORLD + EXCH P,GCPDL ;GET BACK ORIG PDL +IFN ITS,[ + MOVE A,TSINT ;RESTORE INT WORD + + JRST IMPCH ;LOOK FOR MORE INTERRUPTS +] +IFE ITS, JRST GCQUIT + +TPOVFL: SETOM INTFLG ;SIMULATE PDL OVFL + PUSH P,A + MOVEI A,200000 ;TURN ON THE BIT + IORM A,PIRQ + HLRE A,TP ;FIND DOPEW + SUBM TP,A ;POINT TO DOPE WORD + MOVEI A,PDLBUF+1(A) ; ZERO LH AND POINT TO DOPEWD + SKIPN TPGROW + HRRZM A,TPGROW + CAME A,TPGROW ; MAKE SURE WINNAGE + JRST PDLOS1 + SUB TP,[PDLBUF,,0] ; HACK STACK POINTER + POP P,A + POPJ P, + + +; GROW CORE IF PDL OVERFLOW DURING GC + +GCPLOV: EXCH P,GCPDL ; NEED A PDL TO CALL P.CORE + PUSHJ P,GPDLOV ; HANDLE PDL OVERFLOW + EXCH P,GCPDL + PUSHJ P,%FDBUF +IFE ITS,[ + JRST GCQUIT +] +IFN ITS,[ + MOVE A,TSINT + JRST IMPCH + +] + +IFN ITS,[ + +;HERE TO HANDLE LOW-LEVEL CHANNELS + + +CHNACT: SKIPN GCFLG ;GET A WINNING PDL + EXCH P,GCPDL + ANDI A,177777 ;ISOLATE CHANNEL BITS + PUSH P,0 ;SAVE + +CHNA1: MOVEI B,0 ;BIT COUNTER + JFFO A,.+2 ;COUNT + JRST CHNA2 + SUBI B,35. ;NOW HAVE CHANNEL + MOVMS B ;PLUS IT + MOVEI 0,1 + LSH 0,(B) + ANDCM A,0 + MOVEI 0,(B) ; COPY TO 0 + LSH 0,23. ;POSITION FOR A .STATUS + IOR 0,[.STATUS 0] + XCT 0 ;DO IT + ANDI 0,77 ;ISOLATE DEVICE + CAILE 0,2 + JRST CHNA1 + +PMIN4: MOVE 0,B ; CHAN TO 0 + .ITYIC 0, ; INTO 0 + JRST .+2 ; DONE, GO ON + JRST PMIN4 + SETZM GCFLCH ; LEAVE GC MODE + JRST CHNA1 + +CHNA2: POP P,0 + SKIPN GCFLG + EXCH P,GCPDL + JRST GCQUIT + +HOWMNY: SETZ + SIXBIT /LISTEN/ + D + 402000,,B +] + +MFUNCTION GASCII,SUBR,ASCII + ENTRY 1 + + GETYP A,(AB) + CAIE A,TCHRS + JRST TRYNUM + + MOVE B,1(AB) + MOVSI A,TFIX + JRST FINIS + +TRYNUM: CAIE A,TFIX + JRST WTYP1 + SKIPGE B,1(AB) ;GET NUMBER + JRST TOOBIG + CAILE B,177 ;CHECK RANGE + JRST TOOBIG + MOVSI A,TCHRS + JRST FINIS + +TOOBIG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE + + +;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION + +BADPDL: FATAL NON PDL OVERFLOW + +NOGROW: FATAL PDL OVERFLOW ON NON EXPANDABLE PDL + +PDLOS1: MOVEI D,TPGROW +PDLOSS: MOVSI A,(GENERAL) ; FIX UP TP DOPE WORD JUST IN CASE + HRRZ D,(D) ; POINT TO POSSIBLE LOSING D.W. + SKIPN TPGROW + JRST PDLOS2 + MOVEM A,-1(D) + MOVEI A,(TP) ; SEE IF REL STACK SIZE WINS + SUBI A,(TB) + TRNN A,1 + SUB TP,[1,,1] +PDLOS2: MOVSI A,.VECT. + SKIPE PGROW + MOVEM A,-1(D) + SUB P,[2,,2] ; TRY TO RECOVER GRACEFULLY + EXCH P,GCPDL + MOVEI A,DOAGC ; SET UP TO IMMEDIATE GC +IFN ITS,[ + HRRM A,TSINTR +] +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] +IFN ITS, .DISMIS TSINTR +IFE ITS, DEBRK + +DOAGC: SKIPE PGROW + SUB P,[2,,2] ; ALLOW ROOM FOR CALL + JSP E,PDL3 ; CLEANUP + ERRUUO EQUOTE PDL-OVERFLOW-BUFFER-EXHAUSTED + + +DLOSER: PUSH P,LOSRS(B) + MOVE A,TSAVA + MOVE B,TSAVB + POPJ P, + +LOSRS: IMPV + ILOPR + IOC + IPURE + + +;MEMORY PROTECTION INTERRUPT + +IOC: FATAL IO CHANNEL ERROR IN GARBAGE COLLECTOR +IMPV: FATAL MPV IN GARBAGE COLLECTOR + +IPURE: FATAL PURE WRITE IN GARBAGE COLLECTOR +ILOPR: FATAL ILLEGAL OPEREATION IN GARBAGE COLLECTOR + +IFN ITS,[ + +;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO SETUP INTS + +INTINT: SETZM CHNCNT + MOVE A,[CHNCNT,,CHNCNT+1] + BLT A,CHNCNT+16. + SETZM INTFLG + .SUSET [.SPICLR,,[-1]] + MOVE A,MASK1 ;SET MASKS + MOVE B,MASK2 + .SETM2 A, ;SET BOTH MASKS + MOVSI A,TVEC + MOVEM A,QUEUES + SETZM QUEUES+1 ;UNQUEUE ANY OLD INTERRUPTS + SETZM CURPRI + POPJ P, +] +IFE ITS,[ + +; INITIALIZE TENEX INTERRUPT SYSTEM + +INTINT: CIS ; CLEAR THE INT WORLD + SETZM INTFLG ; IN CASE RESTART + MOVSI A,TVEC ; FIXUP QUEUES + MOVEM A,QUEUES + SETZM QUEUES+1 + SETZM CURPRI ; AND PRIORITY LEVEL + MOVEI A,MFORK ; TURN ON MY INTERRUPTS + SKIPN MULTSG + JRST INTINM + PUSHJ P,@[DOSIR] ; HACK TO TEMP GET TO SEGMENT 0 + JRST INTINX + +INTINM: MOVE B,[-36.,,CHNTAB] + MOVSI 0,1 + HLLM 0,(B) + AOBJN B,.-1 + + MOVE B,[LEVTAB,,CHNTAB] ; POINT TO TABLES + SIR ; TELL SYSTEM ABOUT THEM + +INTINX: MOVSI D,-NCHRS + MOVEI 0,40 + MOVEI C,0 + +INTILP: SKIPN A,CHRS(D) + JRST ITTIL1 + IOR C,0 + MOVSS A + HRRI A,(D) + ATI +ITTIL1: LSH 0,-1 + AOBJN D,INTILP + + DPB C,[360600,,MASK1] + MOVE B,MASK1 ; SET UP FOR INT BITS + MOVEI A,MFORK + AIC ; TURN THEM ON + MOVEI A,MFORK ; DO THE ENABLE + EIR + POPJ P, + + +DOSIR: MOVE B,[-36.,,CHNTAB] + MOVSI 0,<1_12.>+FSEG + HLLM 0,(B) + AOBJN B,.-1 + + MOVEI B,..ARGB ; WILL RUN IN SEGMENT 0 +RMT [ +..ARGB: 3 + LEVTAB + CHNTAB +] + XSIR + POP P,D + HRLI D,FSEG + XJRST C ; GET BACK TO CALLING SEGMENT +] + + +; CNTL-G HANDLER + +MFUNCTION QUITTER,SUBR + + ENTRY 2 + GETYP A,(AB) + CAIE A,TCHRS + JRST WTYP1 + GETYP A,2(AB) + CAIE A,TCHAN + JRST WTYP2 + MOVE B,1(AB) + MOVE A,(AB) +IFE ITS, CAIE ^O + CAIN B,^S ; HANDLE CNTL-S + JRST RETLIS + CAIE B,7 + JRST FINIS + + PUSHJ P,CLEAN ; CLEAN UP I/O CHANNELS + PUSH TP,$TATOM + PUSH TP,EQUOTE CONTROL-G? + MCALL 1,ERROR + JRST FINIS + +RETLIS: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET CURRENT VALUE + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + SUB TP,[2,,2] + MOVEI D,(TB) ; FIND A LISTEN OR ERROR TO RET TO + +RETLI1: HRRZ A,OTBSAV(D) + CAIN A,(B) ; CHECK FOR WINNER + JRST FNDHIM + HRRZ C,FSAV(A) ; CHECK FUNCTION + CAIE C,LISTEN + CAIN C,ERROR ; FOUND? + JRST FNDHIM ; YES, GO TO SAME + CAIN C,ERROR% ; FUNNY ERROR + JRST FNDHIM + CAIN C,TOPLEV ; NO ERROR/LISTEN + JRST FINIS + MOVEI D,(A) + JRST RETLI1 + +FNDHIM: PUSH TP,$TTB + PUSH TP,D + PUSHJ P,CLEAN + MOVE B,(TP) ; NEW FRAME + SUB TP,[2,,2] + MOVEI C,0 + PUSHJ P,CHUNW ; UNWIND? + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CLEAN: MOVE B,3(AB) ; GET IN CHAN + PUSHJ P,RRESET + MOVE B,3(AB) ; CHANNEL BAKC + MOVE C,BUFRIN(B) + SKIPN C,ECHO(C) ; GET ECHO + JRST CLUNQ +IFN ITS,[ + MOVEI A,2 + CAMN C,[PUSHJ P,MTYO] + JRST TYONUM + LDB A,[270400,,C] +TYONUM: LSH A,23. + IOR A,[.RESET] + XCT A +] +IFE ITS,[ + MOVEI A,101 ; OUTPUT JFN + CFOBF +] + +CLUNQ: SETZB A,CURPRI + JRST UNQUEU + + +IMPURE +ONINT: 0 ; INT FUDGER +INTBCK: 0 ; GO BACK TO THIS PC AFTER INTERRUPT + MOVEM TP,TPSAV(TB) ; SAVE STUFF + MOVEM P,PSAV(TB) +INTBEN: SKIPL INTFLG ; PENDING INTS? + JRST @INTBCK + PUSH P,A + SOS A,INTBCK + SETZM INTBCK + MOVEM A,LCKINT + POP P,A + JRST LCKINT+1 + + +IFN ITS,[ +;RANDOM IMPURE CRUFT NEEDED +CHNCNT: BLOCK 16. ; # OF CHARS IN EACH CHANNEL + +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 ;HOLDS REQUEST BITS FOR 1ST WORD +PIRQ2: 0 ;SAME FOR WORD 2 +PCOFF: 0 +MASK1: 200,,200100 ;FIRST MASK +MASK2: 0 ;SECOND THEREOF +CURPRI: 0 ; CURRENT PRIORITY +RLTSAV: 0 +] +IFE ITS,[ +CHRS: 7 ; CNTL-G + 23 ; CNTL-O + 17 ; CNTL-S + BLOCK NCHRS-3 + +NETJFN: BLOCK NNETS +MASK1: CHNMSK +RLTSAV: 0 +TSINTR: +P1: 0 + 0 ; PC INT LEVEL 1 (1ST WORD IN 1 SEG MODE, 2D + ; IN MULTI SEG MODE) +P2: 0 + 0 ; PC INT LEVEL 2 +P3: 0 + 0 ; PC INT LEVEL 3 +CURPRI: 0 +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 +PIRQ2: 0 +IOCLOS: 0 ; HOLDS LOSING JFN IN TNX IOC +] +PURE + +END + \ No newline at end of file diff --git a//uuoh.184 b//uuoh.184 index 845b9d5..b76626e 100644 --- a//uuoh.184 +++ b//uuoh.184 @@ -25,6 +25,7 @@ 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] @@ -1052,6 +1053,8 @@ DPOPUN: PUSHJ P,POPUNW ; HERE FOR MULTI SEG SIMULATION STUFF +EXPUNG DMOVE,DMOVEM + DMOVE: MOVSI C,(MOVE) JRST MEX DHRRM: MOVSI C,(HRRM) diff --git a//xfile.muddle b//xfile.muddle index 8ebc443..69e3574 100644 --- a//xfile.muddle +++ b//xfile.muddle @@ -7,7 +7,7 @@ :midas .temp.;_mdlint; mudits :midas .temp.;_mdlint; mappur :midas .temp.;_mdlint; core -:midas .temp.;_mdlint; atomhk 144 +:midas .temp.;_mdlint; atomhk :midas .temp.;_mdlint; interr :midas .temp.;_mdlint; gchack :midas .temp.;_mdlint; readch @@ -28,6 +28,6 @@ :midas .temp.;_mdlint; create :midas .temp.;_mdlint; save :midas .temp.;_mdlint; agc -:midas .temp.;_mdlint; amsgc 107 +:midas .temp.;_mdlint; amsgc :midas .temp.;_mdlint; secagc :midas .temp.;_mdlint; initm