Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/compre.mac
There is 1 other file named compre.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:QUICK,compress);
00300	TEXT PROCEDURE compress(t,c);
00400	TEXT t; CHARACTER c;
00500	COMMENT t is changed by deleting all characters=c, moving all characters
00600	following a c character one step to the left.
00700	The function value of compress is a text reference to the initial subtext
00800	containing all non-c characters. The remaining characters are unaltered.
00900	;
01000	
01100	!*;! MACRO-10 code !*;!
01200	
01300		TITLE	compress
01400		ENTRY	compress
01500		SUBTTL	SIMULA utility, Lars Enderin Nov 1975
01600	
01700	;! Copyright 1975 by the Swedish Defence Research Institute.
01800	;! Copying is allowed.
01900	
02000		sall
02100		search	simmac,simmcr,simrpa
02200		macinit
02300	
02400		;! Local definitions ;!
02500	
02600		lng==XIAC
02700		c==XWAC3
02800		t==XWAC1
02900		cc==X0
03000		p1==X1
03100		p2==X2
03200	
03300	compress:
03400		PROC
03500		LF	lng,ZTVLNG(XTAC)
03600		JUMPE	lng,L9	;! NOTEXT is not affected
03700		EXCH	t,(XTAC)
03800		EXCH	t+1,1(XTAC)
03900		EXCH	c,2(XTAC)
04000		STACK	XTAC
04100		SETZM	t+1
04200		LF	p1,ZTVZTE(,t)
04300		LF	p2,ZTVSP(,t)
04400		IF	;! No subtext
04500			JUMPN	p2,FALSE
04600		THEN	;! Simple case
04700			ADD	p1,bp
04800		ELSE	;! Worst case
04900			STACK	p2+1
05000			IDIVI	p2,5
05100			ADDI	p1,2(p2)
05200			HLL	p1,bp(p2+1)
05300			UNSTK	p2+1
05400		FI
05500		L	p2,p1
05600		LOOP	;! Moving non-c's up front
05700			ILDB	cc,p1
05800			IF	;! t.Getchar NE c
05900				CAIN	cc,(c)
06000				GOTO	FALSE
06100			THEN	;! Move it and count it
06200				IDPB	cc,p2
06300				ADDI	t+1,1
06400			FI
06500		AS
06600			SOJG	lng,TRUE
06700		SA
06800		MOVSS	1+t	;! Length = count of non-c's. Pos=1.
06900		UNSTK	XTAC
07000		EXCH	c,2(XTAC)
07100		EXCH	t+1,1(XTAC)
07200		EXCH	t,(XTAC)
07300	L9():!	RETURN
07400		EPROC
07500	
07600	bp:	POINT	7,2,-1
07700		POINT	7,2,6
07800		POINT	7,2,13
07900		POINT	7,2,20
08000		POINT	7,2,27
08100	
08200		LIT
08300		END;