SUBTTL	MUDDLE DEFINITIONS AND FLAGS

;----------------------------------------------------------------
;		TYPE DEFINITIONS USED IN PASS 1 PARSER
;----------------------------------------------------------------


U%FORM==:0	;FORM
U%FCLS==:1	;END OF A FORM
U%LIST==:2	;LIST
U%LCLS==:3	;END OF A LIST
U%BKT==:4	;BRAKCETED TYPE
U%CBKT==:5	;END OF "
U%VECT==:6	;VECTOR
U%VCLS==:7	;END OF A VECTOR
U%UVCT==:10	;UVECTOR
U%UCLS==:11	;END OF A UVECTOR
U%SEG==:12	;SEGMENT
U%SCLS==:13	;END OF A SEGMENT
U%QUOT==:14	;QUOTED OBJECT
U%ATOM==:15	;ATOM
;U%TYPE WAS HERE...
U%CHAR==:17	;SINGLE CHARACTER TYPE
U%STR==:20	;STRING.

;------------------------------------------------
;	TYPES USED IN SYMBOL TABLE
;------------------------------------------------


U%FUNC:	ATYPE	[Funct]	;FUNCTION
	"f
U%MACR:	ATYPE	[Macro] ;MACRO
	"m
U%GLBL:	ATYPE	[Globl]	;GLOBAL VARIABLE
	"g
U%PCKG:	ATYPE	[Pkg]	;PACKAGE
	"p
U%TYPE:	ATYPE	[Type]	;NEWTYPE
	"t
U%LOCL:	ATYPE	[Local]	;paramtere or localized atom
	"l
U%LREF:	ATYPE	[Local Ref]
	".
U%GREF:	ATYPE	[Global Ref]
	",


SUBTTL	PASS 1 PROCESSING FOR MUDDLE CODE

1MUDDL:	MOVEM	P,LISPP	;SAVE STACK PTR FOR RETURNS TO TOP-LEVEL IN PARSE
	SETOM	MDLFLG	;AND TELL THE WORLD IT'S MUDDLE CODE COMING THRU.
	MOVEI	R,5		;GOING TO ASCII
	MOVEM	R,CHS%WD	;5 CHARACTERS/WORD INSTEAD OF 6
	CAMLE	A,MAXSSZ	; }
	 MOVEM	A,MAXSSZ	;  }  SET MAXIMUM-SEEN SYMBOL
	CAMLE	A,MAXTSZ	;  }  AND TYPE LENGTHS AT 5 CHARS.
	 MOVEM	A,MAXTSZ	; }

1ULOOP:	MOVE	P,LISPP		;RETURN-TO-TOP-LEVEL BRANCH TARGET
	PUSHJ	P,1UOBJ		;PROCESS THE NEXT MUDDLE OBJECT
	JRST	1ULOOP		;AND CONTINUE UNTIL END OF FILE.

1ULOSE:	STRT	[ASCIZ/Error in MUDDLE code. Return to top-level forced.
/]
	JRST	1ULOOP		;FORCE HIM BACK TO TOP LEVEL.


;--------------------------------------------------------
;          MUDDLE OBJECT PARSER
;--------------------------------------------------------

1UOBJ:	1GETCH
	XCT	1UTBL(CH)	; PERFORM CHARACTER-DEPENDENT ACTIONS.
	POPJ	P,		; RETURN TO A HIGHER LEVEL



;--------------------------------------------------------
;		PARSE A FORM
;--------------------------------------------------------


1UFORM:	XCT	UPFRM		;PERFORM ANY PARSING EXIT ROUTINE
	SETZM	SYLBUF		;ZERO FOR ATOM-TESTING
	SETZM	SYLBUF+1	;DITTO
	PUSHJ	P,1UOBJ		;GET FIRST OBJECT
	SKIPA			;HAS AN ELEMENT TO IT
	 JRST	1UFRM2		;NO ELEMENTS; FIND OUT IF THIS IS CORRECT END.
	CAIE	A,U%ATOM	;IS THIS AN ATOM?
	 JRST	1UFRM1		;NO, GO TO NORMAL-OBJECT MODE.
	JSP	H,UBLOOK	;IS THIS A SPECIAL ATOM? (e.g., DEFINE)
	 JRST	1UFRM1		;NO
	HLRZ	C,UBARRAY+1(C)	; GET THE ADDRESS OF THE APPLY-HANDLER FOR PASS 1
	PUSHJ	P,(C)		; AND CALL IT.
	
	;CONTINUE OBJECT SEARCH

1UFRM1:	PUSHJ	P,1UOBJ		;MOVE OVER EVERY OBJECT IN THE FORM
	JRST	1UFRM1		;UNTIL WE HIT AN UNMATCHED CLOSE BKT

1UFRM2:	CAIE	A,U%FCLS	;THIS THE END FOR A FORM (">")?
	 JRST	1ULOSE		;NO--COMPLAIN ABOUT A MISMATCH
	MOVEI	A,U%FORM	;TELL THE NEXT HIGHER LEVEL WHAT WE WERE.
	POPJ	P,		;AND RETURN


;--------------------------------------------------------
;		PARSE AN ATOM
;
;	RETURNS:
;		A/ U%ATOM (TYPE)
;		B/ # OF CHARS IN THE PNAME
;		SYLBUF et seq/ PNAME (IN ASCII)
;
;--------------------------------------------------------

1UBKSL:	MOVE	CP,[440700,,SYLBUF]	;"\"-QUOTED CHARS ALSO START ATOMS.
	XCT	UPATOM			; PERFORM PARSING EXIT ROUTINE
1UATM4:	1GETCH
	CAIN	CH,^M		;IF IT'S A CR, GO DO CR HANDLING.
	 PUSHJ	P,1UCR2		; AND PROCEED.
	CAIN	CH,^L		;IF IT'S A FORM-FEED, MOVE TO NEXT PAGE ALWAYS.
	 PUSHJ	P,1UFF2		; (HANDLE THE FORM-FEED AND COME BACK HERE.)
	JRST	1UATM2		; SKIP ATOM-INIT CODE


