software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / RWTAPE.SB

/DECTAPE I-O ROUTINES                         OS8 FORTRAN II LIBRARY
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/	VERSION 2A
/
/	CALL 4, RTAPE(WTAPE)
/	ARG UNIT
/	ARG +-BLOCK (-MEANS START SEARCH FORWARD)
/	ARG WORD COUNT
/	ARG CORE ADDRESS
/	VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
/
	ENTRY	RTAPE
	ENTRY	WTAPE
	DUMMY WCT
	DUMMY CAD
	OPDEF TADI 1400
	OPDEF DCAI 3400

	LAP		/ENABLE FIT INTO 1 PAGE
/
/DATA
/
DFUNC,	0
DBLK,	0
DWCT,	0
DFIELD,	0
WCT,	7754
CAD,	7755
DCORE,
/
/ARG PICKUP ROUTINE
/
GETARG,	0
	TAD I	RTAPE
	DCA	AA
	INC	RTAPE#
	TADI	RTAPE#
	DCA	WTAPE#
	INC	RTAPE#
AA,	NOP		/SET DATA FIELD
	TADI	WTAPE#
	JMP I	GETARG
/
/ERROR
/
DTERR,	CALL	1,ERROR			/CK FOR ERROR
	ARG	TAPERR
/
/DATA
/
/
/START
/
WTAPE,	BLOCK	1
	2
	TAD	WTAPE		/MOVE ARG ADDR TO RTAPE
	DCA	RTAPE
	TAD	WTAPE#
	DCA	RTAPE#
	IAC			/WRITE FUNCTION
	JMP	TARGS
TAPERR,	2401			/TA
	2005			/PE
RTAPE,	BLOCK	1
	2
TARGS,	DCA	DFUNC		/READ=0, WRITE=1
	JMS	GETARG		/GET UNIT #
	CLL RTR			/TO BITS 0-2
	RTR
	TAD	DFUNC		/COMBINE WITH R-W BIT
	DCA	DFUNC
	JMS	GETARG		/GET BLK #
	SMA
	JMP	RT2		/REV. SRCH.
	CIA			/FORWARD SRCH.
	DCA	DBLK
	JMP	RT3
RT2,	DCA	DBLK
	TAD	(400		/REV. SRCH. BIT
	TAD	DFUNC
	DCA	DFUNC
RT3,	JMS	GETARG		/GET W.C.
	CIA
	DCA	DWCT
	JMS	GETARG		/GET CORE ADDR
	CLA CMA
	TAD	WTAPE#
	DCA	DCORE
	TAD	AA		/GET CORE FIELD
	DCA	DFIELD
/
/DEFINITIONS
/
OPDEF	DTCA	6762
OPDEF	DTXA	6764
OPDEF	DTLB	6774
OPDEF	DTRB	6772
SKPDF	DTSF	6771
OPDEF	DTRA	6761
/
/START OF DECTAPE I-O
/
	TAD	DFUNC		/UNIT & DIRECTION
	AND	(7400
	TAD	(10		/+ SRCH MODE
	DTCA DTXA		/SET STATUS & CLR FLGS
	DTLB			/CLR FIELD BITS
	TAD	WCT		/USE 7754 AS ADDR TO
	6201		/SET FIELD 0
	DCAI	CAD		/STORE BLK FOUND
DTSERR,	RTL			/REENTRY FOR SRCH ERROR
	RAL			/ENDZONE FLAG TO LINK
	CLA CML			/CHANGE DIRECTION
	TAD	(200		/DTA GO FLAG
DTCONT,	SNL			/CK DIR.
DTREV,	TAD	(400		/CHANGE DIR.
DTSRCH,	DTXA			/GO INTO SEARCH
	DTSF DTRB		/READ CONDITION
	JMP	DTSRCH#
	SPA
	JMP	DTSERR		/ERROR
	DTRA			/GET CUR. DIR.
	RTL			/TO LINK
	RTL
	SZL CLA
	TAD	(3		/FOR REV GET BLK-3
	6201
	TADI	WCT		/# OF LAST BLK SEEN
	CMA			/CIA MIGHT BLOW THE LINK
	TAD	DBLK
	CMA
	SZA CLA
	JMP	DTCONT		/CONT. SRCH
	SZL			/FOUND, CK DIR.
	JMP	DTREV		/IF REV, SNEAK BACK UP
	TAD	DWCT		/SET WORD COUNT
	DCAI	WCT
	TAD	DCORE
	DCAI	CAD
LABEL,	TAD	DFIELD		/LOAD FIELD BITS
	DTLB
	IAC			/GET R-W FUNCTION
	AND	DFUNC
	CLL RTL
	RTL
	TAD	(130		/SET UP FUNCTION FOR
				/THE XOR TO GIVE SRCH
				/MODE CLEARED & SET CONTINUOUS MODE
				/READ=3, WRITE=5
	DTXA			/BEGIN TRANSFER
DTWAIT,	DTSF			/WAIT FOR W.C. OVERFLOW
	JMP	DTWAIT
	DTRA
	AND	(200		/STOP-GO BIT
	TAD	(2		/SAVE DTA & ERROR FLAGS
	DTXA			/STOP TAPE
	DTRB			/READ ERROR FLAGS
	SPA CLA			/CK FOR ERROR
	JMP	DTERR		/YES
	RETRN	RTAPE
	END
\f