COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
	  ,<SAVE,RESTR,X22,X33,STRNGC,INSET,GOGTAB,CONFIG,PUTCH>
	  ,<CAT -- CONCATENATION ROUTINE>)
DEFINE CANON (ADR,AC)<
	LDB	TEMP,[POINT 3,ADR,5]	;4,5,6,7,0,1 FROM POSITION
	IMULI	AC,5			;ADDR IN CHARS
	ADD	AC,BPTBL(TEMP)		;0,1,2,3,4,5 EXTRA CHARS
>
BPTBL:	4
	5
	0
	0
	0
	1
	2
        3				;MAP
HERE (CAT.RV)
	POP	SP,TEMP			;ARGUMENTS ARE IN REVERSE ORDER,
	POP	SP,LPSA			; PUT THEM RIGHT
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	MOVEM	LPSA,-3(SP)
	MOVEM	TEMP,-2(SP)
HERE (CAT)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;SAVE FOR STRNGC ERR MESSAGE
	MOVEI	TEMP,-1			;FOR TESTING LENGTHS
	TDNN	TEMP,-3(SP)		;FIRST STRING NULL?
	 JRST	 RETSEC			;YES, RETURN SECOND STRING
	TDNN	TEMP,-1(SP)		;SECOND STRING NULL?
	 JRST	 RETFRS			;YES, RETURN FIRST STRING
CATGO:	MOVEI	TEMP,RACS(USER)
	BLT	TEMP,RACS+3(USER)
	MOVEM	RF,RACS+RF(USER)	;SAVE F-REGISTER
CATGO1:	HRRZ	B,-2(SP)		;ADDR WORD OF FIRST STRING
	MOVE	LPSA,B
	CANON	(<-2(SP)>,LPSA)		;COMPUTE CANONICAL FORM
	HRRZ	A,-3(SP)		;#CHARS IN FIRST
	ADD	LPSA,A			;+#CHARS IN FIRST
	HRRZ	C,(SP)			;2D ADDRESS
	CAMGE	C,B			;IS IT POSSIBLE THEY ARE ALREADY CAT?
	 JRST	 CAT3			;NO
	CANON	(<(SP)>,C)		;GET CANONICAL FORM OF 2D
	CAMN	C,LPSA			;SAME?
	 JRST	 ADJRET			;YES, RETURN ADJUSTED POINTER
CAT3:	HRRZ	C,TOPBYTE(USER)		;TRY SAME TRICK WITH THIS GUY
	CANON	(<TOPBYTE(USER)>,C)
	CAMN	C,LPSA			;FIRST AT THE TOP?
	 JRST 	 ONLY1			;YES	
MOVTWO:	ADD	A,-1(SP)	;#CHARS(2)
	HRRZ	A,A		;ALLOW ROOM FOR POSSIBLE INSET
	ADDM	A,REMCHR(USER)	;#CHARS(NEW) - REMAINING #CHARS
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, GO MAKE SOME
	SKIPE	SGLIGN(USER)	;IF ALIGNING,
	PUSHJ	P,INSET		; ALIGN
	HRRZ	B,-3(SP)	;GET 1ST # CHARS
	HRROM	A,-3(SP)	;COUNT RESULT
	MOVE	LPSA,TOPBYTE(USER);WILL BE NEW BYTE POINTER
	MOVE	A,LPSA		;WILL BE RESULT
	EXCH	A,-2(SP)	;TRADE WITH FIRST BYTE POINTER
	ILDB	C,A		;KNOWN NOT TO BE NULL STRING
	IDPB	C,LPSA		;MOVE THE STRING
	SOJG	B,.-2		;RAPIDLY
	HRRZ	A,-1(SP)	;#CHARS(2)
	JRST	CATB