1UATOM:	MOVE	CP,[440700,,SYLBUF]	;BYTE PTR TO ATOM BUFFER
	XCT	UPATOM			;PERFORM PARSING EXIT ROUTINE

1UATM2:	IDPB	CH,CP			;STORE AWAY THE 1ST CHAR
1UATM1:	1GETCH				;GRAB THE NEXT CHARACTER
	XCT	1UTBL2(CH)		;DISPATCH ON NEW CHAR
1UATM3:	DBP7	IP			;BACK INPUT UP ONE CHAR.
	MOVEI	B,0			;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES
	SETZ	H,			;EXCESS CHARACTER COUNTER
1UATM5:	IDPB	B,CP
	TLNE	CP,760000		;ARE WE AT THE END OF A WORD?
	 AOJA	H,1UATM5		;  NO. KEEP CLEARING, AND COUNT CLEARED CHARS

	MOVEI	A,U%ATOM		;RETURN THE TYPE
	MOVNI	R,(CP)
	HRLI	R,SYLBUF-1(R)
	HRRI	R,SYLBUF
	MOVEI	B,(CP)			;ADDRESS OF LAST WORD IN PNAME
	SUBI	B,SYLBUF-1		; LESS START, GIVING LENGTH OF PNAME IN WORDS
	IMUL	B,CHS%WD		; TIMES CHARS/WORD GIVES CHAR COUNT
	SUBI	B,(H)			; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME
	POPJ	P,


;------------------------------------------------
;		PARSE A LIST
;------------------------------------------------

1ULIST:	XCT	UPLIST		;PERFORM ANY PASING EXIT ROUTINE
1ULST2:	MOVE	A,[PUSHJ P,1UTFN2]
	MOVE	A,[PUSHJ P,1UTFN2]
	PUSHJ	P,1UOBJ		;READ ALL THE OBJECTS IN THE LIST
	JRST	1ULIST		;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET
	CAIE	A,U%LCLS	;IF IT WASN'T A ")",
	 JRST	1ULOSE		;--COMPLAIN AND RETURN TO TOP LEVEL
	MOVEI	A,U%LIST	;DATA TYPE
	POPJ	P,


;------------------------------------------------
;		PARSE A "{"-OBJECT
;------------------------------------------------

1UBKT:	XCT	UPBRKT		;PASING EXIT
	PUSHJ	P,1UOBJ		;SCAN ALL THE OBJECTS IN THE WHATEVER
	JRST	1UBKT		;UNTIL WE HIT THE END
	CAIE	A,U%CBKT	;IF IT ISN'T A CLOSE BRACKET("]")
	 JRST	1ULOSE		;COMPLAIN HORRIBLY
	MOVEI	A,U%BKT		;TYPE
	POPJ	P,		;RETURN TO HIGHER LEVEL.


;------------------------------------------------
;		PARSE A VECTOR
;------------------------------------------------

1UVECT:	XCT	UPVECT
	PUSHJ	P,1UOBJ		;READ EVERY OBJECT IN THE VECTOR
	JRST	1UVECT
	CAIE	A,U%VCLS	;IF NOT A CLOSE BRACKET "]",
	 JRST	1ULOSE		;PUNT
	MOVEI	A,U%VECT
	POPJ	P,


;------------------------------------------------
;		PARSE A UVECTOR
;------------------------------------------------

1UUVCT:	XCT	UPUVEC		;PARSING EXIT ROUTINE
	PUSHJ	P,1UOBJ
	JRST	1UUVCT
	CAIN	A,U%VCLS	;CAN BE CLOSED BY "]"
	 JRST	1UUV1
	CAIE	A,U%UCLS	;OR BY A "!]".
	 JRST	1ULOSE
1UUV1:	MOVEI	A,U%UVCT
	POPJ	P,


;------------------------------------------------
;		PARSE A SEGMENT
;------------------------------------------------

1USEG:	XCT	UPSEG		;PARSING EXIT ROUTINE
	PUSHJ	P,1UOBJ
	JRST	1USEG
	CAIN	A,U%FCLS	;CAN BE ENDED BY JUST A ">",
	 JRST	1USEG1
	CAIE	A,U%SCLS	;OR BY A "!>"
	 JRST	1ULOSE
1USEG1:	MOVEI	A,U%SEG
	POPJ	P,


;------------------------------------------------
;		QUOTED-OBJECT HANDLER
;------------------------------------------------

1UQUOT:	PUSHJ	P,1UOBJ		;SKIP PRECISELY 1 OBJECT
	SKIPA
	 JRST	1ULOSE		;COMPLAINING IF IT'S NOT THERE
	MOVEI	A,U%QUOT
	POPJ	P,


;------------------------------------------------
;		HANDLE A #TYPE...
;------------------------------------------------

1UTYPE:	PUSHJ	P,1UOBJ		;GRAB AN ATOM
	CAIE	A,U%ATOM	;(IF NOT AN ATOM,
	 JRST	1ULOSE		;  COMPLAIN ABOUT IT)
	JSP	H,UBLOOK	; IF IT'S A SPECIAL ATOM,
	 JRST	1UTYP1		; (NOPE...)
	HLRZ	C,UBARRAY+2(C)	;GET HANDLER ADDRESS
	PUSHJ	P,(C)		;INVOKE HANDLER.
	 JRST	1UTYP2		;(SKIPPED TO HANDLE OBJECT IN DEFAULT MANNER)
1UTYP1:	PUSHJ	P,1UOBJ		;GET THE NEXT OBJECT (THE REAL GUTS)
	SKIPA
	 JRST	1ULOSE
1UTYP2:	MOVEI	A,U%TYPE
	POPJ	P,


;------------------------------------------------
;		EXCL (!) HANDLER
;------------------------------------------------

