.TITLE ERFTN - Fortran Interface .IDENT /V01.00/ .ENABL LC ;+ ; This module provides a Fortran interface for directive and QIO errors. ; We assume Fortran does a good enough job on FCS errors. The routines ; check for errors and call the fatal version if an error detected. ; ; Call with: CALL ERDIRF([err1,err2,...errn]) ; CALL ERQIOF(ios,lun[,err1,err2,...errn]) ; ; errn = expected error code (any number allowed) ; ios = QIO I/O status ; lun = QIO logical unit ; ; Exit with: Returns immediately if no error or match with expected ; errir list. Otherwise, outputs message and exits task. ;- .PSECT ERR$CD,RO,I ERDIRF::MOV $DSW,R1 ;Was there an error BPL 9999$ ; If PL - no, return MOV (R5)+,R0 ;Get number of arguments BEQ 2000$ ; If EQ - all done 1000$: CMP @(R5)+,R1 ;Is this a match BEQ 9999$ ; If EQ - yes, return DEC R0 ;Count the argment BNE 1000$ ; If NE - loop again 2000$: CALLR ERDIRX ;Output error and exit 9999$: RETURN ;Return to caller ERQIOF::TSTB @2(R5) ;Was there an error BPL 9999$ ; If PL - no, return MOV (R5)+,R0 ;Get number of arguments MOV @(R5)+,R1 ;Get the error code MOV @(R5)+,R2 ;Get the logical unit SUB #2,R0 ;Subtract required arguments BLE 2000$ ; If LE - all done 1000$: CMPB @(R5)+,R1 ;Is this a match BEQ 9999$ ; If EQ - yes, return DEC R0 ;Count the argment BNE 1000$ ; If NE - loop again 2000$: MOV R1,-(SP) ;Store error code MOV R2,-(SP) ;Store logical unit CALLR ERQIOX ;Output error and exit 9999$: RETURN ;Return to caller .END