--- /dev/null
+/
+/ 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
+\f