Google
 

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