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