Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/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;