Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0125/delete.for
There is 1 other file named delete.for in the archive. Click here to see a list.
SUBROUTINE DELETE(DISNUM)
C************************************************************
C
C THIS ROUTINE IS USED TO DELETE A DISPLAY FILE
C FROM THE MEMORY OF THE GT40. THIS IS USED WHEN
C AN EXISTING DISPLAY IS NO LONGER NEEDED AND
C YOU WANT TO RECLAIM THE MEMORY USED. IF THE GT40
C HAS ENOUGH FREE CORE A DISABLE IS MUCH FASTER THAN
C A DELETE.
C
C POSSIBLE ERRORS:
C %TRYING TO DELETE A NON-EXISTENT DISPLAY
C %TRYING TO DELETE A BAD DISPLAY NUMBER (RETURNS DISNUM = 0)
C %TRYING TO DELETE A WRITE PROTECTED DISPLAY
C %DELETE COMMAND NOT YET IMPLEMENTED (TEMPORARY)
C ?INVALID REPLY TO DELETE (RETURNS DISNUM = 0)
C
C ROUTINES CALLED:
C SEND - SENDS A COMMAND TO THE GT40
C GET - RECEIVES A STATUS TRANSMISSION FROM GT40
C ERROR - ERROR LOGGING ROUTINE
C
C************************************************************
IMPLICIT INTEGER (A - Z)
COMMON /OPTBLK/ OPTION(10, 3), OPMSG, OPPTR, OPLIST
100 CALL SEND(12, DISNUM, X, Y)
CALL GET(STATUS, X, Y, DNUM)
IF(STATUS .EQ. "66) GO TO 100
IF(STATUS .NE. 0) GO TO 150
IF(DISNUM .EQ. OPLIST) OPLIST = 0
RETURN
150 IF(STATUS .NE. 1) GO TO 200
CALL ERROR('%TRYING TO DELETE A NON-EXISTENT DISPLAY =',DISNUM)
RETURN
200 IF(.NOT. (STATUS.EQ.2 .OR. STATUS.EQ.8)) GO TO 300
CALL ERROR('%TRYING TO DELETE A WRITE-PROTECTED DISPLAY =',DISNUM)
RETURN
300 IF(STATUS .NE. 3) GO TO 400
CALL ERROR('%TRYING TO DELETE A BAD DISPLAY NUMBER =',DISNUM)
DISNUM = 0
RETURN
400 IF(STATUS .NE. 10) GO TO 500
CALL ERROR('%DELETE COMMAND IS NOT YET IMPLEMENTED',0)
RETURN
500 CALL ERROR('?INVALID REPLY TO DELETE, STATUS =',STATUS)
DISNUM = 0
RETURN
END