*	*	*	*	*	*	*	*	*
*	*	DECLARATIONS	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*
*		LOCAL
*
	DECLARE('SNOBOL.SUBPROGRAM','EXECPH')
	DECLARE('OPTION','NO.STNO')
	DECLARE('PURGE.VARIABLE',ALL)
	DECLARE('PURGE.LABEL',ALL)
	DECLARE('EXTERNAL.FUNCTION','GETSTA,PUTOUT,GETITM,ERRMSG,STXERR,
.NEWLAB,SUBS,PARLIT,GETATR,NEWNAM')
	DECLARE('INTEGER','SW,I,J,NPAR,VARTYP,OBJTYP,RGL,LOPER,ROPER,
.OPER,TYPE,RSTFLG,MAXLVL,MODFLG,FAILFL,TML,LSGN,RTYP,RSGN,RTYPE,TP,
.DEDFLG')
	DECLARE('ENTRY.FUNCTION','INIEXE()')
	DECLARE('ENTRY.FUNCTION','EXECPH()VARCOD,PATCOD,OBJCOD,STACOD,
.GOTCOD,EVLCOD,STR1,STR2')
*
*		SYSTEM COMMON
*
*	TABLES AND LISTS
	DECLARE('EXTERNAL.VARIABLE',
.'SYMBTB,XNAMTB,KEYWTB,CTRLTB,DECLTB,CROSTB,CONSTB,ENTFTB,DSIZTB,
.BOPRTB,UOPRTB')
	DECLARE('EXTERNAL.VARIABLE',
.'ENTRLS,EXTRLS,FORTLS')
*	ARRAYS
	DECLARE('EXTERNAL.VARIABLE',
.'PTVRAR,PTFNAR,PRIMAR,GOTOAR,DECLAR,PROGAR,VARBAR,MACHAR,STENAR,BOPRAR,
.UOPRAR,PATRAR,EXPRAR,AROPAR,ARITAR,EACTAR')
*	PARAMETERS (STRINGS,DATATYPES)
	DECLARE('EXTERNAL.VARIABLE',
.'C,INDENT,SPLASH,ITNAM,ITENT,NOFAIL,SNONAM,SUBNAM,PARBLK,PRGNAM,STARTP,
.TEMLOC,P1,P2,P3,P4,P5')
*	PARAMETERS (INTEGERS)
	DECLARE('EXTERNAL.VARIABLE',
.'P,OBJFLG,LISTSR,INTGER,ITTYP,ITATR,PRGALV,PRGALL,PRGALF,STNFLG,HSHSIZ,
.STRTIM,DMPFLG,LISTOB,STNO,MAXTMP')
	DECLARE('INTEGER',
.'P,OBJFLG,LISTSR,INTGER,ITTYP,ITATR,PRGALV,PRGALL,PRGALF,STNFLG,HSHSIZ,
.STRTIM,DMPFLG,LISTOB,STNO,MAXTMP')
	DECLARE('EXTERNAL.VARIABLE',
.'XNATRB,VTATRB,VDATRB,LTATRB,FTATRB,FDATRB,TXATRB,VNATRB,VXATRB,VIATRB,
.VGATRB,LIATRB,LGATRB,FIATRB,FGATRB,FXATRB,SKATRB,SDATRB,BTATRB')
	DECLARE('INTEGER',
.'XNATRB,VTATRB,VDATRB,LTATRB,FTATRB,FDATRB,TXATRB,VNATRB,VXATRB,VIATRB,
.VGATRB,LIATRB,LGATRB,FIATRB,FGATRB,FXATRB,SKATRB,SDATRB,BTATRB')
	DECLARE('EXTERNAL.VARIABLE',
.'XNVATR,XNLATR,XNFATR,XNXMSK,VTVATR,VDDATR,VDPATR,VDDMSK,LTDATR,LTTMSK,
.FTFATR,FDPATR,FDIATR,FDDMSK,TXTATR,TXTMSK,VNNATR,VXXATR,VIPATR,VGGATR,
.LIPATR,LGGATR,FIPATR,FGGATR,FXXATR,FXXMSK,SKRATR,SDRATR,BTRATR')
	DECLARE('INTEGER',
.'XNVATR,XNLATR,XNFATR,XNXMSK,VTVATR,VDDATR,VDPATR,VDDMSK,LTDATR,LTTMSK,
.FTFATR,FDPATR,FDIATR,FDDMSK,TXTATR,TXTMSK,VNNATR,VXXATR,VIPATR,VGGATR,
.LIPATR,LGGATR,FIPATR,FGGATR,FXXATR,FXXMSK,SKRATR,SDRATR,BTRATR')
*	SPECIAL CHARACTERS,CHARACTER SEQUENCES, AND CHARACTER CLASSES
	DECLARE('EXTERNAL.VARIABLE',
.'FFCHR,CRLCHR,LFCHR,CRCHR,SQCHR,DQCHR,TBCHR,LCSCHR,BLNCHR,EQLCHR,
.QTSCHR,ELTCHR,LBCHR')
*	PATTERNS AND MATCHES
	DECLARE('EXTERNAL.VARIABLE',
.'COMSPT,INTGPT,BLNKPT,OPBLPT,PCOMPT,PCPRMT,IDENPT,DCLCMT,RSIDPT,LABLPT,
.POPRMT,IDENMT,SQLTPT,DQLTPT,LBDCPT,IDDCPT')
*
*	MINIMAL SYMBOL TABLE
*
	DECLARE('UNPURGE.VARIABLE','INIEXE,EXECPH,VARCOD,PATCOD,OBJCOD,
.STACOD,GOTCOD,EVLCOD,STR1,STR2,PR.X,TP,ROPER,PR.U,PR.L,NOD,NPAR,DEFSTR,
.GETLIT,GETINT,MODFLG,GETREL,DEFLAB,GETLAB,DEFVAR,GETDVR,GETVAR,GTOPTY,
.I,GTPVAL,PUTTRE,G.EX,E.EX,RSTFLG,EVLCOD,V.EX,P.EX,TLAB1,TLAB2,P.VR,
.U.EX,FUNC,MAXLVL,FAILFL,S.EX,DEDVAR,S.PR,S.VR,D.EX,RTYPE,D.PR,A.EX,
.RGL,LSGN,LOPER')
	DECLARE('UNPURGE.LABEL','INIEXE EXECPH PR.X PR.U PR.L DEFSTR
. GETLIT GETINT GETREL DEFLAB GETLAB DEFVAR GETVAR GTOPTY GTPVAL PUTTRE
. G.EX E.EX V.EX P.EX P.VR U.EX S.EX S.PR S.VR D.EX D.PR A.EX A B C D
. E F G')
	DECLARE('PURGE.FUNCTION','DEFINE,DATA,DIFFER,IDENT,DATATYPE,
.ITEM,SUBSTR,REPLACE,APPLY,SIZE')
*	*	*	*	*	*	*	*	*
*	*	INITIALIZE EXECUTABLE STATEMENT PHASE	*	*
*	*	*	*	*	*	*	*	*
INIEXE	DEFINE('PR.X()TP,ROPER')
	DEFINE('PR.U()TP,ROPER')
	DEFINE('PR.L()NOD,NPAR,TP,ROPER')
	DEFINE('DEFSTR(STR1)')
	DEFINE('GETLIT(STR1)')
	DEFINE('GETINT(STR1,MODFLG)')
	DEFINE('GETREL(STR1,MODFLG)')
	DEFINE('DEFLAB()')
	DEFINE('GETLAB()')
	DEFINE('DEFVAR()')
	DEFINE('GETDVR(STR1)')
	DEFINE('GETVAR(STR1)')
	DEFINE('GTOPTY(I)')
	DEFINE('GTPVAL(NOD)')
	DEFINE('PUTTRE(NOD)')
	DEFINE('G.EX()')
	DEFINE('E.EX(NOD)NPAR,RSTFLG,EVLCOD')
	DEFINE('V.EX(NOD)')
	DEFINE('P.EX(NOD,ROPER)TLAB1,TLAB2')
	DEFINE('P.VR(NOD)ROPER')
	DEFINE('U.EX(NOD,FUNC,MAXLVL)FAILFL')
	DEFINE('S.EX(NOD,DEDVAR)NPAR')
	DEFINE('S.PR(NOD)ROPER')
	DEFINE('S.VR(NOD,MODFLG)TLAB1,NPAR')
	DEFINE('D.EX(NOD,MODFLG)ROPER,RTYPE')
	DEFINE('D.PR(NOD,MODFLG)ROPER,RTYPE,TLAB1')
	DEFINE('A.EX(NOD,MODFLG,RGL)ROPER,RTYPE,LSGN,LOPER')
	DATA('SYM(INAM,ATRB)')
	DATA('CRS(NEXT,CRSI)')
	DATA('NOD(FRNT,BACK)')
	DATA('BON(OPTY,LFTS,RGTS)')
	DATA('ELN(OPTY,SBJT,PVAL)')
	DATA('PLN(NXTL,PARP,PVAL)')
	EMPTMT	= TAB(*P)  @TP  (RPOS(0) ! SPAN(BLNCHR)  @TP  (RPOS(0)
. ! ':'))
	MAXLVL	= 12	:(RETURN)
*	*	*	*	*	*	*	*	*
*	*	GENERATE CODE PREAMBLE	*	*	*	*
*	*	*	*	*	*	*	*	*
EXECPH	PRGNAM	= ?DIFFER(SNONAM) SNONAM	:S(PRGHD1)
	PRGNAM	= ?DIFFER(SUBNAM) SUBNAM	:S(PRGHD1)
	PRGNAM	= '.MAIN.'
	SNONAM	= PRGNAM
PRGHD1	?INE(OBJFLG + LISTOB,0)	:F(PRGHD7)
	PUTOUT(SUBS(DECLAR<1>,PRGNAM))
	STR1	= ENTRLS
	STR2	= DECLAR<2>
	SW	= 1	:(PRGHD3)
PRGHD2	STR1	= EXTRLS
	STR2	= DECLAR<4>
	SW	=
PRGHD3	STR3	=
	I	=
PRGHD4	(?IDENT(STR1) ?PUTOUT(STR3))	:F(PRGHD5)
	?IEQ(SW,0)	:F(PRGHD2)S(PRGHD7)
PRGHD5	STR3	= ?IEQ(I,0) SUBS(STR2,CRSI(STR1))	:S(PRGHD6)
	STR3	= STR3 SUBS(DECLAR<3>,CRSI(STR1))
PRGHD6	STR1	= NEXT(STR1)
	(?IGE(I,9) ?PUTOUT(STR3))	:S(PRGHD3)
	I	= I + 1	:(PRGHD4)
PRGHD7	ENTRLS	=
	EXTRLS	=
	PARBLK	= NEWLAB()
	TEMLOC	= NEWLAB()
	PRGNAM	= INAM(DEFSTR(PRGNAM))
	STARTP	= ?DIFFER(SNONAM) NEWLAB()	:F(CHKEOF)
	STARTL	= NEWLAB()
	PUTOUT(SUBS(PROGAR<1>,STARTP,HSHSIZ,PARBLK,STARTL))
* CHECK IF DECLPH HIT EOF
CHKEOF	IDENT(C)	:F(LABL)S(NOEND)
*	*	*	*	*	*	*	*	*
*	*	STATEMENT PROCESSING LOOP	*	*	*
*	*	*	*	*	*	*	*	*
*
STLOOP	C	= GETSTA()	:F(NOEND)
*
*	PROCESS LABEL FIELD
LABL	C	@P  LABLPT  @P	:F(BODY)
	PUTOUT(SUBS(PROGAR<6>,DEFLAB()))	:S(BODY)
	(?DIFFER(ITNAM,'END') ?ERRMSG('MULTIPLY-DEFINED LABEL: ' ITNAM
. ', IGNORED'))	:S(BODY)
	DIFFER(SNONAM)	:F(LABL2)
	C	LEN(*P)  BLNKPT  @P  LABLPT	:F(LABL1)
	PUTOUT(SUBS(PROGAR<5>,STARTL,GETLAB()))	:(LABL2)
LABL1	PUTOUT(SUBS(PROGAR<4>,STARTL,STARTP))
LABL2	PUTOUT(PROGAR<2>)	:(RETURN)
NOEND	(?ERRMSG('NO END STATEMENT') ?DIFFER(SNONAM))	:S(LABL1)F(LABL2
.)
*
*	PROCESS STATEMENT BODY
BODY	STACOD	=
	VARCOD	=
	PATCOD	=
	OBJCOD	=
	TML	=
	DEDFLG	= 1
* CHECK FOR EMPTY BODY
	C	EMPTMT	:F(BODY1)
	P	= TP	:(GOTO)
BODY1	P	= ?INE(P,TP) TP	:F(SYNTAX)
	DEDFLG	=
* PARSE SUBJECT
	VARCOD	= PR.U()	:F(ERRPTR)
	C	EMPTMT	:S(DEGEN)
	P	= ?INE(P,TP) TP	:F(SYNTAX)
* CHECK FOR ASSIGNMENT
	C	LEN(*P)  NOTANY(EQLCHR)	:F(PARSOB)
* PARSE PATTERN
	PATCOD	= PR.X()	:F(ERRPTR)
	C	EMPTMT	:S(MATCH)
	P	= ?INE(P,TP) TP	:F(SYNTAX)
* PARSE EQUALS BEFORE OBJECT
PARSOB	C	LEN(*P)  ANY(EQLCHR)  @P	:F(SYNTAX)
	C	EMPTMT	:S(PARSFN)
	P	= ?INE(P,TP) TP	:F(SYNTAX)
	OBJCOD	= PR.X()	:F(ERRPTR)
	C	EMPTMT	:S(PARSFN)
	P	= TP	:(SYNTAX)
PARSFN	P	= TP
	IDENT(PATCOD)	:F(REPLAC)S(ASSIGN)
*	DEGENERATE
DEGEN	P	= TP
	VARTYP	= GTOPTY(OPTY(VARCOD))
	DEDFLG	= ?ILE(VARTYP,1) 1
	VARTYP	= ?ILE(VARTYP,3) REMDR(VARTYP,2)	:F(DEGEN1)
	STACOD	= D.EX(VARCOD,VARTYP)	:F(ERRPTR)S(GOTO)
DEGEN1	STACOD	= E.EX(VARCOD)	:F(ERRPTR)S(GOTO)
*	ASSIGNMENT
ASSIGN	VARTYP	= GTOPTY(OPTY(VARCOD))
	(?ILE(VARTYP,1) ?ILE(OPER,1))	:F(ASGSTR)
	I	= ?IEQ(OPER,1) SBJT(VARCOD)	:F(DASG1)
	P	= ?ILE(I,7) ?ERRMSG('ASSIGNMENT TO PROTECTED KEYWORD')
. PVAL(VARCOD)	:S(ERRPTR)
	VARCOD	= SUBS(VARBAR<1>,I)	:(DASG2)
DASG1	VARCOD	= GETDVR(SBJT(VARCOD))
DASG2	STACOD	= ?IDENT(OBJCOD) SUBS(VARBAR<3>,VARCOD)	:S(GOTO)
	OBJTYP	= GTOPTY(OPTY(OBJCOD))
	VARTYP	= ?IGT(OBJTYP,3) VARTYP + 2	:S(DASG3)
	DEDFLG	= ?ILE(OBJTYP,1) 1
	STACOD	= NOD(D.EX(OBJCOD,VARTYP),SUBS(VARBAR<2>,VARCOD))
.	:F(ERRPTR)S(GOTO)
DASG3	P	= ?IEQ(OBJTYP,5) ?ERRMSG('ILLEGAL ASSIGNMENT TO DEDICA
.TED VAR') PVAL(VARCOD)	:S(ERRPTR)
	STACOD	= NOD(S.EX(OBJCOD),SUBS(VARBAR<5>,VARTYP,VARCOD))
.	:F(ERRPTR)S(GOTO)
ASGSTR	ITATR	= ?IEQ(OPER,0) ATRB(SBJT(VARCOD))	:F(ASGVAR)
	ITTYP	=
	(?GETATR() ?IEQ(VDATRB,VDDATR))	:F(ASGIDF)
	STACOD	= S.EX(OBJCOD,GETDVR(SBJT(VARCOD))) :F(ERRPTR)S(GOTO)
ASGIDF	P	= ?IEQ(VDATRB,VDPATR) ?ERRMSG('IMPROPER USE OF PATTERN P
.RIMITIVE') PVAL(VARCOD)	:S(ERRPTR)
	STACOD	= ?IDENT(OBJCOD) SUBS(VARBAR<6>,GETVAR(SBJT(VARCOD)))
.	:S(GOTO)
	STACOD	= NOD(E.EX(OBJCOD),SUBS(VARBAR<7>,GETVAR(SBJT(VARCOD))))
.	:F(ERRPTR)S(GOTO)
ASGVAR	STACOD	= S.VR(VARCOD,1)	:F(ERRPTR)
	STACOD	= ?IDENT(OBJCOD) NOD(STACOD,VARBAR<8>)	:S(GOTO)
	STACOD	= NOD(NOD(STACOD,VARBAR<9>),NOD(E.EX(OBJCOD),VARBAR<10>
.))	:F(ERRPTR)S(GOTO)
*	REPLACEMENT
REPLAC	NPAR	=
	EVLCOD	=
	STACOD	= P.EX(PATCOD)	:F(ERRPTR)
	STACOD	= ?IEQ(NPAR,0) NOD(NOD(SUBS(MACHAR<2>,-1),MACHAR<3>),
.STACOD)	:S(REPL2)
	STACOD	= NOD(SUBS(MACHAR<2>,NPAR + 1),STACOD)
REPL2	STACOD	= ?DIFFER(EVLCOD) NOD(EVLCOD,STACOD)
	OBJCOD	= ?IDENT(OBJCOD) MACHAR<9>	:S(REPL3)
	OBJCOD	= S.EX(OBJCOD)	:F(ERRPTR)
REPL3	STACOD	= NOD(NOD(MACHAR<1>,STACOD),NOD(NOD(MACHAR<7>,OBJCOD),
.MACHAR<8>))
	(?GTOPTY(OPTY(VARCOD)) ?IEQ(OPER,0) ?IEQ(TYPE,4)) :F(REPL4)
	VARCOD	= GETVAR(SBJT(VARCOD)) ?IEQ(VDATRB,0)	:F(REPL4)
	STACOD	= NOD(NOD(SUBS(MACHAR<5>,VARCOD),STACOD),SUBS(VARBAR<7>,
.VARCOD))	:(GOTO)
REPL4	VARCOD	= V.EX(VARCOD)	:F(ERRPTR)
	STACOD	= NOD(NOD(VARCOD,NOD(VARBAR<9>,MACHAR<6>)),NOD(STACOD,
.VARBAR<10>))	:(GOTO)
*	MATCH
MATCH	P	= TP
	VARCOD	= S.PR(VARCOD)	:F(ERRPTR)
	NPAR	=
	EVLCOD	=
	STACOD	= P.EX(PATCOD)	:F(ERRPTR)
	STACOD	= ?IEQ(NPAR,0) NOD(NOD(SUBS(MACHAR<2>,-1),MACHAR<3>),
.STACOD)	:S(MATCH1)
	STACOD	= NOD(SUBS(MACHAR<2>,NPAR + 1),STACOD)
MATCH1	STACOD	= ?DIFFER(EVLCOD) NOD(EVLCOD,STACOD)
	STACOD	= NOD(NOD(VARCOD,MACHAR<1>),NOD(STACOD,MACHAR<4>))
*
*	PROCESS GOTO FIELD
GOTO	GOTCOD	=
	GLOBF	= NOFAIL
	C	LEN(*P)  @TP  (RPOS(0) ! ':'  NSPAN(BLNCHR)  @TP)
.	:F(SYNTAX)
	P	= ?INE(P,TP) TP	:F(STLFIN)
	C	LEN(*P)  ANY('SF') $ STR1  @P	:S(GOTO2)
* UNCONDITIONAL GOTO
	GOTCOD	= G.EX()	:F(ERRPTR)
	DIFFER(DATATYPE(GOTCOD),'NOD')	:F(GOTO1)
	GLOBF	= ?IDENT(GLOBF) GOTCOD
	GOTCOD	= SUBS(GOTOAR<5>,GOTCOD)	:(GOTO7)
GOTO1	GLOBF	= ?IDENT(GLOBF) NEWLAB()	:F(GOTO7)
	GOTCOD	= NOD(SUBS(GOTOAR<4>,GLOBF),GOTCOD)	:(GOTO7)
* CONDITIONAL GOTO(S)
GOTO2	IDENT(STR1,'F')	:F(GOTO5)
* FAILURE GOTO
	STR1	= G.EX()	:F(ERRPTR)
	GLOBF	= ?DIFFER(DATATYPE(STR1),'NOD') STR1	:S(GOTO3)
	GLOBF	= NEWLAB()
	GOTCOD	= NOD(SUBS(GOTOAR<4>,GLOBF),STR1)
* CHECK FOR SUCCESS GOTO FOLLOWING FAILURE
GOTO3	C	LEN(*P)  NSPAN(BLNCHR)  'S'  @P	:S(GOTO4)
	STR1	= ?DIFFER(GOTCOD) NEWLAB()	:F(GOTO7)
	GOTCOD	= NOD(NOD(SUBS(GOTOAR<5>,STR1),GOTCOD),SUBS(GOTOAR<4>,
.STR1))	:(GOTO7)
GOTO4	STR1	= G.EX()	:F(ERRPTR)
	STR1	= ?DIFFER(DATATYPE(STR1),'NOD') SUBS(GOTOAR<5>,STR1)
	GOTCOD	= ?IDENT(GOTCOD) STR1	:S(GOTO7)
	GOTCOD	= NOD(STR1,GOTCOD)
* SUCCESS GOTO
GOTO5	GOTCOD	= G.EX()	:F(ERRPTR)
	GOTCOD	= ?DIFFER(DATATYPE(GOTCOD),'NOD') SUBS(GOTOAR<5>,GOTCOD)
* CHECK FOR FAILURE GOTO FOLLOWING SUCCESS
	C	LEN(*P)  NSPAN(BLNCHR)  'F'  @P	:S(GOTO6)
	GLOBF	= ?IEQ(DEDFLG,0) NEWLAB()	:F(GOTO7)
	GOTCOD	= NOD(GOTCOD,SUBS(GOTOAR<4>,GLOBF))	:(GOTO7)
GOTO6	STR1	= G.EX()	:F(ERRPTR)
	GLOBF	= ?DIFFER(DATATYPE(STR1),'NOD') STR1	:S(GOTO7)
	GLOBF	= NEWLAB()
	GOTCOD	= NOD(GOTCOD,NOD(SUBS(GOTOAR<4>,GLOBF),STR1))
* CHECK FOR CLEAN ENDING
GOTO7	C	LEN(*P)  NSPAN(BLNCHR)  @P  RPOS(0)	:F(SYNTAX)
*
*	OUTPUT CODE FOR STATEMENT ENTRY, BODY, AND GOTO
STLFIN	GLOBF	= ?IDENT(GLOBF) ?IEQ(DEDFLG,0) NEWLAB()	:F(STLFN1)
	GOTCOD	= SUBS(GOTOAR<4>,GLOBF)
STLFN1	?INE(OBJFLG + LISTOB,0)	:F(STLOOP)
	(?ILT(STNFLG,0) ?IEQ(DEDFLG,1))	:S(STLFN2)
	PUTOUT(SUBS(STENAR<STNFLG>,GLOBF,STNO))
STLFN2	(?DIFFER(STACOD) ?PUTTRE(STACOD))
	(?DIFFER(GOTCOD) ?PUTTRE(GOTCOD))	:(STLOOP)
*	ERRORS
SYNTAX	STXERR('ERROR IN SYNTAX')	:(ERRCLR)
ERRPTR	STXERR()
ERRCLR	STACOD	= PROGAR<7>
	GOTCOD	=
	GLOBF	=	:(STLFN1)
*	*	*	*	*	*	*	*	*
*	*	SUBROUTINES	*	*	*	*	*
*	*	*	*	*	*	*	*	*
*		PR.X()TP,ROPER PARSE EXPRESSION
*	PARSES A SERIES OF ELEMENTS SEPARATED BY THE BINARY OPERATIONS
*	**,^,/,*,+,-,$,.,(SPACE), AND !, AND BUILDS A TEXT TREE WITH THE
*	LOWEST PRECEDENCE OPERATOR AT THE TOP. **,^,(SPACE), AND ! ARE
*	CONSIDERED RIGHT-ASSOCIATIVE, AND THE REST LEFT-ASSOCIATIVE
*
PR.X	ROPER	= 42
	RGL	=
PR.X0	PR.X	= BON(ROPER + LSHIFT(RGL,6),PR.X,PR.U()) :F(FRETURN)
	C	LEN(*P)  SPAN(BLNCHR)  @RGL	:F(PR.X9)
	C	LEN(*RGL)  (ANY('^*/+-.$!') ! '**') . STR1  SPAN(BLNCHR)
.  @P	:F(PR.X8)
	ROPER	= BOPRTB[STR1]
PR.X1	I	= RSHIFT(ROPER,1)
PR.X2	RGL	= OPTY(PR.X)
	LOPER	= AND(RGL,63)
	J	= RSHIFT(LOPER,1)
	?IGE(I,J)	:F(PR.X0)
	?IEQ(I,J)	:F(PR.X3)
	(?INE(I,15) ?INE(I,19) ?INE(I,20))	:F(PR.X0)
	PR.X	= ?IEQ(I,21) RGTS(PR.X)	:S(RETURN)
PR.X3	STR1	= LFTS(PR.X)
	LFTS(PR.X)	= RGTS(STR1)
	RGTS(STR1)	= PR.X
	J	= ITEM(BOPRAR<J>,GTOPTY(OPTY(LFTS(PR.X))),GTOPTY(OPTY(
.RGTS(PR.X))))
	P	= ?IEQ(J,7) RSHIFT(RGL,6)	:F(PR.X5)
PR.X4	ERRMSG('IMPROPER TYPE FOR OPERATOR')	:(FRETURN)
PR.X5	J	= ?IEQ(J,6) TYPE	:F(PR.X7)
	J	= ?IEQ(OPER,11) GTOPTY(OPTY(LFTS(PR.X))) :S(PR.X6)
	J	= ?GTOPTY(OPTY(LFTS(PR.X))) ?INE(OPER,11) 4 :S(PR.X7)
PR.X6	J	= ?ILE(J,1) J + 2
PR.X7	OPTY(PR.X)	= LSHIFT(LOPER,3) + J
	PR.X	= STR1	:(PR.X2)
PR.X8	C	LEN(*RGL)  NOTANY(':=_)>],')	:F(PR.X9)
	ROPER	= 38
	P	= RGL	:(PR.X1)
PR.X9	ROPER	= 42	:(PR.X1)
*	*	*	*	*	*	*	*	*
*		PR.U()TP,ROPER PARSE ELEMENT
*	PARSES A SINGLE ELEMENT AND RETURNS THE ELN DATATYPE FOR IT
*
PR.U	TP	= P
* CONVERT FIRST CHAR INTO CHARACTERS A-G REPRESENTING: A-UNRECOGNIZA-
* BLE, B-KEYWORD, C-UNARY OPERATOR, D-STRING LITERAL, E-NUMERIC, F-OPEN
* PARENTHESIS, G-ALPHABETIC
	STR1	= SUBSTR(C,1,P)	:S($REPLACE(STR1,&ALPHABET,ELTCHR))
* UNRECOGNIZABLE ELEMENT
A	ERRMSG('UNRECOGNIZABLE ELEMENT')	:(FRETURN)
* KEYWORD
B	P	= P + 1
	C	IDENMT	:F(PR.U2)
	PR.U	= KEYWTB[ITNAM]
	I	= ?DIFFER(PR.U) 0	:F(PR.U2)
	I	= ?IEQ(PR.U / 2,3) 4
	DMPFLG	= ?IEQ(PR.U,18) 1
	I	= I + 8
PR.U1	PR.U	= ELN(I,PR.U,TP)	:(RETURN)
PR.U2	P	= ?ERRMSG('UNRECOGNIZABLE KEYWORD') TP + 1 :(FRETURN)
* UNARY OPERATOR
C	ROPER	= UOPRTB[STR1]
	P	= P + 1
	PR.U	= PR.U()	:F(FRETURN)
	I	= ITEM(UOPRAR<ROPER>,GTOPTY(OPTY(PR.U)))
	P	= ?IEQ(I,7) TP	:S(PR.X4)
	I	= LSHIFT(ROPER,3) + I	:(PR.U1)
* STRING LITERAL
D	P	= P + 1
	ITPAT	= ?IDENT(STR1,SQCHR) SQLTPT	:S(PR.U3)
	ITPAT	= DQLTPT
PR.U3	ITNAM	= PARLIT(STR1,ITPAT)	:F(A)
	P	= P + 1
	PR.U	= ?DIFFER(ITNAM) DEFSTR()
	I	= 36	:(PR.U1)
* NUMERIC
E	C	LEN(*P)  INTGPT  NSPAN('.') $ STR1  @P	:F(A)
	ITATR	=
	ITNAM	= ?IDENT(STR1) INTGER	:F(PR.U5)
	I	= 16
PR.U4	ITPTR	= .CONSTB[ITNAM]
	PR.U	= ?DIFFER($ITPTR) $ITPTR	:S(PR.U1)
	ITATR	= ?IEQ(I,16) ?ILE(INTGER,262143) 262144 + INTGER
	$ITPTR	= SYM(NEWNAM(),ITATR)
	PR.U	= $ITPTR	:(PR.U1)
PR.U5	P	= ?DIFFER(STR1,'.') P - 1	:S(A)
	ITNAM	= INTGER
	INTGER	=
	C	LEN(*P)  NSPAN('0123456789') $ STR1  @P
	P	= ?IGE(SIZE(STR1),10) P - SIZE(STR1)	:S(A)
	ITNAM	= ITNAM + ('0.' STR1)
	I	= 25	:(PR.U4)
* OPEN PARENTHESIS
F	C	POPRMT	:F(A)
	PR.U	= PR.X()	:F(FRETURN)
	C	PCPRMT	:F(PR.U9)
	I	= 56 + GTOPTY(OPTY(PR.U))	:(PR.U1)
* ALPHABETIC
G	C	IDENMT  (ANY('(<[') ! '') $ STR1	:F(A)
	PR.U	= ?IDENT(STR1) DEFVAR()	:F(PR.U6)
	I	= ?ILE(VDATRB,VDDATR) 4	:S(PR.U1)
	I	= ?ILT(VDATRB,VDPATR) VDATRB / VDDATR - 2 :S(PR.U1)
	I	= 5	:(PR.U1)
PR.U6	ITATR	= ?IDENT(STR1,'(') FTFATR + PRGALF	:F(PR.U7)
	ITTYP	= 2
	GETITM()
	ATRB(ITENT)	= ?IEQ(FTATRB,0) OR(ITATR,FTFATR)
	I	= FDATRB / FDPATR
	I	= ?ILE(I,1) I + 4
	C	POPRMT	:F(A)
	PR.U	= ELN(48 + I,PR.L(),TP)	:F(FRETURN)
	C	PCPRMT	:F(PR.U9)S(RETURN)
PR.U7	PR.U	= ?DEFVAR() ?IEQ(VDATRB,0) ELN(44,'',STR1) :F(PR.U10)
	C	LEN(*P)  STR1  NSPAN(BLNCHR)  @P	:F(A)
	SBJT(PR.U)	= PR.L()	:F(FRETURN)
	STR1	= PVAL(PR.U)
	STR1	= ?IDENT(STR1,'<') '>'	:S(PR.U8)
	STR1	= ']'
PR.U8	C	LEN(*P)  NSPAN(BLNCHR)  @P  STR1  @P	:F(PR.U9)
	PVAL(PR.U)	= TP	:(RETURN)
PR.U9	P	= ?STXERR('UNBALANCED EXPRESSION OR PARM LIST') TP
.	:(FRETURN)
PR.U10	P	= ?ERRMSG('ILLEGAL ARRAY REF, DEDICATED VAR') TP
.	:(FRETURN)
*	*	*	*	*	*	*	*	*
*		PR.L()NOD,NPAR,TP,ROPER PARSE PARAMETER LIST
*	PARSES 0 OR MORE EXPRESSIONS SEPARATED BY COMMAS, AND RETURNS
*	A PLN DATATYPE FOR THE LIST. EXPECTS ITENT SET TO THE VARIABLE
*	OR FUNCTION ENTRY, AND SETS PVAL OF THE FIRST PLN TO THE # OF
*	PARMS * 8 + THE MAX OF THE TYPES OF ALL PARMS
*
PR.L	PR.L	= PLN('',ITENT,0)
	C	LEN(*P)  ANY(')>]')	:S(RETURN)
	NOD	= .NXTL(PR.L)
PR.L1	TP	= P
	STR1	= PR.X()	:F(FRETURN)
	NPAR	= NPAR + 1
	ROPER	= ?IGT(GTOPTY(OPTY(STR1)),ROPER) TYPE
	$NOD	= PLN('',STR1,TP)
	C	LEN(*P)  PCOMPT  @P	:F(PR.L2)
	NOD	= .NXTL($NOD)	:(PR.L1)
PR.L2	PVAL(PR.L)	= ?ILE(NPAR,15) LSHIFT(NPAR,3) + ROPER
.	:S(RETURN)
	ERRMSG('TOO MANY (>15) PARAMETERS IN LIST')	:(FRETURN)
*	*	*	*	*	*	*	*	*
*		DEFSTR(STR1) DEFINE STRING
*	SETS STRING BLOCK ATTRIBUTE AND RETURNS ITENT
*
DEFSTR	ITNAM	= ?DIFFER(STR1) STR1
	ITTYP	= 3
	ITATR	= SKRATR
	DEFSTR	= ?GETITM() ITENT
	ATRB(ITENT)	= ?IEQ(SKATRB,0) OR(ITATR,SKRATR) :(RETURN)
*	*	*	*	*	*	*	*	*
*		GETLIT(STR1) GET STRING DESCRIPTOR NAME
*	SETS DESCRIPTOR ATTRIBUTE, RETURNS DESCRIPTOR LOC
*
GETLIT	ATRB(STR1)	= OR(ATRB(STR1),SDRATR)
	GETLIT	= 'S' INAM(STR1)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GETINT(STR1,MODFLG) GET INTEGER
*	IF MODFLG IS 0, GETS LOC OF CONST OR IMMED VAL. IF MODFLG IS
*	1, GETS LOC OF DESCRIPTOR. IF MODFLG IS -1, GETS LOC OF CONST,
*	EVEN IF VALUE CAN BE IMMEDIATE
*
GETINT	ITATR	= ATRB(STR1)
	?ILE(MODFLG,0)	:F(GETIN1)
	GETINT	= ?IEQ(MODFLG,0) ?INE(AND(ITATR,262144),0) SUBS(ARITAR<
.29>,AND(ITATR,262143))	:S(RETURN)
	ATRB(STR1)	= OR(ITATR,1048576)
	GETINT	= 'K' INAM(STR1)	:(RETURN)
GETIN1	ATRB(STR1)	= OR(ITATR,524288)
	GETINT	= 'I' INAM(STR1)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GETREL(STR1,MODFLG) GET REAL
*	IF MODFLG IS 0 OR -1, GETS LOC OF CONST. IF MODFLG IS 1, GETS
*	LOC OF DESCRIPTOR
*
GETREL	ITATR	= ATRB(STR1)
	ATRB(STR1)	= ?ILE(MODFLG,0) OR(ITATR,1048576) :F(GETRE1)
	GETREL	= 'C' INAM(STR1)	:(RETURN)
GETRE1	ATRB(STR1)	= OR(ITATR,524288)
	GETREL	= 'R' INAM(STR1)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		DEFLAB() DEFINE LABEL
*	EXPECTS LABEL IN ITNAM, RETURNS INTERNAL SYMBOL OR FAILS IF AL-
*	READY DEFINED
*
DEFLAB	ITTYP	= 1
	ITATR	= PRGALL
	(?GETITM() ?INE(LTATRB,LTDATR))	:F(FRETURN)
	ATRB(ITENT)	= OR(ITATR - LTATRB,LTDATR)
	DEFLAB	= ?INE(XNATRB,XNLATR) 'L' INAM(ITENT)	:S(RETURN)
	DEFLAB	= XNAMTB[INAM(ITENT)]	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GETLAB() GET LABEL NAME
*	EXPECTS LABEL IN ITNAM, RETURNS INTERNAL SYMBOL
*
GETLAB	ITTYP	= 1
	ITATR	= 2 * LTDATR + PRGALL
	GETITM()
	ATRB(ITENT)	= ?IEQ(LTATRB,0) OR(ITATR,2 * LTDATR + PRGALL)
	GETLAB	= ?INE(XNATRB,XNLATR) 'L' INAM(ITENT)	:S(RETURN)
	GETLAB	= XNAMTB[INAM(ITENT)]	:(RETURN)
*	*	*	*	*	*	*	*	*
*		DEFVAR() DEFINE VARIABLE
*	EXPECTS ITNAM SET TO VARIABLE NAME, RETURNS ENTRY
*
DEFVAR	ITTYP	=
	ITATR	= VTVATR + PRGALV
	DEFVAR	= ?GETITM() ITENT
	ATRB(ITENT)	= ?IEQ(VTATRB,0) OR(ITATR,VTVATR + PRGALV)
.	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GETDVR(STR1) GET DEDICATED VARIABLE LOC
*
GETDVR	ITTYP	=
	ITATR	= ATRB(STR1)
	GETDVR	= ?GETATR() ?INE(XNATRB,XNVATR) 'V' INAM(STR1)
.	:S(RETURN)
	GETDVR	= XNAMTB[INAM(STR1)]	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GETVAR(STR1) GET VARIABLE NAMETYPE LOC
*
GETVAR	ITTYP	=
	ITATR	= ATRB(STR1)
	ATRB(STR1)	= ?GETATR() ?INE(VDATRB,0) OR(ITATR,VNNATR)
.	:F(GETVA1)
	GETVAR	= 'N' INAM(STR1)	:(RETURN)
GETVA1	GETVAR	= ?INE(XNATRB,XNVATR) 'N' INAM(STR1)	:S(RETURN)
	GETVAR	= XNAMTB[INAM(STR1)]	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GTOPTY(I) GET OPER AND TYPE
*	SETS OPER AND TYPE FROM I = OPER*8 + TYPE, RETURNS TYPE
*
GTOPTY	OPER	= RSHIFT(I,3)
	TYPE	= AND(I,7)
	GTOPTY	= TYPE	:(RETURN)
*	*	*	*	*	*	*	*	*
*		GTPVAL(NOD) GETS LEFTMOST PVAL OF TEXT TREE
*	RETURNS THE LEFTMOST POINTER IN A TREE OF BINARY OPERATIONS
*
GTPVAL	NOD	= ?GTOPTY(OPTY(NOD)) ?IGE(OPER,30) LFTS(NOD) :S(GTPVAL)
	GTPVAL	= PVAL(NOD)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		PUTTRE(NOD) OUTPUT OBJECT TREE
*	OUTPUTS COMPONENTS OF TREE IN LEFT-TO-RIGHT,BOTTOM-TO-TOP SE-
*	QUENCE
*
PUTTRE	(?IDENT(DATATYPE(NOD),'NOD') ?PUTTRE(FRNT(NOD)) ?PUTTRE(BACK(
.NOD)))	:S(RETURN)
	PUTOUT(NOD)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		G.EX() GOTO EXPRESSION PARSE AND CODE GENERATION
*	RETURNS STRING (LABEL NAME) IF SIMPLE LABEL OR INDIRECT LITERAL,
*	OR CODE NOD OTHERWISE
*
G.EX	C	POPRMT	:F(G.EX6)
	C	IDENMT	:F(G.EX3)
G.EX1	G.EX	= GETLAB()
G.EX2	C	PCPRMT	:F(G.EX6)S(RETURN)
G.EX3	P	= ?IDENT(SUBSTR(C,1,P),'$') P + 1	:F(G.EX6)
	C	LEN(*P)  ANY(QTSCHR) $ STR1  @P	:F(G.EX5)
	ITPAT	= ?IDENT(STR1,SQCHR) SQLTPT	:S(G.EX4)
	ITPAT	= DQLTPT
G.EX4	ITNAM	= PARLIT(STR1,ITPAT)	:F(G.EX6)S(G.EX1)
G.EX5	G.EX	= PR.U()	:F(FRETURN)
	TP	= P
	VARTYP	= GTOPTY(OPTY(G.EX))
	G.EX	= NOD(S.PR(G.EX),GOTOAR<3>)	:F(FRETURN)
	P	= TP
	G.EX	= ?IGT(VARTYP,1) NOD(GOTOAR<2>,G.EX)	:(G.EX2)
G.EX6	ERRMSG('BAD GOTO SYNTAX')	:(FRETURN)
*	*	*	*	*	*	*	*	*
*		E.EX(NOD)NPAR,RSTFLG,EVLCOD EXPRESSION
*	IF NOD IS AN EXPLICIT PATTERN, GENERATES CODE FOR A PATTERN
*	EXPRESSION WHICH RETURNS A PATTERN DESCRIPTOR IN R1. OTHERWISE
*	GENERATES CODE FOR A STRING EXPRESSION WHICH RETURNS A DES-
*	CRIPTOR IN R1
*
E.EX	(?GTOPTY(OPTY(NOD)) ?INE(TYPE,5))	:F(E.EX1)
	E.EX	= S.EX(NOD)	:F(FRETURN)S(RETURN)
E.EX1	E.EX	= P.EX(NOD,OPER)	:F(FRETURN)
	STR1	= NEWLAB()
	STR2	= SUBS(PATRAR<1>,(-2 * RSTFLG + 1) * (NPAR + 1),STR1)
	STR2	= ?IEQ(NPAR,0) NOD(STR2,PATRAR<2>)
	E.EX	= NOD(NOD(STR2,E.EX),SUBS(PATRAR<3>,STR1))
	E.EX	= ?DIFFER(EVLCOD) NOD(EVLCOD,E.EX)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		V.EX(NOD) VARIABLE EXPRESSION
*	ACCEPTS A NODE WHICH IS EITHER AN IDENTIFIER, UNPROTECTED KEY-
*	WORD, OR STRING VARIABLE, AND RETURNS CODE THAT LEAVES A NAME
*	DESCRIPTOR IN R1
*
V.EX	I	= ?GTOPTY(OPTY(NOD)) ?IEQ(OPER,1) SBJT(NOD) :F(V.EX1)
	P	= ?ILE(I,7) ?ERRMSG('ASSIGNMENT TO PROTECTED KEYWORD')
. PVAL(NOD)	:S(FRETURN)
	V.EX	= SUBS(VARBAR<12>,I)	:(RETURN)
V.EX1	V.EX	= ?IEQ(OPER,0) GETVAR(SBJT(NOD))	:F(V.EX2)
	V.EX	= ?INE(VDATRB,VDPATR) SUBS(VARBAR<11>,V.EX) :S(RETURN)
	P	= ?ERRMSG('IMPROPER USE OF PATTERN PRIMITIVE') PVAL(NOD)
.	:(FRETURN)
V.EX2	V.EX	= S.VR(NOD,1)	:F(FRETURN)S(RETURN)
*	*	*	*	*	*	*	*	*
*		P.EX(NOD,ROPER)TLAB1,TLAB2 PATTERN EXPRESSION
*	GENERATES CODE FOR PATTERN EXPRESSIONS, RETURNING THE MATCH CODE
*	AS VALUE, AND APPENDING ANY EVALUATION CODE TO THE CODE CON-
*	TAINED IN EVLCOD. MAY INCREMENT NPAR AND/OR SET RSTFLG
*
P.EX	ROPER	= ?IEQ(ROPER,0) ?GTOPTY(OPTY(NOD)) OPER
	?IGT(ROPER,35)	:F(P.EX7)
* BINARY PATTERN OPERATOR
	?IEQ(ROPER,40)	:F(P.EX3)
* ALTERNATION
	TLAB1	= NEWLAB()
	TLAB2	= NEWLAB()
	P.EX	= NOD(NOD(SUBS(PATRAR<4>,TLAB2),P.EX(LFTS(NOD))),
.SUBS(PATRAR<5>,TLAB1,TLAB2))	:F(FRETURN)
P.EX1	NOD	= RGTS(NOD)
	TLAB2	= ?GTOPTY(OPTY(NOD)) ?IEQ(OPER,40) NEWLAB() :S(P.EX2)
	P.EX	= NOD(P.EX,NOD(NOD(PATRAR<7>,P.EX(NOD,OPER)),SUBS(
.PATRAR<8>,TLAB1)))	:F(FRETURN)
P.EXR	RSTFLG	= 1	:(RETURN)
P.EX2	P.EX	= NOD(P.EX,NOD(NOD(SUBS(PATRAR<6>,TLAB2),P.EX(LFTS(NOD))
.),SUBS(PATRAR<5>,TLAB1,TLAB2)))	:F(FRETURN)S(P.EX1)
P.EX3	?IEQ(ROPER,38)	:F(P.EX6)
* PATTERN CONCATENATION
	P.EX	= P.EX(LFTS(NOD))	:F(FRETURN)
P.EX4	NOD	= RGTS(NOD)
	(?GTOPTY(OPTY(NOD)) ?IEQ(OPER,38))	:F(P.EX5)
	P.EX	= NOD(P.EX,P.EX(LFTS(NOD)))	:F(FRETURN)S(P.EX4)
P.EX5	P.EX	= NOD(P.EX,P.EX(NOD,OPER))	:F(FRETURN)S(RETURN)
* IMMEDIATE AND CONDITIONAL PATTERN ASSIGNMENT
P.EX6	P.EX	= NOD(NOD(PATRAR<9>,P.EX(LFTS(NOD))),NOD(P.VR(RGTS(NOD))
.,PATRAR<ROPER - 26>))	:F(FRETURN)S(P.EXR)
*
*	PATTERN PRIMARY
P.EX7	?IGE(ROPER,16)	:F(P.EX14)
	?ILT(ROPER,30)	:F(P.EX11)
	NOD	= SBJT(NOD)
	(?GTOPTY(OPTY(NOD)) ?IEQ(ROPER,16))	:F(P.EX8)
* CURSOR POSITION ASSIGNMENT
	P.EX	= ?IEQ(OPER + TYPE,0) SUBS(PATRAR<12>,GETDVR(SBJT(NOD)))
.	:S(RETURN)
	P.EX	= NOD(P.VR(NOD),PATRAR<14>)	:F(FRETURN)S(RETURN)
* UNEVALUATED EXPRESSION
P.EX8	?IEQ(OPER,4)	:F(P.EX10)
P.EX9	P.EX	= ?DIFFER(SBJT(NOD)) SUBS(PATRAR<15>,GETLIT(SBJT(NOD)))
.	:(RETURN)
P.EX10	ROPER	= OPER
	P.EX	= U.EX(NOD,'S.PR',11)	:F(FRETURN)
	P.EX	= ?INE(ROPER,11) NOD(P.EX,PATRAR<16>) :F(RETURN)S(P.EXR)
* SUM, TERM, OR FACTOR
P.EX11	STR1	= S.EX(NOD)	:F(FRETURN)
P.EX12	STR1	= NOD(STR1,PATRAR<17>)
	P.EX	= PATRAR<20>
P.EX13	NPAR	= NPAR + 1
	P.EX	= SUBS(P.EX,NPAR)
	EVLCOD	= ?IDENT(EVLCOD) STR1	:S(RETURN)
	EVLCOD	= NOD(EVLCOD,STR1)	:(RETURN)
* STRING OR PATTERN PRIMARIES
P.EX14	?INE(TYPE,5)	:F(P.EX15)
	?INE(ROPER,4)	:F(P.EX9)
	STR1	= S.PR(NOD)	:F(FRETURN)S(P.EX12)
P.EX15	NOD	= ?IEQ(ROPER,7) SBJT(NOD)	:F(P.EX16)
* PARENTHESIZED EXPR
	ROPER	=	:(P.EX)
* PRIMITIVE PATTERN VARIABLE OR FUNCTION
P.EX16	OPER	= ?IEQ(ROPER,0) AND(ATRB(SBJT(NOD)),TXTMSK) / TXTATR
.	:F(P.EX17)
* FAIL, FENCE, ABORT, ARB, BAL, SUCCEED, REM
	P.EX	= PTVRAR<OPER>
	(?INE(OPER,1) ?INE(OPER,3) ?INE(OPER,7)) :F(RETURN)S(P.EXR)
P.EX17	STR1	= SBJT(NOD)
	ROPER	= AND(ATRB(PARP(STR1)),TXTMSK) / TXTATR
	(?GTOPTY(PVAL(STR1)) ?INE(OPER,1))	:F(P.EX19)
P.EX18	P	= ?ERRMSG('IMPROPER ARG(S) TO PATTERN PRIMITIVE') PVAL(
.NOD)	:(FRETURN)
P.EX19	NOD	= PARP(NXTL(STR1))
	P.EX	= PTFNAR<ROPER>
	?ILE(ROPER,5)	:F(P.EX25)
* LEN, TAB, RTAB, POS, RPOS
	(?GTOPTY(OPTY(NOD)) ?ILE(TYPE,4))	:F(P.EX22)
	P.EX	= ?IEQ(OPER,2) NOD(SUBS(PATRAR<21>,GETINT(SBJT(NOD))),
.P.EX)	:S(RETURN)
	?ILE(TYPE,3)	:F(P.EX20)
	STR1	= NOD(D.EX(NOD),PATRAR<22>)	:F(FRETURN)S(P.EX21)
P.EX20	STR1	= NOD(S.EX(NOD),PATRAR<24>)	:F(FRETURN)
P.EX21	P.EX	= NOD(PATRAR<23>,P.EX)	:(P.EX13)
P.EX22	P.EX	= ?IEQ(OPER,17) NOD(PATRAR<25>,P.EX)	:F(P.EX18)
	NOD	= SBJT(NOD)
	(?GTOPTY(OPTY(NOD)) ?ILE(TYPE,4))	:F(P.EX18)
	STR2	= ?ILE(TYPE,3) 'D.EX'	:F(P.EX23)
	I	= ?IGE(TYPE,2) 11	:S(P.EX24)
	I	= 8	:(P.EX24)
P.EX23	STR2	= 'S.EX'
	I	= 11
	P.EX	= NOD(PATRAR<26>,P.EX)
P.EX24	P.EX	= NOD(U.EX(NOD,STR2,I),P.EX)	:F(FRETURN)S(RETURN)
P.EX25	?ILE(ROPER,12)	:F(P.EX28)
* SPAN, BREAK, ANY, NOTANY, NSPAN, BREAKX, BREAKQ
	(?ILE(TYPE,4) ?GTOPTY(OPTY(NOD)))	:F(P.EX27)
	STR2	= ?IEQ(OPER,4) SBJT(NOD)	:F(P.EX26)
	P.EX	= ?DIFFER(STR2) NOD(SUBS(PATRAR<27>,'B' INAM(STR2)),
.P.EX)	:F(P.EX18)
	STR1	= .ATRB(STR2)
	$STR1	= OR($STR1,BTRATR)
	RSTFLG	= ?IEQ(ROPER,11) 1	:(RETURN)
P.EX26	STR1	= NOD(S.EX(NOD),PATRAR<29>)	:F(FRETURN)
	P.EX	= NOD(PATRAR<19>,P.EX)
	RSTFLG	= ?IEQ(ROPER,11) 1	:(P.EX13)
P.EX27	P.EX	= ?IEQ(OPER,17) NOD(PATRAR<28>,P.EX)	:F(P.EX18)
	NOD	= SBJT(NOD)
	?ILE(GTOPTY(OPTY(NOD)),4)	:F(P.EX18)
	P.EX	= NOD(U.EX(NOD,'S.EX',11),P.EX)	:F(FRETURN)
	RSTFLG	= ?IEQ(ROPER,11) 1	:(RETURN)
* ARBNO
P.EX28	TLAB1	= NEWLAB()
	P.EX	= NOD(SUBS(FRNT(P.EX),TLAB1),NOD(P.EX(NOD),SUBS(BACK(
.P.EX),TLAB1)))	:F(FRETURN)S(P.EXR)
*	*	*	*	*	*	*	*	*
*		P.VR(NOD)ROPER PATTERN VARIABLE
*	GENERATES MATCH CODE THAT PRODUCES A NAME DATATYPE IN R1, WITH
*	ANY EVALUATION CODE BEING ADDED TO EVLCOD
*
P.VR	NOD	= ?GTOPTY(OPTY(NOD)) ?IEQ(OPER,17) SBJT(NOD) :S(P.VR1)
	ROPER	= OPER
	P.VR	= V.EX(NOD)	:F(FRETURN)
	STR1	= ?IGT(ROPER,1) NOD(P.VR,PATRAR<18>)	:F(RETURN)
	NPAR	= NPAR + 1
	P.VR	= SUBS(PATRAR<30>,NPAR)
	EVLCOD	= ?IDENT(EVLCOD) STR1	:S(RETURN)
	EVLCOD	= NOD(EVLCOD,STR1)	:(RETURN)
P.VR1	P.VR	= U.EX(NOD,'V.EX',11)	:F(FRETURN)S(RETURN)
*	*	*	*	*	*	*	*	*
*		U.EX(NOD,FUNC,MAXLVL)FAILFL
*	GENERATES MATCH CODE FOR UNEVALUATED EXPRESSIONS OF TYPE SPE-
*	CIFIED BY FUNC, WITH ARITHMETIC RESTRICTED TO LEVEL SPECIFIED
*	BY MAXLVL
*
U.EX	U.EX	= APPLY(FUNC,NOD)	:F(FRETURN)
	(?GTOPTY(OPTY(NOD)) ?INE(OPER,0) ?IGT(TYPE,1))	:F(RETURN)
	U.EX	= ?IEQ(FAILFL,0) NOD(PATRAR<31>,NOD(U.EX,PATRAR<32>))
.	:S(RETURN)
	U.EX	= NOD(PATRAR<33>,NOD(U.EX,PATRAR<34>))	:(RETURN)
*	*	*	*	*	*	*	*	*
*		S.EX(NOD,DEDVAR)NPAR STRING EXPRESSION
*	GENERATES CODE FOR STRING CONCATENATION AND NON-DEDICATED ARITH-
*	METIC WHICH LEAVES DESCRIPTOR IN R1, OR SAVES STRING IN DEDVAR
*
S.EX	?IEQ(GTOPTY(OPTY(NOD)),5)	:F(S.EX0)
S.EXE	P	= ?ERRMSG('BAD CONTEXT FOR PATTERN') GTPVAL(NOD)
.	:(FRETURN)
S.EX0	?ILT(OPER,30)	:F(S.EX2)
* STRING PRIMARY
	S.EX	= S.PR(NOD)	:F(FRETURN)
S.EX1	S.EX	= ?DIFFER(DEDVAR) NOD(S.EX,SUBS(VARBAR<5>,1,DEDVAR))
.	:(RETURN)
S.EX2	NPAR	= ?ILE(TYPE,3) REMDR(TYPE,2)	:F(S.EX3)
* DEDICATED EXPRESSION
	S.EX	= NOD(D.EX(NOD,NPAR),EXPRAR<NPAR + 3>)
.	:F(FRETURN)S(S.EX1)
S.EX3	?IEQ(OPER,38)	:F(S.EX9)
* STRING CONCATENATION
	S.EX	= S.EX(LFTS(NOD))	:F(FRETURN)

S.EX4	(?GTOPTY(OPTY(LFTS(NOD))) ?INE(OPER,11) ?INE(OPER,12)) :F(S.EX5)
	NPAR	= NPAR + 1
	S.EX	= NOD(S.EX,EXPRAR<1>)
S.EX5	NOD	= RGTS(NOD)
	(?GTOPTY(OPTY(NOD)) ?IEQ(OPER,38) ?IGT(TYPE,3))	:F(S.EX6)
	S.EX	= NOD(S.EX,S.EX(LFTS(NOD)))	:F(FRETURN)S(S.EX4)
S.EX6	S.EX	= NOD(S.EX,S.EX(NOD))	:F(FRETURN)
	(?GTOPTY(OPTY(NOD)) ?INE(OPER,11) ?INE(OPER,12)) :F(S.EX8)
	NPAR	= NPAR + 1
S.EX7	?IGT(NPAR,1)	:F(S.EX1)
	S.EX	= ?IDENT(DEDVAR) NOD(S.EX,SUBS(EXPRAR<2>,NPAR))
.	:S(RETURN)
	S.EX	= ?ILE(NPAR,15) NOD(S.EX,SUBS(VARBAR<4>,NPAR,DEDVAR))
.	:S(RETURN)
	S.EX	= NOD(S.EX,SUBS(EXPRAR<2>,NPAR))	:(S.EX1)
S.EX8	S.EX	= ?IGT(NPAR,0) NOD(S.EX,EXPRAR<6>)	:(S.EX7)
* UNDEDICATED ARITHMETIC OPERATIONS
S.EX9	NPAR	= OPER
	S.EX	= NOD(NOD(S.EX(LFTS(NOD)),EXPRAR<1>),NOD(S.EX(RGTS(NOD))
.,EXPRAR<NPAR - 25>))	:F(FRETURN)S(S.EX1)
*	*	*	*	*	*	*	*	*
*		S.PR(NOD)ROPER STRING PRIMARY
*	GENERATES CODE FOR STRING PRIMARIES WHICH LEAVES DESCRIPTOR IN
*	R1
*
S.PR	(?GTOPTY(OPTY(NOD)) ?ILE(TYPE,3))	:F(S.PR2)
	ROPER	= ?INE(OPER,2) ?INE(OPER,3) REMDR(TYPE,2) :F(S.PR1)
* DEDICATED PRIMARY
	S.PR	= NOD(D.PR(NOD,ROPER),EXPRAR<ROPER + 3>)
.	:F(FRETURN)S(RETURN)
* INTEGER OR REAL CONSTANT
S.PR1	S.PR	= ?IEQ(OPER,2) SUBS(VARBAR<11>,GETINT(SBJT(NOD),1))
.	:S(RETURN)
	S.PR	= SUBS(VARBAR<11>,GETREL(SBJT(NOD),1))	:(RETURN)
S.PR2	?ILE(OPER,10)	:F(S.PR6)
	?ILE(OPER,4)	:F(S.PR5)
	STR1	= ?IEQ(OPER,4) SBJT(NOD)	:F(S.PR3)
* STRING LITERAL
	S.PR	= ?DIFFER(STR1) SUBS(VARBAR<11>,GETLIT(STR1)) :S(RETURN)
	S.PR	= EXPRAR<13>	:(RETURN)
* &ALPHABET OR &RTNTYPE KEYWORD
S.PR3	S.PR	= ?IEQ(OPER,1) SUBS(EXPRAR<11>,SUBS(VARBAR<1>,SBJT(NOD))
.)	:S(RETURN)
* IDENTIFIER
	S.PR	= ?INE(TYPE,5) SUBS(EXPRAR<12>,GETVAR(SBJT(NOD)))
.	:F(S.EXE)
* DEDICATED STRING
	S.PR	= ?IEQ(VDATRB,VDDATR) NOD(S.PR,EXPRAR<14>) :(RETURN)
* PARENTHESIZED EXPR
S.PR5	NOD	= ?IEQ(OPER,7) SBJT(NOD)	:F(S.PR5A)
	S.PR	= S.EX(NOD)	:F(FRETURN)S(RETURN)
* STRING VARIABLE
S.PR5A	S.PR	= S.VR(NOD)	:F(FRETURN)S(RETURN)
S.PR6	ROPER	= ?INE(OPER,15) OPER	:F(S.PR7)
* ?, \, +, -
	S.PR	= S.PR(SBJT(NOD))	:F(FRETURN)
* +
	?INE(ROPER,13)	:F(RETURN)
* ?, -
	S.PR	= ?INE(ROPER,12) NOD(S.PR,EXPRAR<ROPER + 2>) :S(S.PR8)
* \
	STR1	= NEWLAB()
	S.PR	= NOD(SUBS(EXPRAR<15>,STR1),NOD(S.PR,SUBS(EXPRAR<17>,
.STR1)))	:(RETURN)
* .
S.PR7	S.PR	= V.EX(SBJT(NOD))	:F(FRETURN)S(RETURN)
* TRY TO OPTIMIZE ? A LITTLE
S.PR8	STR1	= ?IEQ(ROPER,11) SBJT(NOD)	:F(RETURN)
	STR1	= ?GTOPTY(OPTY(STR1)) ?ILE(TYPE,3) ?IEQ(OPER,6)
. FRNT(FRNT(FRNT(S.PR)))	:F(RETURN)
* ELIMINATES THE MOVING OF RESULT TO R1 AND CONVERSION TO DESCRIPTOR
* MODE IN THE CASE OF ?FORTRAN.FUNC
	FRNT(S.PR)	= STR1	:(RETURN)
*	*	*	*	*	*	*	*	*
*		S.VR(NOD,MODFLG)TLAB1,NPAR STRING VARIABLE
*	GENERATES CODE FOR INDIRECTION, ARRAY REFERENCES, AND NON-
*	FORTRAN FUNCTION CALLS, LEAVING VALUE IN R1 IF CALL FOR VALUE
*	(MODFLG=0), OR NAME DESCR IN R1 IF CALL FOR NAME (MODFLG=1)
*
S.VR	(?GTOPTY(OPTY(NOD)) ?INE(TYPE,5))	:F(S.EXE)
	?INE(TYPE,4)	:F(S.VR1)
S.VR0	P	= ?ERRMSG('ILLEGAL VARIABLE EXPRESSION') GTPVAL(NOD)
.	:(FRETURN)
S.VR1	S.VR	= ?IEQ(OPER,10) EXPRAR<18 + MODFLG>	:F(S.VR2)
	S.VR	= NOD(S.PR(SBJT(NOD)),S.VR)	:F(FRETURN)S(RETURN)
S.VR2	NOD	= ?IGE(OPER,5) ?ILE(OPER,6) SBJT(NOD)	:F(S.VR0)
	TLAB1	= ?IEQ(OPER,5) GETVAR(PARP(NOD))	:S(S.VR3)
	FAILFL	= 1
	ITTYP	= 2
	ITATR	= ATRB(PARP(NOD))
	TLAB1	= ?GETATR() ?INE(XNATRB,XNFATR) 'F' INAM(PARP(NOD))
.	:S(S.VR3)
	TLAB1	= XNAMTB[INAM(PARP(NOD))]
S.VR3	NPAR	= RSHIFT(PVAL(NOD),3)
	TLAB1	= SUBS(EXPRAR<OPER + 2 * MODFLG + 16>,NPAR,TLAB1)
	S.VR	= ?IEQ(NPAR,0) TLAB1	:S(RETURN)
	NOD	= NXTL(NOD)
	S.VR	= E.EX(PARP(NOD))	:F(FRETURN)
S.VR4	NPAR	= NPAR - 1
	S.VR	= ?IEQ(NPAR,0) NOD(S.VR,TLAB1)	:S(RETURN)
	NOD	= NXTL(NOD)
	S.VR	= NOD(S.VR,NOD(EXPRAR<1>,E.EX(PARP(NOD))))
.	:F(FRETURN)S(S.VR4)
*	*	*	*	*	*	*	*	*
*		D.EX(NOD,MODFLG)ROPER,RTYPE DEDICATED EXPRESSION
*	GENERATES CODE THAT RETURNS INTEGER (MODFLG=0) OR REAL
*	(MODFLG=1) IN R1
*
D.EX	?INE(GTOPTY(OPTY(NOD)),5)	:F(S.EXE)
	?ILT(OPER,30)	:F(D.EX1)
* DEDICATED PRIMARY
	D.EX	= D.PR(NOD,MODFLG)	:F(FRETURN)S(RETURN)
D.EX1	?ILE(TYPE,1)	:F(D.EX2)
* PURE DEDICATED EXPRESSION
	D.EX	= A.EX(NOD,MODFLG)	:F(FRETURN)S(RETURN)
D.EX2	?IEQ(TYPE,4)	:F(D.EX3)
* DESCRIPTOR EXPRESSION
	D.EX	= NOD(S.EX(NOD),ARITAR<1 + MODFLG>) :F(FRETURN)S(RETURN)
D.EX3	?IEQ(OPER,38)	:F(D.EX5)
* CONCATENATION OF ? AND DED EXPR (OR VICE VERSA), OR CONCATENATION
* OF ? AND ?
	(?GTOPTY(OPTY(LFTS(NOD))) ?IEQ(OPER,11))	:F(D.EX4)
	D.EX	= NOD(S.EX(LFTS(NOD)),D.EX(RGTS(NOD),MODFLG))
.	:F(FRETURN)S(RETURN)
D.EX4	D.EX	= NOD(NOD(D.EX(LFTS(NOD),MODFLG),ARITAR<3>),NOD(S.EX(
.RGTS(NOD)),ARITAR<4>))	:F(FRETURN)S(RETURN)
D.EX5	ROPER	= ?IGE(OPER,32) OPER	:F(D.EX7)
* IMPURE DEDICATED *, /, +, -
	RTYPE	= REMDR(TYPE,2)
	D.EX	= D.EX(LFTS(NOD),RTYPE)	:F(FRETURN)
	STR1	= RGTS(NOD)
	(?GTOPTY(OPTY(STR1)) ?IGE(TYPE,2))	:F(D.EX6A)
* RIGHT SIDE IMPURE
	D.EX	= NOD(NOD(D.EX,ARITAR<3>),NOD(D.EX(STR1,RTYPE),NOD(
.ARITAR<5>,SUBS(ARITAR<ROPER - 26>,AROPAR<ROPER,RTYPE>)))) :F(FRETURN)
* ADJUST TYPE IF NECESSARY
D.EX6	D.EX	= ?INE(RTYPE,MODFLG) NOD(D.EX,ARITAR<10 + MODFLG>)
.	:(RETURN)
* RIGHT SIDE PURE
D.EX6A	STR1	= A.EX(STR1,RTYPE,2)	:F(FRETURN)
	D.EX	= ?DIFFER(STR1) NOD(D.EX,STR1)
	D.EX	= ?IGE(ROPER,34) NOD(D.EX,SUBS(ARITAR<16>,
.AROPAR<RSGN * (69 - ROPER) + (1 - RSGN) * ROPER,RTYPE>,SUBS(ARITAR<13>,
.'1',RLOC)))	:S(D.EX6)
	D.EX	= NOD(D.EX,SUBS(ARITAR<16>,AROPAR<ROPER,RTYPE>,SUBS(
.ARITAR<13>,'1',RLOC)))
	D.EX	= ?INE(RSGN,0) NOD(D.EX,SUBS(ARITAR<17>,'1')) :(D.EX6)
* DEDICATED ** (ALWAYS IMPURE)
D.EX7	RTYPE	= REMDR(TYPE,2)
	D.EX	= D.EX(LFTS(NOD),RTYPE)	:F(FRETURN)
	ROPER	= RTYPE * 2
	I	= RTYPE
	STR1	= RGTS(NOD)
	(?GTOPTY(OPTY(STR1)) ?IEQ(RTYPE,1) ?IEQ(REMDR(TYPE,2),0))
.	:F(D.EX8)
	ROPER	= 1
	I	=
D.EX8	D.EX	= NOD(NOD(D.EX,ARITAR<3>),NOD(D.EX(STR1,I),NOD(ARITAR<5>
.,ARITAR<18 + ROPER>)))	:(D.EX6)
*	*	*	*	*	*	*	*	*
*		D.PR(NOD,MODFLG)ROPER,RTYPE,TLAB1 DEDICATED PRIMARY
*	GENERATES CODE THAT RETURNS INTEGER (MODFLG=0) OR REAL
*	(MODFLG=1) IN R1
*
D.PR	?INE(GTOPTY(OPTY(NOD)),5)	:F(S.EXE)
	?ILE(TYPE,1)	:F(D.PR1)
* PURE DEDICATED EXPRESSION
	D.PR	= A.EX(NOD,MODFLG)	:F(FRETURN)S(RETURN)
D.PR1	?IEQ(TYPE,4)	:F(D.PR2)
* DESCRIPTOR PRIMARY
	D.PR	= ?IEQ(OPER,0) SUBS(ARITAR<21 + MODFLG>,GETVAR(SBJT(
.NOD)))	:S(RETURN)
	D.PR	= NOD(S.PR(NOD),ARITAR<1 + MODFLG>) :F(FRETURN)S(RETURN)
D.PR2	ROPER	= ?IGE(OPER,13) OPER	:F(D.PR3)
* UNARY + OR -
	D.PR	= D.PR(SBJT(NOD),MODFLG)	:F(FRETURN)
	D.PR	= ?IEQ(ROPER,14) NOD(D.PR,SUBS(ARITAR<17>,'1'))
.	:(RETURN)
D.PR3	?IEQ(OPER,7)	:F(D.PR3A)
* PARENTHESIZED EXPR
	D.PR	= D.EX(SBJT(NOD),MODFLG)	:F(FRETURN)S(RETURN)
* FORTRAN FUNCTION CALL
D.PR3A	ROPER	= TML
	RTYPE	= TYPE - 2
	FAILFL	= 1
	NOD	= SBJT(NOD)
	TLAB1	= XNAMTB[INAM(PARP(NOD))]
	TLAB1	= SUBS(ARITAR<23>,TLAB1)
D.PR4	NOD	= NXTL(NOD)
	STR1	= ?DIFFER(NOD) PARP(NOD)	:F(D.PR11)
	(?GTOPTY(OPTY(STR1)) ?IEQ(TYPE,5))	:S(S.EXE)
	?ILE(TYPE,3)	:F(D.PR8)
	TYPE	= ?ILE(OPER,3) ?INE(OPER,1) TYPE * 2	:F(D.PR6)
	STR1	= SBJT(STR1)
	RLOC	= ?IEQ(OPER,0) GETDVR(STR1)	:S(D.PR5)
	RLOC	= ?IEQ(OPER,2) GETINT(STR1,-1)	:S(D.PR5)
	RLOC	= GETREL(STR1,-1)
D.PR5	TLAB1	= NOD(TLAB1,SUBS(ARITAR<24>,TYPE,RLOC))	:(D.PR4)
D.PR6	TYPE	= REMDR(TYPE,2)
	TLAB1	= NOD(TLAB1,SUBS(ARITAR<24>,TYPE * 2,SUBS(ARITAR<25>,
.TEMLOC,TML)))
	TML	= TML + 1
	STR1	= NOD(D.EX(STR1,TYPE),SUBS(VARBAR<2>,SUBS(ARITAR<25>,
.TEMLOC,TML - 1)))	:F(FRETURN)
D.PR7	D.PR	= ?DIFFER(D.PR) NOD(D.PR,STR1)	:S(D.PR4)
	D.PR	= STR1	:(D.PR4)
D.PR8	TYPE	= ?ILE(OPER,4) ?INE(OPER,1) 5	:F(D.PR10)
	STR1	= ?IEQ(OPER,4) SBJT(STR1)	:F(D.PR9)
	RLOC	= ?DIFFER(STR1) SUBS(ARITAR<25>,'A' INAM(STR1),'1')
.	:S(D.PR5)
	P	= ?ERRMSG('NULL IS BAD ARG FOR FORTRAN') PVAL(NOD)
.	:(FRETURN)
D.PR9	STR2	= SBJT(STR1)
	ITATR	= ATRB(STR2)
	RLOC	= ?GETATR() ?IEQ(VDATRB,VDDATR) SUBS(ARITAR<25>,GETDVR(
.STR2),'2')	:S(D.PR5)
D.PR10	TLAB1	= NOD(TLAB1,SUBS(ARITAR<24>,'0',SUBS(ARITAR<25>,TEMLOC,
.TML)))
	TML	= TML + 1
	STR1	= NOD(S.EX(STR1),SUBS(VARBAR<5>,'2',SUBS(ARITAR<25>,
.TEMLOC,TML - 1)))	:F(FRETURN)S(D.PR7)
* FINISHED
D.PR11	MAXTMP	= ?IGT(TML,MAXTMP) TML
	TML	= ROPER
	TLAB1	= NOD(TLAB1,ARITAR<26>)
	D.PR	= ?DIFFER(D.PR) NOD(D.PR,TLAB1)	:S(D.PR12)
	D.PR	= TLAB1
D.PR12	STR1	= ARITAR<27>
	STR1	= ?INE(MODFLG,RTYPE) NOD(STR1,ARITAR<10 + MODFLG>)
	D.PR	= NOD(D.PR,STR1)	:(RETURN)
*	*	*	*	*	*	*	*	*
*		A.EX(NOD,MODFLG,RGL)ROPER,RTYPE,LSGN,LOPER PURE DEDI-
*		CATED ARITHMETIC EXPRESSION
*	GENERATES CODE, AND ASSURES RESULT IN R1 WITH NORMAL SIGN SENSE
*	IF RGL=0, OTHERWISE RESULT IS IN RLOC, OF TYPE RTYP (0-REGIS-
*	TER, 1-STORAGE), AND WITH SIGN SENSE RSGN (0-NORMAL, 1-
*	REVERSED). OPERATIONS ARE AT REGISTER LEVEL RGL
*
A.EX	LOPER	= ?IEQ(RGL,0) 1	:F(A.EX1)
	RGL	= 1
A.EX1	RTYPE	= REMDR(GTOPTY(OPTY(NOD)),2)
	ROPER	= OPER
	?IGT(RGL,MAXLVL)	:F(A.EX2)
	P	= ?ERRMSG('NESTING TOO DEEP, SIMPLIFY EXPR') GTPVAL(NOD)
.	:(FRETURN)
A.EX2	?IGE(OPER,32)	:F(A.EX8)
	A.EX	= A.EX(LFTS(NOD),RTYPE,RGL)	:F(FRETURN)
	A.EX	= ?INE(RTYP,0) SUBS(ARITAR<16>,ARITAR<14 + RSGN>,SUBS(
.ARITAR<13>,RGL,RLOC))	:F(A.EX3)
	RSGN	=
A.EX3	LSGN	= RSGN
	STR1	= A.EX(RGTS(NOD),RTYPE,RGL + 1)	:F(FRETURN)
	A.EX	= ?IEQ(RTYP,0) NOD(A.EX,STR1)
	A.EX	= ?ILE(ROPER,33) NOD(A.EX,SUBS(ARITAR<16>,AROPAR<ROPER,
.RTYPE>,SUBS(ARITAR<13>,RGL,RLOC)))	:F(A.EX4)
	RSGN	= XOR(RSGN,LSGN)	:(A.EX5)
A.EX4	A.EX	= NOD(A.EX,SUBS(ARITAR<16>,AROPAR<34 + XOR(ROPER - 34,
.XOR(LSGN,RSGN)),RTYPE>,SUBS(ARITAR<13>,RGL,RLOC)))
	RSGN	= LSGN
A.EX5	RTYP	=
	RLOC	= SUBS(ARITAR<12>,RGL)
A.EX6	?INE(MODFLG,RTYPE)	:F(A.EX7)
	A.EX	= ?IEQ(RGL,1) NOD(A.EX,ARITAR<10 + MODFLG>) :S(A.EX7)
	A.EX	= NOD(A.EX,SUBS(ARITAR<28>,RGL))	:(RETURN)
A.EX7	A.EX	= ?IEQ(LOPER,1) ?INE(RSGN,0) NOD(A.EX,SUBS(ARITAR<17>,
.RGL))	:F(RETURN)
	RSGN	=	:(RETURN)
A.EX8	?ILE(OPER,3)	:F(A.EX11)
	STR1	= SBJT(NOD)
	RLOC	= ?IEQ(OPER,0) GETDVR(STR1)	:S(A.EX9)
	RLOC	= ?IEQ(OPER,2) GETINT(STR1)	:S(A.EX9)
	RLOC	= ?IEQ(OPER,3) GETREL(STR1)	:S(A.EX9)
	RLOC	= SUBS(VARBAR<1>,STR1)
A.EX9	RTYP	= 1
	RSGN	=
	(?INE(LOPER,1) ?IEQ(MODFLG,RTYPE))	:S(RETURN)
A.EX10	A.EX	= SUBS(ARITAR<16>,ARITAR<14 + RSGN>,SUBS(ARITAR<13>,
.RGL,RLOC))
	RSGN	=	:(A.EX5)
A.EX11	ROPER	= ?IEQ(OPER,7) 13
	A.EX	= A.EX(SBJT(NOD),MODFLG,RGL)	:F(FRETURN)
	RSGN	= XOR(RSGN,ROPER - 13)
	RTYPE	= ?IEQ(LOPER,1) MODFLG	:F(RETURN)
	?IEQ(RTYP,0)	:F(A.EX10)S(A.EX6)
*	*	*	*	*	*	*	*	*
END