Google
 
Trailing-Edge - PDP-10 Archives - decuslib20-04 - 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