Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/sr.mac
There are 2 other files named sr.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


AUTHOR:		CLAES WIHLBORG
VERSION:	3A [7,40,144]
PURPOSE:	SYNTAX RECOGNITION
CONTENTS:
		A COLLECTION OF BOOLEAN AND PROPER PROCEDURES
		WHICH PARSES A SIMULA-67 PROGRAM


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




	SALL
	SEARCH	SIMMC1,SIMMAC
	CTITLE	SR (SYNTAX RECOGNITION)
	SUBTTL	PROLOGUE
	MACINIT
	TWOSEG
	RELOC	400K

	ENTRY	SRPROG

	EXTERN	LS,O1IC1,O1XR
	EXTERN	YSRFIX,YLSVAL,YSWITC
	EXTERN	SDPEND,SDZQU,SDBEG,SDEND,SDSPEC,SDESPE
	EXTERN	SDABEG,SDAEND
	EXTERN	SDHID	;[40]
	EXTERN	SDEXT,SDPPN
	EXTERN	SMERR,SMLINE,SMLIND,SMUID
	EXTERN	YSRDEV,YSREN,YSRIN,YSRPPN
	EXTERN	YSWCHA
	EXTERN	YSFD,YSFDN,YSFDP,YSFDPPN,YSFDSW,YSFD1,QSFDN	;[144]
	EXTERN	YELIN2
	SUBTTL	MACRO DEFINITIONS

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

The recognition routines are written in a high level macro language.
Both operators and operands are macro calls. The mapping of the operators
on the machine code is highly dependent of which operands that are involved
eg. LOAD REG1 STACK  will be generated as a pop instruction. There are
a few operators which have parameters, but most common is that an operator
defines a macro X(A,B) and that the operands are calling the macro X with
two arguments. Then the first argument is the type of the operand and the
second is its value.

OPERAND TYPES
=============

Constants:	Common to all constants is the fact that they start with
		the letter $. All constants defined in the SYMBOL macro
		are available and some others too.

Accumulators:	A few ac's have been defined and named REG1, REG2 etc.
		Two ac's have special usage: CURRENT holds current symbol
		and NEXT holds the look-ahead symbol.

STACK:		The normal push-down list. When used in a relation
		it is accessed as 0(XPDP), otherwise it is pushed or
		popped depending on the operator and operand position.

Fixup:		Held in memory location YMAXFX.
		Incremented automatically after each reference.

Value:		Of CURRENT or NEXT.

Switches:	In the usage of switches, there is no need to know whether
		or not the switch is located in an accumulator or in memory.

Procedures:	The set of recognition procedures.


OPERATORS
=========

NAME	OPERAND	ACTION

PROCEDURE 1	Define start of recognition routine.

EPROC	0	Define end of a recognition routine. Contains the return
		jump, defines the two labels TEXIT and FEXIT. If the routine
		contains a jump to FEXIT it is considered boolean
		and a true exit will create a skip return.

SAVE	Var	Save the named accumulators.

LOAD	2	Move the 2:nd operand to the 1:st.

ADD	2	Add the 2:nd operand to the 1:st.

ERROR	4	Has arguments and not operands. The 1:st is the relative
		error number, the 2:nd tells special actions to be taken,
		the 3:rd is symbol to be edited into error message and the
		4:th is the message text. the different special actions are:

		  A	Edit 3:rd argument into message
		  C	Edit current symbol into message.
		  E	Output %ERROR symbol to IC1.
		  G	Stop code generation.
		  P	Output %PURGE symbol to IC1.
		  S	Stop pass 2 processing.
		  T	Termination error.
		  W	Warning only.

FIND	1	Find syntax construct by calling recognition routine.

INCR	1	Add 1 to operand (ac only).

IC	Var	Output operands to file IC1.

XRF	0	Output CURRENT to file XRF.

RECOVER	Var	Skip input stream until one of the given symbols or one
		of the symbols $SEMIC $END $BEGIN $EOF is found.

LINE	0	Output line symbol

LINED	0	Output line symbol preceding declaration.

SCAN	0	Advance input stream 1 step.

DSCAN	0	Advance input stream 2 steps.

SET	Var	Seton named switches.

RESET	Var	Setoff named switches.

AND	1
OR	1	Used when evaluating predicates

LSS	1
EQL	1
LEQ	1
GEQ	1
NEQ	1
GRT	1
ONEOF	Var
NONEOF	Var	Relations, used in predicates.

NOT	0	Reverse a predicate.

IF	1
WHILE	1
AS	1
GOIF	1	These have been redefined from the SIMMAC definition.


PREDICATE EVALUATION
====================

The macros defined in SIMMAC for structuring program flow have been
extended here to perform automatic evaluation of the predicate. 
A predicate primary can be:
	a switch
	a boolean recognition procedure
	a relation
	or a predicate primary preceded by NOT.
A predicate is a predicate primary or a predicate followed by OR or AND
and a predicate primary. It is evaluated strictly from left to right
and the operators have no precedences over each other. When the value
of a predicate is known, no more is evaluated.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	IF1,<

DEFINE	PROCEDURE<
	%FPROC=0
	%TEXIT=$$L
	%FEXIT=$$L+1
	$$L=$$L+2
	%FFLA=0
>

DEFINE EPROC<
	IFG AQSIZE,<$$E(<QUEUE A NOT EMPTY>)>
	IFG $$BSP,<$$E(<BLOCK STACK NOT EMPTY>)>
$$C(L,\%TEXIT):	$$$P2(L,\%TEXIT)
IFG %FFLA,<AOS -BSSIZE(XPDP)
$$C(L,\%FEXIT):	$$$P2(L,\%FEXIT)
>
	REPEAT BSSIZE,<
		POP XPDP,BTOP
		BPOP>
	RETURN
>



DEFINE ERROR(A1,A2,A3,A4)<
	ERRORX=XWD A3+0,A1+Q1SR.E
	IFNB <A2>,<
	IRPC A2,<
		IFIDN <A2><A>,<ERRORX=ERRORX+1B<QSREA>>
		IFIDN <A2><C>,<ERRORX=ERRORX+1B<QSREC>>
		IFIDN <A2><E>,<ERRORX=ERRORX+1B<QSREE>>
		IFIDN <A2><G>,<ERRORX=ERRORX+1B<QSREG>>
		IFIDN <A2><P>,<ERRORX=ERRORX+1B<QSREP>>
		IFIDN <A2><S>,<ERRORX=ERRORX+1B<QSRES>>
		IFIDN <A2><T>,<ERRORX=ERRORX-Q1SR.E+Q1SR.T+1B<QSRET>>
		IFIDN <A2><W>,<ERRORX=ERRORX-Q1SR.E+Q1SR.W+1B<QSREW>>
	>
	>
;IFN QDEBUG,<PUSH XPDP,[[ASCIZ/A4/]]>
	PUSH XPDP,[ERRORX]
	EXEC SMERR
;IFN QDEBUG,<SUB XPDP,[XWD 1,1 ]>
	SUB  XPDP,[XWD 1,1]
>

DEFINE ADD<
DEFINE	X(X1,X2)<
DEFINE	X(Y1,Y2)<
	IFE Y1-%FCON,<ADDI X2,Y2>
>>
>

DEFINE	TEXIT<$$C(L,\%TEXIT)>

DEFINE FEXIT<$$C(L,\%FEXIT)
	%FFLA=1>
DEFINE FIND<
	%FPROC=1
>

DEFINE INCR<
DEFINE X(X1,X2)<
IFE X1-%REG,<ADDI X2,1>
>
>

DEFINE IC(D)<
DEFINE X(A,B)<
	IFE A-%REG,<PUTIC1 B>
	IFN A-%REG,<
		LOAD REG0 X(A,B)
		PUTIC1	X1SR0
		IC
	>
>
D
>

DEFINE	XRF<
	IFONA	YSWC
	EXEC	O1XR
>

DEFINE LOAD<
DEFINE X(X1,X2)<
DEFINE X(Y1,Y2)<
	IFE X1-%REG,<
		IFE Y1-%REG,<L X2,Y2>
		IFE Y1-%STACK,<POP XPDP,X2>
		IFE Y1-%FCON,<LI X2,Y2>
		IFE Y1-%FFIX,<L X2,YSRFIX
			IFE Y2-1,<AOS YSRFIX>
			IFG Y2-1,<LI Y2(X2)
				ST YSRFIX>
		>>
	IFE X1-%STACK,<
		IFE Y1-%REG,<PUSH XPDP,Y2>
		IFE Y1-%FCON,<PUSH XPDP,[Y2]>
		>
>>
>
DEFINE	RECOVER(A)<
		%%=0
	IFB <A>,<EXEC SRREC1
		%%=1>
	IFIDN<A><$ELSE $OTHER $WHEN>,<EXEC SRREC2
		%%=1>
	IFIDN<A><$DO $ELSE $OTHER $WHEN>,<EXEC SRREC3
		%%=1>
	IFE %%,<WHILE CURRENT NONEOF $SEMIC $END A $BEGIN $EOF DO SCAN OD>
>

DEFINE  LINE<
	EXEC SMLINE
>


DEFINE	LINED<
	EXEC	SMLIND
>


