mirror of
https://github.com/PDP-10/its.git
synced 2026-01-22 02:26:05 +00:00
a7399d0f9a
Looking at the backup dates for files in <mdl.int>, mdl106.exe is from 20th January 1981, whereas some of the source files are from a couple of years later. Revert to the last version prior to 20th January 1981 -- in every case, this was the earliest revision that was kept in <mdl.int>. This undoes the changes that we'd previously made to these files, many of which are no longer necessary now that we're using MIDAS 73.
1064 lines
19 KiB
Plaintext
1064 lines
19 KiB
Plaintext
|
||
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
|
||
|
||
; 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
|
||
|
||
; 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
|
||
|