VER = '6.0.'
	&STLIMIT = 9999999
*SNO*	DEFINE('LPAD(LPAD,N,SYM)')
*SNO*	DEFINE('RPAD(RPAD,N,SYM)')
	&TRIM = 1
*	TRACE('ADDR')	TRACE('INREG')	TRACE('R')
*	TRACE('TYPE')		TRACE('L.TYPE') 	TRACE('R.TYPE')
*	TRACE('R.F')		TRACE('L.F')		TRACE('LR')
*	TRACE('ADDR')	TRACE('L.ADDR') TRACE('R.ADDR')
	DEFINE('ASS(T1,T2,T3,T4)')
	DEFINE('ASSNL(T2,T3,T4)T1','ASS')
	DEFINE('CALL(SUBROUT)')
	DEFINE('CALLSRT()')
	DEFINE('CHAR(STRING)')
	DEFINE('CKSBSET()')
	DEFINE('CKREG()')
	DEFINE('CKREGD()')
	DEFINE('CKTYPE(POS,CHAR)')
	DEFINE('CKTYPET(POS,CHAR,TYPE)','CKTYPE')
	DEFINE('CLRREG()')
	DEFINE('COMMENT(STATE)')
	DEFINE('COMPILE()ADDR,THISOP')
	DEFINE('COMPLR()')
	DEFINE('COMPOP()')
	DEFINE('DEC2OCT(N)')
	DEFINE('DO.CALL(OPERAND)')
	DEFINE('DS(BASE,LEN)')
	DEFINE('ENDOFF()')
	DEFINE('ERROR(MESS,ETYPE)')
	DEFINE('FILLTAB(FILLTAB,TEMP)')
	DEFINE('FLIP()')
	DEFINE('GEN()')
	DEFINE('GENCALL(LOC)')
	DEFINE('GENLAB(LABEL)')
	DEFINE('GENLD()')
	DEFINE('GENLOAD(R,ADDR)')
	DEFINE('GENLOG(OP,LOC)')
	DEFINE('GETCONT(PARM,WHEN)BASELOC,LREG')
	DEFINE('GETLAB()')
	DEFINE('GETREG()')
	DEFINE('GETTYPE(POS)')
	DEFINE('INIT()')
	DEFINE('OFFLOC(LOC)')
	DEFINE('OFFREG(R)')
	DEFINE('PUT(STRING)')
	DEFINE('PUTREG(R,ADDR)')
	DEFINE('RADIX(RADIX)')
	DEFINE('SETTYPE(POS,CHAR)')
	DEFINE('STATSRT()')
	DEFINE('TABSTM()')
**
	IDTAB = TABLE(10,5)
	DATA('ID(TAB.LEN,TAB.OFF,TAB.TYPE,TAB.BASE,TAB.MASK,TAB.RANGE)')
	REENT.OFF = TABLE(10,5)
	DSCONT = TABLE(10,5)
**
	BLANK = ' ' TAB
	CB = SPAN(BLANK)
	B = CB ! NULL
	DIGIT = '0123456789'
	NUMB = SPAN(DIGIT)
	LITERAL = (ANY('+-') ! '') NUMB
.		! '=' ANY('AC') LEN(1) $ T1 BREAK(*T1) *T1
	LET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ#$'
	AVAR = ANY(LET) (SPAN(LET DIGIT) ! NULL)
	VAR = ANY(LET) (SPAN(DIGIT) ! NULL)
	MINUS = DUPL('-',28)
**
	OPS = 'DO' ! 'IFANY' ! 'IF' ! 'BFIELDE' ! 'FIELD' !
.		'BBLOCKE' ! 'BLOCK' ! 'BEGIN' ! 'FINISH' !
.		'YBLOCKE' ! 'BBLOCK' ! 'BFIELD' ! 'YBLOCK' ! 'CALLS'
	CARD.PARSE = POS(0) (BREAK(BLANK) ! NULL) . LABEL CB