1UEXCL:	1GETCH		; GET THE NEXT CHARACTER
	CAIN	CH," 	; IF IT'S A BLANK, KEEP LOOKING.
	 JRST	1UEXCL

	CAIN	CH,"<	;HANDLE
	 JRST	1USEG	;SEGMENT-EVALUATION

	CAIN	CH,"[	;UVECTORS
	 JRST	1UUVCT

	CAIN	CH,"\	;CHARACTER DATA
	 JRST	1UCHAR

	CAIN	CH,">	;END OF A SEGMENT
	 JRST	1USCLS

	CAIN	CH,"]	;END OF A UVECTOR
	 JRST	1UUCLS

	CAIN	CH,".	;LVAL
	 JRST	1UDOT

	CAIN	CH,",	;GVAL
	 JRST	1UCOMA

	CAIE	CH,""	;ALSO CHARACTER
	 JRST	1ULOSE	;(DIDN'T FIND ANYTHING)

	DROPTHRUTO 1UCHAR	;THIS IS A CONSISTENCY CHECK, NOT A COMMENT.


;------------------------------------------------
;		CHARACTER DATA-TYPE HANDLER
;------------------------------------------------

1UCHAR:	1GETCH			;IGNORE THAT CHARACTER
	CAIN	CH,3		;CONTROL-C?
	PUSHJ	P,1MORE0	;YES. GET NEXT CHUNK OF BUFFER.
	CAIN	CH,^J		;IF IT'S A LF
	 PUSHJ	P,1ULF2
	CAIN	CH,^M		;IF IT'S A CR
	 PUSHJ	P,1UCR2		;;GO HANDLE IT.
	MOVEI	A,U%CHAR	;SAY IT WAS A CHARACTER
	POPJ	P,


;------------------------------------------------
;		STRING PARSER
;------------------------------------------------

1USTR1:	1GETCH			; FOR READING "\"-QUOTED CHARACTERS

1USTR:	1GETCH			;(ENTRY PT) GET NEXT CHAR IN STRING
1USTR2:	CAIN	CH,3		;IF CONTROL-C,
	 PUSHJ	P,1MORE0	;GET MORE INPUT BUFFER (IF ANY)
	CAIN	CH,^J		;LINE-FEED HANDLER
	  JRST	1ULF3
	CAIN	CH,^M		;CARRIAGE-RETURN HANDLER
	  JRST	1UCR3
	CAIN	CH,"\		;MUDDLE QUOTE CHARACTER?
	 JRST	1USTR1		;YES. IGNORE THE NEXT CHAR
	CAIE	CH,""		;END OF THE STRING?
	 JRST	1USTR		;NO -- KEEP READING
	MOVEI	A,U%STR		;TELL THE CALER IT'S A STRING
	POPJ	P,		;AND RETURN.


1UCR3:	PUSHJ	P,1UCR2		;HANDLE THE CR (AND LF)
	CAIN	CH,^J
	 JRST	1USTR2		;DON'T BOTHER WITH ANOTHER CHARACTER.
	JRST	1USTR

1ULF3:	PUSHJ	P,1ULF2
	JRST	1USTR


;------------------------------------------------
;		COMMENT HANDLER
;------------------------------------------------

1USEMI:	PUSHJ	P,1UOBJ		;IGNORE THE NEXT OBJECT.
	JRST	1UOBJ		;AND FORGET WE SAW ANYTHING.
	JRST	1ULOSE	;BAD BUSINESS IF IT'S NOT BALANCED.



;------------------------------------------------
;		GVAL HANDLER
;------------------------------------------------

1UCOMA:	PUSHJ	P,1UOBJ	;SKIP THE NEXT OBJECT
	POPJ	P,
	JRST	1ULOSE


;------------------------------------------------
;		LVAL HANDLER
;------------------------------------------------

1UDOT:	PUSHJ	P,1UOBJ		;SKIP THE NEXT OBJECT.
	POPJ	P,
	JRST	1ULOSE



;------------------------------------------------
;
;	VARIOUS CLOSING BRACKET HANDLERS
;
;	THESE ALL SKIP-RETURN TO INDICATE 
;	THAT THEY ARE CLOSING-BRACKETS OF
;	VARIOUS KINDS.
;
;------------------------------------------------

1ULCLS:	MOVEI	A,U%LCLS	;  )
	AOS	(P)
	POPJ	P,

1UFCLS:	MOVEI	A,U%FCLS	; >
	AOS	(P)
	POPJ	P,

1UVCLS:	MOVEI	A,U%VCLS	; ]
	AOS	(P)
	POPJ	P,

1USCLS:	MOVEI	A,U%SCLS	; !>
	AOS	(P)
	POPJ	P,

1UUCLS:	MOVEI	A,U%UCLS	; !]
	AOS	(P)
	POPJ	P,

1UCBKT:	MOVEI	A,U%CBKT	; }
	AOS	(P)
	POPJ	P,


;------------------------------------------------
;		HANDLE CR, LF, AND FF
;------------------------------------------------

1UCR:	PUSHJ	P,1UCR2
	JRST	1UOBJ


1UCR2:	TLNE	F,FLSCR		;CHECK STRAY-CR IGNORE FLAG
	  POPJ	P,
	1GETCH			; GET NEXT CHARACTER
	CAIN	CH,^J		;LINE FEED?
	  ADDI	N,1
	POPJ	P,





1ULF:	PUSHJ	P,1ULF2
	JRST	1UOBJ


1ULF2:	TLNE	F,FLSCR		; CHECK IGNORE-STRAY-LF FLAG
	  ADDI	N,1		; BUMP THE LINE COUNT
	POPJ	P,



1UFF:	PUSHJ	P,1UFF2		;MOOVE TO THE NEXT PAGE
	JRST	1ULOOP		;AND FORCE A RETURN TO TOP-LEVEL.


1UFF2:	SKIPE	LNDFIL		; IF THIS FILE HAS SOS LINE NUMBERS,
	 PUSHJ	P,CKLNM		; GET AROUND IT
	TRO	N,-1		; KILL LINE NUMBER
	AOJ	N,		; bump page no.
ITS,[
	HLRZ	B,N		; SHOW PAGE NO IN PEEK
	HRLI	B,[SIXBIT/P1/]
	.SUSET	[.SWHO3,,B]
 ]  ; END ITS
	POPJ	P,		;RETURN TO PLAY WITH FF ELSEWHERE.



;------------------------------------------------
;	READ A LOCAL-VARIABLE LIST
;	AND MAKE THE DEFINITIONS
;------------------------------------------------

