C File Name: UNMACI.FOR !Rev 8302.021 C C********** All input routines for UNMAC are in this file ********** C SUBROUTINE GET BLK !Rev 8302.021 C C GET BLK gets the next data block from the input file. On C return the data block is in variable RECORD of common C /RECORD/ and the length of the data block is in the variable C LENGTH of common /RECORD/. C C In RT-11, object modules are made up of formatted binary C blocks. A formatted binary block is a sequence of 8-bit C bytes arranged as follows: C C ------------------------------ C | 1 | C ------------------------------ C | 0 | C ------------------------------ C | Low order byte of length | C ------------------------------ C | High order byte of length | C ------------------------------ C | . | C | . | C | Data block | C | . | C | . | C ------------------------------ C | Checksum byte | C ------------------------------ C C The length includes all bytes except the checksum. The C checksum byte is the negative of the sum of all preceeding C bytes. Formatted binary blocks may be separated by a C variable number of null (0) bytes. C C For RSX object modules the structure is similar except C that the first two bytes and the checksum are omitted. Thus, C the length of the binary block is shorter by 3. Note, C however, that when FLX is used to copy an RSX object to C an RT-11 formatted device, the binary records are modified C by FLX to look exactly like RT-11 formatted binary records C by adding the first two bytes and the checksum, and changing C the length appropriately. C IMPLICIT INTEGER (A-Z) C C------------------------------ COMMONS ------------------------------ C COMMON /RECORD/ LEN, NXT CHR, RECORD (256) BYTE RECORD COMMON /SYSTEM/ SYSTEM, RT,RSX C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C-------------------------- LOCAL VARIABLES -------------------------- C BYTE INB(2) EQUIVALENCE (INB(1),IN) C C===================================================================== C------------------ If RT-11, do some extra stuff -------------------- C IF (SYSTEM .NE. RT) GO TO 20 C C Look for RT-11 header bytes, skipping over nulls C 10 CALL RD NEXT (CODE) IF (CODE.EQ.0) GO TO 10 IF (CODE.NE.1) 1 CALL FTL ERR (1,'First byte of RT data block not 1') CALL RD NEXT (CODE) C 20 CONTINUE C C---------------- Get the length of the binary block ----------------- C CALL RD NEXT (N) INB(1) = N CALL RD NEXT (N) INB(2) = N LEN = IN C C BEGIN DEBUG D IF (.NOT.DEBUG(11)) GO TO 30 D CALL NEWLIN D IF (SYSTEM.EQ.RT)CALL OUT TXT(';GET RT BLK of length ') D IF(SYSTEM.EQ.RSX)CALL OUT TXT(';GET RSX BLK of length ') D CALL OUT INT (LEN) D 30 CONTINUE C END DEBUG C C------- Correct the length for the stuff that is stripped off ------- C IF (SYSTEM.EQ.RT) LEN = LEN-4 C C--------------------------- Check bounds ---------------------------- C IF (LEN .GT. 256) CALL FTL ERR (2,'Data block > 256 words') IF (LEN .LE. 0) CALL FTL ERR (2,'Data block < 1 word') C C-------------- Put the data block in the RECORD array --------------- C DO 40 I=1,LEN CALL RD NEXT (CODE) RECORD (I) = CODE 40 CONTINUE C C--------------- If RSX and LEN odd, read another byte --------------- C IF (SYSTEM.EQ.RSX .AND. (LEN.AND.1).NE.0) CALL RD NEXT(CODE) C C-------------------- If RT-11, skip the checksum -------------------- C NOTE: If someone would like to put in the appropriate code C to verify the checksum, please do it. C IF (SYSTEM .EQ. RT) CALL RD NEXT (CODE) C C------------------ Reset pointers into RECORD array ------------------ C NXT CHR = 1 C RETURN END SUBROUTINE RD NEXT (VALUE) !Rev 8301.291 C C===========>> Gets the next byte from the input buffer <<=========== C IMPLICIT INTEGER (A-Z) C COMMON /INPUT/ BLOCK,COUNT,INPUT(512) BYTE INPUT COMMON /LUN/ LUN IN, LUN OUT, LUN TT D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C---------------- If a new block is needed, read it ---------------- C IF (COUNT.LE.512) GO TO 20 BLOCK = BLOCK + 1 READ (LUNIN'BLOCK,END=100) INPUT COUNT = 1 C C BEGIN DEBUG D IF (.NOT.DEBUG(10)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';RD NEXT - Block ') D CALL OUT OCT (BLOCK) D 10 CONTINUE C END DEBUG C 20 CONTINUE C C---------------------- Get the byte value ----------------------- C VALUE = INPUT (COUNT) VALUE = VALUE .AND. "377 COUNT = COUNT + 1 C C BEGIN DEBUG D IF (.NOT.DEBUG(12)) GO TO 30 D CALL NEWLIN D CALL OUT TXT (';RD NEXT - Byte: ') D CALL OUT OCT (VALUE) D 30 CONTINUE C END DEBUG C RETURN C C====================>> End of input file <<==================== C 100 CONTINUE CALL END ALL C C BEGIN DEBUG D IF (.NOT.DEBUG(10)) GO TO 110 D CALL NEWLIN D CALL OUT TXT (';RD NEXT - Close files and exit') D CALL CRLF D CALL CRLF D 110 CONTINUE C END DEBUG C CLOSE (UNIT=LUNIN) CLOSE (UNIT=LUNOUT) CALL EXIT END SUBROUTINE END ALL !Rev 8301.111 C C======================> Write the .END <========================== C IMPLICIT INTEGER (A-Z) C COMMON /XFR/ XFR ADR, XFR NAM(2), STARTF LOGICAL STARTF C C------------------------------------------------------------------ C CALL CRLF CALL NEWLIN CALL OUT TXT ('.END') IF (XFR ADR .NE. 1) CALL OUT TXT (' START') CALL CRLF CALL CRLF C RETURN END SUBROUTINE RD NAME (NAME,NRAD50) !Rev 8301.291 C C===========>> Returns a name from the record <<=================== C BYTE NAME(7),NRAD50(4) C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C------------- Get four bytes of RAD50 string --------------------- C CALL RD WORD (NRAD50(1)) CALL RD WORD (NRAD50(3)) C C------------------ Convert to ASCII ------------------------------ C CALL R50ASC (6,NRAD50,NAME) NAME(7) = 0 C C BEGIN DEBUG D IF (.NOT.DEBUG(13)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';RD NAME: ') D CALL OUT TXT (NAME) D 10 CONTINUE C END DEBUG C RETURN END SUBROUTINE RD WORD (NVALUE) !Rev 8206.171 C C===>> Returns a word value from next two bytes of the record <<=== C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG BYTE INB(2) EQUIVALENCE (IN,INB(1)) C C------------------------------------------------------------------- C CALL RD BYTE (N) INB(1) = N CALL RD BYTE (N) INB(2) = N NVALUE = IN C C BEGIN DEBUG D IF (.NOT.DEBUG(14)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';RDWORD: ') D CALL OUT OCT (NVALUE) D 10 CONTINUE C END DEBUG C RETURN END SUBROUTINE RD BYTE (VALUE) !Rev 8206.171 C C===============>> Gets the next byte from the record <<=============== C IMPLICIT INTEGER (A-Z) C COMMON /RECORD/ LEN, NXT CHR, RECORD(256) BYTE RECORD C D COMMON /DEBUG/ DEBUG(50) D LOGICAL DEBUG C C--------------------------------------------------------------------- C VALUE = RECORD (NXT CHR) NXT CHR = NXT CHR + 1 LEN = LEN - 1 C C BEGIN DEBUG D IF (.NOT.DEBUG(15)) GO TO 10 D CALL NEWLIN D CALL OUT TXT (';RD BYTE: ') D CALL OUT OCT (VALUE) D 10 CONTINUE C END DEBUG C RETURN END