TITLE	CROSS

F==0
A=1
B=2
C=3
D=4
E=5
LC=6
PG=7
R=7
N=10
LL=10
PL=11
CN=12
TP=13
L=14
L2=15
PD=16
P=17

TYI==1
TYO==2
I==3
O==4
ERRC==5

BUFL==400
SYML==4400

JCRY=JFCL 6,
JRSTF=JRST 2,
LOC 40
	0
	JRST CSYM
LOC 100

MAIN:	JFCL	17,.+1
	MOVSI	A,400000
	MOVNI	B,6
LOOP:	ILDB	C,P
	XCT	DTAB(C)
	JUMPE	B,LOOP
	MOVEI	B,1(B)
	JRST	LOOP

CSYM:	SETZB	C,F
	MOVEI	L,JNEW
	JCRY	SYM
	JRST	@40
SYM:	TLZ	A,740000
	MOVE	B,A
	TSC	B,B
	MOVMS	D,B
	IDIVI	B,SYML
	HRLI	C,-SYML(C)
SYMLUP:	SKIPN	B,ST(C)
	JRST	(L)
	CAMN	B,A
	JRST	1(L)
SL:	AOBJN	C,SYMLUP
	TLOE	F,1
	.VALUE
	MOVN	B,D
	IDIVI	B,SYML
	HRLZI	C,-1(C)
	JRST	SL

NEW:	MOVEM	A,ST(C)
	AOBJP	LC,CORE
C1:	HRRZM	LC,ST2(C)
	HRLZM	PG,(LC)
	JRST	@40
JNEW:	JRST	NEW
OLD:	HLRZ	D,ST2(C)
	XCT	TTAB(D)	;NORMAL CASE DOES	HRRZ	D,ST2(C)
	HLRZ	B,(D)
	CAIN	PG,(B)
	JRST	@40
	AOBJP	LC,CORE
C2:	HRRZM	D,(LC)
	HRLM	PG,(LC)
	HRRM	LC,ST2(C)
	MOVEI	D,(LC)
	JRST	@40

TTAB:	HRRZ	D,ST2(C)
	JRST	@40
	JRST	TXT
	JRST	IGCR

CORE:	MOVEI	A,2000(LC)
	LSH	A,-10.
	.CORE	(A)
	.VALUE
	ADD	LC,[-2000,,]
	JUMPE	B,C1	;?????
	JRST	C2

TXT:	LDB	C,P
	CAIE	C,40	;SPACE
	JRST	.+4
	ILDB	C,P
	CAIN	C,3
	JSP	L,CC1
	SKIPA	B,C
IGCR:	MOVEI	B,15
	ILDB	C,P
	CAIN	C,^L
	 JRST	FF
	CAIN	C,3
	JSP	L,CC1
	CAME	C,B	;CR
	JRST	IGCR+1
	JRST	MAIN

CC1:	SOS	L
CC:	MOVEI	P,(P)
	CAIE	P,BUFE
	JRST	SORT
	MOVE	E,[-BUFL,,BUF]
	.IOT	I,E
	MOVE	P,[350700,,BUF]
	LDB	C,P
	JRSTF	-1(L)
;READ IN A COMMAND, PROCESSING RUBOUTS, PROMPTING WITH "*".
TTILIN:	.IOT	TYO,[^M]

