!Modified 26/ 4/82 10.00 !**********************************************************************! !**********************************************************************! ! ! ! ! ! This Module is designed to provide unformatted I/O ! ! ! ! for FORTRAN77 Programs ! ! ! ! on ICL PERQ Machines ! ! ! ! ! !**********************************************************************! !**********************************************************************! !-----Module History-----! ! ! ! ! ! FIO7701Q --------first version (numerous restrictions) ! (derived from FIO7731N) ! ! FIO7731N ---conversion to IMP80 ! ! FIO7730N -----includes reps to B70 release !Conditional Compilation Variables: ! %CONSTINTEGER EMAS= 0 %CONSTINTEGER PERQ= 1 ! {********************} %CONSTINTEGER SYSTEM=PERQ {********************} %CONSTHALFINTEGER FALSE= 0 %CONSTHALFINTEGER TRUE = 1 %CONSTHALFINTEGER NONE = 0, NOT SET=NONE !*********************************************************************** ! ! RECORD FORMATS ! !*********************************************************************** ! %RECORDFORMAT FILE DEFINITION TABLE ( %C %C %INTEGER LINK , BACK {LINK}, %INTEGER DSNUM , %BYTEINTEGER STATUS , CUR STATE , %BYTEINTEGER VALID ACTION , Spare1 , %BYTEINTEGER MODE OF USE , ACCESS TYPE , %HALFINTEGER EXISTENCE , ACCESS ROUTE , %HALFINTEGER RECORD TYPE , %HALFINTEGER RECORD LEN , {of the current record} %HALFINTEGER RECSIZE , %HALFINTEGER MINREC , %HALFINTEGER MAXREC , %INTEGER DA RECNUM , %INTEGER LINES IN , %INTEGER LINES OUT , %HALFINTEGER FILE ID , %HALFINTEGER SCRATCH ID , %HALFINTEGER LAST BLK , MAX BLK , %HALFINTEGER BLK , {the current one} %HALFINTEGER POS , {and position within it} %HALFINTEGER REC POS , %HALFINTEGER UFD , %HALFINTEGER F77BLANK , %HALFINTEGER F77RECL , %HALFINTEGER FLAGS , %INTEGER CUR POS {in bytes from start of file}, %INTEGER CUR LEN {In bytes from start of file}, %INTEGER ID ADDR ) ! ! %C Values That May Be Set in a File Definition Table: ! ! %CONSTINTEGER F77 DEFINED = X'48'; ! Bit Values %CONSTINTEGER FORMATTED BIT = X'01'; ! of the %CONSTINTEGER FREEFMT BIT = X'02'; ! F77UFD field %CONSTINTEGER FMTED FILE BITS= X'49'; !and byte values %CONSTINTEGER FREEFMT FILE BITS= X'4B'; ! of the field %RECORDFORMAT TRANSFER CONTROL TABLE ( %C %C %INTEGER DSNUM , %INTEGER REC NUMBER , %HALFINTEGER COROUTINE INDEX , %HALFINTEGER IOSTAT VALUE , %INTEGER IOSTAT ADDRESS {used only by user code} ) ! !*********************************************************************** ! ! GLOBAL PROCEDURE SPECIFICATIONS ! !*********************************************************************** ! %HALFINTEGERFNSPEC F77 IOE %C (%RECORD (Transfer Control Table) %NAME TCT , %HALFINTEGER KEY , FORM , %HALFINTEGER IO MODE, FLAGS, MARKERS , %HALFINTEGERFN IO ITEM %C (%HALFINTEGER KEY , %INTEGER LEN TYPE ADR, %INTEGERNAME ADDRESS) ) %EXTERNALHALFINTEGERFN F77 IOE ( %C {! }%C {! }%C {! }%C {! }%C {! THIS PROCEDURE IS THE INTERFACE BETWEEN AN UNFORMATTED I/O }%C {! }%C {! STATEMENT IN THE USER PROGRAM AND THE UNDERLYING }%C {! }%C {! SYSTEM-DEPENDENT PROCEDURES OF THE FORTRAN77 }%C {! }%C {! RUN-TIME SYSTEM. }%C {! }%C {! }%C {! At Exit: RESULT= 1 if the END= label is to be used }%C {! RESULT= 2 if the ERR= label is to be used }%C {! RESULT= 0 otherwise }%C {! }%C {!-Parameters: }%C {! ! }%C {parm1} %RECORD (Transfer Control Table) %NAME TCT , {parm2} %HALFINTEGER KEY , {parm3} %HALFINTEGER FORM , {parm4} %HALFINTEGER IO MODE , {parm5} %HALFINTEGER FLAGS , {parm6} %HALFINTEGER SPECIFIER FLAGS , %C {parm7} %HALFINTEGERFN IO ITEM (%HALFINTEGER KEY , %INTEGER SIZE TYPE ADR, %INTEGERNAME ADDRESS ) ) !The Parameters have the following meanings: ! ! %C DSNUM the FORTRAN channel number, IO MODE classifies the I/O statement ! X'5x' if Internal File I/O, X'6x' if Sequential File I/O, X'7x' if Direct-Access File I/O {where x=1 if input } { or x=2 if output} !also X'04' if Rewind and X'20' if Open, X'08' if Backspace X'40' if Close, X'10' if Endfile X'80' if Inquire, %C FILE TYPE defines the type of file access {5 if an Internal File } {6 if a Sequential File } {7 if a Direct-Access File} !%C IO TYPE defined only for a READ (=1) or WRITE (=2) request, and is undefined for all other operations !%C INOUT set from IO TYPE (above), set to 0 if input , set to 1 if output ! !*********************************************************************** ! ! SPECIFICATIONS FOR EXTERNAL ERROR HANDLING ROUTINES ! !*********************************************************************** ! %EXTERNALROUTINESPEC SSMESS (%HALFINTEGER FAULT) %EXTERNALROUTINESPEC F77IOERR (%HALFINTEGER STACK %C TRACEBACK) ! !*********************************************************************** ! ! SPECIFICATIONS FOR EXTERNAL I/O ROUTINES ! !*********************************************************************** ! %EXTERNALHALFINTEGERFNSPEC NEW FILE OP (%INTEGER DSNUM , %HALFINTEGER ACTION,FILE TYPE, %INTEGERNAME ADDR OF FD TABLE) %EXTERNALHALFINTEGERFNSPEC OUT REC %EXTERNALHALFINTEGERFNSPEC IN REC %EXTERNALHALFINTEGERFNSPEC IN FIELD (%HALFINTEGER LENGTH, BPTR , %INTEGER TO, TO INC) %EXTERNALHALFINTEGERFNSPEC OUT FIELD (%HALFINTEGER LENGTH, %INTEGER FROM, FROM INC, %HALFINTEGER BPTR) %EXTERNALHALFINTEGERFNSPEC OUT FILL (%HALFINTEGER LENGTH,BPTR,WITH) %EXTERNALHALFINTEGERFNSPEC POSITION %C DA FILE (%HALFINTEGER ACTION, %INTEGER RECORD NUMBER ) ! !*********************************************************************** ! ! SPECIFICATIONS FOR MAIN UTILITY ROUTINES ! !*********************************************************************** ! %HALFINTEGERFNSPEC INITIALISE EXTERNAL IO OPERATION %HALFINTEGERFNSPEC NEW UNFMT RECORD %HALFINTEGERFNSPEC SPAN DA IO (%INTEGERNAME TRANSFER LENGTH) %INTEGERFNSPEC ARRAY ADDRESS ( %INTEGER DV ADDR , %HALFINTEGER DATA TYPE ) !*********************************************************************** ! ! ERROR MESSAGES ! !*********************************************************************** ! %CONSTHALFINTEGER INPUT ENDED = 153 %CONSTHALFINTEGER RECORD TOO SMALL = 154 %CONSTHALFINTEGER RECORD OUT OF RANGE = 158 %CONSTHALFINTEGER CONNECTION NOT UNFORMATTED= 193 %CONSTHALFINTEGER ACCESS CONFLICT = 119 !*********************************************************************** ! ! GLOBAL VARIABLES ! !*********************************************************************** ! ! ! Variables defining the compilation options specified ! %HALFINTEGER RELAX ANSI ! !the operating values of these variables is governed ! by the values within the Transfer Control Table ! ! Variables Controlling Access to the File Definition Table ! %RECORD (File Definition Table) %NAME F ! ! Buffer Variables ! %OWNHALFINTEGER BLEN {relative end of buffer +1} , BPTR {scanning ptr through the buffer} %HALFINTEGER BUFF LENGTH; !length of the current record ! ! Declarations of Variables Extracted from the Parameter list ! %HALFINTEGER IO TYPE %HALFINTEGER FILE TYPE %HALFINTEGER INOUT {see the PARAMETERS above } { for the values taken } { by these variables } %INTEGER DSNUM ! ! Variables Controlling Access to or from a File ! %HALFINTEGER UFD; !copy of F77UFD field of the current I/O channel FD Table ! !its bits are set as follows: ! ! F77 DEFINED= X'48' => details are F77 defined ! FORMATTED BIT= X'01' => connection/file is formatted ! FREEFMT BIT= X'02' => connection/file has !list-directed records ! ! Variables associated with Error Reporting ! %HALFINTEGER ERROR ; !the value to be assigned to the IOSTAT scalar ! ! Variables Defining the Current I/O Item ! %INTEGER NUM DATA ITEMS; !set to number of elements in an array !set to 2 for COMPLEX arrays !set to 1 for other scalars %INTEGER DATA AD ; !address of I/O item %INTEGER DATA INC ; !set 0 if I/O item is on a word boundary !set 1 if I/O item is on a byte boundary %HALFINTEGER DATA BYTES ; !length of I/O item in bytes %HALFINTEGER DATA WORDS ; !length of I/O item in words !HALFINTEGER DATA SIZE ; !code for length if I/O item, as follows: %C 0 for Character variables, 3 for Byte , 4 for Word , 5 for Double Word %HALFINTEGER DATA TYPE !DATA TYPE defines the FORTRAN type %C as follows: %constinteger AN INTEGER = 1 , A REAL = 2 , A COMPLEX = 3 , A LOGICAL= 4 , A CHARACTER= 5 !*********************************************************************** ! ! UNFORMATTED I/O SPECIFIC VARIABLES ! !*********************************************************************** ! %HALFINTEGER FAULT; !reported by SPAN DA IO or NEW UNFMT RECORD %INTEGER I ; !the number of bytes of an I/O item on which to do I/O ! ! I/O List related variables ! %HALFINTEGER NOS PER ITEM; !set to 2 for Complex I/O items, else set to 1 %INTEGER ITEM AD ; !address of the next I/O item %HALFINTEGER ITEM TYPE ;!%C ITEM TYPE is the result from %C the coroutine as follows: -1 if end of I/O list ! 0 if a scalar ! 1 if an array ! 2 if a Character scalar ! ! Analyse The Parameters ! RELAX ANSI = FLAGS & 8 ! FILE TYPE = IO MODE >> 4 IO TYPE = IO MODE & 15 INOUT = IO TYPE - 1 ! DSNUM = TCT_DSNUM ! ! Prepare for Another File Operation ! FAULT=INITIALISE EXTERNAL IO OPERATION -> IO ERROR %IF FAULT\=NONE ! ! Extract the FORM Property of the Connection ! UFD= F_UFD %IF UFD= NOT SET %THENSTART ! ! Set the FORM Property of the File ! UFD= X'48' F_UFD= UFD %FINISH !And now Validate the FORM Property: ! %IF (UFD&FMTEDFILE BITS)\=X'48' %THENSTART ! ! Report a FORM Conflict ! FAULT=CONNECTION NOT UNFORMATTED -> IO ERROR %FINISH %IF (FILE TYPE-6)\=F_ACCESS TYPE %THEN FAULT=ACCESS CONFLICT %C %AND -> IO ERROR %IF FILE TYPE=7 %THENSTART ! ! Perform Direct-Access Initialisation ! %UNLESS 0 IO ERROR ! FAULT= POSITION DA FILE (IO TYPE,TCT_REC NUMBER) %UNLESS FAULT= NONE %THEN -> IO ERROR %FINISH %IF INOUT=0 %THENSTART ! ! ! READ THE FIRST RECORD ! ! FAULT = INREC %IF FAULT\= NONE %THEN -> IO ERROR ! !---AND NOW INITIALISE FOR PROCESSING INPUT ! BUFF LENGTH= F_RECSIZE %FINISHELSESTART ! ! ! PREPARE FOR PROCESSING OUTPUT ! ! %IF FILE TYPE=7 %THEN BUFF LENGTH= F_RECSIZE %C %ELSE BUFF LENGTH= F_MAXREC %FINISH; !preparing output ! ! INITIALISE THE BUFFER POINTERS ! BPTR = 0 ; !-> relative start of buffer BLEN = BUFF LENGTH; !-> relative end of buffer !*********************************************************************** ! ! PERFORM UNFORMATTED INPUT OR OUTPUT ! !*********************************************************************** ! %C IO FORM (UNFORMATTED IO): ! ! %IF TCT_COROUTINE INDEX\=NOT SET %THENSTART ! ! GET THE NEXT I/O ITEM ! %CYCLE; ITEM TYPE= IO ITEM (KEY,ADDR(DATA WORDS),ITEM AD) %EXIT %IF ITEM TYPE< 0 DATA INC = NOT SET DATA TYPE=DATA TYPE & 15 %IF DATA TYPE=A COMPLEX %THEN DATA WORDS= DATA WORDS >> 1 %C %AND NOS PER ITEM = 2 %C %ELSE NOS PER ITEM = 1 %IF ITEM TYPE=0 %THENSTART ! ! I/O Item is a Non-Character Scalar ! DATA BYTES=DATA WORDS + DATA WORDS DATA AD =ITEM AD NUM DATA ITEMS= NOS PER ITEM; %FINISHELSESTART %IF ITEM TYPE=1 %THENSTART ! ! I/O Item is an Array ! DATA AD = ARRAY ADDRESS(ITEM AD,DATA TYPE) NUM DATA ITEMS= NUM DATA ITEMS * NOS PER ITEM %FINISHELSESTART {%IF ITEM TYPE=2 %THENSTART} ! ! I/O Item is a Character Scalar ! NUM DATA ITEMS= 1 DATA AD = INTEGER(ITEM AD ) DATA INC = HALFINTEGER(ITEM AD+2) DATA BYTES= DATA WORDS %FINISH %FINISH ! ! DETERMINE IF THE BUFFER IS LARGE ENOUGH ! I= NUM DATA ITEMS * DATA BYTES %IF I+ BPTR>BLEN %THENSTART %IF FILETYPE= 6 %THEN FAULT= RECORD TOO SMALL %C %ELSE FAULT= SPAN DA IO (I) %IF FAULT\=NONE %THEN -> IO ERROR %FINISH ! ! TRANSFER DATA BETWEEN BUFFER AND I/O ITEM ! %IF INOUT=0 %THEN FAULT= IN FIELD (I,BPTR ,DATA AD ,DATA INC) %C %ELSE FAULT=OUT FIELD (I,DATA AD,DATA INC, BPTR) %UNLESS FAULT=0 %THEN -> IO ERROR ! BPTR=BPTR+I; !Update the BUffer Pointer %REPEAT %FINISH ! ! TIDY UP THE I/O OPERATION ! %IF INOUT= 1 %THENSTART FAULT = NEW UNFMT RECORD -> IO ERROR %UNLESS FAULT=NONE %FINISH !*********************************************************************** ! ! RETURN (after successful completion) ! !*********************************************************************** ! !Set the IOSTAT field in the Transfer Control Table ! TCT_IOSTAT VALUE= 0 ! %RESULT= 0 !*********************************************************************** ! ! REPORT AN ERROR ! !*********************************************************************** ! IO ERROR: %IF SPECIFIER FLAGS\=NONE %THENSTART ! ! ! Examine the I/O error specifiers given ! ! ERROR= FAULT ERROR=-1 %IF ERROR=INPUT ENDED {check for FAULT 153} ! TCT_IOSTAT VALUE= ERROR {first set the IOSTAT value} ! ! Check Label Exits ! %RESULT=1 %IF FAULT=INPUT ENDED %AND SPECIFIER FLAGS&1\= 0 %RESULT=2 %IF SPECIFIER FLAGS&2\= 0 ! %RESULT=0 %IF SPECIFIER FLAGS>= 4 ! !Continue with ordinary error reporting !if no label exit was taken and %FINISH; !if no IOSTAT specifier was given %IF FAULT>0 %THENSTART ! ! ! Report a fault detected by FIO ! ! {SELECT OUTPUT (107)} SSMESS (FAULT) {print the error message } %FINISH {give a %MONITOR and %STOP} F77IOERR ( 1 {stack frame to unwind}) !*********************************************************************** ! ! I/O PERFORMING PROCEDURES ! !*********************************************************************** ! %HALFINTEGERFN INITIALISE EXTERNAL IO OPERATION ! ! ! ! ! A PROCEDURE TO ESTABLISH A CONNECTION BETWEEN ! ! THE UNIT SPECIFIER AND THE CORRESPONDING ! ! EXTERNAL FILE. ! ! ! %HALFINTEGER FAULT; !reported from NEW FILE OP %INTEGER AFD ! ! ! Initialise for External File Input/Output ! ! FAULT = NEW FILE OP (DSNUM,IO TYPE,(7-FILE TYPE)<<1,AFD) %IF FAULT\=NONE %THENRESULT=FAULT ! F==RECORD(AFD); !map address of file definition table ! onto the corresponding record fmt %RESULT= 0 %END; !of INITIALISE EXTERNAL IO OPERATION %HALFINTEGERFN NEW UNFMT RECORD ! ! ! ! ! A UTILITY PROCEDURE TO READ OR WRITE THE ! ! NEXT UNFORMATTED RECORD. ! ! ! %HALFINTEGER BUFF LENGTH; !length of the current record or buffer %HALFINTEGER FAULT ; !fault reported by INREC or OUTREC %HALFINTEGER I ; !----a work variable %IF INOUT=0 %THENSTART ! ! ! Read the next record ! ! FAULT= INREC BLEN= F_RECSIZE; %FINISHELSESTART ! ! ! Write the next record ! ! BUFF LENGTH= BPTR I=F_MINREC - BUFF LENGTH %IF I> 0 %THENSTART ! ! Expand the Record to the Required Size ! FAULT= OUT FILL ( I,BUFF LENGTH, 0 {zeros}) %IF FAULT>None %THENRESULT= FAULT ! BUFF LENGTH=F_MINREC %FINISH !OUTPUT THE RECORD: ! FAULT= OUTREC %IF FILETYPE=7 %THEN BLEN= F_RECSIZE %C %ELSE BLEN= F_MAXREC; !determine length of %FINISH; !the next record ! ! RE-SET THE BUFFER POINTER ! BPTR= 0 ! %RESULT= FAULT %END; !of NEW UNFMT RECORD %HALFINTEGERFN SPAN DA IO (%INTEGERNAME TRANSFER LENGTH) ! ! ! ! A LOCAL ROUTINE TO SPAN I/O FOR DIRECT ACCESS, AND ! ! TO UPDATE CERTAIN ASSOCIATED VARIABLES. TRANSFER ! ! OF THE LAST RECORD IS LEFT TO THE OUTER LEVEL. ! ! %HALFINTEGER BUFF LENGTH ; !actual record length %HALFINTEGER IO LENGTH ; !number of bytes to transfer to/from ! the current record %HALFINTEGER BYTES PER BUFF ; !maximum number of bytes that may be moved ! to or from the buffer in this actual ! spanning operation %HALFINTEGER FAULT FAULT= RECORD TOO SMALL %IF RELAX ANSI=FALSE ! ! CHECK THE SIZE OF THE RECORD ! BUFF LENGTH= BLEN %IF BUFF LENGTH< DATA BYTES %THENRESULT= RECORD TOO SMALL !RESULT=> RECORD TOO SMALL TO CONTAIN A ! SINGLE I/O ITEM ! ! FILL THE REST OF THE CURRENT BUFFER ! IO LENGTH = (BLEN - BPTR)//DATA BYTES * DATA BYTES BYTES PER BUFF = BUFF LENGTH //DATA BYTES * DATA BYTES PERFORM TRANSFER: ! %IF INOUT=0 %THENSTART ! ! Receive Input ! FAULT= IN FIELD (IO LENGTH,BPTR,DATA AD,DATA INC) ! %FINISHELSESTART ! ! Send Output ! FAULT=OUT FIELD(IO LENGTH,DATA AD,DATA INC,BPTR) BPTR= IO LENGTH+BPTR %FINISH ! ! READ/WRITE THE NEXT RECORD ! FAULT = NEW UNFMT RECORD %IF FAULT\=0 %THENRESULT= FAULT ! ! UPDATE VARIABLES ! DATA INC = DATA INC + IO LENGTH; !Update item address TRANSFER LENGTH= TRANSFER LENGTH - IO LENGTH; !Update bytes left to ! be written ! ! TEST FOR END OF SPANNING OPERATION ! %IF TRANSFER LENGTH>BYTES PER BUFF %THEN IO LENGTH= BYTES PER BUFF %C %AND -> PERFORM TRANSFER %RESULT= 0 %END; !of SPAN DA IO %INTEGERFN ARRAY ADDRESS (%INTEGER DATA AD , %HALFINTEGER DATA TYPE) ! ! ! ! ! THIS PROCEDURE DETERMINES THE ADDRESS OF THE FIRST ACTUAL ! ! ARRAY ELEMENT AND THE NUMBER OF ARRAY ELEMENTS ! ! USING THE DOPE VECTOR ADDRESS (Data Ad) AND THE ! ! VARIABLE TYPE (Data Type). ! ! !The Form of a Dope Vector is as follows: ! %C Integer: Address of 1st actual element (word boundary) %C Halfinteger: Increment to start of 1st actual element ---AND %C Halfinteger: Element size if type= CHARACTER Array %C Integer: Number of Array elements ! ! %INTEGER RESULT {returned is address of 1st element} RESULT= INTEGER(DATA AD) ! ! %IF DATA TYPE=A CHARACTER %THENSTART ! ! Extract CHARACTER Dependent Information ! DATA INC = HALFINTEGER(DATA AD + 2) DATA BYTES= HALFINTEGER(DATA AD + 3) DATA WORDS= DATA BYTES DATA AD = DATA AD + 4 %FINISHELSE %C DATA BYTES= DATA WORDS + DATA WORDS NUM DATA ITEMS= INTEGER(DATA AD + 2) %RESULT= RESULT ! %END; !of ARRAY ADDRESS %END; !of F77 IOE ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ENDOFFILE