1ULOCL:	PUSH	P,UPLIST	;PUSH LIST PARSING EXIT.
	MOVE	A,[JRST UDFL1]	; HANDLER FOR THE LOCAL-VARIABLE LIST
	MOVEM	A,UPLIST
	PUSHJ	P,1UOBJ		;GRAB THE NEXT OBJECT,
	 SKIPA
	JRST	1ULOSE		;WHICH -MUST- INCLUDE AN ARGS LIST.

	CAIE	A,U%LIST	;IF IT WASN'T A LIST
	 JRST	1ULOSE		;COMPLAIN, SINCE IT BETTER BE.
	POP	P,UPLIST	;GET BACK OLD LIST HANDLER (PROBABLY THE NULL ONE)
	POPJ	P,		;RETURN TO NORMAL FORM HANDLER


;------------------------------------------------
;	LIST-PARSING EXIT ROUTINE
;	TO HANDLE LOCALIZATION LISTS
;	FOR 1ULOCL
;------------------------------------------------

UDFL1:	PUSH	P,UPLIST	; PUSH THE POINTER TO THIS
	MOVE	A,[JRST UDFL2]	; TO GET NAMES OF INITIALIZED LOCALS
	MOVEM	A,UPLIST
UDFL1A:	PUSHJ	P,1UOBJ		;GET THE NEXT OBJECT
	SKIPA
	 JRST	UDFL9		;POTENTIAL END OF LIST -- GO CHECK IT.
	MOVE	B,A
	MOVE	A,R
	MOVEI	R,U%LOCL	; (LOCAL-VARIABLE FLAG)
	CAIN	B,U%ATOM	;IF THIS IS AN ATOM,
	 PUSHJ	P,1UNAM2	;  GO DEFINE IT AS A LOCAL.
	JRST	UDFL1A		;GO BACK FOR MORE.


UDFL2:	PUSH	P,UPLIST	; PUSH POINTER TO THIS
	MOVE	A,[JFCL]
	MOVEM	A,UPLIST	; IGNORE ANY LISTS AT LOWER LEVELS.
	PUSHJ	P,1UOBJ		; GET THE FIRST OBJECT
	SKIPA	
	JRST	1ULOSE		; AN INITTED LOCAL LIST CANNOT BE NULL.
	MOVE	B,A
	MOVE	A,R
	MOVEI	R,U%LOCL
	CAIN	B,U%ATOM	;IF THIS IS AN ATOM,
	 PUSHJ	P,1UNAM2	; DEFINE IT

UDFL2A:	PUSHJ	P,1UOBJ		;SKIP THE REST OF THE LIST.
	JRST	UDFL2A

UDFL9:	POP	P,UPLIST	;POP THE HANDLER SPEC
	CAIE	A,U%LCLS	;IF THIS ISN'T THE END OF A LIST
	 JRST	1ULOSE		;  COMPLAIN
	MOVEI	A,U%LIST	;TELL IT WE HAD LA LIST, AND
	POPJ	P,		;RETURN TO NEXT HIGHER LEVEL.


;----------------------------------------------------------------
;		DISPATCH TABLE FOR TOKEN LOOKUP
;----------------------------------------------------------------

1UTBL:

REPEAT 3.,	JRST	1UOBJ	; ^@ - ^B
		PUSHJ	P,1MORE	; ^C
repeat 6.,	JRST	1UOBJ	; ^D THRU ^I
		JRST	1ULF	; LINE FEED
		JRST	1UOBJ	; ^K
		JRST	1UFF	; FORM FEED
		JRST	1UCR	; CARRIAGE RETURN
REPEAT 18.,	JRST	1UOBJ	;IGNORE CTRL-CHARS. THRU ^_.
		JRST	1UOBJ	;IGNORE SPACES
		JRST	1UEXCL	;EXCLAMATION POINT
		JRST	1USTR	; "
