;MOVE.MAC.11, 7-Dec-77 01:09:05, EDIT BY ALLEN ;FIX JDA POSTINIT BUG FOR OFFSET OF 1 TITLE MOVE - FORTRAN SUBROUTINE TO MOVE N CHARACTERS FROM ARRAY B TO ARRAY A ;STANDARD FORTRAN-10 LINKAGE ;ARGUMENTS ARE PASSED STARTING AT THE LOCATION POINTED TO BY AC16 ;CALL IS BY PUSHJ ;ARGS ARE A,I,B,J,N ;MOVE N CHARACTERS FROM ARRAY B STARTING AT BYTE J TO ARRAY A ; STARTING AT BYTE I. ;NOTE THAT CHARS ARE IN FORTRAN A8 FORMAT - PAIRS OF WORDS, 5 CHARS IN ; WD 1, 3 IN WD2, PADDED WITH BLANKS. Z=0 A=1 B=2 C=3 D=4 E=5 R6=6 R7=7 R10=10 R11=11 R12=12 R13=13 R14=14 R15=15 R16=16 P=17 ENTRY MOVE MOVE: MOVEI 1,@0(16) MOVEM 1, LOCA MOVE 2,@1(16) MOVEM 2,I MOVEI 3,@2(16) MOVEM 3,LOCB MOVE 4,@3(16) MOVEM 4,J SKIPG 5,@4(16) ;GET N POPJ 17, ;RET IF N=0 MOVEM 5,N ;SET UP INITIAL BYTE POINTERS SUBI B,1 ;COUNT STARTS AT 1, NOT 0 IDIVI B,^D8 ;I, THE DST INDEX IS IN B LSH B,1 ;B NOW HAS # DBLWDS PAST ST OF ARRAY ADD B,LOCA ; B <= LOC(A) + #WDS OF WHOLE A8 MOVEM B,DSTWD ;SAVE FOR MOVELP HRLI B,() ;MAKE BYTE PTR FOR DST JUMPE C,FOO ;DON'T GO THRU LOOP IF NO OFFSET MORE1: IBP B ;C HAS DBLWD # BYTES TO OFFSET BP. BY SOJG C,MORE1 ; NOW B CONTAINS PTR TO START OF DST ARRAY A FOO: SOS C,J IDIVI C,^D8 LSH C,1 ADD C,LOCB MOVEM C,SRCWD ;SAVE FOR MOVELP HRLI C,() JUMPE D,BAR ;DON'T GO THRU LOOP IF NO OFFSET MORE2: IBP C SOJG D,MORE2 BAR: ;NOW C CONTAINS PTR TO START OF SRC ARRAY B ;MOVE BYTES - SRC BP IN C, DST BP IN B, NUMBER OF BYTES IN E MOVELP: HLRZ R6,C ;GET LH B.P. IN RH FOR COMPARE CAIE R6,() ;IS IT TIME TO SKIP TO NEXT DOUBLEWD? JRST CONT1 ;NOT YET MOVE R7,SRCWD ;DO 2ND PART OF BP COMPARE ADDI R7,1 ;ARE WE ON 2ND WD OF A8 FMT DBLWD? HRRZ R6,C ;GET R.H. OF B.P. FOR COMPARE CAMN R6,R7 ;IF EQUAL, FIXUP B.P. PUSHJ P,FIXSRC CONT1: ILDB R10,C HLRZ R6,B ;GET LH B.P. IN RH FOR COMPARE CAIE R6,() ;IS IT TIME TO SKIP TO NEXT DOUBLEWD? JRST CONT2 ;NOT YET MOVE R7,DSTWD ;DO 2ND PART OF BP COMPARE ADDI R7,1 ;ARE WE ON 2ND WD OF A8 FMT DBLWD? HRRZ R6,B ;GET R.H. OF B.P. FOR COMPARE CAMN R6,R7 ;IF EQUAL, FIXUP B.P. PUSHJ P,FIXDST ;YES CONT2: IDPB R10,B SOJG E,MOVELP POPJ P, ;DONE FIXSRC: AOS C ;BUMP BYTE PTR UP TO START OF NEXT DOUBLEWORD HRLI C,() POPJ P, FIXDST: AOS B ;BUMP BYTE PTR UP TO START OF NEXT DOUBLEWORD HRLI B,() POPJ P, LOCA: 0 LOCB: 0 I: 0 J: 0 N: 0 SRCWD: 0 DSTWD: 0 LSTLOC: END