perm filename CONC2.MAC[SIM,SYS] blob sn#460010 filedate 1979-07-20 generic text, type T, neo UTF8
COMMENT * SIMULA specification;
OPTIONS(/E:CODE,conc2);
TEXT PROCEDURE conc2(t1,t2);
NAME t1,t2; TEXT t1,t2;
!	BEGIN TEXT c;
!		c:- Blanks(t1.Length+t2.Length);
!		c.Sub(1,t1.Length):=t1;
!		c.Sub(1+t1.Length,t2.Length):=t2;
!		conc2:- c
!	END;

!*;! MACRO-10 code !*;!

	TITLE	conc2
	SUBTTL	SIMULA utility, Lars Enderin Dec 1975

;! *** Copyright 1975 by the Swedish Defence Research Institute ***
;! *** Copying is allowed.					***

	ENTRY	conc2
	sall
	search	SIMMCR,SIMMAC
	macinit

	result==ZBI%S
	t1==result+2
	t2==t1+2
	Xt1=XWAC1
	Xt2=XWAC3
	Xtop==XWAC1

conc2:	PROC
	LD	X1,t1(XCB)
	IF	;! No thunk
		JUMPGE	X1,FALSE
	THEN	;! Simple load
		ADDI	X2,(X1)
		LD	Xtop,(X2)
	ELSE	;! Use standard proc
		LI	Xtop,(XCB)
		HRLI	Xtop,t1
		EXEC	PHFV	;! Value of t1
		XWD	0,0
	FI
	Xtop==Xtop+2
	LD	X1,t2(XCB)
	IF	;! No thunk
		JUMPGE	X1,FALSE
	THEN	ADDI	X2,(X1)
		LD	Xtop,(X2)
	ELSE
		LI	Xtop,(XCB)
		HRLI	Xtop,t2
		EXEC	PHFV	;! Value of t2
		XWD	Xtop-XWAC1,[1B0]
	FI
	LF	X0,ZTVLNG(,Xt1)	;! t1.Length
	Xtop==Xtop+2
	LF	Xtop,ZTVLNG(,Xt2);! t2.Length
	ADD	Xtop,X0		;! total length
	EXEC	TXBL		;!(possible to optimize here)
	XWD	Xtop-XWAC1,[1B0+1B2]
	LD	Xtop+2,Xt1	;! =t1
	EXCH	Xtop+1,Xt1+1	;! copy t1.Length (and Pos)
	LI	XTAC,Xtop
	EXEC	TXVA		;! copy t1 contents
	L	Xt1,Xtop
	HLL	Xt1,Xtop+1	;! Length to offset
	EXCH	Xt1+1,Xtop+1
	HLLZ	Xt1+1,Xt2+1
	LI	XTAC,Xt1
	EXEC	TXVA		;! copy second part
	STD	Xtop,result(XCB)
	BRANCH	CSEP
	EPROC
	LIT
	END;