.MCALL .MODULE .MODULE REPEAT,VERSION=03,COMMENT=,IDENT=NO,LIB=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL REPEAT - FORTRAN CALLABLE SUBROUTINE ; ; CALL REPEAT(IN,OUT,I[,LEN[,ERR]]) ; ; THE STRING IN ARRAY IN IS CONCATENATED TO ITSELF TO PRODUCE I COPIES. ; THE RESULTING STRING IS PLACED INTO OUT. IN AND OUT MAY NOT BE THE ; SAME ARRAY UNLESS I=0 OR I=1. WHEN I IS ZERO, OUT IS REPLACED BY A ; NULL STRING. WHEN I IS ONE, THIS ROUTINE IS THE EQUIVALENT OF SCOPY. ; OPTIONAL ARGUMENTS LEN AND ERR OPERATE THE SAME AS FOR THE ROUTINE SCOPY. ; THE OLD CONTENTS OF OUT ARE LOST WHEN THIS ROUTINE IS CALLED. ; ; MAS .PSECT SYS$I .GLOBL $SYSLB REPEAT::MOV (R5)+,-(SP) ;# OF ARGS IN LOW BYTE MOV (R5)+,R1 ;POINTER TO IN MOV R1,R3 ;COPY POINTER MOV (R5)+,R2 ;POINTER TO OUT CLRB @R2 ;START OFF WITH A NULL STRING MOV @(R5)+,R0 ;NUMBER OF COPIES TO MAKE BEQ 30$ ;DONE CMPB #4,@SP ;LEN ARG GIVEN? BHI 50$ ;NO, DO FAST WORK CMP #-1,@R5 ;ARG PRESENT? BEQ 50$ ;= -> NO MOV @(R5)+,R4 ;GET MAX LEN OF OUTPUT 10$: MOVB (R1)+,(R2)+ ;COPY INPUT STRING BEQ 40$ ;DONE ONE COPY ;>>> sob? DEC R4 ;COUNT LENGTH OF OUTPUT BNE 10$ CLRB (R2)+ ;TERMINATE OUTPUT STRING HERE CMPB #5,@SP ;ERR ARG GIVEN? BHI 30$ ;NO, JUST EXIT CMP #-1,@R5 ;ARG PRESENT? BEQ 30$ ; = -> NO DEC R0 ;ANY MORE COPIES TO MAKE BNE 20$ ;YES, SIGNAL ERROR TSTB @R1 ;DONE LAST COPY? BEQ 30$ ;YES, SO NO ERROR 20$: MOVB #-1,@(R5)+ ;SET ERR TO .TRUE. 30$: TST (SP)+ ;POP # OF ARGS RETURN 40$: DEC R0 ;COUNT COPIES BEQ 30$ ;DONE DEC R2 ;BACK UP OVER NULL BYTE MOV R3,R1 ;RE-POINT TO INPUT STRING BR 10$ ;GO MAKE ANOTHER COPY 50$: MOVB (R1)+,(R2)+ ;MAKE A COPY BNE 50$ DEC R0 ;COUNT COPIES BEQ 30$ ;DONE DEC R2 ;BACK UP OVER NULL BYTE MOV R3,R1 ;RE-POINT TO INPUT STRING BR 50$ .END