--- /dev/null
+TITLE GCHACK\r
+\r
+RELOCATABLE\r
+\r
+.INSRT MUDDLE >\r
+\r
+.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT\r
+.GLOBAL TD.LNT,TD.GET,TD.PUT\r
+\r
+; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING\r
+; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN\r
+\r
+; CALL --\r
+; A/ INSTRUCTION TO BE EXECUTED\r
+; PUSHJ P,GCHACK\r
+\r
+GCHACK: HRRZ E,TYPVEC+1(TVP) ; SET UP TYPE POINTER\r
+ HRLI E,C ; WILL HAVE TYPE CODE IN C\r
+ MOVE B,PARBOT ; START AT PARBOT\r
+ SETOM 1(TP) ; FENCE POST PDL\r
+ PUSH P,A\r
+ MOVEI A,(TB)\r
+ PUSHJ P,FRMUNG ; MUNG CURRENT FRAME\r
+ POP P,A\r
+\r
+; FIRST HACK PAIR SPACE\r
+\r
+PHACK: CAML B,PARTOP ; SKIP IF MORE PAIRS\r
+ JRST VHACK ; DONE, NOW HACK VECTORS\r
+ GETYP C,(B) ; TYPE OF CURRENT PAIR\r
+ MOVE D,1(B) ; AND ITS DATUM\r
+ XCT A ; APPLY INS\r
+ ADDI B,2\r
+ JRST PHACK\r
+\r
+; NOW DO THE SAME THING TO VECTOR SPACE\r
+\r
+VHACK: MOVE B,VECTOP ; START AT TOP, MOVE DOWN\r
+ SUBI B,1 ; POINT TO TOPMOST VECTOR\r
+VHACK2: CAMG B,VECBOT ; SKIP IF MORE TO DO\r
+ JRST REHASQ ; SEE IF MUST REHASH\r
+\r
+ HLRE D,-1(B) ; GET TYPE FROM D.W.\r
+ HLRZ C,(B) ; AND TOTAL LENGTH\r
+ SUBI B,(C)-1 ; POINT TO START OF VECTOR\r
+ PUSH P,B\r
+ SUBI C,2 ; CHECK WINNAGE\r
+ JUMPL C,BADV ; FATAL LOSSAGE\r
+ PUSH P,C ; SAVE COUNT\r
+ JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED\r
+\r
+; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL\r
+\r
+ JUMPGE D,UHACK ; UNIFORM\r
+ TRNE D,377777 ; SKIP IF GENERAL\r
+ JRST SHACK ; SPECIAL\r
+\r
+; FALL THROUGH TO GENERAL\r
+\r
+GHACK1: GETYP C,(B) ; LOOK A T 1ST ELEMENT\r
+ CAIE C,TCBLK\r
+ CAIN C,TENTRY ; FRAME ON STACK\r
+ SOJA B,EHACK\r
+ CAIE C,TUBIND\r
+ CAIN C,TBIND ; BINDING BLOCK\r
+ JRST BHACK\r
+ CAIN C,TGATOM ; ATOM WITH GDECL?\r
+ JRST GDHACK\r
+ MOVE D,1(B) ; GET DATUM\r
+ XCT A ; USER INS\r
+ ADDI B,2 ; NEXT ELEMENT\r
+ SOS (P)\r
+ SOSLE (P) ; COUNT ELEMENTS\r
+ SKIPGE (B) ; OR FENCE POST HIT\r
+ JRST VHACK1\r
+ JRST GHACK1\r
+\r
+; HERE TO GO OVER UVECTORS\r
+\r
+UHACK: CAMN A,[PUSHJ P,SBSTIS]\r
+ JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC\r
+ MOVEI C,(D) ; COPY UNIFORM TYPE\r
+ SUBI B,1 ; BACK OFF\r
+\r
+UHACK1: MOVE D,1(B) ; DATUM\r
+ XCT A\r
+ SOSLE (P) ; COUNT DOEN\r
+ AOJA B,UHACK1\r
+ JRST VHACK1\r
+\r
+; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES\r
+\r
+SHACK: ANDI D,377777 ; KILL EXTRA CRUFT\r
+ CAIN D,SATOM\r
+ JRST ATHACK\r
+ CAIE D,STPSTK ; STACK OR\r
+ CAIN D,SPVP ; PROCESS\r
+ JRST GHACK1 ; TREAT LIKE GENERAL\r
+ CAIN D,SASOC ; ASSOCATION\r
+ JRST ASHACK\r
+ CAIG D,NUMSAT ; TEMPLATE MAYBE?\r
+ JRST BADV ; NO CHANCE\r
+ ADDI C,(B) ; POINT TO DOPE WORDS\r
+ SUBI D,NUMSAT+1\r
+ HRLI D,(D)\r
+ ADD D,TD.LNT+1(TVP)\r
+ JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER\r
+\r
+ CAMN A,[PUSHJ P,SBSTIS]\r
+ JRST VHACK1\r
+\r
+TD.UPD: PUSH P,A ; INS TO EXECUTE\r
+ XCT (D)\r
+ HLRZ E,B ; POSSIBLE BASIC LENGTH\r
+ PUSH P,[0]\r
+ PUSH P,E\r
+ MOVEI B,(B) ; ISOLATE LENGTH\r
+ PUSH P,C ; SAVE POINTER TO OBJECT\r
+\r
+ PUSH P,[0] ; HOME FOR VALUES\r
+ PUSH P,[0] ; SLOT FOR TEMP\r
+ PUSH P,B ; SAVE\r
+ SUB D,TD.LNT+1(TVP)\r
+ PUSH P,D ; SAVE FOR FINDING OTHER TABLES\r
+ JUMPE E,TD.UP2 ; NO REPEATING SEQ\r
+ ADD D,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
+ HLRE D,(D) ; D ==> - LNTH OF TEMPLATE\r
+ ADDI D,(E) ; D ==> -LENGTH OF REP SEQ\r
+ MOVNS D\r
+ HRLM D,-5(P) ; SAVE IT AND BASIC\r
+\r
+TD.UP2: SKIPG D,-1(P) ; ANY LEFT?\r
+ JRST TD.UP1\r
+\r
+ MOVE E,TD.GET+1(TVP)\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ MOVEM D,-6(P) ; SAVE ELMENT #\r
+ SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST\r
+ SOJA D,TD.UP3\r
+\r
+ MOVEI 0,(B) ; BASIC LNT TO 0\r
+ SUBI 0,(D) ; SEE IF PAST BASIC\r
+ JUMPGE 0,.-3 ; JUMP IF O.K.\r
+ MOVSS B ; REP LNT TO RH, BASIC TO LH\r
+ IDIVI 0,(B) ; A==> -WHICH REPEATER\r
+ MOVNS A\r
+ ADD A,-5(P) ; PLUS BASIC\r
+ ADDI A,1 ; AND FUDGE\r
+ MOVEM A,-6(P) ; SAVE FOR PUTTER\r
+ ADDI E,-1(A) ; POINT\r
+ SOJA D,.+2\r
+\r
+TD.UP3: ADDI E,(D) ; POINT TO SLOT\r
+ XCT (E) ; GET THIS ELEMENT INTO A AND B\r
+ MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT\r
+ MOVEM B,-2(P)\r
+ GETYP C,A ; TYPE TO C\r
+ MOVE D,B ; DATUME\r
+ MOVEI B,-3(P) ; POINTER TO HOME\r
+ MOVE A,-7(P) ; GET INS\r
+ XCT A ; AND DO IT\r
+ MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT\r
+ MOVE E,TD.PUT+1(TVP)\r
+ SOS D,-1(P) ; RESTORE COUNT\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ MOVE B,-6(P) ; SAVED OFFSET\r
+ ADDI E,(B)-1 ; POINT TO SLOT\r
+ MOVE A,-3(P) ; RESTORE TYPE WORD\r
+ MOVE B,-2(P)\r
+ XCT (E) ; SMASH IT BACK\r
+ FATAL TEMPLATE LOSSAGE\r
+ MOVE C,-4(P)\r
+ JRST TD.UP2\r
+\r
+TD.UP1: MOVE A,-7(P) ; RESTORE INS\r
+ SUB P,[10,,10]\r
+ MOVSI D,400000 ; RESTORE MARK/UNMARK BIT\r
+ JRST VHACK1\r
+\r
+; FATAL LOSSAGE ARRIVES HERE\r
+\r
+BADV: FATAL GC SPACE IN A BAD STATE\r
+\r
+; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)\r
+\r
+EHACK: MOVSI D,-FRAMLN ; SET UP AOBJN PNTR\r
+\r
+EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE\r
+ PUSH P,D ; SAVE AOBJN\r
+ MOVE D,1(B) ; GET ITEM\r
+ CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT\r
+ XCT A ; USER GOODIE\r
+ POP P,D ; RESTORE AOBJN\r
+ ADDI B,1 ; MOVE ON\r
+ SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR\r
+ AOBJN D,EHACK1\r
+ AOJA B,GHACK1 ; AND GO ON\r
+\r
+; TABLE OF ENTRY BLOCK TYPES\r
+\r
+ETB: TSUBR\r
+ TTB\r
+ TAB\r
+ TSP\r
+ TPDL\r
+ TTP\r
+ TWORD\r
+\r
+; HERE TO GROVEL OVER BINDING BLOCKS\r
+\r
+BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM\r
+ MOVE D,1(B)\r
+ CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT\r
+ XCT A\r
+ PUSHJ P,NXTGDY ; NEXT GOODIE\r
+ PUSHJ P,NXTGDY ; AND NEXT\r
+ MOVEI C,TSP ; TYPE THE BACK LOCATIVE\r
+ PUSHJ P,NXTGD1 ; AND NEXT\r
+ PUSH P,B\r
+ HLRZ D,-2(B) ; DECL POINTER\r
+ MOVEI B,0 ; MAKE SURE NO CLOBBER\r
+ MOVEI C,TDECL\r
+ XCT A ; DO THE THING BEING DONE\r
+ POP P,B\r
+ HRLM D,-2(B) ; FIX UP IN CASE CHANGED\r
+ JRST GHACK1\r
+\r
+; HERE TO HACK ATOMS WITH GDECLS\r
+\r
+GDHACK: CAMN A,[PUSHJ P,SBSTIS]\r
+ JRST VHACK1\r
+\r
+ MOVEI C,TATOM ; TREAT LIKE ATOM\r
+ MOVE D,1(B)\r
+ XCT A\r
+ HRRZ D,(B) ; GET DECL\r
+ JUMPE D,VHACK1\r
+ CAIN D,-1 ; WATCH OUT FOR MAINFEST\r
+ JRST VHACK1\r
+ PUSH P,B ; SAVE POINTER\r
+ MOVEI B,0\r
+ MOVEI C,TLIST\r
+ XCT A\r
+ POP P,B\r
+ HRRM D,(B) ; RESET\r
+ JRST VHACK1\r
+\r
+; HERE TO HACK ATOMS\r
+\r
+ATHACK: ADDI B,1 ; POINT PRIOR TO OBL SLOT\r
+ MOVEI C,TOBLS ; GET TYPE\r
+ MOVE D,1(B) ; AND DATUM\r
+ CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT\r
+ XCT A\r
+ JRST VHACK1\r
+\r
+; HERE TO HACK ASSOCIATION BLOCKS\r
+\r
+ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK\r
+\r
+ASHAK1: PUSH P,D\r
+ MOVE D,1(B)\r
+ GETYP C,(B)\r
+ PUSH P,D ; SAVE POINTER\r
+ XCT A\r
+ POP P,D ; GET OLD BACK\r
+ CAME D,1(B) ; CHANGED?\r
+ TLO E,400000 ; SET NON-VIRGIN FLAG\r
+ POP P,D\r
+ PUSHJ P,BMP ; TO NEXT\r
+ SOJG D,ASHAK1\r
+\r
+; HERE TO GOT TO NEXT VECTOR\r
+\r
+VHACK1: MOVE B,-1(P) ; GET POINTER\r
+ SUB P,[2,,2] ; FLUSH CRUFT\r
+ SOJA B,VHACK2 ; FIXUP POINTER AND GO ON\r
+\r
+; ROUTINE TO GET A GOODIE\r
+\r
+NXTGDY: GETYP C,(B)\r
+NXTGD1: MOVE D,1(B)\r
+ XCT A ; DO IT TO IT\r
+BMP: SOS -1(P)\r
+ SOSG -1(P)\r
+ JRST BMP1\r
+ ADDI B,2\r
+ POPJ P,\r
+BMP1: SUB P,[1,,1]\r
+ JRST VHACK1\r
+\r
+REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT\r
+ POPJ P,\r
+\r
+\r
+MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]\r
+\r
+;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO\r
+;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT\r
+;YOU ARE DOING.\r
+;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE\r
+;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.\r
+;BOTH ITEMS MUST BE OF THE SAME TYPE OR\r
+;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS\r
+; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN\r
+; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN\r
+; A FEW OTHER YUCKY PLACES.\r
+;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT\r
+\r
+ ENTRY 2\r
+\r
+\r
+SBSTI1: GETYP A,2(AB)\r
+ CAIE A,TATOM\r
+ JRST SBSTI2\r
+ MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE?\r
+ PUSHJ P,IMPURI\r
+\r
+SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG\r
+ MOVE D,A\r
+ PUSHJ P,NWORDT ; AND STORAGE ALLOCATION\r
+ MOVE E,A\r
+ GETYP A,(AB) ; GET TYPE OF FIRST ARG \r
+ MOVE B,A\r
+ PUSHJ P,NWORDT\r
+ CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION\r
+ JRST SBSTI3\r
+ CAIN E,1\r
+ CAIE A,1\r
+ JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES\r
+\r
+SBSTI3: MOVEI C,0\r
+ CAIN D,0 ; IF GOODIE IS OF TYPE ZERO\r
+ MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE\r
+ PUSH TP,C\r
+ SUBI E,1\r
+ PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE\r
+ PUSH TP,C\r
+ PUSH TP,D ; TYPE OF GOODIE\r
+ PUSH TP,C\r
+ PUSH TP,[0]\r
+ CAIN D,TLIST\r
+ AOS (TP) ; 1=TYPE LIST, 0=ELSE\r
+ PUSH TP,C\r
+ PUSH TP,2(AB) ; TYPE-WORD\r
+ PUSH TP,C\r
+ PUSH TP,3(AB) ; VALUE-WORD\r
+ PUSH TP,(AB)\r
+ PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO\r
+ MOVE A,[PUSHJ P,SBSTIR]\r
+ CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER\r
+ MOVE A,[PUSHJ P,SBSTIS]\r
+ PUSHJ P,GCHACK ; DO-IT\r
+ MOVE A,-4(TP)\r
+ MOVE B,-2(TP)\r
+ JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE\r
+\r
+SBSTIR: CAME D,-2(TP)\r
+ JRST LSUB ; THIS IS IT\r
+ CAME C,-10(TP)\r
+ JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE\r
+ JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT\r
+ MOVE 0,(TP)\r
+ MOVEM 0,1(B) ; SMASH IT\r
+ MOVE 0,-1(TP) ; GET TYPE WORD\r
+ SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST\r
+ MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT\r
+\r
+LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON\r
+ POPJ P, ; ELSE THATS ALL\r
+ CAMG B,PARTOP\r
+ CAMGE B,PARBOT ; IS IT IN LIST SPACE?\r
+ POPJ P, ; WELL NO LIST SMASHING THIS TIME\r
+ HRRZ 0,(B) ; GET ITS LIST POINTER\r
+ CAME 0,-2(TP)\r
+ POPJ P, ; THIS ONE DIDNT MATCH\r
+ MOVE 0,(TP) ; GET THE NEW REST OF THE LIST\r
+ HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST\r
+ POPJ P,\r
+\r
+SBSTIS: CAMN D,-2(TP)\r
+ CAME C,-10(TP)\r
+ POPJ P,\r
+ SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE\r
+ POPJ P,\r
+ MOVE 0,(TP)\r
+ MOVEM 0,1(B) ; KLOBBER VALUE CELL\r
+ MOVE 0,-1(TP)\r
+ HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE\r
+ POPJ P,\r
+\r
+SBSTIL: PUSH TP,$TATOM ; LOSSAGE ON DIFFERENT TYPES, ONE DOUBLE WORD\r
+ PUSH TP,EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER\r
+ JRST CALER1\r
+\r
+END\r
+\r
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff