Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0125/getblk.lst
There is 1 other file named getblk.lst in the archive. Click here to see a list.
GETBLK GETBLK.FOR FORTRAN V.5A(621) /KI 1-FEB-81 11:37 PAGE 1
00001 SUBROUTINE GETBLK(BLOCK, COUNT, BLKCT)
00002
00003 C THIS SUBROUTINE RETRIEVES A BLOCK OF THE OBJECT PROGRAM
00004 C AND BUFFERS IT IN THE ARRAY "BLOCK". BLOCK IS PACKED 4
00005 C BYTES TO A WORD, SO THE MAXIMUM BLOCK SIZE IS 2000
00006 C BYTES. IF A LARGER BLOCK CAPABILITY IS NEEDED, LOADER
00007 C WOULD HAVE TO BE RECOMPILED
00008
00009 IMPLICIT INTEGER (A - Z)
00010 INTEGER BLOCK(500)
00011 DATA LOG /21/
00012 DATA LEFT, RIGHT /"133000000000, "135000000000/
00013
00014 1 FORMAT(' %BLOCK #',I2,' NULL BYTE EXPECTED BUT ',O3,' OBTAINED')
00015 2 FORMAT(' ? BLOCK #',I2,' COUNT TOO LARGE AT ',I6)
00016 3 FORMAT(' ? CHECKSUM ERROR ON DSK FOR BLOCK#', I2)
00017 4 FORMAT(1X,A1,'TRANSFERRING BLOCK #',I2,' BYTE COUNT = ',
00018 1 I5,'(10) LOAD ADDRESS = ',O6,A1)
00019
00020 10 BYTE = GETBYT(CSUM)
00021 IF(BYTE .NE. 1) GO TO 10
00022 BYTE = GETBYT(CSUM)
00023 IF(BYTE .EQ. 0) GO TO 20
00024 WRITE(LOG, 1) BLKCT, BYTE
00025 GO TO 10
00026 20 CSUM = 1
00027 BYTEL = GETBYT(CSUM)
00028 BYTEH = GETBYT(CSUM)
00029 COUNT = BYTEH * 2 ** 8 + BYTEL
00030 IF(COUNT .LT. 2000) GO TO 30
00031 WRITE(LOG, 2) BLKCT, COUNT
00032 CLOSE(UNIT=LOG)
00033 STOP
00034
00035 C FORM THE FIRST WORD OF THE BLOCK SEPARATELY
00036
00037 30 BLOCK(1)="100000000
00038 BLOCK(1)=BLOCK(1).OR.BYTEL*2**8
00039 BLOCK(1)=BLOCK(1)+BYTEH
00040 CT = COUNT - 3
00041 WORD = 2
00042 BYTEP = 0
00043 BLOCK(WORD) =0
00044
00045 C RETRIEVE THE REMAINING BYTES INCLUDING CHECKSUM
00046
00047 DO 40 I = 1, CT
00048 BYTE = GETBYT(CSUM)
00049 BYTEP = BYTEP + 1
00050 CALL SFIELD(BLOCK(WORD), (BYTEP-1) * 8 + 4, 8, BYTE)
00051 IF(BYTEP .LT. 4) GO TO 40
00052 BYTEP = 0
00053 WORD = WORD + 1
00054 BLOCK(WORD) = 0
00055 40 CONTINUE
00056 LOADDR = (GFIELD(BLOCK(2), 12, 8) * 2 ** 8)
GETBLK GETBLK.FOR FORTRAN V.5A(621) /KI 1-FEB-81 11:37 PAGE 1-1
00057 LOADDR = LOADDR + GFIELD(BLOCK(2), 4, 8)
00058 CSUM = CSUM .AND. "377
00059 IF(CSUM .EQ. 0) GO TO 50
00060 WRITE(LOG, 3) BLKCT
00061 CLOSE(UNIT=LOG)
00062 STOP
00063 50 WRITE(LOG, 4) LEFT, BLKCT, COUNT, LOADDR, RIGHT
00064 RETURN
00065 END
SUBPROGRAMS CALLED
GETBYT
SFIELD GFIELD
SCALARS AND ARRAYS [ "*" NO EXPLICIT DEFINITION - "%" NOT REFERENCED ]
*BYTE 1 *LOADDR 2 BLOCK 3 *WORD 4 *BLKCT 5
*LOG 6 *BYTEH 7 *RIGHT 10 *COUNT 11 .S0000 12
*BYTEL 13 *CT 14 *CSUM 15 *I 16 *BYTEP 17
*LEFT 20
TEMPORARIES
.A 0016 100 .Q0000 101 .Q0001 102
GETBLK [ NO ERRORS DETECTED ]