1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-23 19:07:45 +00:00
PDP-10.its/src/mudsys/gchack.46
Adam Sampson a81db26a7a Rename to ITS conventions.
MIDAS and Muddle source get version numbers (as in the 1973 Muddle
source); the build files don't.
2018-04-25 09:32:25 +01:00

540 lines
12 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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