X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fdecl.mid.103;fp=%3Cmdl.int%3E%2Fdecl.mid.103;h=1fce52b16f417b7d7309cd73fdc1a763b0dd6c61;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c

diff --git a/<mdl.int>/decl.mid.103 b/<mdl.int>/decl.mid.103
new file mode 100644
index 0000000..1fce52b
--- /dev/null
+++ b/<mdl.int>/decl.mid.103
@@ -0,0 +1,1091 @@
+
+TITLE DECLARATION PROCESSOR
+
+RELOCA
+
+.INSRT MUDDLE >
+
+.GLOBAL STBL,TYPFND,TYPSGR,CHKDCL,TESTR,VALG,INCR1,TYPG,ISTRUC,TMATCH,SAT
+.GLOBAL TYPMIS,CHKAB,CHKARG,IGDECL,LOCQQ,APLQ,CALER,IEQUAL,IIGLOC,IGLOC
+.GLOBAL CHLOCI,INCONS,SPCCHK,OUTRNG,WTYP1,FLGSET,IGET,PVSTOR,SPSTOR,DSTORE
+.GLOBAL NOATMS,NOSET,NOSETG
+; Subr to allow user to access the DECL checking code
+
+MFUNCTION CHECKD,SUBR,[DECL?]
+
+	ENTRY	2
+
+	MOVE	C,(AB)
+	MOVE	D,1(AB)
+	MOVE	A,2(AB)
+	MOVE	B,3(AB)
+	PUSHJ	P,TMATCX	; CHECK THEM
+	JRST	IFALS
+
+RETT:	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS
+
+RETF:
+IFALS:	MOVEI	B,0
+	MOVSI	A,TFALSE
+	JRST	FINIS
+
+; Subr to turn DECL checking on and off.
+
+MFUNCTION %DECL,SUBR,[DECL-CHECK]
+
+	ENTRY
+
+	HRROI	E,IGDECL
+	JRST	FLGSET
+
+; Subr to turn on and off allowing new atoms
+
+MFUNCTION %NEWAT,SUBR,[ALLOW-NEW-ATOMS]
+
+	ENTRY
+
+	MOVEI	E,NOATMS
+	JRST	FLGSET
+
+; Subr to turn on and off allowing new GVALS
+
+MFUNCTION %NEWGV,SUBR,[ALLOW-NEW-GVALS]
+
+	ENTRY
+
+	MOVEI	E,NOSETG
+	JRST	FLGSET
+
+; Subr to turn on and off allowing new LVALs
+
+MFUNCTION %NEWLV,SUBR,[ALLOW-NEW-LVALS]
+
+	ENTRY
+
+	MOVEI	E,NOSET
+	JRST	FLGSET
+
+; Change special unspecial normal mode
+
+MFUNCTION SPECM%,SUBR,[SPECIAL-MODE]
+
+	ENTRY
+
+	CAMGE	AB,[-3,,]
+	JRST	TMA
+	MOVE	C,SPCCHK	; GET CURRENT
+	JUMPGE	AB,MODER	; RET CURRENT
+	GETYP	0,(AB)		; CHECK IT IS ATOM
+	CAIE	0,TATOM
+	JRST	WTYP1
+	MOVE	0,1(AB)
+	MOVEI	A,1
+	CAMN	0,MQUOTE UNSPECIAL
+	MOVSI	A,(SETZ)
+	CAMN	0,MQUOTE SPECIAL
+	MOVEI	A,0
+	JUMPG	A,WTYP1
+	HLLM	A,SPCCHK
+
+MODER:	MOVSI	A,TATOM
+	MOVE	B,MQUOTE SPECIAL
+	SKIPGE	C
+	MOVE	B,MQUOTE UNSPECIAL
+	JRST	FINIS
+
+; Function to turn special checking on and of
+
+MFUNCTION SPECC%,SUBR,[SPECIAL-CHECK]
+
+	ENTRY
+	CAMGE	AB,[-3,,]
+	JRST	TMA
+
+	MOVE	C,SPCCHK
+	JUMPGE	AB,SCHEK1
+
+	MOVEI	A,0
+	GETYP	0,(AB)
+	CAIE	0,TFALSE
+	MOVEI	A,1
+	HRRM	A,SPCCHK
+
+SCHEK1:	TRNN	C,1
+	JRST	IFALS
+	JRST	RETT
+
+; Finction to set decls for GLOBAL values.
+
+MFUNCTION GDECL,FSUBR
+
+	ENTRY	1
+
+	GETYP	0,(AB)
+	CAIE	0,TLIST
+	JRST	WTYP1
+
+	PUSH	TP,$TLIST
+	PUSH	TP,1(AB)
+	PUSH	TP,$TLIST
+	PUSH	TP,[0]
+	PUSH	TP,$TLIST
+	PUSH	TP,[0]
+
+GDECL1:	INTGO
+	SKIPN	C,1(TB)
+	JRST	RETT
+	HRRZ	D,(C)		; MAKE SURE PAIRS
+	JUMPE	D,GDECLL	; LOSER, GO AWAY
+	GETYP	0,(C)
+	CAIE	0,TLIST
+	JRST	GDECLL
+	HRRZ	0,(D)
+	MOVEM	0,1(TB)		; READY FOR NEXT CALL
+	MOVE	C,1(C)		; SAVE ATOM LIST
+	MOVEM	C,5(TB)
+	MOVEM	D,3(TB)
+
+GDECL2:	INTGO
+	SKIPN	C,5(TB)
+	JRST	GDECL1		; OUT OF ATOMS
+	GETYP	0,(C)		; IS THIS AN ATOM
+	CAIE	0,TATOM
+	JRST	GDECLL		; NO, LOSE
+	MOVE	B,1(C)
+	HRRZ	C,(C)
+	MOVEM	C,5(TB)
+	PUSHJ	P,IIGLOC	; GET ITS VAL (OR MAKE ONE)
+	GETYP	0,(B)		; UNBOUND?
+	CAIE	0,TUNBOU
+	JRST	CHKCUR		; CHECK CURRENT VALUE
+	MOVE	C,3(TB)		; GET DECL
+	HRRM	C,-2(B)
+	JRST	GDECL2
+
+CHKCUR:	HRRZ	D,3(TB)
+	GETYP	A,(D)
+	MOVSI	A,(A)
+	MOVE	E,B
+	MOVE	B,1(D)
+	MOVE	C,(E)
+	MOVE	D,1(E)
+	PUSH	TP,$TVEC
+	PUSH	TP,E
+	JSP	E,CHKAB
+	PUSHJ	P,TMATCH
+	JRST	TYPMI3
+	MOVE	E,(TP)
+	SUB	TP,[2,,2]
+	MOVE	D,3(TB)
+	HRRM	D,-2(E)
+	JRST	GDECL2
+
+TYPMI3:	MOVE	E,(TP)		; POINT BACK TO SLOT
+	MOVE	A,-1(E)		; ATOM TO A
+	MOVE	B,1(E)
+	MOVE	D,(E)		; GET OLD VALUE
+	MOVE	C,3(TB)
+	JRST	TYPMIS		; GO COMPLAIN
+
+GDECLL:	ERRUUO	EQUOTE BAD-ARGUMENT-LIST
+
+MFUNCTION UNMANIFEST,SUBR
+
+	ENTRY
+
+	PUSH	P,[HLLZS -2(B)]
+	JRST	MANLP
+
+MFUNCTION MANIFEST,SUBR
+
+	ENTRY
+
+	PUSH	P,[HLLOS -2(B)]
+MANLP:	JUMPGE	AB,RETT
+	GETYP	0,(AB)
+	CAIE	0,TATOM
+	JRST	WTYP
+	MOVE	B,1(AB)
+	PUSHJ	P,IIGLOC
+	XCT	(P)
+	ADD	AB,[2,,2]
+	JRST	MANLP
+
+MFUNCTION MANIFQ,SUBR,[MANIFEST?]
+
+	ENTRY	1
+
+	GETYP	0,(AB)
+	CAIE	0,TATOM
+	JRST	WTYP1
+
+	MOVE	B,1(AB)
+	PUSHJ	P,IGLOC		; GET POINTER IF ANY
+	GETYP	0,A
+	CAIN	0,TUNBOU
+	JRST	RETF
+	HRRZ	0,-2(B)
+	CAIE	0,-1
+	JRST	RETF
+	JRST	RETT
+	
+MFUNCTION GETDECL,SUBR,[GET-DECL]
+
+	ENTRY	1
+
+	GETYP	0,(AB)
+	CAIN	0,TOFFS
+	 JRST	GETDOF
+	PUSHJ	P,GTLOC
+	JRST	GTLOCA
+
+	HRRZ	C,-2(B)		; GET GLOBAL DECL
+GETD1:	JUMPE	C,RETF
+	CAIN	C,-1
+	JRST	RETMAN
+	GETYP	A,(C)
+	MOVSI	A,(A)
+	MOVE	B,1(C)
+	JSP	E,CHKAB
+	JRST	FINIS
+GETDOF:	HLRZ	B,1(AB)
+	JUMPE	B,GETDO1
+	MOVE	A,(B)
+	MOVE	B,1(B)
+	JRST	FINIS
+GETDO1:	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE ANY
+	JRST	FINIS
+
+RETMAN:	MOVSI	A,TATOM
+	MOVE	B,MQUOTE MANIFEST
+	JRST	FINIS
+
+GTLOCA:	HLRZ	C,2(B)		; LOCAL DECL
+	JRST	GETD1
+
+MFUNCTION PUTDECL,SUBR,[PUT-DECL]
+
+	ENTRY	2
+
+	GETYP	0,(AB)
+	CAIN	0,TOFFS
+	 JRST	PUTDOF		; MAKE OFFSET WITH NEW DECL
+	PUSHJ	P,GTLOC
+	SKIPA	E,[HRLM B,2(C)]
+	MOVE	E,[HRRM B,-2(C)]
+	PUSH	P,E
+	GETYP	0,(B)		; ANY VALUE
+	CAIN	0,TUNBOU
+	JRST	PUTD1
+	MOVE	C,(B)		; GET CURRENT VALUE
+	MOVE	D,1(B)
+	MOVE	A,2(AB)
+	MOVE	B,3(AB)
+	PUSHJ	P,TMATCH
+	JRST	TYPMI4
+PUTD1:	MOVE	C,2(AB)		; GET DECL BACK
+	MOVE	D,3(AB)
+	PUSHJ	P,INCONS	; CONS IT UP
+	MOVE	C,1(AB)		; LOCATIVE BACK
+	XCT	(P)		; CLOBBER
+	MOVE	A,(AB)
+	MOVE	B,1(AB)
+	JRST	FINIS
+
+TYPMI4:	MOVE	E,1(AB)		; GET LOCATIVE
+	MOVE	A,-1(E)		; NOW ATOM
+	MOVEI	C,2(AB)		; POINT TO DECL
+	MOVE	D,(E)		; AND CURRENT VAL
+	MOVE	B,1(E)
+	JRST	TYPMIS
+
+GTLOC:	GETYP	0,(AB)
+	CAIE	0,TLOCD
+	JRST	WTYP1
+	MOVEI	B,(AB)
+	PUSHJ	P,CHLOCI
+	HRRZ	0,(AB)		; LOCAL OR GLOBAL
+	SKIPN	0
+	AOS	(P)
+	MOVE	B,1(AB)		; RETURN LOCATIVE IN B
+	POPJ	P,
+
+; MAKE OFFSET WITH SUPPLIED DECL
+PUTDOF:	MOVE	D,3(AB)
+	GETYP	0,2(AB)
+	CAIN	TATOM
+	 CAME	D,IMQUOTE ANY
+	  JRST	PUTDO1
+	MOVSI	A,TOFFS
+	HRRZ	B,1(AB)
+	JRST	FINIS
+PUTDO1:	MOVE	C,2(AB)
+	PUSHJ	P,INCONS	; BUILD A LIST
+	MOVSI	A,TOFFS
+	HRLS	B
+	HRR	B,1(AB)		; SET UP OFFSET
+	JRST	FINIS
+
+; BUILD AN OFFSET--TAKES FIX AND DECL (OR ATOM FORM)
+; JUMPS INTO PUT-DECL CODE FOR OFFSETS.
+	MFUNCTION COFFSET,SUBR,[OFFSET]
+
+	ENTRY	2
+	GETYP	0,(AB)
+	CAIE	0,TFIX
+	 JRST	WTYP1
+	SKIPG	1(AB)
+	 JRST	OUTRNG		; CAN'T HAVE NEGATIVE OFFSETS
+	GETYP	0,2(AB)
+	CAIE	0,TATOM
+	 CAIN	0,TFORM
+	  JRST	PUTDOF
+	JRST	WTYP2
+
+; GET FIX PART OF OFFSET
+	MFUNCTION INDEX,SUBR
+
+	ENTRY	1
+	GETYP	0,(AB)
+	CAIE	0,TOFFS
+	 JRST	WTYP1
+	MOVSI	A,TFIX
+	HRRE	B,1(AB)
+	JRST	FINIS
+
+; Interface between EVAL and declaration processor.
+; E points into stack at a binding and C points to decl list.
+
+CHKDCL:	SKIPE	IGDECL		; IGNORING DECLS?
+	POPJ	P,		; YUP, JUST LEAVE
+
+	PUSH	TP,$TTP		; SAVE BINDING
+	PUSH	TP,E
+	MOVE	A,-4(E)		; GET ATOM
+	MOVSI	0,TLIST		; SETUP FOR INTERRUPTABLE
+	MOVE	PVP,PVSTOR+1
+	MOVEM	0,CSTO(PVP)
+	MOVEM	0,BSTO(PVP)
+	MOVSI	0,TATOM
+	MOVEM	0,ASTO(PVP)
+	SETZB	B,0		; CLOBBER FOR INTGO
+
+DCL2:	INTGO
+	HRRZ	D,(C)		; MAKE SURE EVEN ELEMENTS
+	JUMPE	D,BADCL
+	GETYP	B,(C)		; MUST BE LIST OF ATOMS
+	CAIE	B,TLIST
+	JRST	BADCL
+	MOVE	B,1(C)		; GET LIST
+
+DCL1:	INTGO
+	CAMN	A,1(B)		; SKIP IF NOT WINNER
+	JRST	DCLQ		; MAY BE WINNER
+DCL3:	HRRZ	B,(B)		; CDR ON
+	JUMPN	B,DCL1		; JUMP IF MORE
+
+	HRRZ	C,(D)		; CDR MAIN LIST
+	JUMPN	C,DCL2		; AND JUMP IF WINNING
+
+	PUSHJ	P,E.GET		; GET BINDING BACK
+	SUB	TP,[2,,2]	; POP OF JUNK
+	POPJ	P,
+
+DCLQ:	GETYP	C,(B)		; CHECK ATOMIC
+	CAIE	C,TATOM
+	JRST	BADCL		; LOSER
+	PUSHJ	P,E.GET		; GOT IT
+	PUSH	TP,$TLIST	; SAVE PATTERN
+	PUSH	TP,D
+	MOVE	B,1(D)		; GET PATTERN
+	HLLZ	A,(D)
+	MOVE	C,-3(E)		; PROPOSED VALUE
+	MOVE	D,-2(E)
+	PUSHJ	P,TMATCH	; MATCH TYPE
+	JRST	TYPMI1		; LOSER
+DCLQ1:	MOVE	E,-2(TP)
+	MOVE	C,-5(E)		; CHECK FOR SPEC CHANGE
+	SKIPE	0		; MAKE SURE NON ZERO IS -1
+	MOVNI	0,1
+	SKIPL	SPCCHK		; SKIP IF NORMAL UNSPECIAL
+	SETCM	0		; COMPLEMENT
+	ANDI	0,1		; ONE BIT
+	CAMN	C,[TATOM,,-1]
+	JRST	.+3
+	CAME	C,[TATOM,,-2]
+	JRST	.+3
+	ANDCMI	C,1
+	IOR	C,0		; MUNG BIT
+	MOVEM	C,-5(E)
+	HRRZ	C,(TP)
+	SUB	TP,[4,,4]
+	MOVEM	C,(E)		; STORE DECLS
+	MOVSI	C,TLIST
+	MOVEM	C,-1(E)
+	POPJ	P,
+
+TYPMI1:	MOVE	E,-2(TP)
+	GETYP	C,-3(E)
+	CAIN	C,TUNBOU
+	JRST	DCLQ1
+	MOVE	E,-2(TP)	; GET POINTER TO BIND
+	MOVE	D,-3(E)		; GET VAL
+	MOVE	B,-2(E)
+	HRRZ	C,(TP)		; DCL LIST
+	MOVE	A,-4(E)		; GET ATOM
+	SUB	TP,[4,,4]
+TYPMIS:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE TYPE-MISMATCH
+	PUSH	TP,$TATOM
+	PUSH	TP,A
+	PUSH	TP,(C)
+	HLLZS	(TP)
+	PUSH	TP,1(C)
+	JSP	E,CHKARG	; HACK DEFER
+	PUSH	TP,D
+	PUSH	TP,B
+	MOVEI	A,4		; 3 ERROR ARGS
+	JRST	CALER
+
+BADCL:	PUSHJ	P,E.GET
+	ERRUUO	EQUOTE BAD-DECLARATION-LIST
+
+; ROUTINE TO RESSET INT STUFF
+
+E.GET:	MOVE	E,(TP)
+	MOVE	PVP,PVSTOR+1
+	SETZM	ASTO(PVP)
+	SETZM	BSTO(PVP)
+	SETZM	CSTO(PVP)
+	POPJ	P,
+
+; Declarations processor for MUDDLE type declarations.
+; Receives a pattern in a and B and an object in C and D.
+; It skip returns if the object fits otherwise it doesn't.
+; Declaration syntax errors are caught and sent to ERROR.
+
+TMATCH:	MOVEI	0,1		; RET SPECIAL INDICATOR
+	SKIPE	IGDECL		; IGNORING DECLS?
+	JRST	CPOPJ1		; YUP, ACT LIKE THEY WON
+
+TMATCX:	GETYP	0,A		; GET PATTERNS TYPE
+	CAIE	0,TSEG
+	CAIN	0,TFORM		; MUST BE FORM OR ATOM
+	JRST	TMAT1
+	CAIE	0,TATOM
+	JRST	TERR1		; WRONG TYPE FOR A DCL
+
+; SIMPLE TYPE MATCHER
+
+TYPMAT:	GETYP	E,C		; OBJECTS TYPE TO E
+	PUSH	P,E		; SAVE IT
+	PUSH	TP,C
+	PUSH	TP,D
+	PUSHJ	P,TYPFND	; CONVERT TYPE NAME TO CODE
+	JRST	SPECS		; NOT A TYPE NAME, TRY SPECIALS
+	SUB	TP,[2,,2]
+	POP	P,E		; RESTORE TYPE OF OBJECT
+	MOVEI	0,0		; SPECIAL INDICATOR
+	CAIN	E,(D)		; SKIP IF LOSERS
+CPOPJ1:	AOS	(P)		; GOOD RETURN
+CPOPJ:	POPJ	P,
+
+SPECS:	POP	P,A		; RESTORE OBJECTS TYPE
+	POP	TP,D
+	POP	TP,C
+	CAMN	B,IMQUOTE ANY
+	JRST	CPOPJ1		; RETURN IMMEDIATELY IF ANYTHING WINS
+	CAMN	B,IMQUOTE STRUCTURED
+	JRST	ISTRUC		; LET ISTRUC DO THE WORK
+	CAMN	B,IMQUOTE APPLICABLE
+	JRST	APLQ
+	CAMN	B,IMQUOTE LOCATIVE
+	JRST	LOCQQ
+	PUSH	TP,$TATOM
+	PUSH	TP,B
+	PUSH	TP,C
+	PUSH	TP,D
+	MOVSI	A,TATOM
+	MOVSI	C,TATOM
+	MOVE	D,IMQUOTE DECL
+	PUSHJ	P,IGET
+	JUMPE	B,TERR2X
+	MOVEM	A,-3(TP)
+	MOVEM	B,-2(TP)
+	INTGO
+	POP	TP,D
+	POP	TP,C
+	POP	TP,B
+	POP	TP,A
+	JRST	TMATCX	
+
+; ARRIVE HERE FOR A FORM IN THE DCLS
+
+TMAT1:	JUMPE	B,TERR3		; EMPTY FORM LOSES
+	HRRZ	E,(B)		; CDR IT
+	JUMPE	E,TMAT3		; CANT BE SPECIAL/UNSPECIAL, LEAVE
+	PUSHJ	P,0ATGET	; GET POSSIBLE ATOM IN 0
+	JRST	TEXP1		; NOT ATOM
+	CAME	0,MQUOTE SPECIAL
+	CAMN	0,MQUOTE UNSPECIAL
+	JRST	TMAT2		; IGNORE SPECIAL/UNSPECIAL
+TMAT3:	PUSHJ	P,TEXP1
+	JRST	.+2
+	AOS	(P)
+	MOVEI	0,0		; RET UNSPECIAL INDICATION
+	POPJ	P,
+
+TEXP1:	JUMPE	B,TERR3		; EMPTY FORM
+	GETYP	E,A		; CHECK CURRENT TYPE
+	CAIN	E,TATOM		; IF ATOM,
+	JRST	TYPMA1		; SIMPLE MATCH
+	CAIN	E,TSEG
+	JRST	.+3
+	CAIE	E,TFORM
+	JRST	TERR4
+	GETYP	0,(B)		; WHAT IS FIRST ELEMEMT
+	CAIE	0,TFORM		; FORM=> <<OR ..>....> OR <<PRIMTYPE FOO>....>
+	JRST	TEXP12
+	PUSH	TP,$TLIST	; SAVE LIST
+	PUSH	TP,B
+	MOVE	B,1(B)		; GET FORM
+	PUSH	TP,C
+	PUSH	TP,D
+	PUSH	P,E
+	PUSHJ	P,ACTRT1
+	TDZA	0,0		; REMEMBER LACK OF SKIP
+	MOVEI	0,1
+	POP	P,E
+	POP	TP,D
+	POP	TP,C
+	MOVE	B,(TP)		; GET BACK SAVED LIST
+	SUB	TP,[2,,2]
+	JUMPE	0,CPOPJ		; LOSERS EXIT IMMEDIATELY
+	HRRZ	B,(B)		; OTHERWISE REST THE LIST AND FALL INTO ELETYPE
+
+; CHECKS TYPES OF ELEMENTS OF STRUCTURES
+
+ELETYP:	CAIE	E,TSEG		; MUST BE EXAXT?
+	JUMPE	B,CPOPJ1	; EMPTY=> WON
+	PUSH	TP,$TLIST	; SAVE DCL LIST
+	PUSH	TP,B
+	MOVE	A,C		; GET OBJ IN A AND B
+	MOVE	B,D
+	CAIE	E,TSEG
+	TDZA	E,E
+	MOVNI	E,1
+	PUSH	P,E
+	PUSHJ	P,TYPSGR	; GET REST/NTH CODE
+	JRST	ELETYL		; LOSER
+	CAIN	C,5		; BYTE STRING COMES HERE
+	JRST	ELEBYT		; HACK IT
+	PUSH	TP,DSTORE
+	PUSH	TP,D
+	PUSH	P,C		; SAVE CODE
+	PUSH	TP,[0]		; AND SLOTS
+	PUSH	TP,[0]
+
+; MAIN ELEMENT SCANNING LOOP
+
+ELETY1:	XCT	TESTR(C)	; SKIP IF OBJ NOT EMPTY
+	JRST	ELETY2		; CHEK EMPTY WINNER
+	SKIPN	-4(TP)
+	JRST	ELETY4
+	XCT	TYPG(C)		; GET ELEMENT
+	XCT	VALG(C)
+	JSP	E,CHKAB		; CHECK OUT DEFER
+	MOVEM	A,-1(TP)	; AND SAVE IT
+	MOVEM	B,(TP)
+	MOVE	C,A
+	MOVE	D,B		; FOR OTHER MATCHERS
+	MOVE	B,-4(TP)	; GET PATTERN
+	MOVE	A,(B)
+	GETYP	0,(B)		; GET TYPE OF <1 pattern>
+	MOVE	B,1(B)		; GET ATOM OR WHATEVER
+	CAIE	0,TATOM		; ATOM ... SIMPLE TYPE
+	JRST	ELETY3
+	PUSHJ	P,TYPMAT	; DO SIMPLE TYPE MATCH	
+	JRST	ELETY4		; LOSER
+
+; HERE TO REST EVERYTHING AND GO ON BACK
+
+ELETY6:	MOVE	D,-2(TP)	; GET OBJ POINTER
+	MOVE	C,(P)		; GET INCREMENT CODE
+	XCT	INCR1(C)
+	MOVEM	D,-2(TP)	; SAVED INCREMENTED GOODIR
+	MOVE	0,DSTORE
+	MOVEM	0,-3(TP)
+
+ELETY9:	HRRZ	B,@-4(TP)	; CDR IT
+	MOVEM	B,-4(TP)
+	JUMPN	B,ELETY1
+
+	SKIPN	-1(P)		; SKIP IF EXACT REQUIRED
+	JRST	ELETY8
+	XCT	TESTR(C)
+	JRST	ELETY8
+	JRST	ELETY4
+
+
+; HERE IF PATTERN EMPTY
+
+ELETY8:	AOS	-2(P)		; SKIP RETURN
+ELETY4:	SETZM	DSTORE
+	SUB	P,[2,,2]
+	SUB	TP,[6,,6]
+	POPJ	P,
+
+ELETYL:	SUB	P,[1,,1]
+	SUB	TP,[2,,2]
+	POPJ	P,
+
+; HERE TO HANDLE EMPTY OBJECT
+
+ELETY2:	MOVE	B,-4(TP)	; GET PATTERN
+	JUMPE	B,ELETY8
+	GETYP	0,(B)		; CHECK FOR [REST ...]
+	SETZM	DSTORE
+	CAIE	0,TVEC
+	JRST	ELETY4		; LOSER
+	HLRZ	0,1(B)		; SIZE OF IT
+	CAILE	0,-4		; MUST BE 2
+	JRST	ELETY4
+	MOVE	B,1(B)		; GET IT
+	PUSHJ	P,0ATGET	; LOOK FOR REST
+	JRST	ELETY4
+	CAMN	0,MQUOTE OPTIONAL
+	JRST	ELETY8
+	CAME	0,MQUOTE OPT
+	CAMN	0,IMQUOTE REST
+	JRST	ELETY8		; WINNER!!!!
+	JRST	ELETY4		; LOSER
+
+; HERE TO CHECK OUT A FORM ELEMNT
+
+ELETY3:	CAIN	0,TSEG
+	JRST	ELGO
+       	CAIE	0,TFORM
+	JRST	ELETY7
+ELGO:	SETZM	DSTORE
+	PUSHJ	P,TEXP1		; AND ANALYSE IT
+	JRST	ELETY4		; LOSER
+	MOVE	0,-3(TP)	; RESET DSTO
+	MOVEM	0,DSTORE
+	JRST	ELETY6		; WINNER
+
+; CHECK FOR VECTOR IN PATTERN
+
+ELETY7:	CAIE	0,TVEC		; SKIP IF WINNER
+	JRST	TERR12		; YET ANOTHER ERROR
+	HLRE	C,B		; CHECK LEENGTH
+	CAMLE	C,[-4]		; MUST BE 2 LONG
+	JRST	TERR13
+	PUSHJ	P,0ATGET	; 1ST ELEMENT ATOM?
+	JRST	ELET71		; COULD BE FORM
+	CAME	0,MQUOTE OPT
+	CAMN	0,MQUOTE OPTIONAL
+	JRST	ELET72
+	CAME	0,IMQUOTE REST
+	JRST	TERR14
+	MOVE	0,(P)		; GET STRUC CODE
+	CAIN	0,2
+	CAME	C,[-4]
+	JRST	ELNUVE
+
+	GETYP	0,2(B)		; SEE IF UVECTOR REST SIMPLE TYPE
+	CAIE	0,TATOM
+	JRST	ELNUVE
+
+	MOVE	C,3(B)		; GET ATOM
+	HLRE	0,C
+	SUB	C,0		; POINT TO DOPE WDS
+	HRRE	0,(C)
+	JUMPE	0,ELNUVE
+	MOVSI	A,TATOM
+	MOVE	B,3(B)
+	MOVE	C,-2(TP)
+	HLRE	D,C
+	SUB	C,D
+	GETYP	C,(C)
+	MOVSI	C,(C)
+	PUSHJ	P,TMATCX
+	JRST	ELETY4
+	JRST	ELETY8
+
+ELNUVE:	TDOA	0,[-1]
+ELET72:	MOVSI	0,(SETZ)	; FLAG USED IN RESTIT
+	PUSH	P,0
+	PUSHJ	P,RESTIT	; CHECK REST OF STRUCTUR
+	JRST	ELET41
+	POP	P,0
+	TRNE	0,-1
+	JRST	ELETY8		; WIN AND DONE
+	JRST	ELET81
+
+ELET41:	SUB	P,[1,,1]
+	JRST	ELETY4
+
+; CHECK FOR [fix .... ]
+
+ELET71:	CAIE	0,TFIX
+	JRST	TERR15
+	MOVNS	C
+	ASH	C,-1
+	MOVE	0,1(B)		; GET NUMBER
+	IMULI	0,-1(C)		; COUNT MORE
+	PUSH	P,0
+	PUSHJ	P,RESTIT	; AND CHECK FIX NUM OF ELEMENTS
+	TDZA	0,0
+	MOVEI	0,1
+	SUB	P,[1,,1]
+	JUMPE	0,ELETY4
+ELET81:	MOVE	D,-2(TP)	; GET OBJECT BACK
+	MOVE	0,-3(TP)	; RESET DSTO
+	MOVEM	0,DSTORE
+	MOVE	C,(P)		; RESTORE CODE FOR RESTING ETC.
+	JRST	ELETY9
+
+
+; HERE TO DO A TASTEFUL TYPMAT
+
+TYPMA1:	PUSH	TP,C
+	PUSH	TP,D
+	PUSHJ	P,TYPMAT
+	TDZA	0,0		; REMEMBER LOSSAGE
+	MOVEI	0,1		; OR WINNAGE
+	POP	TP,D
+	POP	TP,C		; RESTORE OBJECT
+	JUMPN	0,CPOPJ1	; SKIPPED BEFORE, SKIP AGAIN
+	POPJ	P,
+
+; HERE TO SKIP SPECIAL/UNSPECIAL
+
+TMAT2:	CAME	0,MQUOTE SPECIAL
+	TDZA	0,0
+	MOVEI	0,1
+	PUSH	P,0		; SAVE INDICATOR
+	HRRZ	A,(E)		; CHECK FOR EXACT LENGTH
+	JUMPN	A,TERR16
+	GETYP	A,(E)		; TYPE OF NEW PAT
+	MOVE	B,1(E)		; VALUE
+	MOVSI	A,(A)
+	PUSHJ	P,TEXP1
+	JRST	.+2
+	AOS	-1(P)
+	POP	P,0
+	POPJ	P,
+
+; LOOK FOR <OR...   OR <PRIMTYPE....
+
+TEXP12:	CAIE	0,TATOM
+	JRST	TERR5
+	MOVE	0,1(B)		; GET ATOM
+	CAMN	0,IMQUOTE QUOTE
+	JRST	MQUOT		; MATCH A QUOTED OBJECT
+	CAME	0,IMQUOTE OR
+	CAMN	0,IMQUOTE PRIMTYPE
+	JRST	ACTORT		; FALL INTO ACTOR HACKER
+	PUSH	TP,$TLIST
+	PUSH	TP,B
+	MOVE	B,0		; GET ATOM
+	PUSH	TP,C		; SAVE OBJ
+	PUSH	TP,D
+	PUSH	P,E
+	PUSHJ	P,TYPMAT
+	TDZA	0,0
+	MOVEI	0,1
+	POP	P,E
+	MOVE	C,-1(TP)
+	MOVE	D,(TP)
+	MOVE	B,-2(TP)
+	JUMPN	0,.+3		; TO ELETYP IF WON
+	SUB	TP,[4,,4]
+	POPJ	P,		; ELSE LOSE
+
+	HRRZ	0,(B)
+	MOVSI	A,TFORM
+	JUMPE	0,TERR3
+	MOVE	B,0
+	PUSHJ	P,ELETYP
+FOOPC:	TDZA	0,0
+	MOVEI	0,1
+POPPIT:	POP	TP,D
+	POP	TP,C
+	POP	TP,B
+	POP	TP,A
+	JUMPN	0,CPOPJ1
+	POPJ	P,
+	
+; THIS CODE HANDLES ORs AND PRIMTYPEs
+ACTRT1:	SKIPA	E,[SETZ PACT]
+
+ACTORT:	MOVE	E,[SETZ TEXP1]
+	JUMPE	B,TERR6		; EMPTY, LOSE
+	PUSHJ	P,0ATGET	; ATOM TO 0
+	JRST	PACT
+	CAME	0,IMQUOTE OR
+	JRST	PACT2
+	HRRZ	0,(B)		; REST IT FLUSHING OR
+	JUMPE	0,TERR7
+	PUSH	TP,$TLIST	; SAVE LSIT
+	PUSH	TP,0
+	PUSH	P,E		; SAVE ELEMENT CHECKER
+
+ORLP:	SKIPN	B,(TP)		; ANY LEFT?
+	JRST	ORDON		; NOPE, LOSE
+	HRRZ	0,(B)		; SAVE THE REST
+	MOVEM	0,(TP)
+	GETYP	0,(B)		; WHAT ARE WE ORing
+	MOVE	A,(B)		; TYPE WORD
+	MOVE	B,1(B)		; AND ITEM
+	PUSH	TP,C
+	PUSH	TP,D
+	PUSHJ	P,@(P)		; EITHER PACT OR TEXP1
+	TDZA	0,0
+	MOVEI	0,1
+	POP	TP,D
+	POP	TP,C
+	JUMPE	0,ORLP
+	AOS	-1(P)		; SKIP RETURN FOR WINNER
+
+ORDON:	SUB	TP,[2,,2]	; FLUSH TEMP
+	SUB	P,[1,,1]
+	POPJ	P,
+
+; HERE TO PRIMTYPE ACTORS
+
+PACT:	CAIE	0,TFORM
+	JRST	PACT1
+	JUMPE	B,TERR6		; EMPTY FORM
+	MOVE	0,1(B)		; FIRST ELEMENT MUST BE PRIMTYPE
+PACT2:	CAME	0,IMQUOTE PRIMTYPE
+	JRST	TERR7
+	HRRZ	A,(B)		; GET PRIMTYPE
+	JUMPE	A,TERR7
+	HRRZ	0,(A)
+	JUMPN	0,TERR18
+	MOVEI	B,(A)
+	GETYP	A,C		; GET OBJ TYPE
+	GETYP	0,(B)		; GET PATTERN TYPE
+	CAIE	0,TATOM		; BETTER BE ATOM
+	JRST	TERR8
+	PUSH	TP,$TLIST	; SAVE DCL LIST
+	PUSH	TP,B
+	PUSH	TP,C
+	PUSH	TP,D
+	PUSHJ	P,SAT		; GET STORAGE TYPE
+	CAILE	A,NUMSAT
+	JRST	PTEMP
+	MOVE	B,@STBL(A)	; GET PRIM NAME
+	PUSHJ	P,TYPFND
+	JFCL			; MUST EXIST
+	MOVSI	C,(D)		; FAKE OUT TYPMAT
+	MOVE	B,-2(TP)
+	MOVE	B,1(B)
+	PUSHJ	P,TYPMAT
+	JRST	.+2
+	AOS	(P)
+	MOVE	C,-1(TP)
+	MOVE	D,(TP)
+	SUB	TP,[4,,4]
+	POPJ	P,
+
+PACT1:	CAIE	0,TATOM
+	JRST	TERR4
+	JRST	TYPMAT
+
+PTEMP:	MOVE	B,-2(TP)
+	MOVE	B,1(B)
+	CAMN	B,IMQUOTE TEMPLATE
+	AOS	(P)
+	SUB	TP,[4,,4]
+	POPJ	P,
+
+; RESTIT - TYPE CHECK SELECTED NUMBER OF ELEMENTS IN STRUCTURE
+
+RESTIT:	PUSH	TP,$TVEC	; SAVE TYPE
+	ADD	B,[2,,2]	; SKIP OVER CRUFT
+	PUSH	TP,B		; AND VAL
+	PUSH	TP,$TVEC
+	PUSH	TP,B
+RESTI1:	PUSH	P,A		; SAVE DISP HACK
+	PUSH	P,0		; AND COUNT HACK
+RESTI4:	SKIPL	(P)		; SKIP IF DOING ALL
+	SOSL	(P)		; SKIP IF DONE
+	JRST	RESTI6
+	AOS	-2(P)		; SKIP RET
+RESTI5:	SUB	P,[2,,2]	; POP JUNK
+	SUB	TP,[4,,4]
+	POPJ	P,
+RESTI6:	SKIPGE	(TP)
+	JRST	RESTX1
+	HLRZ	0,(P)
+	CAIN	0,(SETZ)
+	JRST	RESTI2
+RESTX1:	MOVE	C,-4(P)		; REST CODE
+	MOVE	D,-6(TP)	; SET UP FOR REST
+	MOVE	E,-7(TP)	; DONT FORGET DSTO
+	MOVEM	E,DSTORE
+	XCT	TESTR(C)	; DONE?
+	JRST	RESTI2		; YES, CHECK WINNAGE
+	XCT	TYPG(C)
+	XCT	VALG(C)		; GET VAL ANDTYPE
+	JSP	E,CHKAB		; CHECK DEFER
+	XCT	INCR1(C)	; REST IT
+	MOVEM	D,-6(TP)	; SAVE LIST
+	MOVE	E,DSTORE
+	MOVEM	E,-7(TP)	; FIXUP
+	SETZM	DSTORE
+	MOVE	C,A
+	MOVE	D,B
+	SKIPL	A,(TP)		; ANY MORE?
+	MOVE	A,-2(TP)	; NO RECYCLE
+	ADD	A,[2,,2]	; BUMP
+	MOVEM	A,(TP)		; AND SAVE
+	MOVE	B,-1(A)		; GET ELEMENT
+	MOVE	A,-2(A)
+	GETYP	0,A
+	MOVEI	E,TERR15
+	CAIN	0,TATOM
+	MOVEI	E,TYPMAT	; ATOM --> SIMPLE TYPE
+	CAIE	0,TSEG
+	CAIN	0,TFORM		; FORM--> HAIRY PATTERN
+	MOVEI	E,TEXP1
+	TLO	E,400000
+	PUSHJ	P,(E)		; DO IT
+	JRST	RESTI5
+	JRST	RESTI4
+
+RESTI2:	SKIPGE	(P)		; SKIP IF WON
+	AOS	-2(P)		; COUNTERACT CPOPJ1
+	JRST	RESTI5
+
+RESTI3:	TEXP1
+	TYPMAT
+
+; HERE TO MATHC A QUOTED OBJ
+;	B/ FORM QUOTE...  C,D/ OBJECT TO MATCH AGAINST
+
+MQUOT:	HRRZ	B,(B)		; LOOK AT NEXT
+	JUMPE	B,TERR7
+	GETYP	A,(B)		; GET TYPE
+	MOVSI	A,(A)
+	MOVE	B,1(B)		; AND VALUE
+	JSP	E,CHKAB		; HACK DEFER
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSH	TP,C
+	PUSH	TP,D
+	MOVEI	D,-3(TP)
+	MOVEI	C,-1(TP)
+	PUSHJ	P,IEQUAL
+	TDZA	0,0
+	MOVEI	0,1
+	JRST	POPPIT
+
+; HERE TO HANDLE SPECIAL BYTE STRING HAIR
+
+ELEBYT:	MOVE	B,(TP)		; GET DECL LIST BACK
+	POP	P,E		; EXACTNESS FLAG
+	JUMPE	B,ELEBY2
+	GETYP	0,(B)
+	CAIE	0,TFIX
+	JRST	TERR17
+	MOVE	A,1(B)
+	HRRZ	B,(B)
+	HRRZ	0,(B)
+	SKIPE	B
+	JUMPN	0,TERR17
+	LDB	C,[300600,,D]	; GET BYTE SIZE
+	CAIE	A,(C)
+	JRST	ELEBY3
+	HRRZ	C,DSTORE
+ELEBY2:	MOVEI	A,0
+	JUMPE	B,ELEBY4
+	GETYP	0,(B)
+	CAIE	0,TFIX
+	JRST	TERR17
+	MOVE	A,1(B)
+ELEBY4:	CAIGE	C,(A)
+	JRST	ELEBY3
+	CAIE	A,(C)
+	JUMPN	E,ELEBY3
+	AOS	(P)
+ELEBY3:	SETZM	DSTORE
+	SUB	TP,[2,,2]
+	POPJ	P,
+
+	
+
+; GET ATOM IN AC 0
+
+0ATGET:	GETYP	0,(B)
+	CAIE	0,TATOM		; SKIP IF ATOM
+	POPJ	P,
+	MOVE	0,1(B)		; GET ATOM
+	JRST	CPOPJ1
+
+TERR17:	MOVE	B,-2(TP)
+	MOVE	B,1(B)
+	HRRZ	0,(P)
+	CAIN	0,FOOPC
+	MOVE	B,-4(TP)
+	MOVSI	A,TFORM
+	MOVE	E,EQUOTE BAD-BYTES-DECL
+	SETZM	DSTORE
+	JRST	TERRD
+
+TERR18:	SKIPA	E,EQUOTE TOO-MANY-ARGS-TO-PRIMTYPE-DECL
+TERR16:	MOVE	E,EQUOTE TOO-MANY-ARGS-TO-SPECIAL-UNSPECIAL-DECL
+	MOVSI	A,TFORM
+	JRST	TERRD
+
+TERR9:	MOVS	A,0		; TYPE TO A
+TERR4:
+TERR5:
+TERR15:
+TERR1:	MOVE	E,EQUOTE DECL-ELEMENT-NOT-FORM-OR-ATOM
+	JRST	TERRD
+
+TERR2X:	SUB	TP,[2,,2]
+	POP	TP,B
+	POP	TP,A
+
+TERR2:	MOVSI	A,TATOM
+	MOVE	E,EQUOTE ATOM-NOT-TYPE-NAME-OR-SPECIAL-SYMBOL
+	JRST	TERRD
+TERR6:
+TERR3:	MOVE	E,EQUOTE EMPTY-FORM-IN-DECL
+	JRST	TERRD
+TERR7:	MOVE	E,EQUOTE EMPTY-OR/PRIMTYPE-FORM
+	JRST	TERRD
+
+TERR8:	MOVS	A,0		; TYPE TO A
+	MOVE	E,EQUOTE NON-TYPE-FOR-PRIMTYPE-ARG
+	JRST	TERRD
+TERR12:	MOVE	E,EQUOTE ELEMENT-TYPE-NOT-ATOM-FORM-OR-VECTOR
+	JRST	TERRD
+TERR13:	MOVE	E,EQUOTE VECTOR-LESS-THAN-2-ELEMENTS
+	JRST	TERRD
+TERR14:	MOVE	E,EQUOTE FIRST-VECTOR-ELEMENT-NOT-REST-OR-A-FIX
+
+TERRD:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE BAD-TYPE-SPECIFICATION
+	PUSH	TP,$TATOM
+	PUSH	TP,E
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	A,3
+	JRST	CALER
+
+IMPURE
+
+IGDECL:	0
+
+PURE
+
+END
+
\ No newline at end of file