REPEAT 5,	JRST	1UATOM	; # TO '
		JRST	1ULIST	; )
		JRST	1ULCLS	; (
REPEAT 2,	JRST	1UATOM	; * AND +
		JRST	1UCOMA	; ,
		JRST	1UATOM	; -
		JRST	1UDOT	; .
REPEAT 12.,	JRST	1UATOM	; / THRU :
		JRST	1USEMI	; SEMICOLON
		JRST	1UFORM	; <
		JRST	1UATOM	; =
		JRST	1UFCLS	; >
REPEAT 28.,	JRST	1UATOM	; ?, @, AND A-Z (UPPER CASE)
		JRST	1UVECT	; 
		JRST	1UBKSL	; \
		JRST	1UVCLS	; 
REPEAT 29.,	JRST	1UATOM	; ^, _, AND a-z (LOWER CASE)
		JRST	1UBKT	; 
		JRST	1UATOM	; |
		JRST	1UCBKT	; 
		JRST	1UATOM	; ~
		JRST	1UOBJ	; RUBOUT
IFN .-1UTBL-200,	.ERR 1UTBL IS THE WRONG SIZE.

;----------------------------------------------------------------
;		DISPATCH TABLE FOR END-OF-ATOM HUNT.
;----------------------------------------------------------------

	
1UTBL2:
REPEAT 3.,	JRST	1UATM3
		PUSHJ	P,1MORE	; ^C
REPEAT 29.,	JRST	1UATM3	; END OF ATOM
		JRST	1UATM2	; !
		JRST	1UATM3	; "
REPEAT 4,	JRST	1UATM2	; STILL IN THE ATOM
REPEAT 3,	JRST	1UATM3	; OUT
REPEAT 2,	JRST	1UATM2
		JRST	1UATM3	; ,
REPEAT 14.,	JRST	1UATM2	; - THRU :
REPEAT 2,	JRST	1UATM3	; ; AND <
		JRST	1UATM2	; =
		JRST	1UATM3	; >
REPEAT 28.,	JRST	1UATM2	; ?, @, AND A-Z (UPPER CASE)
		JRST	1UATM3	; 
		JRST	1UATM4	; \
		JRST	1UATM3	; 
REPEAT 29.,	JRST	1UATM2	; ^, _, AND a-z (LOWER CASE)
		JRST	1UATM3	; 
		JRST	1UATM2	; |
		JRST	1UATM3	; 
		JRST	1UATM2	; ~
		JRST	1UATM3	; RUBOUT


IFN .-1UTBL2-200,	.ERR 1UTBL2 IS THE WRONG SIZE.


SUBTTL		PASS 1 MUDDLE EXIT ROUTINE VECTOR FOR PARSING
;------------------------------------------------
;	   DISPATCH TABLE FOR PARSE
;		EXIT ROUTINES
;
;	-These are used for special-purpose
;	processing of MUDDLE objects, such
;	as the use of a list for specifying
;	the local variables in a function.
;
;	-The exit routine receives control
;	as soon as an object is recognized,
;	and before anything else occurs. It
;	may perform any processing it sees
;	fit, and then returns to the main
;	object parser to either snarf the
;	rest of the object, or to verify
;	that we have hit its end.
;
;------------------------------------------------

PTHI==. ? .==PTLO	;THIS TABLE IS IMPURE

UPFRM:	JFCL		;FORM
UPATOM:	JFCL		;ATOM
UPLIST:	JFCL		;LIST
UPBRKT:	JFCL		;BRACKETED THING
UPVECT:	JFCL		;VECTOR
UPUVEC:	JFCL		;UVECTOR
UPSEG:	JFCL		;SEGMENT

PTLO==. ? .==PTHI	;BACK TO PURE CODE.

SUBTTL		PASS 1 MUDDLE SPECIAL ATOM HANDLERS
;-----------------------------------------------------------
;		PROGRAMS FOR SPECIAL ATOMS
;-----------------------------------------------------------

1UDFN:	MOVEI	R,U%FUNC	;DEFINE
	PUSHJ	P,1UNAME	;GO NAME THE FUNCTION.
	PUSHJ	P,1ULOCL	;GO READ LIST OF LOCALIZED ATOMS
	POPJ	P,		;AND RETURN TO REGULAR FORM HANDLER.


1UDFM:	MOVEI	R,U%MACR	;DEFMAC
	JRST	1UNAME

1UFCN:	PUSHJ	P,1ULOCL	;<FUNCTION ...> -- READ LOCAL VARIABLE LIST
	POPJ	P,		;AND RETURN TO THE REGULAR FORM HANDLER

1UPCKG:	MOVEI	R,U%PCKG	;PACKAGE
	JRST	1UNAME

1USETG:	MOVEI	R,U%GLBL	;SETG
	JRST	1UNAME

1UNTYP:	MOVEI	R,U%TYPE	;NEWTYPE
	JRST	1UNAME

1UTFCN:	PUSH	P,UPLIST	; #FUNCTION HANDLER
	MOVE	A,[JRST 1UTFN2]
	MOVEM	A,UPLIST
	PUSHJ	P,1UOBJ		;GET THE BODY OF THE FUNCTION
	CAIE	A,U%LIST	;MUST BE A LIST
	 JRST	1ULOSE		;AND NOT AN UNBALANCED CLOSE BKT

	POP	P,UPLIST	;GET BACK LIST EXIT ROUTINE
	POPJ	P,


1UTFN2:	PUSHJ	P,1ULOCL	;READ LOCAL VARIABLE LIST
	MOVE	A,[JFCL]
	MOVEM	A,UPLIST
	JRST	1ULST2		;GO READ REST OF THE LIST.



SUBTTL		MUDDLE OBJECT-ARRAY AND SEARCH ROUTINES
;-----------------------------------------------------------
;	MUDDLE SYMBOL-DEFINITION ROUTINE
;-----------------------------------------------------------

1UNAME:	PUSH	P,R		;SAVE TYPE TO STOW IN ATOM'S SYMTBL SLOT
	PUSHJ	P,1UOBJ		;GET NEXT ITEM
	 SKIPA
	JRST	1UNM1		;POP R AND GO CONTINUE SCAN (1UFRM2)
	CAIE	A,U%ATOM	;IS IT AN ATOM?
	 JRST	1UNM2		;NO, CAN'T DEFINE
	MOVE	A,R		;AOBJN POINTER TO THE SYMBOL.
	POP	P,R
1UNAM2:	JSP	H,LDEFSYM	;JUST AS THE LISP (PG.101, LINE 011)
	HRRM	R,S.TYPE(L)	;PUT TYPE IN
	MOVEM	N,S.PAGE(L)	;PUT IN POINT IT WAS DEFINED.
	POPJ	P,		; RETURN TO PASING THE MAIN FORM.


1UNM1:	POP	P,R		; BAIL OUT, AFTER CLEAING STACK
	JRST	1ULOSE		; AND COMPLAIN ABOUT BAD SYNTAX.


1UNM2:	POP	P,R		; PUNT THIS FORM.
	POPJ	P,


;------------------------------------------------
;	MACROS FOR DEFINING UATOMS
;------------------------------------------------

IF1 [	;ON PASS 1, JUST LEAVE ROOM IN TABLE FOR THE ATOM
	DEFINE UATOM	JUNK/
	BLOCK 3
TERMIN
	]	;END IF1

IF2 [	; ON PASS 2 ASSEMBLE THE ATOM HEADERS IN-LINE, AND
	; PNAMES AT "UPNAME", USING ATMPTR AS AN OFFSET.

	DEFINE	UATOM	NAME=DEFINE,1L=1USUBR,2L=2USUBR,1K=1VSUBR,2K=2VSUBR
	ATMPTR		;PNAME POINTER
	1L,,2L		;HANDLERS  FOR <atom ...> 	PASS1,,PASS2
	1K,,2K		;HANDLERS FOR #atom ...   	PASS1,,PASS2
ZZ==.
.==ATMPTR	;MOVE INTO PNAME TABLE
	ASCIZ /NAME/
ATMPTR==.
.==ZZ			;RETURN TO MAINLINE.
	TERMIN

ATMPTR==UPNAME		;INITIALIZE THE ATOM NAME POINTER
	]		;END OF IF2.

.XCREF	UATOM

1USUBR:2USUBR:1VSUBR:2VSUBR:	STRT	[ASCIZ/ Invalid use of a special atom.
/]
				JRST	1ULOSE




;-----------------------------------------------------------
;		ATOM TABLE FOR MUDDLE DEFINITIONS
;		 (MUST BE IN ALPHABETICAL ORDER)
;-----------------------------------------------------------

UBARRAY:
	UATOM	,1UDFN		;DEFINE
	UATOM	DEFMAC,1UDFM
	UATOM	FUNCTION,1UFCN,,1UTFCN
	UATOM	NEWTYPE,1UNTYP
	UATOM	PACKAGE,1UPCKG
	UATOM	PROG,1UFCN
	UATOM	REPEAT,1UFCN
	UATOM	SETG,1USETG

;-----------------------------------------------------------
;		FILL TABLE OUT TO POWER-OF-2 LENGTH
;-----------------------------------------------------------

MUBARRAY==:<.-UBARRAY>/3

RADIX 2.
LOG2MUB==:CONC .LENGTH /,\MUBARRAY-1,/
RADIX 8.

REPEAT <1_LOG2MUB>-MUBARRAY,[
	[377777777777]
	1LSUBR,,2LSUBR
	1KSUBR,,2KSUBR
]		;END OF REPEAT <1_LOG2MUB>-MUBARRAY

UPNAME:	BLOCK 2*MUBARRAY
	;LEAVE SPACE FOR PNAMES.  ON P2, ATOM NAME ASSEMBLES INTO THIS SPACE.



;------------------------------------------------
;	MUDDLE SPECIAL-ATOM LOOKUP ROUTINE
;	TAKES AN AOBJN POINTER TO THE ATOM
;	NAME (IN SYLBUF) IN R. SKIPS IF THE
;	ATOM IS FOUND, WITH OFFSET INTO
;	UBARRAY IN C. IF NOT FOUND, NO SKIP.
;------------------------------------------------

UBLOOK:	MOVE	A,R
	HLRZ R,A	;ROUTINE TO FIND SPECIAL ATOMS
	CAIGE R,-2	;IF NONE ARE FOUND, DOESN'T SKIP.
	 JRST (H)	;IF ARE FOUND, OFFSET FROM UBARRAY IS LEFT
	MOVE L,(A)	;IN C AND IT SKIPS.
	CAIE R,-1
	 SKIPA R,1(A)
	  SETZ R,
	SETZ C,
REPEAT LOG2MUB,[
	HRRZ D,UBARRAY+<3_<LOG2MUB-.RPCNT-1>>(C)
	CAME L,(D)
	 JRST .+4
	CAML R,1(D)
	 JRST .+3
	JRST .+3
	CAML L,(D)
	 ADDI C,3_<LOG2MUB-.RPCNT-1>
]		;END OF REPEAT LOG2MUB
	HRRZ D,UBARRAY(C)
	CAMN L,(D)
	 CAME R,1(D)
	  JRST (H)
	JRST 1(H)	;THIS ENDS UBLOOK.



SUBTTL	PASS 2 PROCESSING FOR MUDDLE CODE

2MUDDL:	MOVEM	P,LISPP	;SAVE STACK PTR FOR RETURNS TO TOP-LEVEL IN PARSE

2ULOOP:	SETZM	MDLCMT		;GET OUT OF COMMENT MODE.
	TLNE	F,FLFNT3	;REVERT TO "MAIN TEXT" FONT, IF NEED BE.
	TRNE	F,FRFNT3
	 JRST	2ULUP2
	2PATCH	177		;XGP ESCAPE
	2PATCH	1		;"FONT SELECT"
	2PATCH	1		; FONT 2
2ULUP2:	MOVE	P,LISPP		;RETURN-TO-TOP-LEVEL BRANCH TARGET
	PUSHJ	P,2UOBJ		;PROCESS THE NEXT MUDDLE OBJECT
	JRST	2ULUP2		;AND CONTINUE UNTIL END OF FILE.

2ULOSE:	JRST	2ULOOP		;FORCE HIM BACK TO TOP LEVEL. NO MESSAGE 2ND PASS.


;--------------------------------------------------------
;          MUDDLE OBJECT PARSER
;--------------------------------------------------------

2UOBJ:	TRZE	F,FRSQZ		;IF THE READ-AHEAD FLAG IS SET, THEN
	JRST	2UOBJ1		;DON'T BOTHER READING A CHARACTER (RESETS THE FLAG, TOO)
	2GETCH
2UOBJ1:	XCT	2UTBL(CH)	; PERFORM CHARACTER-DEPENDENT ACTIONS.
	POPJ	P,		; RETURN TO A HIGHER LEVEL



;--------------------------------------------------------
;		PARSE A FORM
;--------------------------------------------------------


2UFORM:	PUSHJ	P,2UOBJ		;READ EVERY OBJECT IN THE FORM
	JRST	2UFORM
	CAIE	A,U%FCLS	;MAKE SURE WE ENDED WITH A >
	  JRST	2ULOSE
	MOVEI	A,U%FORM
	POPJ	P,



;--------------------------------------------------------
;		PARSE AN ATOM
;
;	RETURNS:
;		A/ U%ATOM (TYPE)
;		B/ # OF CHARS IN THE PNAME
;		SYLBUF et seq/ PNAME (IN ASCII)
;
;--------------------------------------------------------

2UBKSL:	MOVE	CP,[440700,,SYLBUF]	;"\"-QUOTED CHARS ALSO START ATOMS.
	XCT	UPATOM			; PERFORM PARSING EXIT ROUTINE
2UATM4:	2GETCH
	JRST	2UATM2		; SKIP ATOM-INIT CODE


2UATOM:	MOVE	CP,[440700,,SYLBUF]	;BYTE PTR TO ATOM BUFFER
	XCT	UPATOM			;PERFORM PARSING EXIT ROUTINE

2UATM2:	IDPB	CH,CP			;STORE AWAY THE 1ST CHAR
2UATM1:	2GETCH				;GRAB THE NEXT CHARACTER
	XCT	2UTBL2(CH)		;DISPATCH ON NEW CHAR
2UATM3:	TRO	F,FRSQZ			;SET READ-AHEAD FLAG FOR 2UOBJ MAIN LOOP.
	MOVEI	B,0			;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES
	SETZ	H,			;EXCESS CHARACTER COUNTER
2UATM5:	IDPB	B,CP
	TLNE	CP,760000		;ARE WE AT THE END OF A WORD?
	 AOJA	H,2UATM5		;  NO. KEEP CLEARING, AND COUNT CLEARED CHARS

	MOVNI	R,(CP)
	HRLI	R,SYLBUF-1(R)
	HRRI	R,SYLBUF
	MOVEI	B,(CP)			;ADDRESS OF LAST WORD IN PNAME
	SUBI	B,SYLBUF-1		; LESS START, GIVING LENGTH OF PNAME IN WORDS
	IMUL	B,CHS%WD		; TIMES CHARS/WORD GIVES CHAR COUNT
	SUBI	B,(H)			; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME

	MOVE	A,R
	JSP	H,@LOOKIT		;LOOK UP THE SYMBOL
	POPJ	P,			;NOT SEEN ON 1ST PASS (IGNORE IT)
	JSP	H,REFSYM		;SEEN -- PUT IN A CREF ENTRY
	POPJ	P,


;------------------------------------------------
;		PARSE A LIST
;------------------------------------------------

2ULIST:	PUSHJ	P,2UOBJ		;READ ALL THE OBJECTS IN THE LIST
	JRST	2ULIST		;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET
	CAIE	A,U%LCLS	;IF IT WASN'T A ")",
	 JRST	2ULOSE		;--COMPLAIN AND RETURN TO TOP LEVEL
	MOVEI	A,U%LIST	;DATA TYPE
	POPJ	P,


;------------------------------------------------
;		PARSE A "{"-OBJECT
;------------------------------------------------

2UBKT:	PUSHJ	P,2UOBJ		;SCAN ALL THE OBJECTS IN THE WHATEVER
	JRST	2UBKT		;UNTIL WE HIT THE END
	CAIE	A,U%CBKT	;IF IT ISN'T A CLOSE BRACKET("]")
	 JRST	2ULOSE		;COMPLAIN HORRIBLY
	MOVEI	A,U%BKT		;TYPE
	POPJ	P,		;RETURN TO HIGHER LEVEL.


;------------------------------------------------
;		PARSE A VECTOR
;------------------------------------------------

2UVECT:	PUSHJ	P,2UOBJ		;READ EVERY OBJECT IN THE VECTOR
	JRST	2UVECT
	CAIE	A,U%VCLS	;IF NOT A CLOSE BRACKET "]",
	 JRST	2ULOSE		;PUNT
	MOVEI	A,U%VECT
	POPJ	P,


;------------------------------------------------
;		PARSE A UVECTOR
;------------------------------------------------

2UUVCT:	PUSHJ	P,2UOBJ
	JRST	2UUVCT
	CAIN	A,U%VCLS	;CAN BE CLOSED BY "]"
	 JRST	2UUV1
	CAIE	A,U%UCLS	;OR BY A "!]".
	 JRST	2ULOSE
2UUV1:	MOVEI	A,U%UVCT
	POPJ	P,


;------------------------------------------------
;		PARSE A SEGMENT
;------------------------------------------------

2USEG:	PUSHJ	P,2UOBJ
	JRST	2USEG
	CAIN	A,U%FCLS	;CAN BE ENDED BY JUST A ">",
	 JRST	2USEG1
	CAIE	A,U%SCLS	;OR BY A "!>"
	 JRST	2ULOSE
2USEG1:	MOVEI	A,U%SEG
	POPJ	P,


;------------------------------------------------
;		QUOTED-OBJECT HANDLER
;------------------------------------------------

2UQUOT:	PUSHJ	P,2UOBJ		;SKIP PRECISELY 1 OBJECT
	SKIPA
	 JRST	2ULOSE		;COMPLAINING IF IT'S NOT THERE
	MOVEI	A,U%QUOT
	POPJ	P,


;------------------------------------------------
;		HANDLE A #TYPE...
;------------------------------------------------

2UTYPE:	PUSHJ	P,2UOBJ		;GRAB AN ATOM
	CAIE	A,U%ATOM	;(IF NOT AN ATOM,
	 JRST	2ULOSE		;  COMPLAIN ABOUT IT)
	MOVE	A,R		;GET AOBJN PTR TO THE ATOM
	JSP	H,@LOOKIT	;IF IT WAS NOT SEEN ON PASS 1,
	 SKIPA			;  IGNORE IT. ELSE
	JSP	H,REFSYM	;MAKE A CREF ENTRY FOR IT.
	PUSHJ	P,2UOBJ		;GET THE NEXT OBJECT (THE REAL GUTS)
	SKIPA
	 JRST	2ULOSE
	MOVEI	A,U%TYPE
	POPJ	P,


;------------------------------------------------
;		EXCL (!) HANDLER
;------------------------------------------------

2UEXCL:	2GETCH		; GET THE NEXT CHARACTER
	CAIN	CH," 	; IF IT'S A BLANK, KEEP LOOKING.
	 JRST	2UEXCL

	CAIN	CH,"<	;HANDLE
	 JRST	2USEG	;SEGMENT-EVALUATION

	CAIN	CH,"[	;UVECTORS
	 JRST	2UUVCT

	CAIN	CH,"\	;CHARACTER DATA
	 JRST	2UCHAR

	CAIN	CH,">	;END OF A SEGMENT
	 JRST	2USCLS

	CAIN	CH,"]	;END OF A UVECTOR
	 JRST	2UUCLS

	CAIE	CH,""	;ALSO CHARACTER
	 JRST	2ULOSE	;(DIDN'T FIND ANYTHING)

	DROPTHRUTO 2UCHAR	;THIS IS A CONSISTENCY CHECK, NOT A COMMENT.


;------------------------------------------------
;		CHARACTER DATA-TYPE HANDLER
;------------------------------------------------

2UCHAR:	2GETCH			;IGNORE THAT CHARACTER
	MOVEI	A,U%CHAR	;SAY IT WAS A CHARACTER
	POPJ	P,


;------------------------------------------------
;		STRING PARSER
;------------------------------------------------

2USTR1:	2GETCH	; FOR READING "\"-QUOTED CHARACTERS

2USTR:	2GETCH		;(ENTRY PT) GET NEXT CHAR IN STRING
	CAIN	CH,"\	;MUDDLE QUOTE CHARACTER?
	 JRST	2USTR1	;YES. IGNORE THE NEXT CHAR
	CAIE	CH,""	;END OF THE STRING?
	 JRST	2USTR	;NO -- KEEP READING
	MOVEI	A,U%STR
	POPJ	P,


;------------------------------------------------
;		COMMENT HANDLER
;------------------------------------------------

2USEMI:	PUSH	P,MDLCMT	;PUSH THE STATE OF THE "COMMENT" FLAG
	SETOM	MDLCMT		;WE'RE INSIDE A COMMENT NOW, FOR SURE.
	SETOM	2MCCOL
	TLNE	F,FLFNT3
	TRNE	F,FRFNT3
	 JRST	2USMI2
	2PATCH	177
	2PATCH	1
	2PATCH	2
2USMI2:	PUSHJ	P,2UOBJ		;IGNORE THE NEXT OBJECT.
	SKIPA
	JRST	2ULOSE	;BAD BUSINESS IF IT'S NOT BALANCED.
	POP	P,MDLCMT	;GET BACK OLD COMMENT SWITCH.
	SKIPE	MDLCMT		;IF WE'RE OUT OF THE OUTERMOST COMMENT,
	 POPJ	P,
	TLNN	F,FLFNT2	;(AND WE'RE USING MULTIPLE FONTS)
	 POPJ	P,
	2PATCH	177		;SWITCH BACK TO THE TEXT FONT
	2PATCH	1
	2PATCH	2
	POPJ	P,



;------------------------------------------------
;		GVAL HANDLER
;------------------------------------------------

2UCOMA:	PUSHJ	P,2UOBJ	;SKIP THE NEXT OBJECT
	POPJ	P,
	JRST	2ULOSE


;------------------------------------------------
;		LVAL HANDLER
;------------------------------------------------

2UDOT:	PUSHJ	P,2UOBJ		;SKIP THE NEXT OBJECT.
	POPJ	P,
	JRST	2ULOSE



;------------------------------------------------
;
;	VARIOUS CLOSING BRACKET HANDLERS
;
;	THESE ALL SKIP-RETURN TO INDICATE 
;	THAT THEY ARE CLOSING-BRACKETS OF
;	VARIOUS KINDS.
;
;------------------------------------------------

2ULCLS:	MOVEI	A,U%LCLS	;  )
	AOS	(P)
	POPJ	P,

2UFCLS:	MOVEI	A,U%FCLS	; >
	AOS	(P)
	POPJ	P,

2UVCLS:	MOVEI	A,U%VCLS	; ]
	AOS	(P)
	POPJ	P,

2USCLS:	MOVEI	A,U%SCLS	; !>
	AOS	(P)
	POPJ	P,

2UUCLS:	MOVEI	A,U%UCLS	; !]
	AOS	(P)
	POPJ	P,