DEFINE	SAVE(D)<
DEFINE	X(A,B)<
	PUSH XPDP,B
	BPUSH B
>
D
>

DEFINE SCAN<
	EXEC LS
>

DEFINE DSCAN<
	SCAN
	SCAN
>

DEFINE STACK<
	X	%STACK,0
>
DEFINE HVAL<%%VAL(1)>
DEFINE  VAL<%%VAL(2)>
DEFINE DVAL<%%VAL(4)>

DEFINE	%%VAL(A)<
	IFG A-1,<HLR X1SR0,YLSVAL
	PUTIC1 X1SR0>
	HRR X1SR0,YLSVAL
	PUTIC1 X1SR0
	IFE A-4,<HLR X1SR0,YLSVAL+1
	PUTIC1 X1SR0
	HRR X1SR0,YLSVAL+1
	PUTIC1 X1SR0>
>
DEFINE	AND<
	%TCOND
	GOTO FALSE
$$C(L,\$$LT):	$$$P2(L,\$$LT)
	$$LT=$$L
	$$L=$$L+1
>

DEFINE  OR<
	%FCOND
	GOTO TRUE
$$C(L,\$$LF):	$$$P2(L,\$$LF)
	$$LF=$$L
	$$L=$$L+1
>

DEFINE $$$THEN<
	%TCOND
	GOTO FALSE
>

DEFINE $$$DO<
	%TCOND
	GOTO FALSE
>

DEFINE $$$SA<
	%FCOND
	GOTO TRUE
	$$$SYN	\%LAS,\$$LT
	$$$P2	L,\%LAS
>

DEFINE $$$TO<
	%FCOND
>

DEFINE $$$SYN(A,B)<
	SYN	L'A,L'B
>
DEFINE %TCOND<
	IFGE %FREL,<
		IFN %FNOT,<
			%FREL=<%FREL+4>&7
			%FNOT=0
		>
		AOUTQ X1,X2
		IFN %FREL&3,<%CIN(\<%FREL>)>
		IFE %FREL&3,<
			REPEAT AQSIZE-1,<
				%CIN(\<6>)
				IFE %FREL,<GOTO FALSE>
				IFN %FREL,<GOTO TRUE>
			>
			%CIN(\<<%FREL+6>&7>)
		>
	>
	IFE %FREL+1,<EXEC MPROC
		IFG %FNOT,<%FNOT=0
			GOTO TRUE
		>
	>
	IFE %FREL+2,<
		IFE %FNOT,<%SWOF>
		IFG %FNOT,<%FNOT=0
			%SWON
		>
	>
>


DEFINE %FCOND<
	IFGE %FREL,<
		IFN %FNOT,<
			%FREL=<%FREL+4>&7
			%FNOT=0
		>
		AOUTQ X1,X2
		IFN %FREL&3,<%CIN(\<<%FREL+4>&7>)>
		IFE %FREL&3,<
			REPEAT AQSIZE-1,<
				%CIN(\<6>)
				IFE %FREL,<GOTO FALSE>
				IFN %FREL,<GOTO TRUE>
			>
			%CIN(\<<%FREL+2>>)
		>
	>
	IFE %FREL+1,<EXEC MPROC
		IFE %FNOT,<GOTO FALSE>
		IFG %FNOT,<%FNOT=0>
	>
	IFE %FREL+2,<
		IFE %FNOT,<%SWON>
		IFG %FNOT,<%SWOF
			%FNOT=0
		>
	>
>
DEFINE  %CIN(A)<
	IFE X1-%REG,<%CIN1(\<A>,X2,AHEADL,AHEADR)>
	IFN X1-%REG,<$$E(NOT REG)>
	AOUTQ
>

