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;