Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50463/05/tshift.mac
There are 2 other files named tshift.mac in the archive. Click here to see a list.
00100	COMMENT * tshift, SIMULA specification;
00200	OPTIONS(/E:QUICK,tshift);
00300	PROCEDURE tshift(t,n); TEXT t; INTEGER n;
00400	COMMENT Starting at t.Pos,  tshift  shifts  the  rest  of  t  LEFT  n
00500	positions,  i.e.  shifts  right  if n<0. Vacated positions are filled
00600	with spaces. Shifts too far left or right  will  give  rest  of  t  =
00700	spaces.
00800	;
00900	
01000	!*;! MACRO-10 code !*;!
01100	
01200		TITLE	tshift
01300		ENTRY	tshift
01400		SUBTTL	SIMULA utility, Lars Enderin Feb 1979
01500	
01600	;!*** Copyright 1979 by the Swedish Defence Research Institute. ***
01700	;!*** Copying is allowed.					***
01800	
01900	
02000		sall
02100		search	simmac,simmcr,simrpa
02200		macinit
02300	
02400		;! Local definitions ;!
02500	
02600		t==XWAC1	;! Text, then t.rest
02700		t1==t+2		;! RHS text for t:= t1
02800		n==t1		;! Amount to shift
02900		k==XIAC		;! Length of text moved
03000		p1==t1+2	;! Byte pointer
03100		p2==p1+1	;! Byte pointer
03200		c==X1		;! Character
03300	
03400	tshift:	PROC
03500		JUMPE n,L9	;! No action for n=0
03600		HRLZ t+1	;! t.Pos to left half of AC0, rest zero
03700		IF	;! t.Pos > 1
03800			JUMPE FALSE
03900		THEN	;! t:- t.Sub(t.Pos,t.Length-t.Pos+1)
04000			ADDM t
04100			SUB t+1,
04200			HLLZS t+1	;! (t.Pos:= 1)
04300		FI
04400		JUMPE t+1,L9	;! rest == NOTEXT, nothing to be done
04500	
04600		LF k,ZTVLNG(,t)	;! k:= t.Length
04700		IF	;! n > 0
04800			JUMPL n,FALSE
04900		THEN	;! Left shift, use assignment directly
05000			SUB k,n		;! k:= k-n
05100			IF	;! k > 0
05200				JUMPLE k,FALSE
05300			THEN	;! t1:- t.Sub(n+1,k)
05400				MOVS t
05500				ADDI (n)
05600				MOVSM t1
05700				HRLZM k,t1+1
05800			ELSE	;! t1:- NOTEXT
05900				SETZB t1,t1+1
06000			FI
06100			LI XTAC,t
06200			XEC TXVA	;! t:= t1
06300		ELSE	;! n < 0
06400			ADD k,n		;! k:= k+n
06500			IF	;! k > 0
06600				JUMPLE k,FALSE
06700			THEN	;! Copy character by character backwards
06800				LF p1,ZTVSP(,t)
06900				ADDI p1,(k)
07000				ADJBP p1,[POINT 7,2(t)]
07100				IF	;! n = -1
07200					CAME n,[-1]
07300					GOTO FALSE
07400				THEN	;! Shorter code possible
07500					LOOP
07600						LDB p1
07700						IDPB p1
07800						L p1
07900						MOVNI p1,2
08000						ADJBP p1,
08100					AS
08200						SOJGE k,TRUE
08300					SA
08400				ELSE
08500					MOVN p2,n
08600					ADJBP p2,p1
08700					LOOP
08800						LDB p1
08900						DPB p2
09000						L p1
09100						SETO p1,
09200						ADJBP p1,
09300						MOVN p2,n
09400						ADJBP p2,p1
09500					AS
09600						SOJGE k,TRUE
09700					SA
09800				FI
09900				LF p1,ZTVSP(,t)		;! Spaces to vacated
10000				ADJBP p1,[POINT 7,2(t)] ;! positions, i.e.
10100				LI c," "		;! t.Sub(1,n):= NOTEXT
10200				LOOP
10300					IDPB c,p1
10400				AS
10500					AOJL n,TRUE
10600				SA
10700			ELSE	;! t:= NOTEXT
10800				SETZB t1,t1+1
10900				LI XTAC,t
11000				XEC TXVA
11100			FI
11200		FI
11300	L9():!	RETURN
11400		EPROC
11500		LIT
11600		END;