Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/makete.mac
There are 2 other files named makete.mac in the archive. Click here to see a list.
00100	Comment * SIMULA specification;
00200	OPTIONS(/E:CODE,maketext);
00300	TEXT PROCEDURE maketext(c,n); CHARACTER c; INTEGER n;
00400	COMMENT Returns a reference to a new text object which contains n
00500	copies of the character c;
00600	
00700	! *;! MACRO-10 code *;!
00800	
00900		TITLE	maketext
01000		SUBTTL	SIMULA utility, Lars Enderin Nov 1975
01100	
01200	;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
01300	;!*** Copying is allowed.					***
01400	
01500		ENTRY	maketext
01600		sall
01700		search	simmac,simmcr,simrpa
01800		macinit
01900	
02000		result==ZBI%S
02100		c==result+2
02200		n==c+1
02300	
02400	maketext:
02500		PROC
02600		L	XWAC1,n(XCB)
02700		IF	;! not positive
02800			JUMPG	XWAC1,FALSE
02900		THEN	;! Return NOTEXT
03000			SETZB	XWAC1,XWAC2
03100			GOTO	L9
03200		FI
03300		EXEC	TXBL
03400		XWD	0,0
03500		L	c(XCB)
03600		IMUL	[BYTE (1)0(7)1,1,1,1,1]
03700		LSH	1
03800		L	X1,n(XCB)
03900		LF	X2,ZTVZTE(,XWAC1)
04000		LOOP
04100			ST	2(X2)
04200		AS
04300			SUBI	X1,5
04400			JUMPLE	X1,FALSE
04500			AOJA	X2,TRUE
04600		SA
04700		IF 	;! last word not full
04800			JUMPE X1,FALSE
04900		THEN	;! Make extra characters null in text object
05000			AND mask+4(X1)
05100			ST 2(X2)
05200		FI
05300	L9():!	STD	XWAC1,result(XCB)
05400		BRANCH	CSEP
05500	mask:!	BYTE	(7)177
05600		BYTE	(7)177,177
05700		BYTE	(7)177,177,177
05800		BYTE	(7)177,177,177,177
05900		EPROC
06000		LIT
06100		END;