Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0125/sndblk.for
There is 1 other file named sndblk.for in the archive. Click here to see a list.
SUBROUTINE SNDBLK(FILE, BYTECT, BLOCK)
C************************************************************
C
C THIS ROUTINE IS USED TO SEND EACH INDIVIDUAL BLOCK
C OF A DISPLAY FILE TO THE GT40.
C
C FILE - CONTAINS THE DISPLAY FILE (PACKED FOUR
C BYTES(8-BIT) TO THE WORD)
C BYTECT - NUMBER OF BYTES IN FILE
C BLOCK - CURRENT BLOCK NUMBER
C
C POSSIBLE ERRORS: (ALL ERRORS ARE FATAL AND RETURN BLOCK = 0)
C ?BAD BYTE COUNT (BLOCKS MUST BE LESS THAN "200 BYTES)
C ?INVALID REPLY TO AN ADD COMMAND
C ?INVALID REPLY TO A BLOCK
C
C ROUTINES CALLED:
C SEND - SEND A COMMAND TO THE GT40
C GET - RECEIVE A COMMAND FROM THE GT40
C SETTTY - SET TERMINAL CHARACTERISTICS FOR I/O
C GFIELD - BYTE FETCH FUNCTION
C SNDCHR - SEND AN IMAGE CHARACTER TO GT40
C ERROR - ERROR LOGGING ROUTINE
C
C************************************************************
IMPLICIT INTEGER (A - Z)
INTEGER FILE(BYTECT)
BCT = BYTECT
START = (BLOCK - 1) * "170 + 1
100 END = START + "167
IF(END .LE. BCT) GO TO 200
END = BCT
C TRANSMIT THE ADD COMMAND
200 START = START + 20
END = END + 20
SIZE = END - START + 2
CALL SEND(11, SIZE, 0, 0)
CALL GET(STATUS, X, Y, DNUM)
IF(STATUS .EQ. "66) GO TO 200
IF(STATUS .EQ. 11) GO TO 400
IF(STATUS .NE. 12) GO TO 300
CALL ERROR('?BAD BYTE COUNT =', SIZE)
BLOCK = 0
RETURN
300 CALL ERROR('?INVALID REPLY DURING ADDBLK, STATUS =', STATUS)
BLOCK = 0
RETURN
C ADD COMMAND SUCCESSFUL, SEND BLOCK
400 CSUM = 0
CALL SETTTY
CALL SNDCHR(2)
DO 500 I = START,END
WORD = I / 4
IF(MOD(I,4) .NE. 0) WORD = WORD + 1
POS = MOD(I,4)
IF(POS .EQ. 1) BYTE = GFIELD(FILE(WORD), 10, 8)
IF(POS .EQ. 2) BYTE = GFIELD(FILE(WORD), 2, 8)
IF(POS .EQ. 3) BYTE = GFIELD(FILE(WORD), 28, 8)
IF(POS .EQ. 0) BYTE = GFIELD(FILE(WORD), 20, 8)
CSUM = CSUM + BYTE
CALL SNDCHR(BYTE)
500 CONTINUE
CSUM = -CSUM .AND. "377
CALL SNDCHR(CSUM)
CALL GET(STATUS, X, Y, DNUM)
IF(STATUS .EQ. "66) GO TO 100
IF(STATUS .EQ. 15) RETURN
CALL ERROR('?INVALID REPLY TO A BLOCK, STATUS =', STATUS)
BLOCK = 0
RETURN
END