DEFINE %CIN1(A,B,C,D)<
	IFE C-%REG,<%CIN2(0'A,<B,0(D)>)>
	IFE C-%FCON,<%CIN2(0'A,<B,D>)>
	IFE C-%STACK,<%CIN2(\<A+10>,<B,0(XPDP)>)>
>

DEFINE %CIN2(A,B)<
	OPDEF %CIN3 [XWD 3'A'000,0]
	%CIN3 B
>
DEFINE $$$IF<
	%FPROC=-1
	%FNOT=0
DEFINE X(A,B)<
	AINQ A,B
>>


DEFINE $$$AS<
	%LAS=$$LT
	$$LT=$$L
	$$L=$$L+1
	%FPROC=-1
	%FNOT=0
DEFINE X(A,B)<
	AINQ A,B
>>


DEFINE $$$WHILE<
	%FPROC=-1
	%FNOT=0
DEFINE X(A,B)<
	AINQ A,B
>>


DEFINE $$$GOIF<
	%FPROC=-1
	%FNOT=0
DEFINE X(A,B)<
	AINQ A,B
>>

;				FIXUP
;				-----

DEFINE	X(A,B)<
DEFINE	FIXUP'B<
	X	%FFIX,A
>>
	X	1,
	X	1,1
	X	2,2
	X	3,3
	X	4,4
	X	5,5
	X	6,6
;				REGISTERS
;				---------

DEFINE CURRENT<
	X	%REG,X1CUR
>

DEFINE NEXT<
	X	%REG,X1NXT
>

DEFINE X(A)<
DEFINE REG'A<
	X	%REG,X1SR'A
>>
	X	0
	X	1
	X	2
	X	3
;				PROCEDURES
;				----------

DEFINE X(A)<
DEFINE A<
	IFE %FPROC,<
		SR'A:
		>
	IFG %FPROC,<
		EXEC SR'A
		>
	IFL %FPROC,<
		%FREL=-1
		DEFINE MPROC<SR'A>
		>
>>
	X	PROG
	X	PRG
	X	PROC
	X	CLAS
	X	DECL
	X	TYPE
	X	FPAR
	X	SPEC
	X	VIRT
	X	ARY
	X	LST
	X	EXT
	X	BLK
	X	PBLK
	X	STAT
	X	ELST
	X	UNST
	X	SIST
	X	FLST
	X	LAB
	X	EXPR
	X	SEXP
	X	APAR
	X	MAIN
	X	EPRO
	X	ECLA
	X	ARYS
;				CONSTANTS
;				---------

DEFINE X(A,B,C,D)<
DEFINE $'A<
	X	%FCON,B
>>
	SYMB  3,0,X
	X	ID,2000
	X	REL,11
	X	BOP,23
	X	OP,30
	X	ZERO,0
	X	ONE,1
	X	TWO,2
	X	THREE,3
	X	MARK,777777
	X	CLLIM,SYMBL3
	X	CULIM,SYMBL4
	X	LDEF,SYMBL4
	X	HDEF,SYMBL5
	X	MAXIDX,12	;[7]  10 (DECIMAL) SUBSC. ALLOWED
	X	QACTIV,0
	X	QREACT,1
	X	QBEFOR,2
	X	QAFTER,4
	X	QAT,10
	X	QDELAY,20
	X	QPRIOR,40

DEFINE $ZQU(A,E,C,D)<
	$$ZQU=0
	IFNB<A>,<$$ZQU=1B<Q'A>>
	X	%FCON,<<$$ZQU+<Q'E>B<%ZQUTY>+<Q'C>B<%ZQUKN>+<Q'D>B<%ZQUMO>>B53>
>

DEFINE $BEG(A,C)<
	X	%FCON,<<1B<Q'A>+<Q'C>B<%ZHETY>>B53>
>
	Q=0



;				SWITCHES
;				--------

DEFINE	X(A,B)<
DEFINE	A<
	IFL %FPROC,<
		%FREL=-2
		DEFINE %SWON<IFON'B Y'A>
		DEFINE %SWOF<IFOFF'B Y'A>
	>
	IFE %FPROC,<SETON'B Y'A>
	IFG %FPROC,<
		IFB<B>,<SETOFF Y'A>
		IFNB<B>,<SETOF'B Y'A>
	>
>
>

DEFINE	SET(A)<
	%FPROC=0
	A
>

DEFINE	RESET(A)<
	%FPROC=1
	A
>

	X	SWECL,A
	X	SWEPR,A
	X	SWEFO,A
	X	SWEM,A
	X	SWEMN,A
	X	SWECO,A
	X	SWEMP,A
	X	SWEMQ,A		;[144]
	X	SWR
	X	SWCE
	X	SWE40,A
;				RELATIONS
;				---------

DEFINE X(A,B)<
DEFINE A<
	%FREL=B
>>
	X	NONEOF,0
	X	LSS,1
	X	EQL,2
	X	LEQ,3
	X	ONEOF,4
	X	GEQ,5
	X	NEQ,6
	X	GRT,7

DEFINE NOT<
	%FNOT=1
>


	%REG=1
	%FCON=2
	%STACK=3
	%FFIX=4

	GETSTACK B
	GETQUE A,H


>			;END OF MACRO DEFINITIONS
	SUBTTL	RECOGNITION ROUTINES
	SUBTTL	PROCEDURE PROG

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE PROG IS THE MASTER PROCEDURE OF SR.
TO CHECK IF CURRENT SYMBOL IS START OF A PROGRAM THE
BOOLEAN PROCEDURE PRG IS CALLED.

ERROR MESSAGES:
		ILLEGAL START OF PROGRAM
		ILLEGAL END OF PROGRAM(WARNING)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE PROG
IF NOT PRG THEN
    ERROR 0,G,,ILLEGAL START OF PROGRAM
    LOOP
	IC $PURGE
	WHILE CURRENT NONEOF $CLASS $PROC $EXT $BEGIN $EOF DO
	    SCAN	;FIND A PROGRAM START
	OD
    AS NOT PRG SA
FI
IF CURRENT EQL $SEMIC THEN
    SCAN
FI
IF CURRENT NEQ $EOF THEN
    LINED
    ERROR 0,W,,ILLEGAL END OF PROGRAM
FI
SCAN
LINED
IC $EPROG
EPROC
	SUBTTL	PROCEDURE PRG

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE PRG PARSES A PROGRAM STARTING WITH
CURRENT SYMBOL.

ERROR MESSAGES:
		MISPLACED SYMBOL 'CURRENT'
		NO PROGRAM FOUND

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE PRG
WHILE CURRENT EQL $EXT DO	;<PROGRAM>::=<EXT.DECL.><PROGRAM>
    LINED
    FIND EXT
    IF CURRENT EQL $SEMIC THEN
	SCAN
    ELSE
	ERROR 1,GC,,MISPLACED SYMBOL XXXX
    FI
OD
LINED
LOAD REG1 $ZQU(ZQU,,,DECLARED)
IF NEXT EQL $CLASS AND
    CURRENT NEQ $BEGIN OR
    CURRENT EQL $CLASS THEN	;<PROGRAM>::=<CLASS DECL.>
    FIND ECLA
ELSE
IF TYPE THEN			;<PROGRAM>::=<TYPE PROCEDURE DECL.>
    GOIF CURRENT NEQ $PROC TO FEXIT ;WRONG ASSUMPTION
    FIND EPRO
ELSE
IF CURRENT EQL $PROC THEN	;<PROGRAM>::=<PROPER PROCEDURE DECL.>
    ADD REG1 $ZQU(,NOTYPE,,)
    FIND EPRO
ELSE
IF CURRENT EQL $EOF THEN	;PROGRAM MISSING
    ERROR 0,T,,NO PROGRAM FOUND
ELSE
FIND LAB
IF CURRENT EQL $BEGIN THEN	;<PROGRAM>::=<BLOCK>
    SCAN
    FIND MAIN
    FIND BLK
    EXEC SDPEND
ELSE
    FIND EXPR
    GOIF CURRENT NEQ $BEGIN TO FEXIT	;ERRONEOUS START
    FIND MAIN
    FIND PBLK			;<PROGRAM>::=<PREFIX BLOCK>
FI FI FI FI FI
EPROC
	SUBTTL	PROCEDURE MAIN

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE MAIN CHECKS THE SWITCHES OF A MAIN PROGRAM.

ERROR MESSAGES:
		ILLEGAL SWITCH SETTING

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE MAIN
IF SWCE THEN
    ERROR 1,W,,ILLEGAL SWITCH SETTING
    RESET SWECL SWEPR SWEFO SWEM SWEMN SWEMQ SWE40 SWCE ;[144]
FI
SET SWEMP SWECO
EPROC
	SUBTTL	PROCEDURE EPRO

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE EPRO CHECKS THE SWITCHES OF AN EXTERNAL PROCEDURE.

ERROR MESSAGES:
		ILLEGAL SWITCH SETTING

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE EPRO
IF SWEMP THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   RESET SWEMP
FI
IF SWR THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   RESET SWR
FI
IF NOT SWCE THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   SET SWEPR SWCE
FI
RESET SWECL
SET SWECO
FIND PROC
EPROC
	SUBTTL	PROCEDURE ECLA

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE ECLA CHECKS THE SWITCHES OF AN EXTERNAL CLASS.

ERROR MESSAGES:
		ILLEGAL SWITCH SETTING

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE ECLA
IF SWEMP THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   RESET SWEMP
FI
IF SWR THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   RESET SWR
FI
IF NOT SWECL THEN
   ERROR 1,W,,ILLEGAL SWITCH SETTING
   SET SWECL SWCE
FI
RESET SWEPR SWEFO SWEM SWEMN SWEMQ SWE40 ;[144]
SET SWECO
FIND CLAS
EPROC
	SUBTTL	PROCEDURE BLK

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE BLK PARSES THE SYNTACTIC ENTITY <BLOCK>.
AT ENTRY CURRENT IS THE SYMBOL FOLLOWING 'BEGIN'.
AT EXIT CURRENT CONTAINS THE SYMBOL AFTER 'END'

ERROR MESSAGES:
		MISSING END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE BLK
SAVE REG2
LOAD REG1 $BEG(ZHE,RBLOCK)
LOAD REG2 FIXUP2
IC $BBLK
EXEC SDBEG
WHILE DECL AND CURRENT EQL $SEMIC DO
    SCAN
OD
FIND STAT
WHILE CURRENT EQL $SEMIC DO
    SCAN
    FIND STAT
OD
IC $EBLK
EXEC SDEND
IF CURRENT NEQ $END THEN
    ERROR 3,G,,MISSING END
ELSE
    SCAN
FI
EPROC
	SUBTTL	PROCEDURE PBLK

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE PBLK PARSES THE SYNTACTIC ENTITY <PREFIX BLOCK>.
AT ENTRY CURRENT CONTAIN THE SYMBOL 'BEGIN'.
AT EXIT CURRENT CONTAINS THE SYMBOL AFTER 'END'.

ERROR MESSAGES:
		MISSING END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE PBLK
SAVE REG2
LOAD REG1 $BEG(ZHB,PBLOCK)
LOAD REG2 FIXUP6
IC $BEGPB
EXEC SDBEG
SCAN
WHILE DECL AND CURRENT EQL $SEMIC DO
    SCAN
OD
IC $EDPB
FIND STAT
WHILE CURRENT EQL $SEMIC DO
    SCAN
    FIND STAT
OD
IC $PBEND
EXEC SDEND
IF CURRENT NEQ $END THEN
    ERROR 3,G,,MISSING END
ELSE
    SCAN
FI
EPROC
	SUBTTL	PROCEDURE CLAS

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE CLAS PARSES THE SYNTACTIC ENTITY <CLASS DECL.>.
AT ENTRY CURRENT OR NEXT CONTAINS THE SYMBOL 'CLASS'.

ERROR MESSAGES:
		'CURRENT' ILLEGAL CLASS PREFIX
		'CURRENT' ILLEGAL SPECIFICATION
		VIRTUAL MUST BE FOLLOWED BY COLON
		VALUE SPEC MUST PRECEDE OTHER SPEC
		MISPLACED SYMBOL 'CURRENT'
		MISSING END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE CLAS
BEGIN
IF CURRENT LSS $ID AND
    NEXT EQL $CLASS THEN
    ERROR 4,CG,,XXXX IS ILLEGAL CLASS PREFIX
    SCAN
FI
IF CURRENT EQL $CLASS THEN
    LOAD REG3 $ZERO
ELSE
    XRF
    LOAD REG3 CURRENT
    SCAN
FI
LOAD REG2 FIXUP6
SCAN
IC CURRENT $BEGCL
LOAD REG1 $ZQU(ZQU,NOTYPE,CLASS,DECLARED)
EXEC SDZQU
LOAD REG1 $BEG(ZHB,CLASB)
;FIND FORMAL PARAMETERS
IF FPAR THEN
    WHILE NEXT EQL $VALUE AND
	CURRENT EQL $SEMIC DO
	SCAN
	LINED
	SCAN
	LOAD REG1 $ZQU(,,,VALUE)
	FIND LST
    OD
;FIND TYPE SPEC
L1():
    IF CURRENT EQL $SEMIC THEN
	SCAN
	LINED
	LOAD REG1 $ZERO
	IF TYPE THEN
	    IF CURRENT EQL $ARRAY THEN
		SCAN
		ADD REG1 $ZQU(,,ARRAY,)
	    ELSE
	    IF CURRENT EQL $PROC THEN
		ERROR 6,G,,ILLEGAL SPECIFICATION
		RECOVER
		GOTO L1
	    FI
	    ADD REG1 $ZQU(,,SIMPLE,)
	    FI
	    FIND LST
	    GOTO L1
	FI
	IF CURRENT EQL $ARRAY THEN
	    ADD REG1 $ZQU(,REAL,ARRAY,)
	    SCAN
	    FIND LST
	    GOTO L1
	FI
	IF CURRENT EQL $VALUE THEN
	    ERROR 5,CG,,"VALUE" SPEC MUST PRECEDE TYPE SPEC
	    RECOVER
	    GOTO L1
	FI
	IF CURRENT ONEOF $NAME $PROC $SWIT $LABEL THEN
	    ERROR 6,G,,ILLEGAL SPECIFICATION
	    RECOVER
	    GOTO L1
	FI
    FI
FI
LINED
;FIND PROTECTION PART [40]
WHILE CURRENT ONEOF $NOT $HIDDEN $PROTECTED DO
    LOAD REG1 $ZQU(ZQU,,,)
    IF CURRENT EQL $NOT THEN
	SCAN
	SETONA ZQUNOT(X1SR1)
    FI
    IF CURRENT NONEOF $HIDDEN $PROTECTED THEN
	ERROR 6,G,,ILLEGAL SPECIFICATION
    ELSE
	IF CURRENT EQL $HIDDEN THEN
	    ADD REG1 $ZQU(,,,HDN)
	    SCAN
	    IF CURRENT EQL $PROTECTED THEN
		SETONA ZQUTPT(X1SR1)
		SCAN
	    FI
	ELSE
	    SETONA ZQUTPT(X1SR1)
	    SCAN
	    IF CURRENT EQL $HIDDEN THEN
		ADD REG1 $ZQU(,,,HDN)
		SCAN
	    FI
	FI
	IF CURRENT GEQ $ID THEN
	    EXEC SDHID
	    SCAN
	    WHILE CURRENT EQL $COMMA AND
		NEXT GEQ $ID DO
		SCAN
		EXEC SDHID
		SCAN
	    OD
	    IF CURRENT EQL $COMMA AND
		NEXT NEQ $SEMIC THEN
		SCAN  ;GET MEANINGFUL ERROR MESSAGE
	    FI
	ELSE
	    ERROR 14,G,,MISSING IDENTIFIER LIST
	FI
    FI
    IF CURRENT NEQ $SEMIC THEN
	ERROR 1,CG,,MISPLACED SYMBOL XXXX
	RECOVER
    FI
    IF CURRENT EQL $SEMIC THEN
	SCAN
	LINED
    FI
OD
;FIND VIRTUALS
IF CURRENT EQL $VIRT THEN
    SCAN
    IF CURRENT EQL $COLON THEN
	SCAN
    ELSE
	ERROR 7,G,,VIRTUAL MUST BE FOLLOWED BY :
    FI
    IF NOT VIRT OR
	CURRENT NEQ $SEMIC THEN
	ERROR 10,G,,ILLEGAL VIRTUAL SPECIFICATION
	RECOVER
	IF CURRENT EQL $SEMIC THEN
	    SCAN
	FI
    ELSE
	SCAN
	WHILE VIRT AND
	    CURRENT EQL $SEMIC DO
	    SCAN
	OD
    FI
FI
EXEC SDESPE
;FIND CLASS BODY
LINED
IF CURRENT EQL $BEGIN THEN
    SCAN
    WHILE DECL AND
	CURRENT EQL $SEMIC DO
	SCAN
    OD
    IC $EDCL
    IF CURRENT NEQ $INNER THEN
	FIND STAT
    FI
    WHILE CURRENT EQL $SEMIC AND
	NEXT NEQ $INNER DO
	SCAN
	FIND STAT
    OD
    IF CURRENT EQL $SEMIC THEN
	SCAN
    FI
    IF CURRENT  EQL $INNER THEN
	LINE
	SCAN
	IC $INNER
	IF CURRENT NONEOF $SEMIC $END THEN
	    ERROR 11,E,,<MISSING ";" AFTER INNER>
	    FIND STAT
	FI
	WHILE CURRENT EQL $SEMIC DO
	    SCAN
	    FIND STAT
	OD
	IC $ENDCL
    ELSE
	IC $IENDC
    FI
    IF CURRENT EQL $END THEN
	SCAN
    ELSE
	ERROR 3,G,,MISSING END
    FI
ELSE
    IC $EDCL
    FIND STAT
    IC $IENDC
FI
EXEC SDEND
ENDD
EPROC
	SUBTTL	PROCEDURE PROC

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE PROC PARSES THE SYNTACTIC ENTITY <PROCEDURE DECL.>.
AT ENTRY CURRENT CONTAINS THE SYMBOL 'PROCEDURE'.

ERROR MESSAGES:
		'VAL/NAM' SPEC MUST PRECEDE TYPE SPEC
		MISSING END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE PROC
BEGIN
ADD REG1 $ZQU(,,PROCEDURE,)
SCAN
IC CURRENT $BEGPR
LOAD REG2 FIXUP4
EXEC SDZQU
LOAD REG1 $BEG(ZHB,PROCB)
IF FPAR THEN
L1():
    WHILE NEXT EQL $VALUE AND
	CURRENT EQL $SEMIC DO
	SCAN
	LINED
	SCAN
	LOAD REG1 $ZQU(,,,VALUE)
	FIND LST
    OD
    IF NEXT EQL $NAME AND
	CURRENT EQL $SEMIC THEN
	SCAN
	LINED
	SCAN
	LOAD REG1 $ZQU(,,,NAME)
	FIND LST
	GOTO L1
    FI
L2():
    IF CURRENT EQL $SEMIC THEN
	SCAN
	WHILE SPEC AND
	    CURRENT EQL $SEMIC DO
	    SCAN
	OD
	IF CURRENT ONEOF $VALUE $NAME THEN
	    ERROR 5,CG,,"VALUE-NAME" SPEC MUST PRECEDE TYPE SPEC
	    RECOVER
	    GOTO L2
	FI
    FI
    EXEC SDESPE
FI
;START PROCEDURE BODY
LOAD REG1 $BEG(ZHE,PROCB)
EXEC SDBEG
IF NOT SWCE OR
    SWECL OR
    SWEPR THEN
    IF CURRENT EQL $BEGIN THEN
        SCAN
        WHILE DECL AND
    	CURRENT EQL $SEMIC DO
    	SCAN
        OD
        FIND STAT
        WHILE CURRENT EQL $SEMIC DO
    	SCAN
    	FIND STAT
        OD
        IF CURRENT NEQ $END THEN
    	ERROR 3,G,,MISSING END
        ELSE
    	SCAN
        FI
    ELSE
        FIND STAT
    FI
FI
IC $ENDPR
EXEC SDEND
EXEC SDEND
ENDD
EPROC
	SUBTTL	PROCEDURE FPAR

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE FPAR PARSES THE SYNTACTIC ENTITY
<CLASS/PROC. NAME>['LP'<IDENTIFIER>[,<IDENTIFIER>]...'RP']
IF NO FORMAL PARAMETERS EXIST IT TAKES THE FALSE RETURN AND
EATS POSSIBLY SUCCEEDING SEMICOLON.

ERROR MESSAGES:
		'CURRENT' ILLEGAL CLASS/PROC. NAME
		MISPLACED SYMBOL 'CURRENT'

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE FPAR
IF CURRENT LSS $ID THEN
    ERROR 12,CS,,XXXX IS ILLEGAL CLASS-PROCEDURE NAME
    LOAD CURRENT $UDEF
    EXEC SDBEG
    RECOVER $LP
ELSE
    EXEC SDBEG
    SCAN
FI
IF CURRENT NEQ $LP THEN
    IF CURRENT NEQ $SEMIC THEN
	ERROR 1,CG,,MISPLACED SYMBOL XXXX
	RECOVER
    FI
    IF CURRENT EQL $SEMIC THEN
	SCAN
    FI
    GOTO FEXIT
FI
SCAN
LOAD REG3 $ZERO
LOAD REG1 $ZQU(ZQU,,,)
IF CURRENT LSS $ID THEN
    ERROR 1,CG,,MISPLACED SYMBOL XXXX
ELSE	;THERE ARE FORMAL PARAMETERS
    IF SWEMN THEN
	ERROR 40,S,,NOCHECK PROCEDURE MUST NOT HAVE ANY FORMALS
    FI
    EXEC SDZQU
    SCAN
    WHILE CURRENT EQL $COMMA AND
	NEXT GEQ $ID DO
	SCAN
	EXEC SDZQU
	SCAN
    OD
    IF CURRENT NEQ $RP THEN
	ERROR 1,GC,,MISPLACED SYMBOL XXXX
    ELSE
	SCAN
	IF CURRENT NEQ $SEMIC THEN
	    ERROR 1,CG,,MISPLACED SYMBOL XXXX
	FI
    FI
FI
RECOVER
EPROC
	SUBTTL	PROCEDURE VIRT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE VIRT PARSES THE SYNTACTIC ENTITY <VIRTUAL SPEC.>.

ERROR MESSAGES:
		ILLEGAL VIRTUAL TYPE
		MISPLACED SYMBOL 'CURRENT'

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE VIRT
LINED
LOAD REG1 $ZQU(ZQU,,,VIRTUAL)
IF CURRENT EQL $SWIT THEN
    ADD REG1 $ZQU(,LABEL,PROCEDURE,)
ELSE
IF CURRENT EQL $PROC THEN
    ADD REG1 $ZQU(,NOTYPE,PROCEDURE,)
ELSE
IF CURRENT EQL $LABEL THEN
    ADD REG1 $ZQU(,LABEL,SIMPLE,)
ELSE
IF TYPE THEN
    IF CURRENT NEQ $PROC THEN
	ERROR 13,G,,ILLEGAL VIRTUAL TYPE
	RECOVER
	GOTO TEXIT
    FI
    ADD REG1 $ZQU(,,PROCEDURE,)
ELSE
GOIF CURRENT NONEOF $ARRAY $CLASS TO FEXIT
    ERROR 13,G,,ILLEGAL VIRTUAL TYPE
    RECOVER
    GOTO TEXIT
FI FI FI FI
SCAN
IF CURRENT GEQ $ID THEN
    EXEC SDZQU
    SCAN
    WHILE CURRENT EQL $COMMA AND
	NEXT GEQ $ID DO
	SCAN
	EXEC SDZQU
	SCAN
    OD
    GOIF CURRENT EQL $SEMIC TO TEXIT
FI
ERROR 1,CG,,MISPLACED SYMBOL XXXX
RECOVER
EPROC
	SUBTTL	PROCEDURE SPEC

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE SPEC PARSES THE SYNTACTIC ENTITY <SPECIFICATION>.

ERROR MESSAGES:	NONE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE SPEC
LINED
LOAD REG1 $ZERO
IF TYPE THEN
    IF CURRENT EQL $ARRAY THEN
	SCAN
	ADD REG1 $ZQU(,,ARRAY,)
    ELSE
    IF CURRENT EQL $PROC THEN
	SCAN
	ADD REG1 $ZQU(,,PROCEDURE,)
    ELSE
	ADD REG1 $ZQU(,,SIMPLE,)
    FI FI
ELSE
IF CURRENT EQL $ARRAY THEN
    ADD REG1 $ZQU(,REAL,ARRAY,)
ELSE
IF CURRENT EQL $PROC THEN
    ADD REG1 $ZQU(,NOTYPE,PROCEDURE,)
ELSE
IF CURRENT EQL $LABEL THEN
    ADD REG1 $ZQU(,LABEL,SIMPLE,)
ELSE
GOIF CURRENT NEQ $SWIT TO FEXIT
    ADD REG1 $ZQU(,LABEL,PROCEDURE,)
FI FI FI
SCAN
FI
FIND LST
EPROC
	SUBTTL	PROCEDURE LST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE LST PARSES THE SYNTACTIC ENTITY <IDENTIFIER LIST>.

ERROR MESSAGES:
		MISPLACED SYMBOL 'CURRENT'

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE LST
IF CURRENT LSS $ID THEN
    ERROR 14,G,,MISSING IDENTIFIER LIST
ELSE
    EXEC SDSPEC
    SCAN
    WHILE CURRENT EQL $COMMA AND
	NEXT GEQ $ID DO
	SCAN
	EXEC SDSPEC
	SCAN
    OD
    IF CURRENT EQL $COMMA AND
	NEXT NONEOF $SEMIC $END $EOF THEN
	SCAN
    FI
FI
IF CURRENT NEQ $SEMIC THEN
    ERROR 1,CG,,MISPLACED SYMBOL XXXX
    RECOVER
FI
EPROC
	SUBTTL	PROCEDURE DECL

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE DECL PARSES THE SYNTACTIC ENTITY <DECLARATION>.

ERROR MESSAGES:
		MISSING IDENTIFIER LIST
		MISPLACED SYMBOL 'CURRENT'
		ERRONEOUS SWITCH DECLARATION

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE DECL
LINED
LOAD REG1 $ZQU(ZQU,,,DECLARED)
LOAD REG2 $ZERO
IF TYPE THEN
    IF CURRENT EQL $ARRAY THEN
	FIND ARY
    ELSE
    IF CURRENT EQL $PROC THEN
	FIND PROC
    ELSE
    IF CURRENT GEQ $ID THEN
	ADD REG1 $ZQU(,,SIMPLE,)
	EXEC SDZQU
	SCAN
	WHILE CURRENT EQL $COMMA AND
	    NEXT GEQ $ID DO
	    SCAN
	    EXEC SDZQU
	    SCAN
	OD
	IF CURRENT EQL $COMMA AND
	    NEXT NONEOF $SEMIC $END $EOF THEN
	    SCAN
	FI
    ELSE
	ERROR 14,G,,MISSING IDENTIFIER LIST
	RECOVER
    FI FI FI
ELSE
IF CURRENT EQL $ARRAY THEN
    LOAD REG1 $ZQU(ZQU,REAL,,)
    FIND ARY
ELSE
IF CURRENT EQL $PROC THEN
    LOAD REG1 $ZQU(ZQU,NOTYPE,,)
    FIND PROC
ELSE
IF CURRENT EQL $EXT THEN
    FIND EXT
ELSE
IF NEXT EQL $CLASS AND
    CURRENT NONEOF $SEMIC $BEGIN OR
    CURRENT EQL $CLASS THEN
    FIND CLAS
ELSE
GOIF CURRENT NEQ $SWIT TO FEXIT
    SCAN
    IF CURRENT GEQ $ID AND
	NEXT EQL $BECOM THEN
	LOAD REG1 $ZQU(ZQU,LABEL,PROCEDURE,DECLARED)
	LOAD REG2 FIXUP2
	IC CURRENT $SWITC
	EXEC SDZQU
	SCAN
	LOOP
	    SCAN
	    FIND EXPR
	    IC $SWEL
	AS CURRENT EQL $COMMA SA
	IC $SWEND
    ELSE
	ERROR 15,G,,ERRONEOUS SWITCH DECLARATION
	RECOVER
    FI
FI FI FI FI FI
IF CURRENT NONEOF $END $SEMIC $EOF THEN
    ERROR 1,CG,,MISPLACED SYMBOL XXXX
    RECOVER
FI
IF CURRENT EQL $END THEN
    ERROR 2,G,,DECLARATION MUST BE FOLLOWED BY SEMICOLON
    LF ,YLSCLIN
    ST YELIN2
    ERRLI
FI
EPROC
	SUBTTL	PROCEDURE TYPE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE TYPE PARSES THE SYNTACTIC ENTITY <TYPE>

ERROR MESSAGES:
		SHORT NOT FOLLOWED BY INTEGER
		LONG NOT FOLLOWED BY REAL
		ILLEGAL REF TYPE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE TYPE
LOAD REG3 $ZERO
WHILE CURRENT EQL $SHORT AND
    NEXT NEQ $INT DO
    ERROR 2,W,,SHORT NOT FOLLOWED BY INTEGER
    IF NEXT GEQ $ID THEN
	LOAD CURRENT $INT
    ELSE
	SCAN
    FI
OD
IF CURRENT EQL $SHORT THEN
    SCAN
FI
WHILE CURRENT EQL $LONG AND
    NEXT NEQ $REAL DO
    ERROR 3,W,,LONG NOT FOLLOWED BY REAL
    IF NEXT GEQ $ID THEN
	LOAD CURRENT $REAL
    ELSE
	SCAN
    FI
OD
IF CURRENT EQL $INT THEN
    SCAN
    ADD REG1 $ZQU(,INTEGER,,)
ELSE IF CURRENT EQL $REAL THEN
    SCAN
    ADD REG1 $ZQU(,REAL,,)
ELSE IF CURRENT EQL $TEXT THEN
    SCAN
    ADD REG1 $ZQU(,TEXT,,)
ELSE IF CURRENT EQL $BOOL THEN
    SCAN
    ADD REG1 $ZQU(,BOOLEAN,,)
ELSE IF CURRENT EQL $CHAR THEN
    SCAN
    ADD REG1 $ZQU(,CHARACTER,,)
ELSE IF CURRENT EQL $LONG AND
    NEXT EQL $REAL THEN
    DSCAN
    ADD REG1 $ZQU(,LREAL,,)
ELSE
    GOIF CURRENT NEQ $REF TO FEXIT
    IF NEXT EQL $LP THEN
	DSCAN
	IF CURRENT GEQ $ID AND
	    NEXT EQL $RP THEN
	    XRF
	    ADD REG1 $ZQU(,REF,,)
	    LOAD REG3 CURRENT
	    DSCAN
	    GOTO TEXIT
	FI
    FI
    ERROR 16,G,,ILLEGAL REF TYPE
    RECOVER
    GOIF CURRENT NEQ $SEMIC TO FEXIT
    SCAN
    LINED
    GOIF NOT TYPE TO FEXIT
FI FI FI FI FI FI
EPROC
	SUBTTL	PROCEDURE EXT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE EXT PARSES THE SYNTACTIC ENTITY <EXTERNAL DECLARATION>.

ERROR MESSAGES:
		ILLEGAL EXTERNAL TYPE
		ERROR IN EXTERNAL ITEM

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE EXT
BEGIN
LOAD REG1 $ZQU(ZQU,,,DECLARED)
LOAD REG3 $ZERO
SCAN
IF CURRENT EQL $CLASS THEN
    ADD REG1 $ZQU(,NOTYPE,CLASS,)
    LOAD REG2 $BEG(ZHB,CLASB)
ELSE
IF CURRENT EQL $PROC THEN
    ADD REG1 $ZQU(,NOTYPE,PROCEDURE,)
    LOAD REG2 $BEG(ZHB,PROCB)
ELSE
IF TYPE AND
    CURRENT EQL $PROC THEN
    ADD REG1 $ZQU(,,PROCEDURE,)
    LOAD REG2 $BEG(ZHB,PROCB)
ELSE
    ERROR 45,G,,ILLEGAL EXTERNAL TYPE
    RECOVER
    GOTO TEXIT
FI FI FI
LOOP	;GET EXTERNAL ITEMS
    SCAN
    SETZM YSRIN
    SETZM YSREN
    SETZM YSRDEV
    SETZM YSRPPN
    SETZM YSFDN ;[144]
    IF CURRENT GEQ $ID AND
	NEXT EQL $EQ THEN ;Specification has "... <id>=<filespec>" form
	SKIPN	YSRPPN	;[144] With no explicit ppn given,
	SETOM	YSRPPN	;[144] PPN=-1 shows that request was specific
	ST X1CUR,YSRIN
	DSCAN
    FI
    IF CURRENT GEQ $ID AND
	NEXT EQL $COLON THEN
	ST X1CUR,YSRDEV	;Device found, makes request specific
	SKIPN	YSRPPN	;[144]
	SETOM	YSRPPN	;[144]
	DSCAN
    FI
    IF CURRENT GEQ $ID THEN ;File spec
	ST X1CUR,YSREN	;File name
	SCAN
	IF CURRENT EQL $LB THEN ;[144] Path specification: "[...]"
	    SETOM   YSFDSW	;No hashing of id's in LS
	    SCAN
	    IF CURRENT EQL $MINUS THEN ;"[-]", default directory
		GOIF NEXT NEQ $RB TO L1
		SETOM	YSRPPN ;Equivalent to no path specification
		DSCAN
	    ELSE ;"[<project>,...]"
		IF CURRENT EQL $COMMA THEN ;Default project no from UFD
		    SETZ
		    GETPPN	;UFD used to define project (and programmer)
		    ST	YSRPPN
		    SCAN
		ELSE
		IF CURRENT EQL $CONI THEN ;Explicit project number given
		    GOIF NEXT NEQ $COMMA TO L1
		    EXEC SDPPN
		    HRLM YSRPPN
		    DSCAN
		ELSE	;Error
		    GOTO L1
		FI FI
		IF CURRENT EQL $CONI THEN ;<programmer>
		    EXEC SDPPN
		    HRRM YSRPPN
		    SCAN
		ELSE
		    SETZ
		    GETPPN
		    HRRM YSRPPN
		FI  ;End of PPN part
		IF CURRENT EQL $COMMA THEN	;SFD list start expected
		    LI	X1,YSFD1	;Set up AOBJN word
		    MOVNI QSFDN
		    HRLM  X1
		    LOOP ;over SFD list
			ST	X1,YSFDP
			GOIF NEXT LSS $ID TO L1
			ST	X1ID1,(X1)
			AOS	YSFDN	;Count
			DSCAN
			L	X1,YSFDP
			AOBJP	X1,L1	;Too many
		    AS
			CURRENT EQL $COMMA
		    SA
		    SETZM 1(X1)
		    LI YSFD
		    EXCH YSRPPN
		    ST YSFDPPN
		FI
		SETZM	YSFDSW
		GOIF CURRENT NEQ $RB TO L1
		SCAN	;Past "]"
	FI FI ;[144]

	EXEC SDEXT
    ELSE  ;ERROR IN EXTERNAL ITEM
L1():
	ERROR 46,G,,ERROR IN EXTERNAL ITEM
	SETZM	YSFDSW	;[144]
	RECOVER
    FI
AS
    CURRENT EQL $COMMA
SA
ENDD
EPROC
	SUBTTL	PROCEDURE ARY

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE ARY PARSES THE SYNTACTIC ENTITY <ARRAY DECLARATION>

ERROR MESSAGES:
		MISPLACED SYMBOL 'CURRENT'
		MISSING RIGHT PARENTHESIS/BRACKET

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE ARY
BEGIN
ADD REG1 $ZQU(,,ARRAY,)
IF NEXT GEQ $ID THEN
    LOOP
	SCAN
	EXEC SDZQU
	IC CURRENT
	EXEC SDABEG
	SCAN
	WHILE CURRENT EQL $COMMA AND
	    NEXT GEQ $ID DO
	    SCAN
	    EXEC SDZQU
	    IC CURRENT
	    SCAN
	OD
	IF CURRENT NONEOF $LP $LB THEN
	    ERROR 1,CGP,,MISPLACED SYMBOL XXXX
	    RECOVER
	ELSE
	    IF CURRENT EQL $LP THEN
		GOIF NOT ARYS TO L1
		IF CURRENT NEQ $RP THEN
		    ERROR 20,AG,%RP,MISSING "RIGHT PARENTHESIS"
		ELSE
		    SCAN
		FI
	    ELSE
		GOIF NOT ARYS TO L1
		IF CURRENT NEQ $RB THEN
		    ERROR 20,AG,%RB,MISSING "RIGHT BRACKET"
		ELSE
		    SCAN
		FI
	    FI
	L1():
	    IC $ADEC
	    EXEC SDAEND
	FI
    AS
	CURRENT EQL $COMMA AND
	NEXT GEQ $ID
    SA
ELSE
    SCAN
FI
ENDD
EPROC
	SUBTTL	PROCEDURE ARYS

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE ARYS PARSE THE SYNTACTIC ENTITY <SUBSCR. BOUNDS>

ERROR MESSAGES:
		MORE THAN 10 DIMENSIONS
		MISPLACED SYMBOL

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE ARYS
LOAD REG2 $ZERO
LOOP
    SCAN
    IF REG2 GEQ $MAXIDX THEN
	ERROR 17,G,,MORE THAN 10 DIMENSIONS
	RECOVER
	GOTO FEXIT
    FI
    INCR REG2
    FIND EXPR
    IF CURRENT EQL $COLON THEN
	SCAN
    ELSE
    IF CURRENT EQL $DENOT THEN
	LOAD CURRENT $MINUS
    ELSE
	ERROR 1,CG,,MISPLACED SYMBOL XXXX
    FI FI
    FIND EXPR
    IC $BOUND
AS CURRENT EQL $COMMA SA
EPROC
	SUBTTL	PROCEDURE STAT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE STAT PARSES STATEMENTS.
THE STATEMENTS MUST FINISH WITH END OR SEMICOLON.
THIS CONSTRUCTION IS MADE FOR RECOVERY REASONS.

ERROR MESSAGES:
		HOMELESS 'ELSEW/WHEN/OTHERWISE' PART
		STATEMENT BEFORE BEGIN NOT TERMINATED WITH SEMICOLON

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE STAT
FIND ELST
IF CURRENT ONEOF $ELSE $WHEN $OTHER THEN
    ERROR 21,CE,,HOMELESS "ELSE-WHEN-OTHERWISE" PART
    RECOVER
FI
IF CURRENT EQL $BEGIN THEN
    ERROR 22,G,,STATEMENT BEFORE BEGIN NOT TERMINATED
    FIND STAT
FI
EPROC
	SUBTTL	PROCEDURE ELST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE ELST PARSES THE SYNTACTIC ENTITY <STATEMENT>

ERROR MESSAGES:
		MISPLACED SYMBOL 'CURRENT'
		CANNOT FIND THEN IN IF-STATEMENT
		FOR/INSPECT/WHILE-STATEMENT CANNOT BE PLACED BETWEEN THEN & ELSE
		IF-STATEMENT CANNOT BE PLACED AFTER THEN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE ELST
LINE
SAVE REG2
FIND LAB
IF CURRENT NEQ $IF THEN
    IF NOT SIST THEN
	FIND UNST
    FI
ELSE
    SCAN
    FIND EXPR
    IF CURRENT NEQ $THEN THEN
	ERROR 1,CE,,MISPLACED SYMBOL XXXX
	RECOVER $OTHER $THEN $WHEN
    FI
    IF CURRENT NEQ $THEN THEN
	ERROR 23,P,,CANNOT FIND THEN IN IF-STATEMENT
    ELSE
    SCAN
    IF CURRENT EQL $GOTO THEN    ;IF-GOTO
	SCAN
	FIND EXPR
	IF CURRENT NONEOF $SEMIC $ELSE $END $OTHER $WHEN $EOF THEN
	    ERROR 1,CE,,MISPLACED SYMBOL XXXX
	    RECOVER $ELSE $OTHER $WHEN
	FI
	IF CURRENT EQL $ELSE THEN
	    LOAD REG2 FIXUP
	    SCAN
	    IC $IFTRE REG2
	    FIND ELST
	    IC $FIX REG2
	ELSE
	    IC $IFTRU
	FI
    ELSE		;ORDINARY IF
	LOAD REG2 FIXUP
	IC $IFST REG2
	FIND LAB
	IF CURRENT EQL $IF THEN
	    ERROR 24,E,,IF-STATEMENT CANNOT BE PLACED AFTER THEN
	    FIND ELST
	ELSE
	IF SIST THEN
	    IF CURRENT EQL $ELSE THEN
	    ERROR 25,E,,FOR-INSPECT-WHILE STATEMENT CANNOT BE PLACED BETWEEN THEN & ELSE
	    FI
	ELSE
	    FIND UNST
	FI FI
	IF CURRENT NEQ $ELSE THEN
	    IC $FIX REG2
	ELSE
	    LOAD REG3 REG2
	    LOAD REG2 FIXUP
	    IC $JUMP REG2 $FIX REG3
	    SCAN
	    FIND ELST
	    IC $FIX REG2
	FI
FI FI FI
EPROC
	SUBTTL	PROCEDURE UNST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE UNST PARSES THE SYNTACTIC ENTITIES:
	<PREFIX BLOCK>
	<ASSIGNMENT STATEMENT>
	<GOTO-STATEMENT>
	<BLOCK>
	<COMPOUND STATEMENT>
	<ACTIVATION STATEMENT>
	<PROCEDURE CALL>
	<OBJECT GENERATOR>
WHEN THEY STAND AS A STATEMENT.
IT RECOVERS FOR AN ILLEGALLY PLACED INNER OR DECLARATION.

ERROR MESSAGES:
		MISPLACED SYMBOL 'CURRENT'
		INNER ILLEGALLY PLACED
		DECLARATION AFTER STATEMENT
		MISSING END

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE UNST
IF CURRENT ONEOF $LP $THIS $NEW OR
    CURRENT GEQ $ID AND
    NEXT NEQ $CLASS THEN
    FIND EXPR
    IF CURRENT EQL $BEGIN THEN	;PREFIX BLOCK
	FIND PBLK
    ELSE
    IF CURRENT EQL $BECOM THEN	;ASSIGNMENT
	LOOP
	    SCAN
	    FIND EXPR
	AS CURRENT EQL $BECOM SA
	IC $BECOM
    ELSE
    IF CURRENT EQL $DENOT THEN
	LOOP
	    SCAN
	    FIND EXPR
	AS CURRENT EQL $DENOT SA
	IC $DENOT
    ELSE
	LINE		;PROCEDURE CALL
    FI FI FI
ELSE
IF CURRENT EQL $GOTO THEN	    ;GOTO-STATEMENT
    SCAN
    FIND EXPR
    IC $GOTO
ELSE
IF CURRENT EQL $BEGIN THEN	;BLOCK OR COMPOUND
    SCAN
    IF CURRENT GRT $LDEF AND
	CURRENT LSS $HDEF THEN	;BLOCK
	FIND BLK
    ELSE
    IF NEXT EQL $CLASS AND
	CURRENT NEQ $BEGIN THEN	;BLOCK
	FIND BLK
    ELSE		    ;COMPOUND
	FIND STAT
	WHILE CURRENT EQL $SEMIC DO
	    SCAN
	    FIND STAT
	OD
	IF CURRENT NEQ $END THEN
	    ERROR 3,G,,MISSING END
	ELSE
	    SCAN
	FI
    FI FI
ELSE
IF CURRENT ONEOF $ACTIV $REACT THEN
    IF CURRENT EQL $ACTIV THEN
	LOAD REG1 $QACTIV
    ELSE
	LOAD REG1 $QREACT
    FI
    SCAN
    FIND EXPR
    IF CURRENT EQL $AFTER THEN
	ADD REG1 $QAFTER
	SCAN
	FIND EXPR
    ELSE
    IF CURRENT EQL $BEFOR THEN
	ADD REG1 $QBEFOR
	SCAN
	FIND EXPR
    ELSE
    IF CURRENT ONEOF $AT $DELAY THEN
	IF CURRENT EQL $AT THEN
	    ADD REG1 $QAT
	ELSE
	    ADD REG1 $QDELAY
	FI
	SCAN
	FIND EXPR
	IF CURRENT EQL $PRIOR THEN
	    SCAN
	    ADD REG1 $QPRIOR
	FI
    FI FI FI
    IC $ACTIV REG1
ELSE
GOIF CURRENT ONEOF $SEMIC $END $EOF $ELSE $OTHER $WHEN TO TEXIT
IF CURRENT EQL $INNER THEN
    SCAN
    ERROR 26,E,,INNER ILLEGALLY PLACED
ELSE
IF DECL THEN			;DECLARATION?????
    ERROR 27,G,,DECLARATION AFTER STATEMENT
FI FI FI FI FI FI
IF CURRENT NONEOF $SEMIC $END $ELSE $WHEN $OTHER $EOF THEN
    ERROR 1,CE,,MISPLACED SYMBOL XXXX
    RECOVER $ELSE $OTHER $WHEN
FI
EPROC
	SUBTTL	PROCEDURE SIST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE SIST PARSES THE SYNTACTIC ENTITIES:
	<FOR-STATEMENT>
	<CONNECTION STATEMENT>
	<WHILE-STATEMENT>

ERROR MESSAGES:
		MISSING FOR LIST ELEMENT
		MISPLACED SYMBOL 'CURRENT'
		ILLEGAL CONTROLLED VARIABLE
		MISSING CONNECTION BLOCK
		ILLEGAL WHEN CLAUSE
		MISSING DO AFTER WHILE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE SIST
SAVE REG2
IF CURRENT EQL $FOR THEN	;<FOR-STATEMENT> 
    IF NEXT GEQ $ID THEN
	SCAN
	EXEC	SMUID
	IF CURRENT ONEOF $BECOM $DENOT THEN
	    IF CURRENT EQL $BECOM THEN
		IC $CVBE
	    ELSE
		IC $CVDE
	    FI
	    SCAN
	    LOAD REG2 FIXUP3
	    LOAD REG1 $BEG(ZHE,FOR)
	    EXEC SDBEG
	    IF CURRENT EQL $DO THEN
		ERROR 30,E,,MISSING FOR LIST
	    ELSE
		FIND FLST
		WHILE CURRENT EQL $COMMA DO
		    SCAN
		    FIND FLST
		OD
	    FI
	    IF CURRENT NEQ $DO THEN
		ERROR 1,CE,,MISPLACED SYMBOL XXXX
		RECOVER $DO $ELSE $OTHER $WHEN
	    FI
	    IC $FORDO
	    IF CURRENT EQL $DO THEN
		SCAN
		FIND ELST
	    ELSE
		ERROR 31,,,MISSING DO IN FOR-STATEMENT
	    FI
	    IC $ENDFO
	    EXEC SDEND
	    GOTO TEXIT
	FI
    FI
    ERROR 32,P,,ILLEGAL CONTROLLED VARIABLE
    RECOVER $ELSE $OTHER $WHEN
ELSE
IF CURRENT EQL $INSPE THEN	;<CONNECTION STATEMENT>
    SCAN
    FIND EXPR
    IF CURRENT NONEOF $DO $WHEN THEN
	ERROR 1,CE,,MISPLACED SYMBOL XXXX
	RECOVER $DO $WHEN
    FI
    IF CURRENT NONEOF $WHEN $DO THEN
	ERROR 33,P,,MISSING CONNECTION BLOCK
    ELSE
	LOAD REG2 FIXUP4
	IC $INSPE REG2
	IF CURRENT EQL $DO THEN
	    IC $DO
	    SCAN
	    LOAD REG1 $BEG(ZHB,INSPEC)
	    EXEC SDBEG
	    FIND ELST
	    IC $ENDDO
	    EXEC SDEND
	ELSE
	    LOOP
		LINE
		SCAN
		IF CURRENT LSS $ID OR
		    NEXT NEQ $DO THEN
		    ERROR 34,E,,ILLEGAL WHEN CLAUSE
		    RECOVER $OTHER $WHEN
		ELSE
		    EXEC SMUID
		    SCAN
		    IC $WHEDO
		    LOAD REG1 $BEG(ZHB,INSPEC)
		    EXEC SDBEG
		    FIND ELST
		    IC $ENDDO
		    EXEC SDEND
		FI
	    AS CURRENT EQL $WHEN SA
	FI
	IF CURRENT EQL $OTHER THEN
	    SCAN
	    IC $OTHER
	    FIND ELST
	    ADD REG2 $THREE
	    IC $FIX REG2
	ELSE
	    IC $NOTHR
	FI
    FI
ELSE
GOIF CURRENT NEQ $WHILE TO FEXIT
    SCAN			;<WHILE-STATEMENT>
    FIND EXPR
    IF CURRENT NEQ $DO THEN
	ERROR 1,CE,,MISPLACED SYMBOL XXXX
	RECOVER $DO $ELSE $OTHER $WHEN
    FI
    IF CURRENT NEQ $DO THEN
	ERROR 35,P,,MISSING DO IN WHILE-STATEMENT
    ELSE
	LOAD REG2  FIXUP2
	IC $WHILE REG2
	SCAN
	FIND ELST
	IC $JUMP REG2
	INCR REG2
	IC $FIX REG2
    FI
FI FI
EPROC
	SUBTTL	PROCEDURE LAB

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE LAB PARSES THE SYNTACTIC ENTITY <LABELS>
	<LABELS>::= ! <LABEL IDENTIFIER>: ! <LABELS><LABEL IDENTIFIER>:

ERROR MESSAGES:	NONE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE LAB
SAVE REG2
WHILE NEXT EQL $COLON AND
    CURRENT GEQ $ID DO
    LOAD REG1 $ZQU(ZQU,LABEL,SIMPLE,DECLARED)
    LOAD REG3 $ZERO
    LOAD REG2 FIXUP
    IC $FIX REG2
    EXEC SDZQU
    DSCAN
OD
EPROC
	SUBTTL	PROCEDURE FLST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE BOOLEAN PROCEDURE FLST PARSES THE SYNTACTIC ENTITY <FOR LIST ELEMENT>

ERROR MESSAGES:
		CANNOT FIND UNTIL

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE FLST
FIND EXPR
IF CURRENT EQL $STEP THEN
    SCAN
    FIND EXPR
    IF CURRENT NEQ $UNTIL THEN
	ERROR 36,P,,CANNOT FIND UNTIL
    ELSE
	SCAN
	FIND EXPR
	IC $FORST
    FI
ELSE
IF CURRENT EQL $WHILE THEN
    SCAN
    FIND EXPR
    IC $FORWH
ELSE
    IC $FORSI
FI FI
EPROC
	SUBTTL	PROCEDURE EXPR

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

EXPRESSIONS ARE PARSED BY THE PROCEDURE EXPR.
AS HELP IT HAS THE PROCEDURES:
    SEXP  WHICH PARSES SIMPLE EXPRESSIONS
    APAR  WHICH PARSES ACTUAL PARAMETER LST

EXPR ALWAYS RETURNS TRUE AND ALWAYS OUTPUTS A
SYNTACTICALLY CORRECT EXPRESSION TO IC1

ON EXIT, CURRENT CONTAINS ONE OF ',' ')' ']' 'THEN' 'ELSE'
OR A SYMBOL WHICH CAN NOT BE PART OF AN EXPRESSION


ERROR MESSAGES:
		CANNOT FIND THEN IN CONDITIONAL EXPRESSION
		CANNOT FIND ELSE IN CONDITIONAL EXPRESSION

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE EXPR
IF CURRENT NEQ $IF THEN
    FIND SEXP
ELSE
    SCAN
    FIND EXPR
    IF CURRENT NEQ $THEN THEN
	ERROR 37,AE,%THEN,"THEN" MISSING IN CONDITIONAL EXPRESSION
    ELSE
	SCAN
	FIND SEXP
	IF CURRENT NEQ $ELSE THEN
	    ERROR 37,AE,%ELSE,"ELSE" MISSING IN CONDITIONAL EXPRESSION
	ELSE
	    SCAN
	FI
	FIND EXPR
	IC $IFEX
    FI
FI
EPROC
	SUBTTL	PROCEDURE SEXP

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE SEXP PARSES THE SYNTACTIC ENTITY <SIMPLE EXPRESSION>

ERROR MESSAGES:
		MISSING )
		MISSING IDENTIFIER AFTER 'NEW/THIS/QUA/.'
		ILLEGAL CONDITIONAL EXPRESSION. PLUG IN PARENTHESIS.
		MISSING OPERAND BEFORE 'CURRENT'
		MISSING OPERATOR BEFORE 'CURRENT'

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE SEXP
SAVE REG1
LOAD STACK $MARK
LOOP	    ; BOOLEAN OPERATOR
IF CURRENT EQL $NOT THEN
    LOAD STACK CURRENT
    SCAN
FI
LOOP	    ; RELATIONAL OPERATOR
IF CURRENT ONEOF $PLUS $MINUS THEN
    INCR CURRENT
    LOAD STACK CURRENT
    SCAN
FI
LOOP	    ; ARITHMETIC OPERATOR
; TRY TO FIND OPERAND
BEGIN
    IF CURRENT GEQ $ID THEN
	EXEC SMUID
	FIND APAR
    ELSE
    IF CURRENT EQL $LP THEN
	SCAN
	FIND EXPR
	IF CURRENT EQL $RP THEN
	    SCAN
	ELSE
	    ERROR 20,AE,%RP,MISSING "RIGHT PARENTHESIS"
	FI
	IC $PAREN
    ELSE
    IF CURRENT ONEOF $NONE $NOTEX $TRUE $FALSE THEN
	IC CURRENT
	SCAN
    ELSE
    IF CURRENT ONEOF $CONI $CONR $CONT THEN
	IC CURRENT VAL
	SCAN
    ELSE
    IF CURRENT EQL $CONC THEN
	IC CURRENT HVAL
	SCAN
    ELSE
    IF CURRENT EQL $CONLR THEN
	IC CURRENT DVAL
	SCAN
    ELSE
    IF CURRENT EQL $NEW THEN
	SCAN
	IF CURRENT LSS $ID THEN
	    ERROR 41,AE,%NEW,MISSING IDENTIFIER AFTER "NEW"
	    IC $UDEF
	ELSE
	    EXEC SMUID
	FI
	FIND APAR
	IC $NEW
    ELSE
    IF CURRENT EQL $THIS THEN
	SCAN
	IF CURRENT LSS $ID THEN
	    ERROR 41,AE,%THIS,MISSING IDENTIFIER AFTER "THIS"
	    IC $UDEF
	ELSE
	    EXEC SMUID
	FI
	IC $THIS
    ELSE
    IF CURRENT EQL $LB THEN
	ERROR 4,W,,LEFT BRACKET IN EXPRESSION
	SCAN
	FIND EXPR
	IF CURRENT EQL $RB THEN
	    SCAN
	ELSE
	    ERROR 20,AE,%RB,MISSING "RIGHT BRACKET"
	FI
	IC $PAREN
    ELSE	    ;ERROR  RECOVERY
	IF CURRENT EQL $IF THEN
	    ERROR 42,E,,COND EXPRESSION AS SIMPLE
	    FIND EXPR
	ELSE
	    ERROR 43,E,,MISSING OPERAND
	    IC $UDEF
	FI
    FI FI FI FI FI FI FI FI FI
L1():
    IF CURRENT EQL $DOT THEN
	SCAN
	IF CURRENT LSS $ID THEN
	    ERROR 41,AE,%DOT,MISSING IDENTIFIER AFTER "DOT"
	    IC $UDEF
	ELSE
	    EXEC SMUID
	FI
	IC $DOT
	FIND APAR
	GOTO L1
    FI
    IF CURRENT EQL $QUA THEN
	SCAN
	IF CURRENT LSS $ID THEN
	    ERROR 41,AE,%QUA,MISSING IDENTIFIER AFTER "QUA"
	    IC $UDEF
	ELSE
	    EXEC SMUID
	FI
	IC $QUA
	GOTO L1
    FI
ENDD
WHILE CURRENT EQL $NOT DO
    ERROR 1,CE,,MISPLACED SYMBOL XXXX
    SCAN
OD
IF CURRENT GEQ $CLLIM AND
    CURRENT LEQ $CULIM OR
    CURRENT GEQ $ID OR
    CURRENT ONEOF $LP $THIS $NEW $IF THEN
	ERROR 44,CE,,MISSING BINARY OPERATOR
	LOAD REG1 $DELOP
	LOAD STACK REG1
ELSE
    IF CURRENT GEQ $OP THEN
	LOAD REG1 CURRENT
    ELSE
	MOVE X1SR1,ZSROPR(X1CUR)
    FI
    WHILE REG1 GEQ STACK DO
	IC STACK
    OD
    LOAD REG1 CURRENT
    IF CURRENT LSS $OP THEN
	LOAD STACK CURRENT
	SCAN
    FI
FI
AS REG1 LSS $REL SA
AS REG1 LSS $BOP SA
AS REG1 LSS $OP SA
LOAD REG1 STACK
EPROC
	SUBTTL	PROCEDURE APAR

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

THE PROPER PROCEDURE APAR PARSES THE SYNTACTIC ENTITY <ACTUAL PARAMETER PART>

ERROR MESSAGES:
		MISSING )
		MISSING ]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


