--- /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,TMA,TFA,NODPNT,NODES,IPUTP,IGETP,PUT
+
+MFUNCTION GETP,SUBR,[GETPROP]
+
+ ENTRY
+
+IGETP: CAML AB,[-2,,0] ;DONT SKIP IF TOO FEW
+ JRST TFA
+ CAMG AB,[-6,,0] ;SKIP IF WITHIN RANGE
+ JRST TMA
+ MOVE C,2(AB) ;GET INDICATOR TYPE
+ MOVE D,3(AB) ;AND VALUE
+ PUSHJ P,IGET ;SEE IF ASSOCIATION EXISTS
+ JUMPE B,CHFIN ;IF 0, NONE EXISTS
+ MOVE A,VAL(B) ;ELSE RETURN VALUE
+ MOVE B,VAL+1(B)
+CFINIS: JRST FINIS
+
+CHFIN: CAML AB,[-4,,0] ;IS 3RD ARG SUPPLIED?
+ JRST FINIS ;NO, RETURN FALSE
+ PUSH TP,4(AB) ;YES, EVAL IT
+ PUSH TP,5(AB)
+ MCALL 1,EVAL
+ JRST FINIS
+
+
+; FUNCTION TO MAKE AN ASSOCIATION
+
+MFUNCTION PUTP,SUBR,[PUTPROP]
+
+ ENTRY
+
+IPUTP: HLRE A,AB ;GET -NUM OF A
+ ASH A,-1 ;DIVIDE BY 2
+ AOJGE A,TFA ;0 OR 1 ARGS IS TOO FEW
+ AOJE A,REMAS ;TWO ARGS, REMOVE AN ASSOC
+ AOJL A,TMA ;MORE THAN 3 TOO MANY
+ PUSH P,CFINIS ;CAUSE FINIS TO BE POPPED TO
+
+IPUT: MOVE C,2(AB) ;GET INDICATOR TYPE AND VALUE
+ MOVE D,3(AB)
+IPUT1: PUSHJ P,IGET ;SEE IF THIS ONE EXISTS
+
+ JUMPE B,NEWASO ;JUMP IF NEED NEW ASSOCIATION BLOCK
+ MOVE C,5(AB) ;GET NEW VALUE
+ MOVEM C,VAL+1(B) ;STORE IT
+ MOVE A,4(AB) ;GET VALS TYPE
+ MOVEM A,VAL(B)
+ITMRET: MOVE A,(AB)
+ MOVE B,1(AB)
+CPOPJ: POPJ P,
+
+; HERE TO CREATE A NEW ASSOCIATION
+
+NEWASO: MOVSI A,TUVEC ;GET VECTOR TYPE
+ SKIPE D ;D>0 MEANS SOME EXIST IN CHAIN
+ MOVSI A,TASOC ;IN THIS CASE USE DIFFERENT TYPE
+ PUSH TP,A ;AND SAVE
+ PUSH TP,C
+ PUSH P,D ;SAVE INDICATOR
+ PUSH TP,$TFIX ;GET ARG FOR VECTOR CALL
+ PUSH TP,[ASOLNT]
+ MCALL 1,UVECTOR
+ MOVSI A,400000+SASOC ;CLOBBER THE UNIFORM TYPE
+ MOVEM A,ASOLNT(B)
+
+;NOW SPLICE IN CHAIN
+
+ MOVE C,(TP) ;RESTORE SAVED VALUE
+ POP P,E ;RESTORE SWITCH
+ JUMPE E,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
+ MOVE C,AB ;COPY ARG POINTER
+ SUB TP,[2,,2] ;POP TP JUNK
+ MOVEI A,0 ;AND COPY POINTER
+
+PUT2: MOVE D,(C) ;START COPYING
+ MOVEM D,@CLOBTB(A)
+ ADDI A,1
+ AOBJN C,PUT2 ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
+
+ MOVE C,B ;RETURN POINTER TO ASSOC. IN C
+ JRST ITMRET
+ MOVE A,2(AB)
+ POPJ P,
+
+
+;HERE TO REMOVE AN ASSOCIATION
+
+REMAS: MOVE C,2(AB) ;GET INDIC
+ MOVE D,3(AB)
+ PUSHJ P,IGET ;LOOK IT UP
+ JUMPE B,FINIS ;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
+ CAIN C,(B) ;DOES IT POINT TO THIS NODE
+ HRLM A,NODPNT(E) ;YES, SPLICE
+ GETYP C,VAL(E) ;CHECK VAL
+ HRRZ D,VAL+1(E)
+ CAIN C,TASOC ;IS IT AN ASSOCIATION
+ CAIE D,(B) ;AND DOES IT POINT TO THIS NODE
+ JRST PUT4 ;NO
+ HRRZM A,VAL+1(E) ;YES, CLOBBER
+PUT4: MOVE A,VAL(B) ;RETURN VALUE
+ SETZM NODPNT(B)
+ SETZM PNTRS(B)
+ MOVE B,VAL+1(B)
+ JRST FINIS
+
+
+;INTERNAL GET FUNCTION CALLED BY PUT AND GET
+;(AB) AND 1(AB) ARE THE ITEM
+;C AND D ARE THE INDICATOR
+
+IGET: PUSH TP,C ;SAVE C AND D
+ PUSH TP,D
+ MOVE A,C ;BUILD UP HASH IN A
+ XOR A,D
+ XOR A,(AB)
+ XOR A,1(AB) ;NOW HAVE A HASH
+ MOVMS A
+ HLRE B,ASOVEC+1(TVP) ;GET LENGTH OF HASH VECTOR
+ MOVMS B
+ IDIVI A,(B) ;RELATIVE BUCKET NOW IN B
+ HRLI B,(B) ;IN CASE GC OCCURS
+ ADD B,ASOVEC+1(TVP) ;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
+ HLLZM 0,ASTO(PVP)
+
+IGET1: INTGO ;IN CASE CIRCULARITY EXISTS
+ GETYPF 0,ITEM(A) ;GET ITEMS TYPE
+\r MOVE E,ITEM+1(A)
+ CAMN 0,(AB) ;COMPARE TYPES
+ CAME E,1(AB) ;AND VALUES
+ JRST NXTASO ;LOSER
+ MOVE 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: SUB TP,[2,,2]
+ 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
+
+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
+CHPT: MOVE C,$TCHSTR
+ MOVE D,CHQUOTE NODE
+ PUSHJ P,IGET
+ 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(TVP) ;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
+CLOBTB: ITEM(B)
+ ITEM+1(B)
+ INDIC(B)
+ INDIC+1(B)
+ VAL(B)
+ VAL+1(B)
+
+
+
+END
+\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff