Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0125/adfile.for
There is 1 other file named adfile.for in the archive. Click here to see a list.
SUBROUTINE ADFILE(BYTECT, FILE, DSTAT, DISNUM)
C************************************************************
C
C THIS ROUTINE IS USED TO TRANSMIT A DISPLAY FILE
C FROM THE 10 TO THE GT40.
C
C FILE - THIS ARRAY CONTAINS THE FILE, PACKED
C FOUR BYTES(8-BIT) TO THE WORD
C BYTECT - NUMBER OF BYTES(8-BIT) IN THE FILE
C DSTAT - STATUS WORD
C BIT #22 - FILE IS WRITE PROTECTED
C BIT #23 - FILE CAN NOT BE DISABLED
C BIT #24 - DISPLAY IS L.P. SENSITIVE
C BIT #25 - DISPLAY CAN BE MOVED
C DISNUM - DISPLAY NUMBER (FROM GIDUS)
C THIS DISPLAY NUMBER BECOMES THE SUBSEQUENT
C TAG FOR ALL OPERATIONS, INVOLVING THIS FILE
C
C POSSIBLE ERRORS: (ALL ARE FATAL, AND RETURN DISNUM = 0)
C ?NOT ENOUGH CORE FOR ADDITION
C ?NO FREE DISPLAY SLOT FOR FILE
C ?INVALID REPLY TO REQUEST TO ADD
C ?DISPLAY BLOCK COULD NOT BE TRANSMITTED
C ?INVALID RESPONSE TO LAST BLOCK
C
C ROUTINES CALLED:
C SEND - SEND A COMMAND TO THE GT40
C GET - RECEIVE STATUS TRANSMISSION FROM GT40
C SNDBLK - SEND EACH INDIVIDUAL BLOCK OF THE FILE
C
C************************************************************
IMPLICIT INTEGER (A - Z)
INTEGER FILE(BYTECT)
BCT = BYTECT
CALL ADWORD(BCT, FILE, "160000)
CALL ADWORD(BCT, FILE, "000000)
DISNUM = 0
BCT = BCT - 21
BLOCKS = BCT / "170
IF(MOD(BCT,120) .NE. 0) BLOCKS = BLOCKS + 1
C REQUEST TO ADD, SEE IF BLOCK WILL FIT
100 CALL SEND(10, BCT , 0, 0)
CALL GET(STATUS, EBLK, Y, DNUM)
IF(STATUS .EQ. 11) GO TO 400
IF(STATUS .EQ. "66) GO TO 100
IF(STATUS .NE. 6) GO TO 200
CALL ERROR('?NOT ENOUGH CORE FOR ADDITION', 0)
RETURN
200 IF(STATUS .NE. 7) GO TO 300
CALL ERROR('?NO FREE DISPLAY SLOT FOR ADDITION', 0)
RETURN
300 CALL ERROR('?INVALID REPLY TO REQUEST TO ADD, STATUS =', STATUS)
RETURN
C REQUEST TO ADD SUCCESSFUL, LOOP FOR ALL BLOCKS
400 DO 500 IBLOCK = 1,BLOCKS
BLOCK = IBLOCK
CALL SNDBLK(FILE, BCT, BLOCK)
IF(BLOCK .NE. 0) GO TO 500
CALL ERROR('?ADD BLOCK FAILS', 0)
RETURN
500 CONTINUE
C TRANSMIT DISPLAY STATUS, AND RECEIVE DISPLAY NUMBER
600 CALL SEND(11, 0, DSTAT, 0)
CALL GET(STATUS, X, Y, DISNUM)
IF(STATUS .EQ. "66) GO TO 600
IF(STATUS .EQ. 0) RETURN
CALL ERROR('?INVALID RESPONSE TO LAST BLOCK, STATUS =', STATUS)
DISNUM = 0
RETURN
END