Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - 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