Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0125/getblk.for
There is 1 other file named getblk.for in the archive. Click here to see a list.
SUBROUTINE GETBLK(BLOCK, COUNT, BLKCT)
C THIS SUBROUTINE RETRIEVES A BLOCK OF THE OBJECT PROGRAM
C AND BUFFERS IT IN THE ARRAY "BLOCK". BLOCK IS PACKED 4
C BYTES TO A WORD, SO THE MAXIMUM BLOCK SIZE IS 2000
C BYTES. IF A LARGER BLOCK CAPABILITY IS NEEDED, LOADER
C WOULD HAVE TO BE RECOMPILED
IMPLICIT INTEGER (A - Z)
INTEGER BLOCK(500)
DATA LOG /21/
DATA LEFT, RIGHT /"133000000000, "135000000000/
1 FORMAT(' %BLOCK #',I2,' NULL BYTE EXPECTED BUT ',O3,' OBTAINED')
2 FORMAT(' ? BLOCK #',I2,' COUNT TOO LARGE AT ',I6)
3 FORMAT(' ? CHECKSUM ERROR ON DSK FOR BLOCK#', I2)
4 FORMAT(1X,A1,'TRANSFERRING BLOCK #',I2,' BYTE COUNT = ',
1 I5,'(10) LOAD ADDRESS = ',O6,A1)
10 BYTE = GETBYT(CSUM)
IF(BYTE .NE. 1) GO TO 10
BYTE = GETBYT(CSUM)
IF(BYTE .EQ. 0) GO TO 20
WRITE(LOG, 1) BLKCT, BYTE
GO TO 10
20 CSUM = 1
BYTEL = GETBYT(CSUM)
BYTEH = GETBYT(CSUM)
COUNT = BYTEH * 2 ** 8 + BYTEL
IF(COUNT .LT. 2000) GO TO 30
WRITE(LOG, 2) BLKCT, COUNT
CLOSE(UNIT=LOG)
STOP
C FORM THE FIRST WORD OF THE BLOCK SEPARATELY
30 BLOCK(1)="100000000
BLOCK(1)=BLOCK(1).OR.BYTEL*2**8
BLOCK(1)=BLOCK(1)+BYTEH
CT = COUNT - 3
WORD = 2
BYTEP = 0
BLOCK(WORD) =0
C RETRIEVE THE REMAINING BYTES INCLUDING CHECKSUM
DO 40 I = 1, CT
BYTE = GETBYT(CSUM)
BYTEP = BYTEP + 1
CALL SFIELD(BLOCK(WORD), (BYTEP-1) * 8 + 4, 8, BYTE)
IF(BYTEP .LT. 4) GO TO 40
BYTEP = 0
WORD = WORD + 1
BLOCK(WORD) = 0
40 CONTINUE
LOADDR = (GFIELD(BLOCK(2), 12, 8) * 2 ** 8)
LOADDR = LOADDR + GFIELD(BLOCK(2), 4, 8)
CSUM = CSUM .AND. "377
IF(CSUM .EQ. 0) GO TO 50
WRITE(LOG, 3) BLKCT
CLOSE(UNIT=LOG)
STOP
50 WRITE(LOG, 4) LEFT, BLKCT, COUNT, LOADDR, RIGHT
RETURN
END