mirror of
https://github.com/PDP-10/its.git
synced 2026-01-21 02:08:50 +00:00
a81db26a7a
MIDAS and Muddle source get version numbers (as in the 1973 Muddle source); the build files don't.
397 lines
7.6 KiB
Plaintext
397 lines
7.6 KiB
Plaintext
|
||
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 /:FATAL 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
|
||
|