PROCEDURE APAR
IF CURRENT EQL $LP THEN
    IC $LP
    LOOP
	SCAN
	FIND EXPR
    AS CURRENT EQL $COMMA SA
    IC $RP
    IF CURRENT EQL $RP THEN
	SCAN
    ELSE
	ERROR 20,AE,%RP,MISSING "RIGHT PARENTHESIS"
    FI
ELSE IF CURRENT EQL $LB THEN
    IC $LB
    LOOP
	SCAN
	FIND EXPR
    AS CURRENT EQL $COMMA SA
    IC $RP
    IF CURRENT EQL $RB THEN
	SCAN
    ELSE
	ERROR 20,AE,%RB,MISSING "RIGHT BRACKET"
    FI
FI FI
EPROC
	SUBTTL	RECOVERY PROCEDURES

SRREC1:
	WHILE CURRENT NONEOF
	$SEMIC $END $BEGIN $EOF DO
		SCAN
	OD
	RETURN
SRREC2:
	WHILE CURRENT NONEOF
	$SEMIC $END $ELSE $OTHER $WHEN $BEGIN $EOF DO
		SCAN
	OD
	RETURN
SRREC3:
	WHILE CURRENT NONEOF
	$SEMIC $END $DO $ELSE $OTHER $WHEN $BEGIN $EOF DO
		SCAN
	OD
	RETURN
	SUBTTL	PRECEDENCE RELATIONS OF OPERATORS

ZSROPR:

	0	;		=DELETION OPERATOR

; ARITHMETIC OPERATORS

	1	; ^ OR **	=POWER
	4	; *		=MULTIPLICATION
	4	; /		=DIVISION
	4	; //		=INTEGER DIVISION
	10	; +		=ADDITION
	10	; +		=UNARY PLUS
	10	; -		=SUBTRACTION
	10	; -		=UNARY MINUS

; RELATIONAL OPERATORS

	22	; < OR LT	=LESS THAN
	22	; <= OR LE	=NOT GREATER
	22	; = OR EQ	=EQUAL
	22	; > OR GT	=GREATER THAN
	22	; >= OR GE	=NOT LESS
	22	; \= OR NEQ	=NOT EQUAL
	22	; ==
	22	; =/=
	22	; IS
	22	; IN

; BOOLEAN OPERATORS

	23	; \ OR NOT
	24	; AND
	25	; OR
	26	; IMP		=IMPLICATE
	27	; EQV		=EQUIVALENT
	SUBTTL	EPILOGUE
	LIT
	END