.		OPS . OPCODE B REM . OPERAND
	OPER.PARSE = POS(0) '(' (
.		BREAK(',') . LEFT ',' BREAK(',') . OPR ','
.		BREAK(')') . RIGHT !
.		BREAK(',') . OPR ',' BREAK(')') . LEFT '' . RIGHT
.		) ')' RPOS(0)
	CALL.PARSE = POS(0) (
.		BREAK(',') . SUB ',(' BAL . ARGS ')' !
.		REM . SUB '' . ARGS
.		) RPOS(0)
	BREAK.TAB = BREAK(',') . T1 ',' BREAK('"') . T2 '"'
**
	BFIELD.PARSE = POS(0) VAR . N1 ',' AVAR . BASE
	FIELD.PARSE = POS(0) VAR . N1 ',' NUMB . OFF ',(' NUMB . LOW ','
.		NUMB . HIGH ')'
	BLOCK.PARSE = POS(0)  VAR . N1 ',(' NUMB . OFF ','
.		NUMB . LEN ')'
	BBLOCK.PARSE = POS(0) VAR . N1 ',(' AVAR . BASE  ','
.		NUMB . LEN ')'
**
	LF = 0
	BF = 1
	TF = 2
	DF = 3
*******
**
** TYPE FLAGS TO IDENTIFY EACH TYPE
**
**POS	NAME		CONTENTS
**---	----		--------
**0	LF(LEN FLD)	Y(BYTE), W(WORD), 1(1 BIT), L(LT 1 WD), G(GT 1
**1	BF(BASE FLD)	B(BASED), -(NONBASED)
**2	TF(TYPE FLD)	B(BLOCK), F(FIELD)
**3	DF(DEF FLD)	E(DEFINED), -(UNDEF)
********
**
**
	SW.REG = '1'
	CLRREG()
	INIT()
	SCSC = SC SC
	BRANCH = LOGOP<'<>'>
	VER = 'VERSION ' VER '	' DATE() '   WECO<-ERC<-STONE'
	OUTPUT = VER
	COMMENT(OUTPUT)
	SWITCH.CK = POS(0) ('*' ! '')
.		('+' REM . T1 . T2 !
.		'-' REM . T1 '' . T2)
	GET.THIS.OP = POS(0) BAL . THISOP (',' ! ' ' REM ! RPOS(0))
	CK.LIT = POS(0) LITERAL RPOS(0)
	GET.VAR.X = POS(0) VAR . X
**
	IDTAB<'#1'> = ID(100,0,'WBB-')
	IDTAB<'#2'> = ID(ADDR.WORD,0,'W-B-')
	IDTAB<'#3'> = ID(ADDR.WORD,0,'WBF-',SCSC '3')
	IDTAB<'#4'> = ID(ADDR.WORD,0,'WBF-',SCSC '4')
**
LOOP	CARD = INPUT		:F(END)
	STATENO = STATENO + 1
	OUTPUT = RPAD(STATENO,8) CARD
	CARD POS(72) REM =	:F(CKSW)
	CARD = TRIM(CARD)
CKSW	CARD SWITCH.CK		:F(TRYCOM)
	$('SW.' T1) = T2	:(LOOP)
TRYCOM	CARD POS(0) ANY('*/;')	:S(ASSEMC)
	IDENT(CARD)		:S(ASSEMC)
	CARD CARD.PARSE 	:F(ASSEMB)
	( COMMENT(MINUS) COMMENT(OUTPUT) )
	THENSW = '1'
	( IDENT(OPCODE,'FINISH') ENDOFF() )
	( STATSRT() CALL(OPCODE) )	:(LOOP)
**
ASSEMC	COMMENT(CARD)		:(LOOP)
**
ASSEMB	PUT(CARD)		:(LOOP)
**
********
** STATEMENT HANDLING
********
DO	COMPILE()		:F(RETURN)S(DO)
**
IFANY	BTYPE = 'Y'
IFANY2	LAB1 = GETLAB()
	LAB2 = GETLAB()
	THENSW =
	LLAB = IDENT(BTYPE,'Y') LAB1	:S(IFANY1)
	LLAB = LAB2
IFANY1	COMPILE()			:S(IFANY1)
	GENLAB(LAB2)
	( IDENT(THENSW) ERROR('NO THEN IN IF') )	:(RETURN)
**
IF	BTYPE = 'N'			:(IFANY2)
**
BFIELD	T = 'WBF-' :(TB)
BBLOCK	T = 'WBB-' :(TB)
YBLOCK	T = 'Y-B-' :(TB)
YBBLOCK T = 'YBB-' :(TB)
BFIELDE T = 'WBFE' :(TB)
BBLOCKE T = 'WBBE' :(TB)
BLOCK	T = 'W-B-' :(TB)
FIELD	T = '--F-' :(TB)
TB	TYPE = T
	LEN = 1
	Y =
	OPCODE POS(0) 'Y' . Y =
	OPCODE RPOS(1) 'E' =
	OPERAND $(OPCODE '.PARSE')	:S(TABSTOR)
	ERROR('SYNTAX') 		:(RETURN)
TABSTOR	LOW = REMDR(LOW,WSIZE)
	HIGH = REMDR(HIGH,WSIZE)
	RANGE = LOW ',' HIGH
	( EQ(LOW,0) EQ(HIGH + 1,WSIZE) SETTYPE(LF,'W') )
	( EQ(LOW,HIGH) IDENT(OPCODE,'FIELD') SETTYPE(LF,'1') )
	T1 = HIGH + 1 - LOW
	( EQ(T1,HSIZE) EQ(REMDR(LOW,HSIZE),0) SETTYPE(LF,'H') )
	( EQ(T1,BSIZE) EQ(REMDR(LOW,BSIZE),0) SETTYPE(LF,'Y') )
	( GT(LEN,1) \CKTYPE(BF,'B') ERROR('WARNING..NON-BASED LEN>1') )
	LEN = DIFFER(Y,'Y') ADDR.WORD * LEN
	OFF = DIFFER(Y,'Y') ADDR.WORD * OFF
	( CKTYPE(LF,'-') ERROR('ILLEGAL RANGE...BYTE ASSUMED')
.		SETTYPE(LF,'Y') )
	TABSTM()
	( CKTYPE(DF,'E') DS(BASE,LEN) )
	IDTAB<N1> = ID(LEN,OFF,TYPE,BASE,MASK,RANGE)
	MASK =
	LOW = ; HIGH = ; OFF = ; BASE = :(RETURN)
**
DO.CALL
CALLS	OPERAND CALL.PARSE		:F(ERR)
	CALLLAB = GETLAB()
	NARG = 0
	TAB.BASE(IDTAB<'#1'>) = CALLLAB
	TP2 = IDTAB<'#2'>
	TAB.OFF(TP2) = 0
	REENT.OFF<CALLLAB> = DIFFER(SW.REENT) TOTSTORE
	CALLSRT()
CALLLP	ARGS POS(0) SPAN(LET DIGIT) . ARG (',' ! RPOS(0)) = :F(CALLEND)
	NARG = NARG + 1
	OPERAND = '(#1#2,<-[,' ARG ')'
	COMPILE()
	TAB.OFF(TP2) = TAB.OFF(TP2) + ADDR.WORD :(CALLLP)
CALLEND CLRREG() GENCALL(SUB)		:(RETURN)
**
COMPILE	OPERAND "=C" LEN(1) $ T1 BREAK(*T1) . T2 *T1
.		= "=A'" CHAR(T2) "'"	:S(COMPILE)
	OPERAND GET.THIS.OP =		:F(COMPERR)
	THISOP OPER.PARSE		:S(COMP1)
	IDENT(THISOP,'THEN')		:S(O.THEN)
	ERROR('FUNNY OPERAND')		:(FRETURN)
COMPERR DIFFER(OPERAND)
.		ERROR('INCORRECT OPERAND:' OPERAND)	:(FRETURN)
COMP1	SAVECOM = THISOP
	IDENT(THENSW)			:S(O.LOG)
	OP = JUMPLOC<OPR>
	DIFFER(OP)			:S(GOTOP)
	OPR POS(0) ('<-<-' ! '->->') . OPR REM . RIGHT	:S(COMP1)
COMPUN1 OPR POS(0) '<-[/' =			:F(COMPUN)
	( DS(SCSC '4',ADDR.WORD) DS(SCSC '3',ADDR.WORD) )
	CKSBSET()				:F(COMFULL)
	RIGHT = EQ(RIGHT,1) OPR			:S(COMPLS)
	RIGHT = RIGHT * CONVERT(OPR,'INTEGER')	:F(COMMUL)
COMPLS	OPR = '+'				:(COMP1)
COMMUL	OPERAND = '(#4,<-,' RIGHT '),'
.		'(#4,*,' OPR '),(' LEFT ',+,#4),'
.		OPERAND 			:(COMPILE)
COMFULL OPERAND = '(#3,<-[,' LEFT '),(#4,<-[,' RIGHT
.		'),(#4,-,#3),'
.		'(#4,*,' OPR '),(' LEFT ',+,#4),'
.		OPERAND 			:(COMPILE)
COMPUN	OPR POS(0) AVAR RPOS(0)			:S(COMPUN2)
	ERROR('UNDEFINED OPERATION...' OPR)	:(RETURN)
COMPUN2	DO.CALL(OPR ',(' LEFT ',' RIGHT ')')	:(RETURN)
GOTOP	IDENT(OPR,'GOTO')		:S(O.GOTO)
	OPR = IDENT(OPR,'<-[') CKSBSET() '+'	:S(COMP1)
	COMPLR()
	OPGO = 'O.' OP			:($OPGO)
**
O.THEN	THENSW = '1'
	( IDENT(BTYPE,'Y') GENLOG(BRANCH,LAB2)
.		GENLAB(LAB1) )		:(RETURN)
**
O.LOG	LEFT CK.LIT			:F(O.LOGOK)
	T1 = LEFT ; LEFT = RIGHT ; RIGHT = T1
	OPR = REPLACE(OPR,'<>','><')
O.LOGOK	COMPLR()
	OP = IDENT(BTYPE,'N') COMPOP()	:S(O.LOG1)
	OP = LOGOP<OPR>
O.LOG1	( IDENT(OP) ERROR('UNDEF RELATION OP') )
	GENLOG(OP,LLAB)			:(RETURN)
**
COMPOP	OPR '\' =			:S(COMPOP1)
	OPR = '\' OPR
COMPOP1	COMPOP = LOGOP<OPR>		:(RETURN)
**
COMPLR	GETCONT(LEFT,2) ; L.ENTRY = ENTRY
	L.ADDR = ADDR	; L.TYPE = TYPE ; L.F = GETTYPE(LF)
	GETCONT(RIGHT,1) ; R.ENTRY = ENTRY
	R.ADDR = ADDR	; R.TYPE = TYPE ; R.F = GETTYPE(LF)
	IDENT(L.F,R.F)			:S(COMPLR1)
	TYPE = L.TYPE
	( \( CKTYPE(BF,'BF') DIFFER(SW.CONV) )
.		 ERROR('LEFT AND RIGHT SIZES DIFFER') )	:S(COMPLR1)
	ERROR('WARNING...LEFT SIZE CHANGED TO SIZE OF RIGHT')
	L.F = R.F
	SETTYPE(LF,R.F)
	L.TYPE = TYPE
	TAB.TYPE( L.ENTRY ) = L.TYPE
	TAB.RANGE( L.ENTRY ) = TAB.RANGE( R.ENTRY )
	TAB.MASK( L.ENTRY ) = TAB.MASK( R.ENTRY )
COMPLR1	LR = L.F R.F			:(RETURN)
**
GETCONT CHAR.CNT = 0 ; OFF = 0 ; LOAD.CNT = 0
	PARM GET.VAR.X =		:S(GETC)
	PARM CK.LIT			:F(GETERR)
	( IDENT(WHEN,2) ERROR('LITERAL ON THE LEFT') )
CKCCH	TYPE = L.TYPE
	PARM POS(0) "=A" LEN(1) RTAB(1) . ADDR	:S(RETURN)
	ADDR = '#' RADIX(PARM)		:(RETURN)
GETERR	( DIFFER(PARM) ERROR('STRANGE OPERAND...' PARM) )
.						:(RETURN)
GETC	GEN()
	PARM GET.VAR.X =		:S(GETC)F(GETERR)
**
GEN	CHAR.CNT = CHAR.CNT + 1
	ENTRY = IDTAB<X>
	( IDENT(ENTRY) ERROR('UNDEFINED ELEMENT...' X) ) :S(RETURN)
	TYPE = TAB.TYPE(ENTRY)
	OFF = OFF + TAB.OFF(ENTRY)
	( DIFFER(TAB.BASE(ENTRY)) GT(CHAR.CNT,1)
.		ERROR('MISPLACED BASE:' X) )
	EQ(CHAR.CNT,1)			:F(GEBASE)
	( IDENT(TAB.BASE(ENTRY)) ERROR('MISPLACED BASE:' X) )
	BASELOC = TAB.BASE(ENTRY)
	TAB.MASK(ENTRY) = TAB.MASK(ENTRY) - 1
	ADDR =
	DIFFER(SW.REENT)		:F(GEBASE)
	( DIFFER(SW.REG) IDENT(BASELOC,'REG') )	:S(GEBASE)
	LREG = REENT.REG
	OFF = OFF + REENT.OFF<BASELOC>
	BASELOC =
GEBASE	( CKTYPE(TF,'B') DIFFER(PARM) )	:S(RETURN)
	LOAD.CNT = LOAD.CNT + 1
	GENLD()
	OFF = ; BASELOC =		:(RETURN)
**
GENLD	R = GETREG()
	( DIFFER(ADDR) CKREG() CKREGD()
.		PUTREG(R,ADDR) GENLOAD(R,ADDR) )
	OFF = EQ(OFF)			:S(NOOFF)
	OFF = RADIX(OFF)
NOOFF	BASELOC = DIFFER(BASELOC) DIFFER(OFF) BASELOC '+'
	LREG = DIFFER(LREG) '(' LREG ')'
	ADDR = BASELOC OFF LREG
	LREG = R			:(RETURN)
**
PUT	PUNCH = STRING			:(RETURN)
**
**SNO*LPAD	LPAD = DUPL(SYM,N - SIZE(LPAD)) LPAD	:(RETURN)
**SNO*RPAD	SYM = IDENT(SYM) ' '
**SNO*	RPAD = RPAD DUPL(SYM,N - SIZE(RPAD))	:(RETURN)
**
GENLAB	( DIFFER(LABEL) ASS(LABEL) CLRREG() ) :(RETURN)
**
FILLTAB TEMP BREAK.TAB =		:F(RETURN)
	FILLTAB<T1> = T2		:(FILLTAB)
**
ERR	ERROR('SYNTAX') 		:(RETURN)
**
ERROR	MESS = DIFFER(THISOP) MESS ':' THISOP
	TTYOUT = DIFFER(CARD) STATENO TAB CARD CRLF
	CARD =
	TTYOUT = 'ERROR-' MESS CRLF
	OUTPUT = '**********' MESS
	COMMENT(OUTPUT) 		:(RETURN)
**
SETTYPE TYPE POS(POS) LEN(1) = CHAR	:(RETURN)
**
GETTYPE TYPE POS(POS) LEN(1) . GETTYPE	:(RETURN)
**
CKTYPE	TYPE POS(POS) CHAR		:F(FRETURN)S(RETURN)
**
DEC2OCT N = CONVERT(N,'INTEGER')	:F(FRETURN)
	( GT(N,MAXSIZE) ERROR('GT MAX SIZE...' N) ) :S(FRETURN)
	DEC2OCT = LT(N,0) '-' DEC2OCT(0 - N)	:S(RETURN)
D2O	DEC2OCT = REMDR(N,8) DEC2OCT
	N = GT(N,7) N / 8		:F(RETURN)S(D2O)
**
FLIP	T1 = L.ADDR ; L.ADDR = R.ADDR ; R.ADDR = T1
	T1 = L.ENTRY ; L.ENTRY = R.ENTRY ; R.ENTRY = T1
	T1 = L.F ; L.F = R.F ; R.F = T1
	LR = L.F R.F			:(RETURN)
**
GETLAB	L.CNT = L.CNT + 1
	GETLAB = SC L.CNT		:(RETURN)
**
DS	( IDENT(BASE,'REG') DIFFER(SW.REG) )	:S(RETURN)
	SAVEDS (POS(0) ! '"') BASE ','	:S(RETURN)
	LEN = ((LEN + ADDR.WORD - 1) / ADDR.WORD)  * ADDR.WORD
	DIFFER(SW.REENT)		:F(DSNR)
	REENT.OFF<BASE> = TOTSTORE
	TOTSTORE = TOTSTORE + LEN	:(RETURN)
DSNR	SAVEDS = SAVEDS BASE ',' LEN '"' :(RETURN)
**
CHAR	CHAR = GETLAB()
	SAVEDC = SAVEDC CHAR ',' STRING '"'	:(RETURN)
**
ENDOFF	IDTAB = CONVERT(IDTAB,'ARRAY')
	OUTPUT =
	OUTPUT =
	OUTPUT = 'NAME  LOCATN  LEN OFF #REF TYPE'
	OUTPUT = REPLACE(OUTPUT,LET,MINUS)
	I =
ENDLP	I = I + 1
	NAME = IDTAB<I,1>		:F(RETURN)
	NAME POS(0) '#'			:S(ENDLP)
	ENTRY = IDTAB<I,2>
	NREF = -TAB.MASK(ENTRY)
	NREF = LE(NREF,0)
	OUTPUT = RPAD(NAME,6,'.') RPAD(TAB.BASE(ENTRY),8,'.')
.		RPAD(TAB.LEN(ENTRY),4,'.') RPAD(TAB.OFF(ENTRY),4,'.')
.		RPAD(NREF,5,'.') TAB.TYPE(ENTRY)
.					:(ENDLP)
**
CALL				:($SUBROUT)
********
** OPTIMIZATION
********
**
CKREG	LREG = IDENT(ADDR,'REG') DIFFER(SW.REG)
.		BASE.REG		:S(FRETURN)
	DIFFER(SW.OPT1) 		:F(RETURN)
	ADDR POS(0) ANY(LET)		:F(RETURN)
	INREG '"' ADDR ',' BREAK('"') . LREG	:S(FRETURN)F(RETURN)
**
PUTREG	OFFREG(R)
	INREG = INREG ADDR ',' R '"'	:(RETURN)
**
OFFREG	INREG '"' BREAK(',') ',' R =	:F(RETURN)S(OFFREG)
**
CLRREG	INREG = '"'			:(RETURN)
**
OFFLOC	INREG '"' LOC ',' BREAK('"') =	:F(RETURN)S(OFFLOC)
**
CKSBSET OFF = 0 ; RT = RIGHT
	RT POS(0) LEFT =		:F(FRETURN)
CKBLK	RT GET.VAR.X =			:F(FRETURN)
	ENTRY.X = IDTAB<X>
	( DIFFER(ENTRY.X) CKTYPET(TF,'B',TAB.TYPE(ENTRY.X)) )
.					:F(FRETURN)
	OFF = OFF + TAB.OFF(ENTRY.X)
	DIFFER(RT)			:S(CKBLK)
	RIGHT = OFF			:(RETURN)
**