Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99g-bb - cblio.c05
There are 2 other files named cblio.c05 in the archive. Click here to see a list.
 INS 27/1	;05C1
	;EDIT HISTORY
	;***** V12B *****
	;WHO	DATE	COMMENT
	;SMI	13-SEP-82 [1043] Process end-of-file errors.
	;SMI	30-AUG-82 [1042] Pop stack if error on blocked file open.
	;RLF	26-JUL-82 [1037] Change error message to "for OUTPUT only".
	;RLF	21-JUL-82 [1036] Zero out right half of UOUT. after checkpointing
	;RLF	20-JUL-82 [1035] READ NEXT after DELETE get correct record
	;JEH	15-JUL-82 [1034] Zero out end of data block after deleting a record
	;SMI    06-JUL-82 [1033] Do abort close on labeled tapes during fatal error
	;                        processing
	;LEM	07-JUN-82 [1031] FIX RECORDS MISSING WHEN READING AN ASCII FILE SEQUENTIALLY
	;RJD	08-JUN-82 [1030] Check for use of ersatz device when opening a SMU
	;			 file from a SFD
	;JEH	04-JUN-82 [1027] Zero buffer address to force FAKE READ to get block
	;				number for a RETAIN of a LOW-VALUE key
	;JEH	01-JUN-82 [1026] APPEND FILOP. doesn't reset buffer ptr if file ended
	;			 on a block boundary
	;RJD	14-MAY-82 [1024] USE COUNT ON LAST BLOCK TO CHECK FOR END OF RECORD
	;RLF	07-MAY-82 [1023] UPDATE POINTER FOR READ AFTER REWRITE
	;LEM	27-MAR-82 [1021] make READ NEXT return correct record as ANSI standard states
	;RJD	17-MAR-82 [1016] TEST FOR ISAM FILES CHECKPOINTING EVERY n RECORDS
	;LEM	02-MAR-82 [1015] ALLOW COMPT. UUO TO RETURN CORRECT FILE STATUS ERROR NO
	;LEM	16-FEB-82 [1014] ALLOW ASCII FILE ON MTA TO HAVE EXTRA <CR>
	;WTK	20-JAN-82 [1013] SEQ REL ASCII FILE: NULL REC IN BLK CAUSES
	;			 REST OF BLOCK TO BE SKIPPED
	;JSM	22-OCT-81 [1011] FIX CLOSE WITH DELETE FOR NON-SMU OUTPUT
	;JEH/JM	13-OCT-81 [1010] LOOKUP ERROR MSG IS INCORRECT
	;DMN	09-OCT-81 [1007] TURN ON TOPS2X SWITCH FOR TOPS-20 VERSION 5
	;WTK/JM 6-OCT-81 [1006] CAN'T REWRITE A NON-NULL EBCDIC RECORD
	;JEH/JM	6-OCT-81 [1005] SMU CLOSE W/DELETE FAILS UNDER TOPS-10 7.01
	;DMN/JM 3-SEP-81 [1003] FIE INCORRECTLY CLOSED WITH DELETE
	;HAM/JM 9-SEP-81 [1001] RESET ISAM INDEX AND DATA POINTERS AFTER DEL/REWRITE
	;
 REP 55/1	;05C2
		IFNDEF	TOPS2X,<TOPS2X==0>	; [667] THIS CODE HAS NOT BEEN TESTED YET
 WIT
	;[D1007]	IFNDEF	TOPS2X,<TOPS2X==0>	; [667] THIS CODE HAS NOT BEEN TESTED YET
		TOPS2X==TOPS20			;[1007] TURN ON TOPS2X FOR VERSION 5
 REP 18/27	;05C3
		JRST	KILL4			;[444] NO, CHECK NEXT ONE
		MOVE	AC13,D.DC(I16)		;[444] GET DEV CHARACTERISTICS
 WIT
		SKIPA				;[1033] SKIP IF INPUT FILE
		JRST	KILL1A			;[1033] JUMP IF OUTPUT ONLY
		MOVE	AC13,D.DC(I16)		;[1033] GET DEV CHARACTERISTICS
		TXNE	AC13,DV.MTA		;[1033] MAG TAPE?
		JRST	KILL2A			;[1033] YES, DO ABORT CLOSE
		JRST	KILL4			;[444] NO, CHECK NEXT ONE
	KILL1A:	MOVE	AC13,D.DC(I16)		;[1033][444] GET DEV CHARACTERISTICS
 REP 42/27	;05C4
		LDB	AC4,DTCN.		;[444] GET CHANNEL NUMBER
 WIT
	KILL2A:	LDB	AC4,DTCN.		;[1033][444] GET CHANNEL NUMBER
 INS 347/45	;05C5
		SETZM	D.OBB(I16)	;[1026] ZERO BUFFER POINTER
 REP 351/45	;05C6
			  JUMPN	AC0,OFERR	; JUMP IF BLOCKED
			  POP	PP,(PP)		; DISCARD .JBFF SAV
 WIT
			  SKIPE	AC0		;[1042] JUMP IF NOT BLOCKED
			  TLNN	FLG,IOFIL+RANFIL+IDXFIL	;[1042] SEQUENTIAL FILE?
			  POP	PP,(PP)		;[1042] YES, DISCARD .JBFF SAV
 REP 16/47	;05C7
		TLNE	FLG,IOFIL!OPNOUT ;[667] IF OPEN READ ONLY OR
 WIT
		TLNE	FLG,OPNOUT	;[1007][667] IF OPEN READ ONLY OR
 REP 15/48	;05C8
		TLNN	FLG,IOFIL!OPNOUT ;[667] IF OPEN READ ONLY OR
 WIT
		TLNN	FLG,OPNOUT	;[1007] [667] OR OPEN READ ONLY 
 INS 17/59	;05C9
		TRNA			;[1007] NOT
		JRST	OPNLU3		;[1007] YES IT IS, ULBLK. IS CORRECT
 INS 30/61	;05C10
		MOVE	AC1,UOBLK.+1	;[1030] GET SIXBIT NAME
		DEVNAM	AC1,		;[1030] IS DEVICE AN ERSATZ?
		 JRST	OPNF2A		;[1030] NO CONTINUE
		CAME	AC1,UOBLK.+1	;[1030] SAME NAME?
		JRST	OPNF2A		;[1030] NO, CONTINUE
		DEVPPN	AC1,		;[1030] GET PPN
		 JRST	OPNF2A		;[1030] CONTINUE
		CAME	AC1,PTH.BK+2	;[1030] SAME PPN?
		SETZM	PTH.BK+3	;[1030] NO, MUST BE ERSATZ SO CLEAR SFD
	OPNF2A:				;[1030] 
 REP 7/62	;05C11
		E.MCPT==^D8000000	; [431] MONITOR COMPT. UUO ERROR
 WIT
		E.MCPT==^D2000000	; [431] [1015] MONITOR COMPT. UUO ERROR
 INS 35/93	;05C12
	PRGERR:	SETZM	PRGFLG		;[1003] IN CASE FILE WAS CLOSED WITH DELETE
 REP 14/102	;05C13
		OUTSTR	[ASCIZ/ for OUTPUT./]			;11
 WIT
		OUTSTR	[ASCIZ/ for OUTPUT only./]		;[1037] 11
 REP 3/103	;05C14
	LUPERR:	TDZA				;LOOKUP ERROR
 WIT
	LUPERR:	MOVE	AC0,ULBLK.+1		;[1010] LOOKUP ERROR
		MOVEM	AC0,UEBLK.+1		;[1010] MOVE ERROR ARGUMENT
		TDZA				;[1010] TO ENTER BLOCK
 REP 45/106	;05C15
		JRST	OXITER		;FILE WAS NOT OPEN.
 WIT
	;[D1003]	JRST	OXITER		;FILE WAS NOT OPEN.
		JRST	PRGERR		;[M1003] FILE WAS NOT OPEN.
 REP 39/107	;05C16
		TXNE	AC13,DV.MTA	;MTA?
		JRST	CLOSE2		; YES, SKIP FUNNY EXTRA 'CR'
 WIT
	;	TXNE	AC13,DV.MTA	;[1014]MTA? allow mta to have extra 'CR'
	;	JRST	CLOSE2		;[1014] YES, SKIP FUNNY EXTRA 'CR'
 REP 11/115	;05C17
		JRST	CLSWL1		;[576] SKIP BUFFER SAVES,DELETE FOLLOWS
	IFE TOPS20,<
 WIT
	IFN TOPS20, <			;[1005] TOPS10 MUST FREE RETAINED RECORDS
		JRST	CLSWL1		;[576] SKIP BUFFER SAVES,DELETE FOLLOWS
	>;				;[1005]
	IFE TOPS20,<
		JRST	CLSPRG		;[1005] JUMP TO FREE RETAINED RECORDS
 INS 47/115	;05C18
	CLSPRG:	SKIPN	F.WSMU(I16)	;[1005] SKIP IF RETAINED RECORDS
	;[D1011] JRST	CLSWLX		;[1005]
		JRST	CLSWL1		;[1011]
		PUSHJ	PP,CLWSMU	;[1005] FREE ALL RETAINED RECORDS

 REP 152/144	;05C19
	RNR30A:	MOVE	AC1,AC5		; GET COPY DESTINATION PTR
		ADDI	AC1,1		; ADVANCE PTR PAST RDW
		ILDB	AC1,AC1		; GET A BYTE
 WIT
	;[D1006] RNR30A:	MOVE	AC1,AC5		; GET COPY DESTINATION PTR
	;[D1006] ADDI	AC1,1		; ADVANCE PTR PAST RDW
	;[D1006] ILDB	AC1,AC1		; GET A BYTE
	RNR30A:				;[1006]
		PUSH	PP,AC5		;[1006] SAVE DEST POINTER
		PUSH	PP,AC3		;[1006]  AND BYTES/REC
	RNR30D:				;[1006]
		ILDB	AC1,AC5		;[1006] GET A BYTE
		SKIPN	AC1		;[1006] CONTINUE WHEN NON-NULL FOUND
		SOJG	AC3,RNR30D	;[1006]  OR WHEN NO BYTES LEFT
		POP	PP,AC3		;[1006] RESTORE BYTES/REC
		POP	PP,AC5		;[1006]  AND DEST POINTER
 REP 89/145	;05C20
	IFN ANS74,<
		TXNE	AC16,V%RWRT	; IS THIS RERIT?
		JRST	RANXI0		; YES,SKIP CURRENT POSITION RESET
	>
 WIT
	;IFN ANS74,<			;[1023]test is taken out
	;	TXNE	AC16,V%RWRT	; IS THIS RERIT?
	;	JRST	RANXI0		; YES,SKIP CURRENT POSITION RESET
	;				;[1023] to update pointer
	;>
 REP 105/145	;05C21
		AOJA	AC5,RNWR2X	;UPDATE THE RECORD POINTER & SIGNAL ACTIVE DATA
 WIT
		MOVE	AC0,R.BPNR(I12)	;[1035] CURRENT RECORD
		MOVEM 	AC0,R.BPLR(I12)	;[1035] LAST RECORD
		HRRI	AC0,(AC5)	;[1035] ADR OF 1ST WRD OF NEXT REC
		MOVEM	AC0,R.BPNR(I12)	;[1035] BP TO NEXT RECORD
		SETOM	R.DATA(I12)	;[1035] THERE IS ACTIVE DATA IN BUFFER
		SETOM	R.WRIT(I12)	;[1035] THE LAST COBOL UUO WAS A WRITE
		AOJA	AC5,RANXI0	;[1035] UPDATE REC POINTER & SIGNAL ACTIVE DATA
 REP 29/146	;05C22
		JUMPE	AC4,RANDOM	;[300] JUMP IF SEQ
 WIT
	;[1013]	JUMPE	AC4,RANDOM	;[300] JUMP IF SEQ
		JUMPN	AC4,RANREN	;[1013]IF SEQUENTIAL
		MOVE	AC5,D.WPR(I16)	;[1013]  ADD WORDS/RECORD TO BYTE PTR
		ADDB	AC5,R.BPNR(I12)	;[1013]  SO IT POINTS TO NEXT RECORD
		JRST	RANDOM		;[1013]  AND TRY AGAIN
	RANREN:				;[1013]
 INS 11/147	;05C23
		CAIE	11,15		;[1031] EXCLUDE <CR> <LF> WHEN DECREMENTING 
		CAIN	11,12		;[1031] THE CHRCNT
		JRST	RANRE8		;[1031]
 REP 88/147	;05C24
	REPEAT 0,<			; THIS PATCH IS NOT WORTH IT
					; THERE ARE OTHER PLACES WHERE THE COUNT CAN RUN OUT
 WIT
	REPEAT 1,<			;[1024] THIS PATCH IS NOT WORTH IT
					; THERE ARE OTHER PLACES WHERE THE COUNT CAN RUN OUT
	;[1024] THE PATCH IS NECESSARY FOR THE LAST BLOCK OF A FILE
		MOVE	AC1,D.LBN(I16)	;[1024] GET LAST BLOCK NO.
		CAME	AC1,D.CBN(I16)	;[1024] SAME AS CURRENT BLOCK?
		JRST	RNR13D		;[1024] NO, SKIP CALCULATION
 REP 114/147	;05C25
	>

	REPEAT 1,<			; THIS IS THE ORIGINAL CODE
 WIT
		JRST	RANR14		;[1024] CONT
	>
	RNR13D:	ILDB	C,AC5		;[1024] GET A CHAR
		XCT	AC10		;[1024] CONVERT IT
		JUMPGE	C,RNR13D	;[1024]	SCAN TO EOR CHAR
	REPEAT 0,<			;[1024] THIS IS THE ORIGINAL CODE
 INS 52/154	;05C26
		SETZM	CNTRY(I12)	;[1027] ZERO BUFFER ADDRESS
 REP 7/165	;05C27
		;  CLEAR SAVED NEXT RECORD POSITION FLAG
		HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
		TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
		HRRM	AC0,D.RFLG(I16)	; PUT IT BACK IF WAS SET
 WIT
		PUSHJ	PP,SVDLRW	;[1021] SAVE CURRENT RECORD POSITION AND CONTINUE
 REP 34/166	;05C28
	IWRIX:	SKIPE	OLDBK		;ANY BLOCKS TO DEALLOCATE
 WIT
	;[D1001]IWRIX:	SKIPE	OLDBK		;ANY BLOCKS TO DEALLOCATE
	IWRIX:				;[M1001]
	IFN ANS74,<
		PUSHJ	PP,@GETSET(I12)	;[1001] RESET INDEX AND DATA POINTERS
	>
		SKIPE	OLDBK		;[M1001] ANY BLOCKS TO DEALLOCATE
 INS 50/166	;05C29
	IFN ANS74,<
		SETZM	NNTRY(I12)	;[1021] CLEAR NEXT REC FLAG, NO CURRENT REC
		SETZM	CNTRY(I12)	;[1021] CLEAR CURRNET DATA ENTRY TO INDICATE
					;[1021]SEQ READ CURRENT ENTRY IS NOT SET
	>; END IFN ANS74
 INS 21/195	;05C30
		MOVE	AC5,LRW(I12)	;[1034] SAVE OLD LRW
 INS 26/195	;05C31
		MOVEI	AC3,1(AC2)	;[1034] SET UP SOURCE
		HRL	AC3,AC3		;[1034] 
		ADDI	AC3,1		;[1034] ADJUST DESTINATION
		BLT	AC3,(AC5)	;[1034] ZERO UNUSED BLOCK AREA
 INS 30/203	;05C32
		TLNN	FLG,IDXFIL	; [1016] SKIP IF ISAM FILE
 INS 37/203	;05C33
		HLLZS	UOUT.		; [1036] ZEROES RIGHT HALF
 REP 32/208	;05C34
	IFN ANS74,<
		MOVE	AC1,FS.FS	;GET ERROR CODE
		CAIN	AC1,^D10	;END-OF-FILE ONLY?
		JRST	IGTST2		;YES
	>
 WIT

	;[1043] END-OF-FILE ERRORS ARE NOT TO BE IGNORED 
	;[1043] IFN ANS74,<
	;[1043]	MOVE	AC1,FS.FS	;GET ERROR CODE
	;[1043]	CAIN	AC1,^D10	;END-OF-FILE ONLY?
	;[1043]	JRST	IGTST2		;YES
	;[1043]>

 SUM 50987