Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/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;