Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/puttex.mac
There is 1 other file named puttex.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;

OPTIONS(/E:CODE,puttex);

BOOLEAN PROCEDURE puttext(target,source);
	NAME source; NAME target;
	TEXT  source, target;

COMMENT puts source into target at target.Pos and advances target.Pos
to point to the character following the copy of source.
Returns FALSE if there was not room for source in target;

! BEGIN TEXT t,s;
!	s:-source;
!	t:-target;
!	IF t.Pos+s.Length-1 <= t.Length THEN
!	BEGIN
!		puttext:=TRUE;
!		t.Sub(t.Pos,s.Length):=s;
!		target.Setpos(t.Pos+s.Length);
!	END;
! END	puttext;

COMMENT	*;! MACRO-10 code*;!

	TITLE	puttext
	SUBTTL	SIMULA utility procedure, Lars Enderin FOA Sept 1972

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

	ENTRY	puttext
	sall
	search	simmcr,simmac
	macinit

	result==2
	target==result+1
	source==target+2
	XL==	XWAC5

	DEFINE	textaddr(x,par,map)<
		LD	x,par(XCB)
		IF	;! No thunk
			JUMPGE	x,FALSE
		THEN	;! Simple access
			HRLI	x,(x+1)
			ADDI	x+1,(x)
		ELSE	;! Use PHFT
			LI	x,(XCB)
			HRLI	x,par
			EXEC	PHFT
			.n.==x-XWAC1
			IFE 	.n.,<Z>
			IFN	.n.,<XWD .n.,[map]>
			PURGE	.n.
		FI
		>

	DEFINE	textvalue(x,par,map)<
		LD	x,par(XCB)
		IF	;! No thunk
			JUMPGE	x,FALSE
		THEN	;! Simple access
			ADDI	x+1,(x)
			LD	x,(x+1)
		ELSE	;! Use PHFV
			LI	x,(XCB)
			HRLI	x,par
			EXEC	PHFV
			.n.==x-XWAC1
			IFE 	.n.,<Z>
			IFN	.n.,<XWD .n.,[map]>
			PURGE	.n.
		FI
		>
puttext:PROC
	textvalue(XWAC1,target)
	textvalue(XWAC3,source,1B0)
	LF	XL,ZTVLNG(,XWAC3)
	ADDI	XL,(XWAC2)		;! New Pos
	LF	X1,ZTVLNG(,XWAC1)	;! target.Length
	IF	;! There is room after pos
		CAMLE	XL,X1
		GOTO	FALSE
	THEN	;! Put it there
		SETOM	result(XCB)	;! puttext:=TRUE
		HRLZ	X2,XWAC2	;! Subtext offset for receiving field
		ADD	XWAC1,X2
		HLL	XWAC2,XWAC4	;! Copy source.Length before assignment
		LI	XTAC,XWAC1
		EXEC	TXVA		;! Copy source into target
		STACK	XL		;! Save new Pos
		textaddr(XWAC1,target)
		UNSTK
		SF	,ZTVCP(XWAC2)
	FI
	BRANCH	CSEP
	EPROC
	LIT
	END;