Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:CODE,NOCHECK,conc);
TEXT PROCEDURE conc;!(t1,t2,...);
!NAME t1,t2,...; !TEXT t1,t2,...;
!	BEGIN TEXT c,c1;
!		c:- Blanks(t1.Length+t2.Length+...);
!		c1:-c.Sub(1,t1.Length);
!		c:-c.Sub(1+t1.Length,c.Length-t1.Length);! c1:=t1;
!		etc.....
!		conc:- c.Main
!	END;

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

	TITLE	conc
	SUBTTL	SIMULA utility, Lars Enderin Dec 1975

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

	ENTRY	conc
	sall
	search	SIMMCR,SIMMAC
	macinit

	result==ZBI%S
	t1==result+2
	maxofs==^D30*2
	Xt1=XWAC1
	Xt2=XWAC3
	Xtop==XWAC1

conc:	PROC
	SKIPN	t1(XCB)		;! Return directly if no parameter
	BRANCH	CSEP

	L	[Z t1(XCB)]	;! To be used for indirect addressing
	ST	result+1(XCB)
	LOOP	;! Convert all ZFL's to ZTV's
		L	@result+1(XCB)
		LF	X1,ZFLATP
		CAIE	X1,QTEXT
		RTSERR	107	;! Wrong type
		LF	X1,ZFLAKD
		IF	;! [142] Not simple or PROCEDURE
			CAIE	X1,QSIMPLE
			CAIN	X1,QPROCEDURE
			GOTO	FALSE
		THEN	;! Error
			RTSERR	113	;! Wrong kind
		FI
		LD	X1,@result+1(XCB)
		IF	;! Simple descriptor
			JUMPGE	X1,FALSE
		THEN	;! Get value of text descriptor
			ADDI	X2,(X1)
			LD	XWAC1,(X2)
		ELSE	;! Do it the hard way
			HRLZ	XWAC1,result+1(XCB)
			HRRI	XWAC1,(XCB)
			EXEC	PHFV	;! Text ref to XWAC1, XWAC2
			XWD	0,0
		FI
		STD	XWAC1,@result+1(XCB)
		HLRZ	result(XCB)	;! Sum lengths
		LF	X1,ZTVLNG(,XWAC1)
		ADDI	(X1)
		HRLM	result(XCB)
		HRRZ	result+1(XCB)
		ADDI	2
	AS
		CAILE	maxofs
		GOTO	FALSE
		HRRM	result+1(XCB)
		SKIPE	@result+1(XCB)	;! Stop if last param processed
		GOTO	TRUE
	SA
	HLRZ	XWAC1,result(XCB);! Total length
	EXEC	TXBL		;! Allocate text object
	XWD	0,0
	LI	XWAC5,t1(XCB)
	HLLZ	XWAC6,OFFSET(ZTECLN)(XWAC1)	;! Length
	LOOP
		LD	XWAC3,(XWAC5)
		IF	;! NOT NOTEXT
			JUMPE	XWAC3,FALSE
		THEN	;! Copy text using TXVA
			HLL	XWAC2,XWAC4	;! Make length the same
			LI	XTAC,XWAC1
			EXEC	TXVA
			HLLZ	XWAC4
			ADDM	XWAC1		;! Increment offset
			SUB	XWAC6,
		FI
	AS
		ADDI	XWAC5,2
		JUMPG	XWAC6,TRUE
	SA

	;! Return c.Main
	HRRZM	XWAC1,result(XCB)
	LF	,ZTECLN(XWAC1)
	HRLZM	result+1(XCB)
	BRANCH	CSEP
	EPROC
	LIT
	END;