X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FRWTAPE.SB;fp=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FRWTAPE.SB;h=4b41021caa46cafb05ab3d766f5821fe44b0567a;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git

diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB
new file mode 100644
index 0000000..4b41021
--- /dev/null
+++ b/sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB
@@ -0,0 +1,204 @@
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/	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
+