sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/date.ra

   1 /       \ eD A T E   S U B R O U T I N E
   2 /
   3 /       FORTRAN (F4) LIBRARY
   4 /       ORIGINAL RELEASE 22-MAY-74
   5 /
   6 /       UPDATES
   7 /       1.  NOW WE ADD 78 (0116) TO THE YEAR INSTEAD OF 1970 (03662)
   8 /               24-APR-81 H.A.
   9 /
  10         SECT    DATE
  11         JA      #ST
  12         EXTERN  #DATE
  13 #XR,    ORG     .+10
  14         TEXT    +DATE  +
  15 #RET,
  16 #BASE,  ORG     .+3
  17 MONTH,  ORG     .+3
  18 DAY,    ORG     .+3
  19 YEAR,   ORG     .+3
  20 TEMP,   ORG     .+3
  21 DATADR, 0
  22         JA      #DATE-1         /ADDRESS OF PS8 DATE WORD
  23         ORG     10*3+#BASE
  24         FNOP
  25         JA      #RET
  26         0
  27 DRTN,   JA      .
  28         BASE    0
  29 #ST,    STARTD
  30         0210
  31         FSTA    DRTN
  32         0200
  33         BASE    #BASE
  34         SETX    #XR
  35         SETB    #BASE
  36         LDX     0,1
  37         FSTA    #BASE
  38         FLDA%   #BASE,1+
  39         FSTA    MONTH
  40         FLDA%   #BASE,1+
  41         FSTA    DAY
  42         FLDA%   #BASE,1+
  43         FSTA    YEAR
  44         FLDA%   DATADR          /GET THE PS-8 DATE WORD
  45         FSTA    TEMP            /SAVE IT
  46         FCLA
  47         FSTA    TEMP,0          /ZERO EXPONENT AND HIGH HALF OF MANTISSA
  48         LDX     10,1            /SHIFT COUNT
  49         FLDA    TEMP            /GET IT BACK
  50         ALN     1               /ISOLATE THE MONTH
  51         ATX     1               /SAVE THE MONTH
  52         LDX     -4,2            /DAY SHIFT COUNT
  53         FLDA    TEMP            /GET BACK THE DATE
  54         ALN     2               /SHIFT MONTH BITS INTO
  55                                 /HIGH HALF OF MANTISSA
  56         FSTA    TEMP            /SAVE THIS
  57         FCLA
  58         FSTA    TEMP,0          /ISOLATING DAY/YEAR BITS
  59         FLDA    TEMP            /GET THEM BACK
  60         LDX     7,2             /NOW ISOLATE DAY
  61         ALN     2
  62         ATX     2               /AND SAVE IT IN 2
  63         FLDA    TEMP            /GET DAY/YEAR BITS
  64         LDX     -5,3            /PREPARE TO REMOVE DAY BITS
  65         ALN     3               /BY SHIFTING THEM INTO HIGH HALF OF MANTISSA
  66         FSTA    TEMP            /SAVE THEM
  67         FCLA
  68         FSTA    TEMP,0          /ZERO DAY BITS
  69         FLDA    TEMP            /RESTORE YEAR BITS
  70         LDX     11,3            /SHIFT BACK
  71         ALN     3
  72         ATX     3               /PUT THEM INTO XR 3
  73         STARTF                  /RE-ENTER F MODE
  74         XTA     1               /GET MONTH
  75         FSTA%   MONTH           /RETURN IN ARG
  76         XTA     2               /NOW DAY
  77         FSTA%   DAY
  78         ADDX    116,3           /MAKE IT + 78
  79         XTA     3               /NOW YEAR
  80         FSTA%   YEAR
  81         JA      DRTN            /RETURN
  82         END
  83 \f\1a