sw/os8/v3d/sources/fortran/dectapes/dectape2/date.ra

   1 /
   2 / VERSION 5A 4/28/77  PT
   3 /
   4         SECT8   DATE
   5         JA      #ST
   6         EXTERN  #DATE
   7 #XR,    ORG     .+10
   8         TEXT    +DATE  +
   9 #RET,
  10 #BASE,  ORG     .+3
  11 MONTH,  ORG     .+3
  12 DAY,    ORG     .+3
  13 YEAR,   ORG     .+3
  14 TEMP,   ORG     .+3
  15 DATADR, 0
  16         JA      #DATE-1         /ADDRESS OF PS8 DATE WORD
  17         ORG     10*3+#BASE
  18         FNOP
  19         JA      #RET
  20         0
  21 DRTN,   JA      .
  22         BASE    0
  23 NEWDAT, 0
  24         CDF 0
  25         TAD%    BIPCCL
  26         AND     BITMSK
  27         CLL RTR
  28         RTR
  29         DCA DATEMP
  30         CDF CIF 0
  31         JMP% NEWDAT
  32 BIPCCL, 7777
  33 BITMSK, 600
  34 #ST,    STARTD
  35         0210
  36         FSTA    DRTN
  37         0200
  38         BASE    #BASE
  39         SETX    #XR
  40         SETB    #BASE
  41         LDX     0,1
  42         FSTA    #BASE
  43         FLDA%   #BASE,1+
  44         FSTA    MONTH
  45         FLDA%   #BASE,1+
  46         FSTA    DAY
  47         FLDA%   #BASE,1+
  48         FSTA    YEAR
  49         FLDA%   DATADR          /GET THE PS-8 DATE WORD
  50         FSTA    TEMP            /SAVE IT
  51         FCLA
  52         FSTA    TEMP,0          /ZERO EXPONENT AND HIGH HALF OF MANTISSA
  53         LDX     10,1            /SHIFT COUNT
  54         FLDA    TEMP            /GET IT BACK
  55         ALN     1               /ISOLATE THE MONTH
  56         ATX     1               /SAVE THE MONTH
  57         LDX     -4,2            /DAY SHIFT COUNT
  58         FLDA    TEMP            /GET BACK THE DATE
  59         ALN     2               /SHIFT MONTH BITS INTO
  60                                 /HIGH HALF OF MANTISSA
  61         FSTA    TEMP            /SAVE THIS
  62         FCLA
  63         FSTA    TEMP,0          /ISOLATING DAY/YEAR BITS
  64         FLDA    TEMP            /GET THEM BACK
  65         LDX     7,2             /NOW ISOLATE DAY
  66         ALN     2
  67         ATX     2               /AND SAVE IT IN 2
  68         FLDA    TEMP            /GET DAY/YEAR BITS
  69         LDX     -5,3            /PREPARE TO REMOVE DAY BITS
  70         ALN     3               /BY SHIFTING THEM INTO HIGH HALF OF MANTISSA
  71         FSTA    TEMP            /SAVE THEM
  72         FCLA
  73         FSTA    TEMP,0          /ZERO DAY BITS
  74         FLDA    TEMP            /RESTORE YEAR BITS
  75         LDX     11,3            /SHIFT BACK
  76         ALN     3
  77         ATX     3               /PUT THEM INTO XR 3
  78         TRAP4   NEWDAT
  79         STARTF                  /RE-ENTER F MODE
  80         XTA     1               /GET MONTH
  81         FSTA%   MONTH           /RETURN IN ARG
  82         XTA     2               /NOW DAY
  83         FSTA%   DAY
  84         ADDX    3662,3          /MAKE IT + 1970
  85         ADDX    0,3
  86         DATEMP=.-1
  87         XTA     3               /NOW YEAR
  88         FSTA%   YEAR
  89         JA      DRTN            /RETURN
  90         END
  91 \f