
 1000  *--------------------------------
 1010  *    DATE PROCESSING MODULES
 1020  *       BY BROOKE BOERING
 1030  *--------------------------------
 1040         .OR $800
 1050  *--------------------------------
 1060  *         JUMP TABLE            *
 1070   JMP CONV1  MM/DD/YY -> STD FMT
 1080   JMP CONV2  STD FMT -> MM/DD/YY
 1090   JMP CONV3  STD FMT -> CENTURY
 1100  *           DAY & WEEKDAY CODE
 1110   JMP CONV4  KICK STD FMT DATE UP
 1120  *           (FROM 1 TO 225 DAYS)
 1130  *--------------------------------
 1140  *       MONITOR EQUATES
 1150   
 1160  COUT   .EQ $FDED
 1170  PRBYTE .EQ $FDDA
 1180  *--------------------------------
 1190  *         LOCAL EQUATES
 1200  
 1210  LOC0    .EQ $40  (A3L)
 1220  LOC1    .EQ $41  (A3H)
 1230  LOC2    .EQ $42  (A5L)
 1240  LOC3    .EQ $43  (A5H)
 1250  ACL     .EQ $50
 1260  ACH     .EQ $51
 1270  XTNDL   .EQ $52
 1280  XTNDH   .EQ $53
 1290  AUXL    .EQ $54
 1300  AUXH    .EQ $55
 1310  ANSLO   .EQ $50
 1320  PLIER   .EQ $51
 1330  CAND    .EQ $52
 1340  SAVER   .EQ $53
 1350  SLASH   .EQ $AF (/)
 1360  *--------------------------------
 1370  * - - - - LOCAL WORKING - - - - *
 1380  WKG   .HS 0000000000000000
 1390  BINYY .EQ WKG+0
 1400  BINMM .EQ WKG+1
 1410  BINDD .EQ WKG+2
 1420  CENTURY.DAY.HI  .EQ WKG+4
 1430  CENTURY.DAY.LO  .EQ WKG+5
 1440  *--------------------------------
 1450  *     USER ALTERABLE CONTROLS
 1460  
 1470  * LOWEST ACCEPTABLE YEAR
 1480  *   DEFAULT= 75
 1490  * HIGHEST ACCEPTABLE YEAR
 1500  *   DEFAULT= 84
 1510  * DAY-OF-WEEK SKIP
 1520  *   DEFAULT= SUNDAY & SATURDAY
 1530  *--------------------------------
 1540  *      CONVERT EXTERNAL FORMAT
 1550  *   MM/DD/YY TO STANDARD INTERNAL
 1560  *   FORMAT; BITS YYYYYYYMMMMDDDDD
 1570  *
 1580  * ENTRY: RA= DATA ADDRESS-LO
 1590  *        RY=   "      "  -HI
 1600  *  EXIT: CC= EQUAL IF OK 
 1610  *          RA= YYYYYYYM BYTE
 1620  *          RX= MMMMDDDD BYTE
 1630  *        CC= NEQ IF ERROR
 1635         .PG
 1640  CONV1
 1650   STA LOC2     SET INDIRECT ADDR
 1660   STY LOC3       :
 1670   LDA #0       INIT WKG
 1680   STA BINMM
 1690   STA BINDD
 1700   STA BINYY
 1710  *-- DO 'MM'
 1720   JSR GET.DOUBLE
 1730   BNE BADATE
 1740   TAY          ZERO?
 1750   BEQ BADATE
 1760   CMP #13      TOO HI?
 1770   BCS BADATE
 1780   STA BINMM    ITS OK
 1790   INC LOC2     KICK PAST '/'
 1800  *-- DO 'DD'
 1810   JSR GET.DOUBLE
 1820   BNE BADATE
 1830   TAY          ZERO?
 1840   BEQ BADATE
 1850   LDX BINMM    RX= INDEX TO LIST
 1860   DEX
 1870   CMP DAYS.COUNT,X
 1880   BCC .3       G-A IF OK
 1890   BEQ .3       G-A IF OK
 1900   CMP #29      29TH (OF FEB)?
 1910   BNE BADATE   NO, ERR!
 1920   STY BINYY    YES, SET YY-FLAG
 1930  * (ACCEPT TEMPORARILY)
 1940  .3
 1950   STY BINDD    ITS OK (PROBABLY)
 1960   INC LOC2     KICK PAST '/'
 1970  *-- DO 'YY'
 1980   JSR GET.DOUBLE
 1990   BNE BADATE
 2000   CMP OLDEST.YEAR
 2010   BCC BADATE
 2020    LDX BINYY   RX= FEB 29TH FLAG
 2030   STA BINYY    = 0YYYYYYY
 2040    BEQ .6      G-A IF NOT FEB 29
 2050   AND #$03     LEAP YEAR?
 2060   BNE BADATE   ERR IF NOT LEAPYEAR
 2070  *-- SET EXIT CONDITIONS
 2080  .6
 2090   LDA BINMM
 2100   ASL
 2110   ASL
 2120   ASL
 2130   ASL
 2140   ASL
 2150   ORA BINDD
 2160   TAX          RX= MMMDDDDD
 2170   LDA BINYY
 2180   ROL          RA= YYYYYYYM
 2190   LDY #0       EXIT OK
 2200   RTS
 2210  
 2220  BADATE
 2230   LDY #$FF     DATE ERROR EXIT
 2240   RTS
 2245         .PG
 2250  *********************************
 2260  * S/R TO GET NEXT DOUBLE DIGIT
 2270  *   (MAINLY USED FOR DATE INPUT)
 2280  * ENTRY: LOC2/3= DATA ADDRESS
 2290  GET.DOUBLE
 2300   LDY #0
 2310   LDA (LOC2),Y
 2320   TAX          RX= TENS DIGIT
 2330   INC LOC2
 2340   LDA (LOC2),Y RA= UNITS DIGIT
 2350   INC LOC2
 2360   JSR ASC2BIN
 2370  * (CC= ERROR STATUS; PASS BACK)
 2380   RTS
 2390  *********************************
 2400  * S/R TO CONVERT 2 ASCII DIGITS
 2410  *   TO SINGLE BINARY BYTE
 2420  *
 2430  * ENTRY: RA= UNITS ASCII DIGIT
 2440  *        RX= TENS ASCII DIGIT
 2450  *
 2460  *  EXIT: CC= EQUAL IF OK
 2470  *          RA= BINARY EQUIV
 2480  *        CC= NEQ IF NON DIGIT
 2490  ASC2BIN
 2500   STA LOC1     (SAVE TEMP)
 2510   TXA          RA= TENS
 2520   CMP #0
 2530   BCC NOTNUM
 2540   CMP #10
 2550   BCS NOTNUM
 2560   AND #$0F
 2570   BEQ .4
 2580   TAX
 2590   LDA #0
 2600   CLC
 2610  .3
 2620   ADC #10
 2630   DEX
 2640   BNE .3
 2650  .4
 2660   STA LOC0
 2670   LDA LOC1     RA= UNITS
 2680   CMP #0
 2690   BCC NOTNUM
 2700   CMP #10
 2710   BCS NOTNUM
 2720   AND #$0F
 2730   CLC
 2740   ADC LOC0
 2750   LDX #0       SET EXIT= OK
 2760   RTS
 2770  
 2780  NOTNUM
 2790   LDX #$FF
 2800   RTS
 2805         .PG
 2810  *--------------------------------
 2820  *      CONVERT STANDARD INTERNAL
 2830  *   DATE FORMAT, YYYYYYYMMMMDDDDD
 2840  *   TO EXTERNAL FORMAT MM/DD/YY.
 2850  *
 2860  * ENTRY: RA= HI BYTE (YYYYYYYM)
 2870  *        RX= LO BYTE (MMMDDDDD)
 2880  *        CV/CH PRESUMED PRESET
 2890  CONV2
 2900  *-- EXPLODE TO BINYY,BINMM,BINDD
 2910   JSR EXPLODE.STANDARD.FORMAT
 2920   LDA BINMM
 2930   JSR DATE.MM  PRINT MM
 2940   LDA #SLASH   PRINT '/'
 2950   JSR COUT
 2960   LDA BINDD
 2970   JSR DATE.DD  PRINT DD
 2980   LDA #SLASH   PRINT '/'
 2990   JSR COUT
 3000   LDA BINYY
 3010   JSR DATE.YY  PRINT YY
 3020   RTS
 3030  *********************************
 3040  * S/R TO CONVERT YY BYTE TO DECI-
 3050  *   MAL, THEN TO ASCII & DISPLAY.
 3060  DATE.YY
 3070   CMP #100     OVFLO PROTECT
 3080   BCC .4         :
 3090   LDA #99        :
 3100  .4
 3110   JMP DATE.DD  GOTO COMMON
 3120  *********************************
 3130  * S/R TO CONVERT MM BYTE TO DECI-
 3140  *   MAL, THEN TO ASCII & DISPLAY.
 3150  DATE.MM
 3160   CMP #12      OVFLO PROTECT
 3170   BCC .4         :
 3180   LDA #12        :
 3190  .4
 3200   JMP DATE.DD  GOTO COMMON
 3210  *********************************
 3220  * S/R TO CONVERT DD BYTE TO DECI-
 3230  *   MAL, THEN TO ASCII & DISPLAY.
 3240  DATE.DD
 3250   LDX #0      RX= 10'S CTR
 3260  .2
 3270   CMP #$A     < 10 ?
 3280   BCC .3      YES, JUMP OUT
 3290   SEC
 3300   SBC #$A     MINUS 10
 3310   INX         KICK 10'S CTR
 3320   BNE .2      LOOP BACK
 3330  *JMP^^^
 3340  .3
 3350   STA LOC0    SAVE TEMP
 3360   TXA         GET 10'S CTR
 3370   ASL         POSN HI
 3380   ASL           :
 3390   ASL           :
 3400   ASL           :
 3410   ORA LOC0    'OR' TOGETHER
 3420   JMP PRBYTE  PRINT IT
 3430  *RTS*
 3435         .PG
 3440  *--------------------------------
 3450  *     CONVERT STANDARD FORMAT TO
 3460  *     CENTURY DAY & WEEKDAY CODE
 3470  *
 3480  * ENTRY: RA= YYYYYYYM
 3490  *        RX= MMMMDDDD
 3500  *
 3510  *  EXIT: RA= CENTURY DAY (HI)
 3520  *        RX= CENTURY DAY (LO)
 3530  *        RY= WEEKDAY CODE
 3540  *          1= MONDAY
 3550  *          2= TUESDAY
 3560  *          3= WEDNESDAY
 3570  *          4= THURSDAY
 3580  *          5= FRIDAY
 3590  *          6= SATURDAY
 3600  *          7= SUNDAY
 3610  *          0= UNKNOWABLE
 3620  CONV3
 3630  *-- EXPLODE TO BINYY,BINMM,BINDD
 3640   JSR EXPLODE.STANDARD.FORMAT
 3650  *-- CALCULATE DAYS OF PRIOR YEARS
 3660   LDY BINYY        STORE 256 DAYS
 3670   DEY                : FOR EACH
 3680   STY CENTURY.DAY.HI : PRIOR YEAR
 3690   TYA              STORE 1 DAY
 3700   LSR                : FOR EACH
 3710   LSR                : PRIOR
 3720   STA CENTURY.DAY.LO : LEAP YEAR
 3730   LDA #109         STORE 109 DAYS
 3740   JSR MULTIPLY.8X8   : FOR EACH
 3750   CLC          A     : PRIOR
 3760   ADC CENTURY.DAY.LO : YEAR
 3770   STA CENTURY.DAY.LO :
 3780   TYA                :
 3790   ADC CENTURY.DAY.HI :
 3800   STA CENTURY.DAY.HI :
 3810  
 3820  *-- CALCULATE DAYS OF THIS YEAR
 3830    LDY BINDD   RY= DD
 3840   TYA          (IN CASE WAS JAN)
 3850   LDX BINMM    RX= MM
 3860   DEX          RX= MM-1
 3870   BEQ .7       G-A IF WAS JAN
 3880   CPX #1
 3890   BEQ .3       G-A IF WAS FEB
 3900   LDA BINYY    (WAS MAR - DEC)
 3910   AND #$03     LEAP YEAR?
 3920   BNE .3       NO, G-A
 3930   INY          YES, KICK DAY CTR
 3940  .3
 3950   TYA          RA= DD (OR DD+1)
 3960  .4
 3970   CLC          ADD A MONTH'S DAYS
 3980   ADC DAYS.COUNT-1,X :
 3990   BCC .5       G-A IF > 255 DAYS
 4000   INC CENTURY.DAY.HI
 4010  .5
 4020   DEX          DECR CTR
 4030   BNE .4       LOOP TIL DONE
 4035         .PG
 4040  .7
 4050  *-- ADD THIS YEAR'S DAYS
 4060  *     TO PRIOR YEARS' DAYS
 4070  *RA= DAYS THIS YEAR
 4080   CLC
 4090   ADC CENTURY.DAY.LO  :
 4100   STA CENTURY.DAY.LO  :
 4110   BCC .8              :
 4120   INC CENTURY.DAY.HI  :
 4130  .8
 4140  *-- CALCULATE WEEKDAY CODE
 4150   TAX          RX= CENTURY.DAY.LO
 4160   LDA CENTURY.DAY.HI
 4170   JSR GET.WEEKDAY
 4180  *             RY= WEEKDAY CODE
 4190   RTS
 4200  *********************************
 4210  *    CALCULATE WEEKDAY CODE FROM
 4220  *    CENTURY DATE
 4230  *
 4240  * ENTRY: RA= CENTURY DATE-HI
 4250  *        RX= CENTURY DATE-LO
 4260  *
 4270  *  EXIT: RA/RX= AS ON ENTRY
 4280  *        RY= WEEKDAY CODE
 4290  *          1= MONDAY
 4300  *          2= TUESDAY
 4310  *          3= WEDNESDAY
 4320  *          4= THURSDAY
 4330  *          5= FRIDAY
 4340  *          6= SATURDAY
 4350  *          7= SUNDAY
 4360  *          0= UNKNOWABLE
 4370  GET.WEEKDAY
 4380   STA ACH
 4390   STX ACL
 4400   PHA          SAVE RA
 4410   TXA          SAVE RX
 4420   PHA            :
 4430   LDA #0
 4440   STA XTNDH    SET DIV'D (HIHI)
 4450   STA XTNDL    SET DIV'D (LOLO)
 4460   STA AUXH     SET DIVISOR(LO)
 4470   LDA #7       SET DIVISOR(HI)
 4480   STA AUXL       :
 4490   LDY #8       SET FOR 8BIT DIVSR
 4500   JSR DIVIDE.32X16
 4510   LDA XTNDL
 4520   CLC          REMAINDER + WEEKDAY
 4530   ADC #0       : OF 12/31/1900
 4540    TAY         (PRESET)
 4550   SEC    
 4560   SBC #7
 4570   BCC .4       G-A IF RY OK
 4580    TAY         (RESET)
 4590  .4
 4600   INY          ADJ: ANS+1 = CODE
 4610   PLA          RESTORE RA/RX
 4620   TXA            :
 4630   PLA            :
 4640   RTS
 4645         .PG
 4650  *--------------------------------
 4660  *     ADD FROM 1 TO 225 DAYS TO
 4670  *     A GIVEN STD FORMAT DATE
 4680  *
 4690  * ENTRY: RA= YYYYYYYM
 4700  *        RX= MMMMDDDD
 4710  *        RY= # DAYS TO ADD
 4720  *  EXIT: RA/RX UPDATED
 4730  CONV4
 4740  *-- SAVE RY TO STACK
 4750   STA LOC0
 4760   TYA
 4770   PHA
 4780   LDA LOC0
 4790  *-- EXPLODE TO BINYY,BINMM,BINDD
 4800   JSR EXPLODE.STANDARD.FORMAT
 4810  *-- INIT FOR LOOP
 4820   PLA          = # DAYS TO KICK
 4830   CLC
 4840   ADC BINDD    RA= WKG CTR
 4850   LDX BINMM    RX= WKG MM
 4860  .2
 4870  * IN THIS LOOP:
 4880  *   RY= UTILITY REGISTER
 4890  *   RX= WKG MM TO BE INCREMENTED
 4900  *   RA= WKG CTR TO BE DECREMENTED
 4910  * LOC3= WKG DAY COUNT FOR THE
 4920  *       CURRENT MM (IN RX)
 4930    LDY DAYS.COUNT-1,X
 4940    STY LOC3    = MM'S DAY COUNT
 4950   CPX #2       IS MM FEB?
 4960   BNE .4       NO, G-A
 4970  *-- DO FEB
 4980   PHA          SAVE WKG CTR
 4990   LDA BINYY
 5000   AND #$03     LEAP YEAR?
 5010   BNE .3       NO, G-A
 5020   LDA #29      RESET DAY COUNT
 5030   STA LOC3     :
 5040  .3
 5050   PLA          RESTORE WKG CTR
 5060  .4
 5070   CMP LOC3
 5080   BCC .7       G-A IF DONE
 5090   BEQ .7       : (ALSO DONE)
 5100   SEC          WKG CTR MINUS
 5110   SBC LOC3     : WKG DAY COUNT
 5120   INX          MM+1
 5130   CPX #13      OVFLO?
 5140   BCC .2       NO, LOOP BACK
 5150   LDX #1       YES, SET MM= JAN
 5160   INC BINYY    : AND SET YY+1
 5170   JMP .2       : AND LOOP BACK
 5180  .7
 5190   STA BINDD
 5200   STX BINMM
 5210   JSR IMPLODE.STANDARD.FORMAT
 5220   RTS
 5225         .PG
 5230  *********************************
 5240  * S/R TO EXPLODE STD FORMAT TO
 5250  *   BINYY, BINMM & BINDD
 5260  * ENTRY: RA= YYYYYYYM
 5270  *        RX= MMMMDDDD
 5280  *  EXIT: BINYY,BINMM,BINDD SET
 5290  EXPLODE.STANDARD.FORMAT
 5300   LSR          RA= 0YYYYYYY CC=M
 5310   STA BINYY
 5320   TXA          RA= MMMDDDDD
 5330   PHA         SAVE MMMDDDDD
 5340   ROR          RA= MMMMDDDD
 5350   LSR              0MMMMDDD
 5360   LSR              00MMMMDD
 5370   LSR              000MMMMD
 5380   LSR              0000MMMM
 5390   STA BINMM
 5400   PLA         PULL MMMDDDDD
 5410   AND #$1F     RA= 000DDDDD
 5420   STA BINDD
 5430   RTS
 5440  *********************************
 5450  * S/R TO IMPLODE BINYY, BINMM &
 5460  *   BINDD TO STD FORMAT
 5470  * ENTRY: BINYY,BINMM,BINDD PRESET
 5480  *  EXIT: RA= YYYYYYYM
 5490  *        RX= MMMMDDDD
 5500  IMPLODE.STANDARD.FORMAT
 5510   LDA BINMM    RA= 0000MMMM
 5520   ASL              000MMMM0
 5530   ASL              00MMMM00
 5540   ASL              0MMMM000
 5550   ASL              MMMM0000
 5560   ASL              MMM00000 (CC=M)
 5570   ORA BINDD        MMMDDDDD
 5580   TAX          RX= MMMDDDDD (CC=M)
 5590   LDA BINYY    RA= 0YYYYYYY (CC=M)
 5600   ROL          RA= YYYYYYYM
 5610   RTS
 5620  *********************************
 5630  
 5640  OLDEST.YEAR
 5650   .DA #75
 5660  HIGHEST.YEAR
 5670   .DA #84
 5680  DAYS.COUNT
 5690   .DA #31 (JAN)
 5700   .DA #28 (FEB)
 5710   .DA #31 (MAR)
 5720   .DA #30 (APR)
 5730   .DA #31 (MAY)
 5740   .DA #30 (JUN)
 5750   .DA #31 (JUL)
 5760   .DA #31 (AUG)
 5770   .DA #30 (SEP)
 5780   .DA #31 (OCT)
 5790   .DA #30 (NOV)
 5800   .DA #31 (DEC)
 5805         .PG
 5810  *********************************
 5820  *
 5830  *       8 X 8 MULTIPLY
 5840  *
 5850  *  ENTRY: RY= MULTIPLCAND
 5860  *         RA= MULTIPLIER
 5870  *
 5880  *   EXIT: RY= ANSWER-HI
 5890  *         RA= ANSWER-LO
 5900  *
 5910  *  TIMING: 212 US - MAX
 5920  *          180 US - MIN
 5930  *          192 US - AVER
 5940  * NOTE: KEEP CLOSE TO SGN8X8
 5950  MULTIPLY.8X8
 5960   STA PLIER   SAVE (MULTI)PLIER
 5970   STY CAND    SAVE (MULTIPL)CAND
 5980   LDA #0      RA= ANSWER-HI
 5990   LDY #8      SET 8-BIT CTR
 6000  MUL1
 6010   LSR PLIER   TEST NEXT BIT
 6020   BCC MUL2    IF OFF, GO ROUND
 6030   CLC
 6040   ADC CAND    IF ON, ADD
 6050  MUL2
 6060   ROR         SHIFT ANSWER 1 BIT
 6070   ROR ANSLO   :
 6080   DEY         DECR POSITION CTR
 6090   BNE MUL1    LOOP TIL DONE 8 BITS
 6100   TAY         RY= ANSWER-HI
 6110   LDA ANSLO   RA= ANSWER-LO
 6120   RTS
 6130  *********************************
 6140  *
 6150  *        32 X 16 DIVIDE
 6160  *
 6170  *  PRE-ENTRY:
 6180  *    DIVIDEND IN:
 6190  *      XTNDH,XTNDL,ACH,ACL
 6200  *    DIVISOR --> AUXL,AUXH
 6210  *
 6220  *   EXIT: QUOTIENT -> ACL,ACH
 6230  *    REMAINDER -> XTNDL,XTNDH
 6240  DIVIDE.32X16
 6250   LDY #$10      INDEX FOR 16 BITS
 6260  .2
 6270   ASL ACL
 6280   ROL ACH
 6290   ROL XTNDL     XTND/AUX
 6300   ROL XTNDH     : -> ACCUM
 6310   SEC
 6320   LDA XTNDL
 6330   SBC AUXL      MOD TO XTND.
 6340   TAX
 6350   LDA XTNDH
 6360   SBC AUXH
 6370   BCC .3
 6380   STX XTNDL
 6390   STA XTNDH
 6400   INC ACL
 6410  .3
 6420   DEY
 6430   BNE .2
 6440   RTS
 6450  *********************************

