X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fdate.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fdate.ra;h=875cd4defd8803e30af6b30b19e57f4075d5f68f;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/date.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/date.ra
new file mode 100644
index 0000000..875cd4d
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/date.ra
@@ -0,0 +1,91 @@
+/
+/ VERSION 5A 4/28/77  PT
+/
+	SECT8	DATE
+	JA	#ST
+	EXTERN	#DATE
+#XR,	ORG	.+10
+	TEXT	+DATE  +
+#RET,
+#BASE,	ORG	.+3
+MONTH,	ORG	.+3
+DAY,	ORG	.+3
+YEAR,	ORG	.+3
+TEMP,	ORG	.+3
+DATADR,	0
+	JA	#DATE-1		/ADDRESS OF PS8 DATE WORD
+	ORG	10*3+#BASE
+	FNOP
+	JA	#RET
+	0
+DRTN,	JA	.
+	BASE	0
+NEWDAT,	0
+	CDF 0
+	TAD%	BIPCCL
+	AND	BITMSK
+	CLL RTR
+	RTR
+	DCA DATEMP
+	CDF CIF 0
+	JMP% NEWDAT
+BIPCCL,	7777
+BITMSK,	600
+#ST,	STARTD
+	0210
+	FSTA	DRTN
+	0200
+	BASE	#BASE
+	SETX	#XR
+	SETB	#BASE
+	LDX	0,1
+	FSTA	#BASE
+	FLDA%	#BASE,1+
+	FSTA	MONTH
+	FLDA%	#BASE,1+
+	FSTA	DAY
+	FLDA%	#BASE,1+
+	FSTA	YEAR
+	FLDA%	DATADR		/GET THE PS-8 DATE WORD
+	FSTA	TEMP		/SAVE IT
+	FCLA
+	FSTA	TEMP,0		/ZERO EXPONENT AND HIGH HALF OF MANTISSA
+	LDX	10,1		/SHIFT COUNT
+	FLDA	TEMP		/GET IT BACK
+	ALN	1		/ISOLATE THE MONTH
+	ATX	1		/SAVE THE MONTH
+	LDX	-4,2		/DAY SHIFT COUNT
+	FLDA	TEMP		/GET BACK THE DATE
+	ALN	2		/SHIFT MONTH BITS INTO
+				/HIGH HALF OF MANTISSA
+	FSTA	TEMP		/SAVE THIS
+	FCLA
+	FSTA	TEMP,0		/ISOLATING DAY/YEAR BITS
+	FLDA	TEMP		/GET THEM BACK
+	LDX	7,2		/NOW ISOLATE DAY
+	ALN	2
+	ATX	2		/AND SAVE IT IN 2
+	FLDA	TEMP		/GET DAY/YEAR BITS
+	LDX	-5,3		/PREPARE TO REMOVE DAY BITS
+	ALN	3		/BY SHIFTING THEM INTO HIGH HALF OF MANTISSA
+	FSTA	TEMP		/SAVE THEM
+	FCLA
+	FSTA	TEMP,0		/ZERO DAY BITS
+	FLDA	TEMP		/RESTORE YEAR BITS
+	LDX	11,3		/SHIFT BACK
+	ALN	3
+	ATX	3		/PUT THEM INTO XR 3
+	TRAP4	NEWDAT
+	STARTF			/RE-ENTER F MODE
+	XTA	1		/GET MONTH
+	FSTA%	MONTH		/RETURN IN ARG
+	XTA	2		/NOW DAY
+	FSTA%	DAY
+	ADDX	3662,3		/MAKE IT + 1970
+	ADDX	0,3
+	DATEMP=.-1
+	XTA	3		/NOW YEAR
+	FSTA%	YEAR
+	JA	DRTN		/RETURN
+	END
+