2UCBKT:	MOVEI	A,U%CBKT	; }
	AOS	(P)
	POPJ	P,




;------------------------------------------------
;	DISPATCH TABLE FOR TKOEN LOOKUP
;------------------------------------------------


2UTBL:

REPEAT 3.,	JRST	2UOBJ	; ^@ - ^B
		JRST	2UOBJ
repeat 6.,	JRST	2UOBJ	; ^D THRU ^I
		JRST	2UOBJ
		JRST	2UOBJ	; ^K
		JRST	2UOBJ
		JRST	2UOBJ
REPEAT 18.,	JRST	2UOBJ	;IGNORE CTRL-CHARS. THRU ^_.
		JRST	2UOBJ	;IGNORE SPACES
		JRST	2UEXCL	;EXCLAMATION POINT
		JRST	2USTR	; "
REPEAT 5,	JRST	2UATOM	; # TO '
		JRST	2ULIST	; )
		JRST	2ULCLS	; (
REPEAT 2,	JRST	2UATOM	; * AND +
		JRST	2UCOMA	; ,
		JRST	2UATOM	; -
		JRST	2UDOT	; .
REPEAT 12.,	JRST	2UATOM	; / THRU :
		JRST	2USEMI	; SEMICOLON
		JRST	2UFORM	; <
		JRST	2UATOM	; =
		JRST	2UFCLS	; >
REPEAT 28.,	JRST	2UATOM	; ?, @, AND A-Z (UPPER CASE)
		JRST	2UVECT	; 
		JRST	2UBKSL	; \
		JRST	2UVCLS	; 
REPEAT 29.,	JRST	2UATOM	; ^, _, AND a-z (LOWER CASE)
		JRST	2UBKT	; 
		JRST	2UATOM	; |
		JRST	2UCBKT	; 
		JRST	2UATOM	; ~
		JRST	2UOBJ	; RUBOUT
IFN .-2UTBL-200,	.ERR 2UTBL IS THE WRONG SIZE.

;----------------------------------------------------------------
;		DISPATCH TABLE FOR END-OF-ATOM HUNT.
;----------------------------------------------------------------

	
2UTBL2:
REPEAT 3.,	JRST	2UATM3
		JRST	2UATM3
REPEAT 29.,	JRST	2UATM3	; END OF ATOM
		JRST	2UATM2	; !
		JRST	2UATM3	; "
REPEAT 4,	JRST	2UATM2	; STILL IN THE ATOM
REPEAT 3,	JRST	2UATM3	; OUT
REPEAT 2,	JRST	2UATM2
		JRST	2UATM3	; ,
REPEAT 14.,	JRST	2UATM2	; - THRU :
REPEAT 2,	JRST	2UATM3	; ; AND <
		JRST	2UATM2	; =
		JRST	2UATM3	; >
REPEAT 28.,	JRST	2UATM2	; ?, @, AND A-Z (UPPER CASE)
		JRST	2UATM3	; 
		JRST	2UATM4	; \
		JRST	2UATM3	; 
REPEAT 29.,	JRST	2UATM2	; ^, _, AND a-z (LOWER CASE)
		JRST	2UATM3	; 
		JRST	2UATM2	; |
		JRST	2UATM3	; 
		JRST	2UATM2	; ~
		JRST	2UATM3	; RUBOUT


IFN .-2UTBL2-200,	.ERR 2UTBL2 IS THE WRONG SIZE.

