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