X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fgchack.mid.46;fp=%3Cmdl.int%3E%2Fgchack.mid.46;h=b2b86f6398d9447f668053455979b779c3e406d3;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//gchack.mid.46 b//gchack.mid.46 new file mode 100644 index 0000000..b2b86f6 --- /dev/null +++ b//gchack.mid.46 @@ -0,0 +1,540 @@ + +TITLE GCHACK + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG +.GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR + +UBIT==40000 ; BIT INDICATING VECTOR +.LIST.==400000 + +; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING +; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN + +; CALL -- +; A/ INSTRUCTION TO BE EXECUTED +; PVP/ NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS +; PUSHJ P,GCHACK + +; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE + +GCHK10: PUSHJ P,GHSTUP + JRST GCHK1 + +GCHACK: PUSHJ P,GHSTUP ; SETUP + MOVE B,CODTOP ; START OFF WITH IMPURE STORAGE + SUBI B,1 ; START AT FIRST WORD +LOPSTO: CAIG B,STOSTR + JRST GCHK1 + HRRE 0,1(B) ; GET INDICATOR OF MODIFICATION + JUMPGE 0,LOSTO ; JUMP IF GARBAGE + PUSHJ P,VHACK ; VHACK + JRST LOPSTO +LOSTO: HLRZ C,1(B) ; BACK OF VECTOR + TRZ C,400000 + SUBI B,(C) ; SKIP OVER VECTOR + JRST LOPSTO + +GCHK1: MOVE B,VECTOP ; NO LOOP THRU GCS + MOVEI B,-2(B) + + +LOOPHK: MOVE C,SVTAB + MOVEM B,(C) + EXCH C,NXTTAB ; SWAP LOCATIONS + EXCH C,SVTAB + TLZ B,.LIST. ; TURN OFF LIST BIT + CAMGE B,GCSBOT ; SEE IF DONE + JRST REHASQ ; SEE IF ASSOCIATIONS ARE GOOD + MOVE C,(B) ; GET ELEMENT + TLNE C,.VECT. ; SEE IF IT IS A VECTOR + JRST VHCK ; JUMP IF IT IS +GLSTHK: GETYP C,(B) ; TYPE OF CURRENT PAIR + MOVE D,1(B) ; AND ITS DATUM + TLO B,.LIST. ; INDICATE A LIST + SKIPL (B) ; SKIP IF MARKED + XCT A ; APPLY INS + SUBI B,2 + JRST LOOPHK +VHCK: PUSHJ P,VHACK ; TO VHACK + JRST LOOPHK + +; NOW DO THE SAME THING TO VECTOR SPACE +VHACK: HLRE D,(B) ; GET TYPE FROM D.W. + TRZ D,.VECT. ; GET RID OF VECTOR INDICATION BIT + HLRZ C,1(B) ; AND TOTAL LENGTH + TRZE C,400000 ; GET RID OF POSSIBLE MARK BIT + JRST MKHAK ; JUMP IF MARKED + SUBI B,(C)-2 ; POINT TO START OF VECTOR + PUSH P,B + SUBI C,2 ; CHECK WINNAGE + JUMPL C,BADV ; FATAL LOSSAGE + PUSH P,C ; SAVE COUNT + JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED + +; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL + + JUMPGE D,UHACK ; UNIFORM + TRNE D,377777 ; SKIP IF GENERAL + JRST SHACK ; SPECIAL + +; FALL THROUGH TO GENERAL + +GHACK1: SKIPGE (B) ; CHECK FOR FENCE POST + JRST VHACK1 + GETYP C,(B) ; LOOK A T 1ST ELEMENT + CAIE C,TCBLK + CAIN C,TENTRY ; FRAME ON STACK + SOJA B,EHACK + CAIE C,TUBIND + CAIN C,TBIND ; BINDING BLOCK + JRST BHACK + CAIN C,TGATOM ; ATOM WITH GDECL? + JRST GDHACK + MOVE D,1(B) ; GET DATUM + XCT A ; USER INS +GDHCK1: ADDI B,2 ; NEXT ELEMENT + SOS (P) + SOSLE (P) ; COUNT ELEMENTS + SKIPGE (B) ; OR FENCE POST HIT + JRST VHACK1 + JRST GHACK1 + +; HERE TO GO OVER UVECTORS + +UHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC + MOVEI C,(D) ; COPY UNIFORM TYPE + JUMPE PVP,UHACKX ; JUMP IF NOT ONLY ATOMS + ASH C,1 ; COMPUTE SAT + ADD C,TYPVEC+1 + HRRZ C,(C) + ANDI C,SATMSK ; GOT ITS SAT + CAIE C,SCHSTR ; COULD BE SPNAME + JRST .+3 + CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS + JRST VHACK1 + MOVEI C,(D) +UHACKX: PUSH P,C ; ATFIX CLOBBERS C + SUBI B,1 ; BACK OFF + +UHACK1: MOVE C,(P) + TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR + MOVE D,1(B) ; DATUM + XCT A + SOSLE -1(P) ; COUNT DOEN + AOJA B,UHACK1 + TLZ UBIT + POP P,C + JRST VHACK1 + +; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES + +SHACK: ANDI D,377777 ; KILL EXTRA CRUFT + CAIN D,SATOM + JRST ATHACK + CAIE D,STPSTK ; STACK OR + CAIN D,SPVP ; PROCESS + JRST GHACK1 ; TREAT LIKE GENERAL + CAIN D,SASOC ; ASSOCATION + JRST ASHACK + CAIG D,NUMSAT ; TEMPLATE MAYBE? + JRST BADV ; NO CHANCE + ADDI C,(B) ; POINT TO DOPE WORDS + SUBI D,NUMSAT+1 + HRLI D,(D) + ADD D,TD.LNT+1 + JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER + + CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 + +TD.UPD: PUSH P,A ; INS TO EXECUTE + XCT (D) + HLRZ E,B ; POSSIBLE BASIC LENGTH + PUSH P,[0] + PUSH P,E + MOVEI B,(B) ; ISOLATE LENGTH + PUSH P,C ; SAVE POINTER TO OBJECT + + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB D,TD.LNT+1 + PUSH P,D ; SAVE FOR FINDING OTHER TABLES + JUMPE E,TD.UP2 ; NO REPEATING SEQ + ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE D,(D) ; D ==> - LNTH OF TEMPLATE + ADDI D,(E) ; D ==> -LENGTH OF REP SEQ + MOVNS D + HRLM D,-5(P) ; SAVE IT AND BASIC + +TD.UP2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.UP1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.UP3 + + 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,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.UP3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + TLO A,UBIT ; INDICATE ITS A ANY + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + GETYP C,A ; TYPE TO C + MOVE D,B ; DATUME + MOVEI B,-3(P) ; POINTER TO HOME + MOVE A,-7(P) ; GET INS + XCT A ; AND DO IT + MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT + MOVE E,TD.PUT+1 + SOS D,-1(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVE B,-6(P) ; SAVED OFFSET + ADDI E,(B)-1 ; POINT TO SLOT + MOVE A,-3(P) ; RESTORE TYPE WORD + MOVE B,-2(P) + XCT (E) ; SMASH IT BACK + JRST TD.LOS +TD.WIN: MOVE C,-4(P) + JRST TD.UP2 + +TD.LOS: SKIPN GCDFLG + FATAL TEMPLATE LOSSAGE + JRST TD.WIN + +TD.UP1: MOVE A,-7(P) ; RESTORE INS + SUB P,[10,,10] + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST VHACK1 + +; FATAL LOSSAGE ARRIVES HERE + +BADV: FATAL GC SPACE IN A BAD STATE + +; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS) + +EHACK: JUMPE PVP,EHACKX + ADDI B,FRAMLN+1 ; SKIP THE FRAME + JRST GHACK1 + +EHACKX: HRRZ D,1(B) + CAILE D,HIBOT + JRST EHCK10 + PUSH P,1(B) + HRL D,(D) + MOVEI C,TVEC + CAME A,[PUSHJ P,SBSTIS] + XCT A ; XCT SUBSTITUTE + POP P,C ; RESTORE TYPE + HLLM C,1(B) ; SMASH BACK +EHCK10: ADDI B,1 + MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR + +EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE + PUSH P,D ; SAVE AOBJN + MOVE D,1(B) ; GET ITEM + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A ; USER GOODIE + POP P,D ; RESTORE AOBJN + ADDI B,1 ; MOVE ON + SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR + AOBJN D,EHACK1 + AOJA B,GHACK1 ; AND GO ON + +; TABLE OF ENTRY BLOCK TYPES + +ETB: TTB + TAB + TSP + TPDL + TTP + TWORD + +; HERE TO GROVEL OVER BINDING BLOCKS + +BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM + MOVE D,1(B) + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A + PUSHJ P,NXTGDY ; NEXT GOODIE + PUSHJ P,NXTGDY ; AND NEXT + MOVEI C,TSP ; TYPE THE BACK LOCATIVE + SKIPGE D,1(B) + XCT A + PUSHJ P,BMP ; AND NEXT + PUSH P,B + HLRZ D,-2(B) ; DECL POINTER + MOVEI B,0 ; MAKE SURE NO CLOBBER + MOVEI C,TDECL + XCT A ; DO THE THING BEING DONE + POP P,B + HRLM D,-2(B) ; FIX UP IN CASE CHANGED + JRST GHACK1 + +; HERE TO HACK ATOMS WITH GDECLS + +GDHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST GDHCK1 + + MOVEI C,TATOM ; TREAT LIKE ATOM + MOVE D,1(B) + XCT A + HRRZ D,(B) ; GET DECL + JUMPE D,GDHCK1 + CAIN D,-1 ; WATCH OUT FOR MAINFEST + JRST GDHCK1 + PUSH P,B ; SAVE POINTER + MOVEI B,0 + MOVEI C,TLIST + XCT A + POP P,B + HRRM D,(B) ; RESET + JRST GDHCK1 + + +; HERE TO HACK ATOMS + +ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST + MOVEI C,TOBLS ; GET TYPE + HRRZ D,2(B) ; AND DATUM + JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH + CAMGE D,VECBOT + MOVE D,(D) ; GET REAL OBLIST POINTER + HRLI D,-1 + CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + PUSH P,B + MOVEI B,0 + XCT A + POP P,B + HRRM D,2(B) +BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + HLRZ D,2(B) + JUMPE D,VHACK1 + PUSH P,B + PUSH P,D + MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK +; HLRZ B,1(D) +; ANDI B,377777 +; SUBI B,2 +; HRLI B,(B) +; SUB D,B ; D NOW ATOM PNTR + MOVEI C,TATOM + XCT A +; HLRE B,D +; SUB D,B + POP P,D + POP P,B + HRLM D,2(B) + JRST VHACK1 + +; HERE TO HACK ASSOCIATION BLOCKS + +ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK + +ASHAK1: PUSH P,D + MOVE D,1(B) + GETYP C,(B) + PUSH P,D ; SAVE POINTER + XCT A + POP P,D ; GET OLD BACK + CAME D,1(B) ; CHANGED? + TLO E,400000 ; SET NON-VIRGIN FLAG + POP P,D + PUSHJ P,BMP ; TO NEXT + SOJG D,ASHAK1 + +; HERE TO GOT TO NEXT VECTOR + +VHACK1: MOVE B,-1(P) ; GET POINTER + SUB P,[2,,2] ; FLUSH CRUFT + SUBI B,2 ; FIX UP PTR + POPJ P, + +; HERE TO SKIP OVER MARKED VECTOR + +MKHAK: SUBI B,(C) ; POINT BELOW VECTOR + POPJ P, + +; ROUTINE TO GET A GOODIE + +NXTGDY: GETYP C,(B) +NXTGD1: MOVE D,1(B) + XCT A ; DO IT TO IT +BMP: SOS -1(P) + SOSG -1(P) + JRST BMP1 + ADDI B,2 + POPJ P, +BMP1: SUB P,[1,,1] + JRST VHACK1 + +REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT + POPJ P, + + +MFUNCTION SUBSTI,SUBR,[SUBSTITUTE] + +;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO +;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT +;YOU ARE DOING. +;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE +;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA. +;BOTH ITEMS MUST BE OF THE SAME TYPE OR +;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS +; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN +; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN +; A FEW OTHER YUCKY PLACES. +;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT + + ENTRY 2 + + +SBSTI1: GETYP A,2(AB) + CAIE A,TATOM + JRST SBSTI2 + MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE? + PUSHJ P,IMPURI + GETYP A,(AB) ; ATOM FOR ATOM SUBS? + CAIE A,TATOM + JRST SBSTI2 ; NO + MOVE B,3(AB) ; SEE IF OLD GUY + HLRE A,B + SUBM B,A ; POINT TO DOPE + HRRZ A,(A) ; POSSIBLE TYPE CODE + JUMPE A,SBSTI2 ; NOT A TYPE, GO + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRZ C,(C) ; GET OTHER POSSIBLE CODE + JUMPN C,BADTYP + PUSH P,A + PUSHJ P,IMPURI ; IMPURIFY FOR SMASH + POP P,A + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRM A,(C) + +SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG + MOVE D,A + PUSHJ P,NWORDT ; AND STORAGE ALLOCATION + MOVE E,A + GETYP A,(AB) ; GET TYPE OF FIRST ARG + MOVE B,A + PUSHJ P,NWORDT + CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION + JRST SBSTI3 + CAIN E,1 + CAIE A,1 + JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES + +SBSTI3: MOVEI C,0 + CAIN D,0 ; IF GOODIE IS OF TYPE ZERO + MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE + PUSH TP,C + SUBI E,1 + PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE + PUSH TP,C + PUSH TP,D ; TYPE OF GOODIE + PUSH TP,C + PUSH TP,[0] + CAIN D,TLIST + AOS (TP) ; 1=TYPE LIST, 0=ELSE + PUSH TP,C + PUSH TP,2(AB) ; TYPE-WORD + PUSH TP,C + PUSH TP,3(AB) ; VALUE-WORD + PUSH TP,(AB) + PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO + MOVE A,[PUSHJ P,SBSTIR] + CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER + MOVE A,[PUSHJ P,SBSTIS] + MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING + PUSHJ P,GCHACK ; DO-IT + MOVE A,-4(TP) + MOVE B,-2(TP) + JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE + +SBSTIR: CAME D,-2(TP) + JRST LSUB ; THIS IS IT + CAME C,-10(TP) + JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE + JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT + MOVE 0,(TP) + MOVEM 0,1(B) ; SMASH IT + MOVE 0,-1(TP) ; GET TYPE WORD + SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST + MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT + +LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON + POPJ P, ; ELSE THATS ALL + TLNN B,.LIST. ; SEE IF A LIST + POPJ P, ; WELL NO LIST SMASHING THIS TIME + HRRZ 0,(B) ; GET ITS LIST POINTER + CAME 0,-2(TP) + POPJ P, ; THIS ONE DIDNT MATCH + MOVE 0,(TP) ; GET THE NEW REST OF THE LIST + HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST + POPJ P, + +SBSTIS: CAMN D,-2(TP) + CAME C,-10(TP) + POPJ P, + SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE + POPJ P, + MOVE 0,(TP) + MOVEM 0,1(B) ; KLOBBER VALUE CELL + MOVE 0,-1(TP) + HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE + POPJ P, + +SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER +BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE + +GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER + HRLI E,C ; WILL HAVE TYPE CODE IN C + SETOM 1(TP) ; FENCE POST PDL + PUSH P,A + MOVEI A,(TB) + PUSHJ P,FRMUNG ; MUNG CURRENT FRAME + POP P,A + POPJ P, + + +IMPURE + +; LOCATION TO REMEMBER PREVIOUS VALUES + +SVTAB: SVLOC1 +NXTTAB: SVLOC2 + +SVLOC1: 0 +SVLOC2: 0 + +PURE + +END + + \ No newline at end of file