ONLY1:	SKIPE	SGLIGN(USER)	;CHECK ALIGNMENT?
	JSP	C,CHKLGN	;YES, DON'T RETURN IF MISALIGNED
	HRRZ	A,-1(SP)	;#CHARS(2)
	ADDM	A,REMCHR(USER)	; - REMAINING CHARS
	SKIPLE	REMCHR(USER)	;ROOM?
	JRST	[PUSHJ	P,STRNGC	;no, collect, then start from scratch
		MOVNS	A		;since new string space may void
		ADDM	A,REMCHR(USER)	;the ONLY1 condition.
		JRST	CATGO1]		;CATGO1 is new for this fix.
	ADDM	A,-3(SP)	;NEW #CHARS
	MOVE	LPSA,TOPBYTE(USER);EXTEND FROM HERE
CATB:	MOVE	B,(SP)		;2D BYTE POINTER
	ILDB	C,B		;MOVE THIS STRING
	IDPB	C,LPSA		;AND MOVE IT
	SOJG	A,.-2		; FAST
	MOVEM	LPSA,TOPBYTE(USER);PUT THIS AWAY, BY ALL MEANS
REST.4:	MOVSI	TEMP,RACS(USER)
	BLT	TEMP,C
RETFRS:	SUB	SP,X22		;REMOVE NON-RESULT
	JRST	@UUO1(USER)	;RETURN
RETSEC:	POP	SP,-2(SP)
	POP	SP,-2(SP)
	JRST 	@UUO1(USER)	;DIDN'T SAVE THEM
ADJRET:	SKIPE	SGLIGN(USER)	;IF NEED ALIGNMENT, MUST CHECK IT
	 JSP	 C,CHKLGN	;DON'T RETURN IF NOT ALIGNED
OKLG:	HRRZ	TEMP,-1(SP)	;COUNT OF 2D
	ADDM	TEMP,-3(SP)	;INCREASE COUNT OF FIRST
	JRST	REST.4
CHKLGN:	MOVE	TEMP,-2(SP)	;Check the position field of first arg --
	TLNN	TEMP,300000	;44, 01 are aligned, 35,27,17,10 not.  Bits
	 JRST	 (C)		; 1 and 2 are both off only for 44 and 01.
	 JRST	 MOVTWO		;Not aligned, move both
HERE (CHRCAT)
	HRRZ	TEMP,-1(SP)	;CHECK OTHER STRING NULL
	JUMPE	TEMP,ITSNUL
	PUSH	SP,-1(SP)	;MAKE ROOM FOR ONE UNDERNEATH
	PUSH	SP,-1(SP)
	MOVEI	TEMP,-4(SP)	;NOW PUT SINGLE-CHAR STRING
	PUSH	TEMP,[ONECH: 1
		      POINT 7,RACS+5(USER),27] ;CONSTANT IN
	PUSH	TEMP,ONECH+1
	JRST	CATCGO		;GO DO SPECIAL CAT
HERE (CATCHR)
	HRRZ	TEMP,-1(SP)
	JUMPE	TEMP,ITSNUL
	PUSH	SP,ONECH	;PUT ONE-CHAR DESCRIPTOR ON
	PUSH	SP,ONECH+1	;TOP
CATCGO:	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;RETURN ADDRESS
	POP	P,TEMP		;PUT IT SOMEWHERE SAFE
	ADD	TEMP,TEMP
	MOVEM	TEMP,RACS+5(USER)
	JRST	CATGO		;EVERYBODY'S NON-NULL
ITSNUL:	SUB	SP,X22
	JRST	PUTCH		;ZAP
HERE (CHRCHR)
	MOVE	USER,GOGTAB
	MOVEM	RF,RACS+RF(USER)
	PUSH	P,A
	MOVEI	A,2		;NEED 2 CHARS
	ADDM	A,REMCHR(USER)
	SKIPLE	A,REMCHR(USER)
	 PUSHJ	 P,STRNGC	;THE USUAL
	MOVE	A,-3(P)		;CHAR 1
	EXCH	A,(P)		;GET BACK SAVED
	PUSHJ	P,PUTCH		;A STRING
	AOS	-1(SP)		;2 CHARACTER STRING
	MOVE	TEMP,-1(P)	;CHAR 2
	IDPB	TEMP,TOPBYTE(USER);A 2-CHAR STRING
	SUB	P,X33
	JRST	@3(P)		;QUICK AS A BUNNY
ENDCOM (CAT)