.TITLE IMR004 IFTRAN MACRO ROUTINES .IDENT /V01.04/ .GLOBL COPY, ALPINT, INTALP, NEXT .ENABL LC .SBTTL SUBROUTINE COPY ; ; This subroutine replaces the original IFTRAN subroutine, COPY. ; The function of this subroutine is to copy NUMBER characters ; from array LIST1 to LIST2, when invoked by a FORTRAN call. ; Parameter types are defined to be INTEGER*2 for NUMBER, and ; BYTE arrays for LIST1 and LIST2. COPY must be used with care ; when LIST1 and LIST2 are the same array. ; ; Calling form: CALL COPY (NUMBER, LIST1, LIST2) ; ; Revision History: ; 19-FEB-81 Changed MOVB to autoincrement mode ; COPY: MOV @2(R5), R0 ; Number of characters to move MOV 4(R5), R1 ; Address of array LIST1 MOV 6(R5), R2 ; Address of array LIST2 CHMOV: MOVB (R1)+, (R2)+ ; Move character SOB R0, CHMOV ; Loop if all not moved RTS PC ; Return ; .PAGE .SBTTL SUBROUTINE ALPINT ; ; This subroutine replaces the original IFTRAN subroutine, ALPINT. ; The function of this subroutine is to convert an ASCII numeric ; character, LABEL, to a binary number, NUMBER, when invoked ; by a FORTRAN call. Parameter types are defined to be INTEGER*2 ; for NUMBER, and BYTE array for LABEL. ; ; Calling form: CALL ALPINT (NUMBER, LABEL) ; ; Revision History: ; ALPINT: MOVB @4(R5), R0 ; Copy LABEL to R0, sign-extended BIC #177760, R0 ; Wipe off top 12 bits MOV R0, @2(R5) ; Return value in NUMBER RTS PC ; Return ; .PAGE .SBTTL SUBROUTINE INTALP ; ; This subroutine replaces the original IFTRAN subroutine, INTALP. ; The function of this subrotuine is to convert a binary integer ; number, NUMBER, to the corresponding alphanumerics in array ; LABEL when invoked by a FORTRAN call. Parameter types are ; defined to be INTEGER*2 for NUMBER, and byte array for LABEL. ; ; Calling form: CALL INTALP (NUMBER, LABEL) ; ; Revision History: ; INTALP: MOV 4(R5), R0 ; Define address of output area MOV @2(R5), R1 ; Define binary for conversion MOV #027412, R2 ; Conversion mask for $CBTA CALL $CBTA ; Convert binary to ASCII RTS PC ; .PAGE .SBTTL FUNCTION NEXT ; ; This function replaces the original IFTRAN function, NEXT. ; The purpose of this function is to return the next nonblank ; character in LIST, as long as I is less than L. When I reaches ; L, a blank is returned. Parameter types are INTEGER*2 for I ; and L, and BYTE array for LIST. ; ; Calling form: variable = NEXT(I) ; ; Revision History: ; 27-APR-81 I changed to return true value when I=L ; ; Map into IFTCOM common using this PSECT ; .PSECT IFTCOM,RW,D,GBL,REL,OVR ; DONE: .BLKW 1 INFILE: .BLKW 1 IP: .BLKW 1 KIND: .BLKW 1 L: .BLKW 1 LNUM: .BLKW 1 LOUT: .BLKW 1 OUTFIL: .BLKW 1 ERRCNT: .BLKW 1 LISTNG: .BLKB 1 PASCOM: .BLKB 1 CONLBL: .BLKB 6 LABEL: .BLKB 66. LHEAD: .BLKB 6 LIST: .BLKB 1320. ; ; This PSECT contains the code for function NEXT. ; .PSECT CODE ; NEXT: MOV @2(R5), R1 ; Move I into R1 MOV #LIST, R2 ; Move address of LIST into R2 MOV L, R3 ; Move L into R3 ADD R1, R2 ; R2 now points at LIST(I + 1) CHECK: INC R1 ; I = I + 1 CMPB (R2)+, #32. ; Is this character a blank? BNE FOUND ; If not, character was found CMP R1, R3 ; Is I > L? BLE CHECK ; If not, iterate MOV #32., R0 ; Return blank in R0 BR FOUND1 ; and branch to return FOUND: MOVB -(R2), R0 ; Return character in R0 FOUND1: MOV R1, @2(R5) ; Return new value of I RTS PC ; and return. ; .DSABL LC .END