Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0125/get.for
There is 1 other file named get.for in the archive. Click here to see a list.
	SUBROUTINE GET(STATUS, X, Y, DISNUM)
C************************************************************
C
C  THIS ROUTINE IS USED TO RECEIVE A STATUS TRANSMISSION
C  FROM THE GT40. IN GENERAL A STATUS TRANSMISSION CONSISTS
C  OF A STATUS WORD, FOLLOWED BY X & Y CO-ORDINATES (RASTER),
C  FOLLOWED BY A DISPLAY NUMBER. GIDUS ENCODES EACH CHARACTER
C  IN ORDER TO MAKE IT A PRINTING CHARACTER; THIS ROUTINE
C  DOES THE DECODING INTO FOUR BINARY WORDS.
C
C  IF A CHECKSUM ERROR IS DETECTED FROM THE GT40 THIS
C  ROUTINE REQUESTS THE GT40 TO RE-SEND THE LAST
C  TRANSMISSION. FIVE ATTEMPTS ARE MADE TO RECEIVE THE
C  TRANSMISSION INTACT. IF THE TRANSMISSION IS STILL BAD
C  THIS ROUTINE DECIDES THAT THE GT40 IS HUNG, AND
C  PROGRAM EXECUTION IS STOPPED (VIA "FINI").
C
C  POSSIBLE ERRORS:
C	%CHECKSUM ERROR FROM GT40
C	?GT40 HUNG DURING TRANSMISSION
C	%CHECKSUM ERROR FROM 10
C	?10 HUNG DURING TRANSMISSION
C
C  ROUTINES CALLED:
C	WAITCH - RECEIVES ONE ASCII CHARACTER FROM GT40
C	ERROR  - ERROR LOGGING ROUTINE
C	FINI   - LOG FILE WRAP-UP ROUTINE (*** STOPS PROGRAM ***)P
C	SEND   - SEND A COMMAND TO THE GT40
C	CLRTTY - COMPLEMENT OF ROUTINE SETTTY
C
C************************************************************
	IMPLICIT INTEGER (A - Z)
	LOGICAL LOG, SHIFT
	INTEGER REC(18,3)
	COMMON /LOGBLK/ LOG, GTLOG, FATAL, WARN
	COMMON /MSCBLK/ SHIFT, CHECK

	DATA (REC(1,I),I=1,3) /'NO SU', 'CH DI', 'SPLAY'/
	DATA (REC(2,I),I=1,3) /'CANNO', 'T DIS', 'ABLE '/
	DATA (REC(3,I),I=1,3) /'BAD D', 'ISP N', 'UMBER'/
	DATA (REC(4,I),I=1,3) /'CANNO', 'T MOV', 'E    '/
	DATA (REC(5,I),I=1,3) /'NO LI', 'GHT P', 'EN   '/
	DATA (REC(6,I),I=1,3) /'NOT E', 'NOUGH', ' CORE'/
	DATA (REC(7,I),I=1,3) /'NO DI', 'SPLAY', ' SLOT'/
	DATA (REC(8,I),I=1,3) /'CANNO', 'T DEL', 'ETE  '/
	DATA (REC(9,I),I=1,3) /'BAD C', 'OMMAN', 'D    '/
	DATA (REC(10,I),I=1,3) /'NOT I', 'MPLEM', 'ENTED'/
	DATA (REC(11,I),I=1,3) /'SEND ', 'NEXT ', 'BLOCK'/
	DATA (REC(12,I),I=1,3) /'BAD B', 'YTE C', 'OUNT '/
	DATA (REC(13,I),I=1,3) /'?SEQU', 'ENCE ', 'ERROR'/
	DATA (REC(14,I),I=1,3) /'CANNO', 'T ADD', '     '/
	DATA (REC(15,I),I=1,3) /'BLOCK', ' RECE', 'IVED '/
	DATA (REC(16,I),I=1,3) /'?TABL', 'E COR', 'RUPT '/
	DATA (REC(17,I),I=1,3) /'EXECU', 'TED O', 'K    '/
	DATA (REC(18,I),I=1,3) /'CHECK', 'SUM E', 'RROR '/

1	FORMAT(//10X,'RECEIVING: ',3A5,3(2X,I6))
2	FORMAT(10X,'CHECKSUM = "',O3)

	TRY = 0
100	STATUS = WAITCH(0)
	XL = WAITCH(0)
	XH = WAITCH(0)
	YL = WAITCH(0)
	YH = WAITCH(0)
	DISNUM = WAITCH(0)
	CSUMH = WAITCH(0)
	CSUM = CSUMH * 16 .OR. WAITCH(0)
	X = XH * 32 .OR. XL
	Y = YH * 32 .OR. YL
	IF(.NOT. LOG) GO TO 200
	IS = STATUS
	IF(IS .EQ. 0) IS = 17
	IF(IS .EQ. "66) IS = 18
	WRITE(GTLOG, 1) (REC(IS,I),I=1,3), X, Y, DISNUM
	WRITE(GTLOG, 2) CSUM

200	IF(CSUM .EQ. ((STATUS+XL+XH+YL+YH+DISNUM) .AND. "377)) GO TO 300
	TRY = TRY + 1
	CALL ERROR('%CHECKSUM ERROR FROM GT40, ATTEMPT #', TRY)
	IF(TRY .GE. 5) CALL ERROR('?GT40 HUNG DURING TRANSMISSION', 0)
	IF(TRY .GE. 5) CALL FINI
	CALL SEND(13, 0, 0, 0)
	GO TO 100

300	CALL CLRTTY
	IF(STATUS .EQ. "66) GO TO 400
	CHECK = 0
	RETURN

400	CHECK = CHECK + 1
	CALL ERROR('%CHECKSUM ERROR FROM 10, ATTEMPT #', CHECK)
	IF(CHECK .LT. 5) RETURN
	CALL ERROR('?10 HUNG DURING TRANSMISSION',0)
	CALL FINI
	END