;COME HERE AFTER NULL LINE.
TTILI2:	.IOT	TYO,["*]
	SETZM	TTICNT		;NO CHARS READ YET.
	MOVE	B,[440700,,TTIBUF]
	MOVEM	B,TTIPNT
TTILUP:	.IOT	TYI,B		;READ A CHAR.
	CAIN	B,^M
	JRST	TTICR		;^M MEANS ALL READ.
	CAIN	B,177
	JRST	TTIRUB
	CAIN	B,^U
	JRST	TTILIN		;^U - CANCEL COMMAND.
	IDPB	B,TTIPNT	;NORMAL CHAR.
	AOS	TTICNT
	JRST	TTILUP

TTICR:	SKIPN	TTICNT		;IF READING CMD, ON NULL LINE, RETRY.
	JRST	TTILI2
	IDPB	B,TTIPNT
	MOVE	B,[440700,,TTIBUF]
	MOVEM	B,TTIPNT	;SET UP FOR REMOVAL OF CHARS.
	JRST	CLUP3		;RETURN.

TTIRUB:	SOSGE	TTICNT		;IF NO CHAR TO RUB, RETRY.
	JRST	TTILIN
	LDB	B,TTIPNT
	.IOT	TYO,B		;PRINT RUBBED CHAR.
	MOVSI	B,070000
	ADD	B,TTIPNT
	JUMPGE	B,TTIRU1	;IF STILL IN SAME WD.
	MOVEI	B,-1(B)		;ELSE, MOVE TO END OF PREV. WD.
	HRLI	B,010700
TTIRU1:	MOVEM	B,TTIPNT
	JRST	TTILUP

TTICNT:	0		;NUM CHARS READ.
TTIPNT:	0		;PTR INTO BUFFER.
TTIBUF:	BLOCK	40
BEG:	.OPEN	TYI,[0,,(SIXBIT /TTY/)]
	.VALUE
	.OPEN	TYO,[1,,(SIXBIT /TTY/)]
	.VALUE
IN:	.CORE	<FS+LEN>/2000
	.VALUE
	.SUSET	[.RSNAM,,N]
	MOVEM	N,OUTFIL+3
	MOVSI	A,(SIXBIT /TPL/)
	MOVEM	A,OUTFIL
	.BREAK	12,[5,,TTIBUF]	;TRY GETTING :JCL COMMAND.
	SKIPN	TTIBUF
	JRST	TTILIN		;IF NONE, READ LINE FROM TTY.
	.BREAK	12,[SETZ [0](5)];FLUSH :JCL COMMAND
CLUP3:	MOVE	A,[440700,,TTIBUF]
	MOVEM	A,TTIPNT	;SET UP FOR READING COMMAND.
CLUP2:	MOVEM	N,INFIL+3
	MOVSI	A,(SIXBIT /DSK/)
	MOVEM	A,INFIL
	MOVSI	A,(SIXBIT />/)
	MOVEM	A,INFIL+2
	MOVNI	C,2
CLUP:	MOVEI	A,0
	MOVE	P,[440600,,A]
CLUP1:	ILDB	B,TTIPNT
	CAIN	B,40
	JRST	CMSP
	CAIN	B,":
	JRST	CMCOL
	CAIN	B,";
	JRST	CMSEM
	CAIN	B,"_
	JRST	CBAK
	CAIN	B,15
	JRST	CMCR
	CAIN	B,^Q
	ILDB	B,TTIPNT
	SUBI	B,40
	TLNE	P,770000
	IDPB	B,P
	JRST	CLUP1
CMCR:	TDZA	B,B
CBAK:	SETO	B,
CMSP:	JUMPE	A,CMSP2
	MOVEM	A,INFIL+3(C)
	AOJL	C,CMSP2
	MOVNI	C,3
CMSP2:	JUMPG	B,CLUP
	JUMPE	B,OPEN
	MOVE	A,[INFIL,,OUTFIL]
	BLT	A,OUTFIL+3
	JRST	CLUP2

CMCOL:	MOVEM	A,INFIL
	JRST	CLUP
CMSEM:	MOVEM	A,INFIL+3
	JRST	CLUP

ERR:	.SUSET	[.SSNAM,,N]
	.LOGOUT
	.OPEN	ERRC,ERRFIL
	.VALUE
ERR0:	.IOT	ERRC,B		;COPY ERR DEV TO TTY.
	CAIN	B,^L
	JRST	ERR1
	.IOT	TYO,B
	JRST	ERR0
ERR1:	.RESET	TYI,
	JRST	IN

ERRFIL:	SIXBIT/   ERR/
	1?0

OPEN:	MOVEI	A,2
	HLL	A,INFIL
	MOVSM	A,INFIL
	CAME	N,INFIL+3
	.SUSET	[.SSNAM,,INFIL+3]
	.OPEN	I,INFIL
	JRST	ERR
	MOVEI	A,3
	HLL	A,OUTFIL
	MOVSM	A,OUTFIL
	MOVE	A,OUTFIL+3
	CAME	A,INFIL+3
	.SUSET	[.SSNAM,,OUTFIL+3]
	.OPEN	O,OUTFIL
	JRST	ERR
	CAME	A,N
	.SUSET	[.SSNAM,,N]	MOVSI	A,-SYML
	SETZM	ST(A)
	SETZM	ST2(A)
	AOBJN	A,.-2
	MOVEI	E,ISYMT+1
ISL:	MOVE	A,-1(E)
	JSP	L,SYM
	SKIPA	B,-1(E)
	.VALUE
	LSH	B,-16
	ADD	B,[1,,]
	MOVEM	A,ST(C)
	HLLZM	B,ST2(C)
TEST:	CAIE	E,TSS
	AOJA	E,ISL

	MOVEI	PG,1
	MOVE	LC,[-LEN-1,,FS-1]
	MOVE	E,[-BUFL,,BUF]
	.IOT	I,E
	MOVE	P,[440700,,BUF]
	JRST	MAIN

FF:	AOS	PG
	U	MAIN
SORT:	MOVEI	B,SYML/2
SORT1:	MOVE	C,[ST(B)]
SORT3:	MOVE	A,(C)
	MOVEI	D,@C
	CAMG	A,(D)
	AOJA	C,SORT2
	EXCH	A,(D)
	MOVEM	A,(C)
	MOVE	A,ST2-ST(C)
	EXCH	A,ST2-ST(D)
	MOVEM	A,ST2-ST(C)
	TLO	C,400000
	AOS	C
SORT2:	CAIE	D,ST+SYML-1
	JRST	SORT3
	TLZE	C,400000
	JRST	SORT1
	CAIN	B,1
	JRST	PH3
	AOS	B
	LSH	B,-1
	JRST	SORT1
PH3:	MOVEI	PD,PDL-1
	MOVSI	A,-SYML
	MOVEI	LL,60.
	MOVEI	CN,BUFL*5
	MOVE	P,[440700,,BUF]
PLOOP:	SKIPE	B,ST2(A)
	TRNN	B,777777
	JRST	PEND
	MOVE	TP,LL
	IMULI	TP,11
	HRRZ	C,(B)
	HLLZS	(B)
	JUMPE	C,REND
RLOOP:	HRRZ	D,(C)
	SOS	TP
	HRRM	B,(C)
	MOVE	B,C
	MOVE	C,D
	JUMPN	C,RLOOP
REND:	CAIG	LL,10.
	SOJL	TP,PAGE
	MOVEI	R,50
	MOVE	C,ST(A)
	PUSHJ	PD,UNDO
	JRST	.+5
	JUMPE	D,CPOPJ
	MOVE	D,RTAB(D)
	JSP	L,OUT
CPOPJ:	POPJ	PD,
	MOVEI	R,10.
	MOVEI	PL,11.
PENT:	SOJGE	PL,.+3
	JSP	L2,CR
	MOVEI	PL,10.
MENT:	MOVEI	D,11
	JSP	L,OUT
	HLRZ	C,(B)
	PUSHJ	PD,UNDO
	JRST	.+4
	ADDI	D,60
	JSP	L,OUT
	POPJ	PD,
	HRRZ	B,(B)
	JUMPN	B,PENT
	JSP	L2,CR
PEND:	AOBJN	A,PLOOP
	MOVEI	D,3
	JSP	L,OUT
	JRST	.-1
DONE:	.CLOSE	O,	;DONE!!!
	.CLOSE	I,
	.LOGOUT
	.BREAK	16,140000
UNDO:	MOVE	D,(PD)
	AOS	D
	HRRM	D,UNDI
UND1:	IDIVI	C,(R)
	HRLM	D,(PD)
	JUMPE	C,UNDI
	PUSHJ	PD,UND1
	HLRZ	D,(PD)
UNDI:	JRST	.

PAGE:	MOVEI	D,14
	JSP	L,OUT
	MOVEI	LL,60.
	JRST	REND+2

CR:	MOVEI	D,15
	JSP	L,OUT
	MOVEI	D,12
	JSP	L,OUT
	SOSG	LL
	MOVEI	LL,60.
	JRST	(L2)

OUT:	SOJL	CN,OUT1
	IDPB	D,P
	JRST	(L)
OUT1:	MOVE	E,[-BUFL,,BUF]
	.IOT	O,E
	CAIN	D,3
	JRST	DONE
	MOVE	P,[440700,,BUF]
	MOVEI	CN,BUFL*5
	JRST	OUT
U=1000,,
DTAB:	REPEAT 3,U MAIN
	JSP	L,CC
	REPEAT 10,U MAIN
	JRST	FF
	REPEAT 27,U MAIN
	ADD	A,SQ.$(B)
	ADD	A,SQ.%(B)
	REPEAT 10,U MAIN
	ADD	A,SQ..(B)
	U	MAIN
	IRPC Z,,0123456789
	ADD	A,SQ.!Z(B)
	TERMIN
	U	MAIN
	U	IGCR
	REPEAT 5,U MAIN
	IRPC Z,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
	ADD	A,SQ.!Z(B)
	TERMIN
	REPEAT 45,U MAIN
IFN .-200-DTAB,PRINTX /LOSE LOSE/

DEFINE	SQT	A,B
	SQUOZE 0,B+A_40
	SQUOZE 0,B/50+A_40
	SQUOZE 0,B/50/50+A_40
	SQUOZE 0,B/50/50/50+A_40
	SQUOZE 0,B/50/50/50/50+A_40
	SQUOZE 0,B/50/50/50/50/50+A_40
SQ.!B:	A_40
TERMIN

IRPC Z,,ABCDEFGHIJKLMNOPQRSTUVWXYZ$%
	SQT	10,Z
TERMIN
	SQT	4,.
IRPC Z,,0123456789
	SQT	0,Z
TERMIN

RTAB:	0
	IRPC Z,,0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%
	"Z
TERMIN
CONSTANTS
VARIABLES

INFIL:	BLOCK 4
OUTFIL:	BLOCK 4

PDL:	BLOCK 10

DEFINE	S	A
	SQUOZE	0,A
TERMIN
DEFINE	T	A
	SQUOZE	4,A
TERMIN
DEFINE	II	A
	SQUOZE	10,A
TERMIN
DEFINE	MS	FOO/
DEFINE	M	X
IRP	Z,,[,FOO]
	S	X!!Z
TERMIN
TERMIN
TERMIN

ISYMT:	S UFA
	S DFN
	S FSC
	S IBP
	S ILDB
	S LDB
	S IDPB
	S DPB
MS	L,M,B,R,RL,RM,RB
	M FAD
	M FSB
	M FMP
	M FDV
MS	I,M,S
	M MOVE
	M MOVS
	M MOVN
	M MOVM
MS	I,M,B
	M IMUL
	M MUL
	M IDIV
	M DIV
	S ASH
	S ROT
	S LSH
	S JFFO
	S ASHC
	S ROTC
	S LSHC
	S EXCH
	S BLT
	S AOBJP
	S AOBJN
	S JRST
	S JFCL
	S XCT
	S PUSHJ
	S PUSH
	S POP
	S POPJ
	S JSR
	S JSP
	S JSA
	M ADD
	M SUB
MS	L,E,LE,A,GE,N,G
	M CAI
	M CAM
	M JUMP
	M SKIP
	M AOJ
	M AOS
	M SOJ
	M SOS
MS	I,M,B
	M SETZ
	M AND
	M ANDCA
	M SETM
	M ANDCM
	M SETA
	M XOR
	M IOR
	M ANDCB
	M EQV
	M SETCA
	M ORCA
	M SETCM
	M ORCM
	M ORCB
	M SETO
MS	I,M,S,Z,ZI,ZM,ZS,O,OI,OM,OS,E,EI,EM,ES
	M HLL
	M HRL
	M HLR
	M HRR
MS	N,NE,NA,NN,Z,ZE,ZA,ZN,C,CE,CA,CN,O,OE,OA,ON
	M TR
	M TL
	M TD
	M TS
	S BLKI
	S DATAI
	S BLKO
	S DATAO
	S CONO
	S CONI
	S CONSZ
	S CONSO
	S APR
	S PI
	S PTP
	S PTR
	S TTY
	S LPT
	S DIS
	S DC
	S UTC
	S UTS
	S IBM
MS	I,M,B
	M CLEAR
	S END
	S LOC
	S XWORD
	S RIM1
	S RIM10
	S SBLK
	S RIM
	II TITLE
	S SQUOZE
	S EXP
	S XWD
	S .BEGIN
	S REPEAT
	S .END
	S OCT
	S CONSTA
	T SIXBIT
	T ASCII
	S RADIX
	S BLOCK
	S NOSYMS
	S EXPUNGE
	S NULL
	S EQUALS
	S DEFINE	;UGH
	II IRP	;UGH
	II IRPC	;UGH
	II IRPS	;UGH
	S TERMIN
	S .QUOTE
	S WORD
	S RELOCA
	S 1PASS
	S OFFSET
	S IFG
	S IFGE
	S IFE
	S IFLE
	S IFN
	S IFSE	;UGH
	S IFSN	;UGH
	S IF1
	S IF2
	S IFL
	T PRINTX
	T PRINTC
	S VARIAB
	S .LIBRA
	T .LENGTH
	S .LIFS
	S .ELDC
	S .LIFE
	S .LIFN
	S .LIFG
	S .LIFLE
	S .LIFGE
	S .LIFL
	S .SLDR
	S .OP
	S .FORMAT
	S .STOP
	S .ISTOP
	S .RPCNT
	S .LOP
	S $.
	S $R.
	S .LVAL1
	S .LVAL2
	S .LNKOT
	S .NSTGW
	S .YSTGW
	S .GSSET
	S .TYPE
	S .LIBRQ
	S .GLOBAL
	S .GO
	S .TAG
	T .ASCII
	T ASCIZ
	S .BYTC
	S .BYTE
	S .WALGN
	S .IRPCNT
	S .FNAM1
	S .FNAM2
	II .INSRT
	II .I
	II .F
TSS:

BUF:	BLOCK BUFL
BUFE:	3_35

ST:	BLOCK SYML
ST2:	BLOCK SYML

FS:
LOC .\1777+4000
LEN==.-FS+1
END BEG