--- /dev/null
+
+TITLE GETPUT ASSOCIATION FUNCTIONS FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+; COMPONENTS IN AN ASSOCIATION BLOCK
+
+ITEM==0 ;ITEM TO WHICH INDUCATOR APPLIES
+VAL==2 ;VALUE
+INDIC==4 ;INDICATOR
+NODPNT==6 ;IF NON ZERO POINTS TO CHAIN
+PNTRS==7 ;POINTERS NEXT (RH) AND PREV (LH)
+
+ASOLNT==8 ;NUMBER OF WORDS IN AN ASSOCIATION BLOCK
+
+.GLOBAL ASOVEC ;POINTER TO HASH VECTOR IN TV
+.GLOBAL ASOLNT,ITEM,INDIC,VAL,NODPNT,NODES,IPUTP,IGETP,PUT,IFALSE
+.GLOBAL DUMNOD,IGETLO,IBLOCK,MONCH,RMONCH,IPUT,IGETL,IREMAS,IGET
+.GLOBAL NWORDT,CIGETP,CIGTPR,CIPUTP,CIREMA,MPOPJ,PVSTOR,SPSTOR
+
+MFUNCTION GETP,SUBR,[GETPROP]
+
+ ENTRY
+
+IGETP: PUSHJ P,GETLI
+ JRST FINIS ; NO SKIP, LOSE
+ MOVSI A,TLOCN
+ HLLZ 0,VAL(B)
+ PUSHJ P,RMONCH ; CHECK MONITOR
+ MOVE A,VAL(B) ;ELSE RETURN VALUE
+ MOVE B,VAL+1(B)
+CFINIS: JRST FINIS
+
+; FUNCTION TO RETURN LOCATIVE TO ASSOC
+
+MFUNCTION GETPL,SUBR
+
+ ENTRY
+
+IGETLO: PUSHJ P,GETLI
+ JRST FINIS
+ MOVSI A,TLOCN
+ JRST FINIS
+
+GETLI: PUSHJ P,2OR3 ; GET ARGS
+ PUSHJ P,IGETL ;SEE IF ASSOCIATION EXISTS
+ SKIPE B
+ AOS (P) ; WIN RETURN
+ CAMGE AB,[-4,,0] ; ANY ERROR THING
+ JUMPE B,CHFIN ;IF 0, NONE EXISTS
+ POPJ P,
+
+CHFIN: PUSH TP,4(AB)
+ PUSH TP,5(AB)
+ MCALL 1,EVAL
+ POPJ P,
+
+; COMPILER CALLS TO SOME OF THESE
+
+CIGETP: SUBM M,(P) ; FIX RET ADDR
+ PUSHJ P,IGETL ; GO TO INTERNAL
+ JUMPE B,MPOPJ
+ MOVSI A,TLOCN
+MPOPJ1: SOS (P) ; WINNER (SOS BECAUSE OF SUBM M,(P))
+MPOPJ: SUBM M,(P)
+ POPJ P,
+
+CIGTPR: SUBM M,(P)
+ PUSHJ P,IGETL
+ JUMPE B,MPOPJ
+ MOVE A,VAL(B) ; GET VAL TYPE
+ MOVE B,VAL+1(B)
+ JRST MPOPJ1
+
+CIPUTP: SUBM M,(P)
+ PUSH TP,-1(TP) ; SAVE VAL
+ PUSH TP,-1(TP)
+ PUSHJ P,IPUT ; DO IT
+ POP TP,B
+ POP TP,A
+ JRST MPOPJ
+
+CIREMA: SUBM M,(P)
+ PUSHJ P,IREMAS ; FLUSH IT
+ JRST MPOPJ
+
+; CHECK PUT/GET PUTPROP AND GETPROP ARGS
+
+2OR3: HLRE 0,AB
+ ASH 0,-1 ; TO -# OF ARGS
+ ADDI 0,2 ; AT LEAST 2
+ JUMPG 0,TFA ; 1 OR LESS, LOSE
+ AOJL 0,TMA ; 4 OR MORE, LOSE
+ MOVE A,(AB) ; GET ARGS INTO ACS
+ MOVE B,1(AB)
+ MOVE C,2(AB)
+ MOVE D,3(AB)
+ POPJ P,
+
+; INTERNAL GET
+
+IGET: PUSHJ P,IGETL ; GET LOCATIVE
+ JUMPE B,CPOPJ
+ MOVE A,VAL(B)
+ MOVE B,VAL+1(B)
+ POPJ P,
+
+; FUNCTION TO MAKE AN ASSOCIATION
+
+MFUNCTION PUTP,SUBR,[PUTPROP]
+
+ ENTRY
+
+IPUTP: PUSHJ P,2OR3 ; GET ARGS
+ JUMPN 0,REMAS ; REMOVE AN ASSOCIATION
+ PUSH TP,4(AB) ; SAVE NEW VAL
+ PUSH TP,5(AB)
+ PUSHJ P,IPUT ; DO IT
+ MOVE A,(AB) ; RETURN NEW VAL
+ MOVE B,1(AB)
+ JRST FINIS
+
+REMAS: PUSHJ P,IREMAS
+ JRST FINIS
+
+IPUT: SKIPN DUMNOD+1 ; NEW DUMMY NEDDED?
+ PUSHJ P,DUMMAK ; YES, GO MAKE ONE
+IPUT1: PUSHJ P,IGETI ;SEE IF THIS ONE EXISTS
+
+ JUMPE B,NEWASO ;JUMP IF NEED NEW ASSOCIATION BLOCK
+CLOBV: MOVE C,-5(TP) ; RET NEW VAL
+ MOVE D,-4(TP)
+ SUB TP,[6,,6]
+ HLLZ 0,VAL(B)
+ MOVSI A,TLOCN
+ PUSHJ P,MONCH ; MONITOR CHECK
+ MOVEM C,VAL(B) ;STORE IT
+ MOVEM D,VAL+1(B)
+CPOPJ: POPJ P,
+
+; HERE TO CREATE A NEW ASSOCIATION
+
+NEWASO: MOVE B,DUMNOD+1 ; GET BALNK ASSOCIATION
+ SETZM DUMNOD+1 ; CAUSE NEW ONE NEXT TIME
+
+
+;NOW SPLICE IN CHAIN
+
+ JUMPE D,PUT1 ;NO OTHERS EXISTED IN THIS BUCKET
+ HRLZM C,PNTRS(B) ;CLOBBER PREV POINTER
+ HRRM B,PNTRS(C) ;AND NEXT POINTER
+ JRST .+2
+
+PUT1: HRRZM B,(C) ;STORE INTO VECTOR
+ HRRZ C,NODES+1
+ HRLM C,NODPNT(B)
+ MOVE D,NODPNT(C)
+ HRRZM B,NODPNT(C)
+ HRRM D,NODPNT(B)
+ HRLM B,NODPNT(D)
+ MOVEI C,-3(TP) ;COPY ARG POINTER
+ MOVSI A,-4 ;AND COPY POINTER
+
+PUT2: MOVE D,(C) ;START COPYING
+ MOVEM D,@CLOBTB(A)
+ ADDI C,1
+ AOBJN A,PUT2 ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
+
+ JRST CLOBV
+
+;HERE TO REMOVE AN ASSOCIATION
+
+IREMAS: PUSHJ P,IGETL ;LOOK IT UP
+ JUMPE B,CPOPJ ;NEVER EXISTED, IGNORE
+ HRRZ A,PNTRS(B) ;NEXT POINTER
+ HLRZ E,PNTRS(B) ;PREV POINTER
+ SKIPE A ;DOES A NEXT EXIST?
+ HRLM E,PNTRS(A) ;YES CLOBBER ITS PREV POINTER
+ SKIPN D ;SKIP IF NOT FIRST IN BUCKET
+ MOVEM A,(C) ;FIRST STORE NEW ONE
+ SKIPE D ;OTHERWISE
+ HRRM A,PNTRS(E) ;PATCH NEXT POINTER IN PREVIOUS
+ HRRZ A,NODPNT(B) ;SEE IF MUST UNSPLICE NODE
+ HLRZ E,NODPNT(B)
+ SKIPE A
+ HRLM E,NODPNT(A) ;SPLICE
+ JUMPE E,PUT4 ;FLUSH IF NO PREV POINTER
+ HRRZ C,NODPNT(E) ;GET PREV'S NEXT POINTER
+ CAIE C,(B) ;DOES IT POINT TO THIS NODE
+ .VALUE [ASCIZ /:\eFATAL PUT LOSSAGE/]
+ HRRM A,NODPNT(E) ;YES, SPLICE
+PUT4: MOVE A,VAL(B) ;RETURN VALUE
+ SETZM PNTRS(B)
+ MOVE B,VAL+1(B)
+ POPJ P,
+
+
+;INTERNAL GET FUNCTION CALLED BY PUT AND GET
+; A AND B ARE THE ITEM
+;C AND D ARE THE INDICATOR
+
+IGETL: PUSHJ P,IGETI
+ SUB TP,[4,,4] ; FLUSH CRUFT LEFT BY IGETI
+ POPJ P,
+
+IGETI: PUSHJ P,LHCLR
+ EXCH A,C
+ PUSHJ P,LHCLR
+ EXCH C,A
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,C ;SAVE C AND D
+ PUSH TP,D
+ XOR A,B ; BUILD HASH
+ XOR A,C
+ XOR A,D
+ TLZ A,400000 ; FORCE POS A
+ HLRZ B,ASOVEC+1 ;GET LENGTH OF HASH VECTOR
+ MOVNS B
+ IDIVI A,(B) ;RELATIVE BUCKET NOW IN B
+ HRLI B,(B) ;IN CASE GC OCCURS
+ ADD B,ASOVEC+1 ;POINT TO BUCKET
+ MOVEI D,0 ;SET FIRST SWITCH
+ SKIPN A,(B) ;GET CONTENTS OF BUCKET (DONT SKIP IF EMPTY)
+ JRST GFALSE
+
+ MOVSI 0,TASOC ;FOR INTGOS, MAKE A TASOC
+ MOVE PVP,PVSTOR+1
+ HLLZM 0,ASTO(PVP)
+
+IGET1: GETYPF 0,ITEM(A) ;GET ITEMS TYPE
+ MOVE E,ITEM+1(A)
+ CAMN 0,-3(TP) ;COMPARE TYPES
+ CAME E,-2(TP) ;AND VALUES
+ JRST NXTASO ;LOSER
+ GETYPF 0,INDIC(A) ;MOW TRY INDICATORS
+ MOVE E,INDIC+1(A)
+ CAMN 0,-1(TP)
+ CAME E,(TP)
+ JRST NXTASO
+
+ SKIPN D ;IF 1ST THEN
+ MOVE C,B ;RETURN POINTER IN C
+ MOVE B,A ;FOUND, RETURN ASSOCIATION
+ MOVSI A,TASOC
+IGRET: MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+ POPJ P,
+
+NXTASO: MOVEI D,1 ;SET SWITCH
+ MOVE C,A ;CYCLE
+ HRRZ A,PNTRS(A) ;STEP
+ JUMPN A,IGET1
+
+ MOVSI A,TFALSE
+ MOVEI B,0
+ JRST IGRET
+
+GFALSE: MOVE C,B ;PRESERVE VECTOR POINTER
+ MOVSI A,TFALSE
+ SETZB B,D
+ JRST IGRET
+
+; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE
+
+REPEAT 0,[
+MFUNCTION PUTN,SUBR
+
+ ENTRY
+
+ CAML AB,[-4,,0] ;WAS THIS A REMOVAL
+ JRST PUT
+
+ PUSHJ P,IPUT ;DO THE PUT
+ SKIPE NODPNT(C) ;NODE CHAIN EXISTS?
+ JRST FINIS
+
+ PUSH TP,$TASOC ;NO, START TO BUILD
+ PUSH TP,C
+ SKIPN DUMNOD+1 ; FIX UP DUMMY?
+ PUSHJ P,DUMMAK
+CHPT: MOVE C,$TCHSTR
+ MOVE D,CHQUOTE NODE
+ PUSHJ P,IGETL
+ JUMPE B,MAKNOD ;NOT FOUND, LOSE
+NODSPL: MOVE C,(TP) ;HERE TO SPLICE IN NEW NODE
+ MOVE D,VAL+1(B) ;GET POINTER TO NODE STRING
+ HRRM D,NODPNT(C) ;CLOBBER
+ HRLM B,NODPNT(C)
+ SKIPE D ;SPLICE ONLY IF THERE IS SOMETHING THERE
+ HRLM C,NODPNT(D)
+ MOVEM C,VAL+1(B) ;COMPLETE NODE CHAIN
+ MOVE A,2(AB) ;RETURN VALUE
+ MOVE B,3(AB)
+ JRST FINIS
+
+MAKNOD: PUSHJ P,NEWASO ;GENERATE THE NEW ASSOCIATION
+ MOVE A,@CHPT ;GET UNIQUE STRING
+ MOVEM A,INDIC(C) ;CLOBBER IN INDIC
+ MOVE A,@CHPT+1
+ MOVEM A,INDIC+1(C)
+ MOVE B,C ;POINTER TO B
+ HRRZ C,NODES+1 ;GET POINTER TO CHAIN OF NODES
+ HRRZ D,VAL+1(C) ;SKIP DUMMY NODE
+ HRRM B,VAL+1(C) ;CLOBBER INTO CHAIN
+ HRRM D,NODPNT(B)
+ SKIPE D ;SPLICE IF ONLY SOMETHING THERE
+ HRLM B,NODPNT(D)
+ HRLM C,NODPNT(B)
+ MOVSI A,TASOC ;SET TYPE OF VAL TO ASSOCIATION
+ MOVEM A,VAL(B)
+ SETZM VAL+1(B)
+ JRST NODSPL ;GO SPLICE ITEM ONTO NODE
+]
+
+DUMMAK: PUSH TP,A
+ PUSH TP,B
+ PUSH TP,C
+ PUSH TP,D
+ MOVEI A,ASOLNT
+ PUSHJ P,IBLOCK
+ MOVSI A,400000+SASOC+.VECT.
+ MOVEM A,ASOLNT(B) ;SET SPECIAL TYPE
+ MOVEM B,DUMNOD+1
+ POP TP,D
+ POP TP,C
+ POP TP,B
+ POP TP,A
+ POPJ P,
+
+CLOBTB: SETZ ITEM(B)
+ SETZ ITEM+1(B)
+ SETZ INDIC(B)
+ SETZ INDIC+1(B)
+ SETZ VAL(B)
+ SETZ VAL+1(B)
+
+MFUNCTION ASSOCIATIONS,SUBR
+
+ ENTRY 0
+ MOVE B,NODES+1
+ASSOC1: MOVSI A,TASOC ; SET TYPE
+ HRRZ B,NODPNT(B) ; POINT TO 1ST REAL NODE
+ JUMPE B,IFALSE
+ JRST FINIS
+
+; RETURN NEXT ASSOCIATION IN CHAIN OR FALSE
+
+MFUNCTION NEXT,SUBR
+
+ ENTRY 1
+
+ GETYP 0,(AB) ; BETTER BE ASSOC
+ CAIE 0,TASOC
+ JRST WTYP1 ; LOSE
+ MOVE B,1(AB) ; GET ARG
+ JRST ASSOC1
+
+; GET ITEM/INDICATOR/VALUE CELLS
+
+MFUNCTION %ITEM,SUBR,ITEM
+
+ MOVEI B,ITEM ; OFFSET
+ JRST GETIT
+
+MFUNCTION INDICATOR,SUBR
+
+ MOVEI B,INDIC
+ JRST GETIT
+
+MFUNCTION AVALUE,SUBR
+
+ MOVEI B,VAL
+GETIT: ENTRY 1
+ GETYP 0,(AB) ; BETTER BE ASSOC
+ CAIE 0,TASOC
+ JRST WTYP1
+ ADD B,1(AB) ; GET ARG
+ MOVE A,(B)
+ MOVE B,1(B)
+ JRST FINIS
+
+LHCLR: PUSH P,A
+ GETYP A,A
+ PUSHJ P,NWORDT ; DEFERRED ?
+ SOJE A,LHCLR2
+ POP P,A
+LHCLR1: TLZ A,TYPMSK#<-1>
+ POPJ P,
+LHCLR2: POP P,A
+ HLLZS A
+ JRST LHCLR1
+
+END
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff