Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0130/strsub.src
There are 2 other files named strsub.src in the archive. Click here to see a list.
\PROCESS
\KEY=STRSUB
SUBR(S)
=TITLE		^S^
SEARCH		STRMAC
.DIRECT		.XTABM
TWOSEG
RELOC		400000

^S^:		ENTRY ^S^
END=
NOSYM
PRGEND
%PAGE%
SAVE(NAM,AC1,AC2)=
%SUBR(^NAM^)%
N=^AC2^-^AC1^+1
K=0
REPEAT <N>,<PUSH		P,^AC1^+<K=K+1>-1>
PUSHJ		P,@-N(P)	; CALL CALLER BACK
CAIA				; NO SKIP RETURN, SKIP INCREMENT
AOS		-<N+1>(P)	; SKIP RETURN, INCREMENT RETURN ADDRESS
REPEAT <N>,<POP		P,^AC1^+<K=K-1>>
POP		P,(P)		; DISCARD ORIGINAL RETURN ADDRESS
RETURN
%END%
PAGE=\.CHR<12>\
\EOD
\.OUTF<STRSUB.MAC>\
\.TMPWRT<SVC><COM STRSUB/L>\
\.NEXT</RUN:SYS:COMPIL/RUNOFF:1>\
%SUBR(SKP.RT)%
AOS		(P)		; INCREMENT RETURN ADDRESS FOR SKIP RETURN
RETURN
%END%
%SUBR(RST.PC)%
.+1				; CALLED BY RETURN AFTER PUSH P,RST.PC
CAIA				; NO SKIP RETURN, SKIP INCREMENT
AOS		-1(P)		; SKIP RETURN, INCREMENT RETURN ADDRESS
POP		P,PC		; RESTORE SAVED PC
HLR		PC,PC		; GET ADDRESS OF CALLER'S SAVED PC
HRR		PC,(PC)		; RESTORE CALLER'S SAVED PC
RETURN
%END%
%SUBR(RST.LP)%
.+1				; CALLED BY RETURN AFTER PUSH P,RST.LP
CAIA				; NO SKIP RETURN, SKIP INCREMENT
AOS		(LP)		; SKIP RETURN, INCREMENT RETURN ADDRESS
MOVE		P,LP		; RESTORE PUSHDOWN POINTER
MOVE		LP,1(P)		; RESTORE PREVIOUS LOCAL STORAGE POINTER
RETURN
%END%
%SUBR(CAL.FS)%
F=		P1		; FIRST AC TO SAVE
N=		PC-F+1		; NUMBER OF AC'S TO SAVE
ADD		P,[N,,N]	; ALLOCATE SPACE ON PDL TO SAVE AC'S
JUMPG		P,[PUSHJ P,.]	; CAUSE PDL OVERFLOW IF OVERFLOWED
MOVEM		PC,(P)		; SAVE PC ON PDL
MOVSI		PC,F		; GET ADR OF FIRST AC FOR BLT POINTER
HRRI		PC,-<N-1>(P)	; GET ADR OF SAVE AREA ON PDL FOR BLT POINTER
BLT		PC,-1(P)	; SAVE AC'S F THRU PC-1 ON PDL
MOVE		PC,@-N(P)	; GET ARG LIST ADDRESS FROM CALLING PROGRAM
PUSHJ		P,@-1(PC)	; CALL FORTRAN SUBROUTINE
MOVSI		PC,-<N-1>(P)	; GET ADR OF SAVE AREA ON PDL FOR BLT POINTER
HRRI		PC,F		; GET ADR OF FIRST AC FOR BLT POINTER
BLT		PC,PC		; RESTORE AC'S F THRU PC FROM PDL
SUB		P,[N,,N]	; RESTORE PDL POINTER
AOS		(P)		; SKIP ARG LIST POINTER
RETURN
%END%
%SAVE(S.R0R0,R0,R0)%
%SAVE(S.T1T1,T1,T1)%
%SAVE(S.T1T2,T1,T2)%
%SAVE(S.T1T3,T1,T3)%
%SAVE(S.T1T4,T1,T4)%
%SAVE(S.P1P1,P1,P1)%
%SAVE(S.P1P2,P1,P2)%
%SAVE(S.P1P3,P1,P3)%
%SAVE(S.P1P4,P1,P4)%
%SAVE(S.P1R1,P1,R1)%
%SAVE(S.P1R2,P1,R2)%
%SAVE(S.P1R3,P1,R3)%
%SAVE(S.P1R4,P1,R4)%
%SAVE(S.R1R1,R1,R1)%
%SAVE(S.R1R2,R1,R2)%
%SAVE(S.R1R3,R1,R3)%
%SAVE(S.R1R4,R1,R4)%

END