;*; Updated on 01-Mar-94 at 3:26 PM by Jim Randazzo; edit time: 0:00:45
;JULIAN.M68             Convert MMDDYY date to Julian Date Subroutine
;
; Author..............  Jalal E. Raissi
; Installation........  Mini-Microcomputer Consultants
; Last Date Modified..  April 10, 1984
; Reason for Change...  Added the System Date routine. JER
;
; Purpose.............  To edit dates in MMDDYY form and return their value
;                       in number of days since 01/01/00.
;
;       XCALL JULIAN,SNDDTE,RCVDTE,FLGDTE
;
; Where:
;       MAP1 SNDDTE,S,6
;       MAP1 RCVDTE,F,6
;       MAP1 FLGDTE,B,1
;
; And:
;       A4 = address of SNDDTE
;       A5 = address of RCVDTE
;       A2 = address of FLGDTE
;

       SEARCH  SYS
       SEARCH  SYSSYM
       SEARCH  MMCRT
       SEARCH  TRM

VMAJOR=1.
VMINOR=1.
VSUB=0.
VEDIT=0.
VWHO=0.

       OBJNAM  .SBR

       PHDR    -1,PV$RSM,PH$REE!PH$REU

       CLR     D0              ; clear D0
       CLR     D1              ; clear D1
       CLR     D2              ; clear D2
       MOV     A3,A1           ; move A3 to A1
       MOVW    @A1,D1          ; look at the argument count
       CMPB    D1,#3           ; three arguments must be passed
       JLT     LESARG          ; if less, let'm know
       CLR     D4              ; clear index register
       MOVW    2(A1)[D4],D1    ; move argument type to D1
       CMPB    D1,#2           ; is it string?
       JNE     NOSTR           ; if not, let'm know
       MOVL    4(A1)[D4],A4    ; move address of SNDDTE to A4
       MOVL    10(A1)[D4],D1   ; move size of SNDDTE to D1
       CMPB    D1,#6           ; must be at least 6 bytes
       JLT     SERROR          ; if not, let'm know
       ADD     #12,D4          ; step to next argument passed
       MOVW    2(A1)[D4],D1    ; move argument type to D1
       CMPB    D1,#4           ; is it floating point?
       JNE     NOFLT           ; if not, let'm know
       MOV     4(A1)[D4],A5    ; move address of RCVDTE to A5
       ADD     #12,D4          ; step to next argument passed
       MOVW    2(A1)[D4],D1    ; move argument type to D1
       CMPB    D1,#6           ; is it binary?
       JNE     NOBIN           ; if not, let'm know
       MOV     4(A1)[D4],A2    ; move address of FLGDTE to A2
       MOVB    @A2,D1          ; move FLGDTE to D1
       CMPB    D1,#2           ; System Date wished?
       JNE     SKPSYS          ; if not, skip System Date routine
;::::::::::::::::::::::::::
;       SYSTEM DATE       :
;::::::::::::::::::::::::::
; The following routine up to [SKPSYS:] label reads the System Date  and
; stores it in SNDDTE variable.  It does what AlphaACCOUNTING subroutine
; RDATE.SBR does and more.   It returns dates prior to first of November
; in the form 0XXXXX instead of XXXXX thereby taking the masking routine
; off programmers' hands!
       CLR     D3              ; clear D3
       CLR     D4              ; clear D4
       CLR     D5              ; clear D5
       GDATES  D4              ; get System Date
       SWAP    D4              ; exchange halves
       MOVB    D4,D5           ; move MONTH to D5
       MOV     D4,D3           ; move entire word to D3
       RORW    D3,#10          ; rotate 8 bits
       AND     #377,D3         ; get DAY
       SWAP    D4              ; exchange again
       AND     #377,D4         ; get YEAR
       MOV     D4,D2           ; move year to D2
       CMPB    D5,#12          ; is MONTH 10?
       BLT     ZEROM           ; if less, go to ZEROM
       MOVB    #61,D0          ; set MONTH's 1st digit to 1
       MOV     D5,D1           ; move MONTH's 2nd digit to D1
       SUBB    #12,D1          ; single out the @nd digit
       BR      FSTMM           ; go to FSTMM
ZEROM:  MOVB    #60,D0          ; set MONTH's 1st digit to 0
       MOV     D5,D1           ; move MONTH's 2nd digit to D1
FSTMM:  MOVB    D0,(A4)+        ; move MONTH's 1st digit to SNDDTE[1,1]
       ADDB    #60,D1          ; ASCII 2nd digit!
       MOVB    D1,(A4)+        ; move MONTH's 2nd digit to SNDDTE[2,2]
       CLR     D0              ; clear D0
       CMPB    D3,#12          ; is DAY 10?
       BLT     ZEROD           ; if less, go to ZEROD
       MOVB    D3,D0           ; move DAY to D0
       DIV     D0,#12          ; single out DAY's 1st digit
       MOVB    D0,D4           ; move it to D4
       MUL     D4,#12          ; multiply by 10
       SUB     D4,D3           ; get DAY's 2nd digit
       MOV     D3,D1           ; put it in D1
       ADDB    #60,D0          ; ASCII DAY's 1st digit
       BR      FSTDD           ; go to FSTDD
ZEROD:  MOVB    #60,D0          ; set DAY's 1st digit to 0
       MOV     D3,D1           ; move DAY's 2nd digit to D1
FSTDD:  MOVB    D0,(A4)+        ; move DAY's 1st digit to SNDDTE[3,3]
       ADDB    #60,D1          ; ASCII 2nd digit!
       MOVB    D1,(A4)+        ; move DAY's 2nd digit to SNDDTE[4,4]
       CLR     D0              ; clear D0
       CMPB    D2,#12          ; is YEAR 10?
       BLT     ZEROY           ; if less, go to ZEROY
       MOV     D2,D0           ; move YEAR to D0
       DIV     D0,#12          ; single out YEAR's 1st digit
       MOV     D0,D4           ; move it to D4
       MUL     D4,#12          ; multiply by 10
       SUB     D4,D2           ; get YEAR's 2nd digit
       MOV     D2,D1           ; put it in D1
       ADDB    #60,D0          ; ASCII YEAR's 1st digit
       BR      FSTYY           ; go to FSTYY
ZEROY:  MOVB    #60,D0          ; set YEAR's 1st digit to 0
       MOV     D2,D1           ; move YEAR's 2nd digit to D1
FSTYY:  MOVB    D0,(A4)+        ; move YEAR's 1st digit to SNDDTE[5,5]
       ADDB    #60,D1          ; ASCII 2nd digit!
       MOVB    D1,(A4)+        ; move YEAR's 2nd digit to SNDDTE[6,6]
       MOVL    4(A1),A4        ; move address of SNDDTE to A4
       CLR     D0
       CLR     D1
       CLR     D2
SKPSYS: CLR     D5              ; clear D5
       MOVB    (A4)+,D5        ; move MONTH's 1st digit to D5
       SUB     #60,D5          ; convert it to Octal
       CMPB    D5,#1           ; compare it to 1!
       JGT     MERROR          ; if greater, let'm know
       CMPB    D5,#0           ; compare it to 0!
       JLT     MERROR          ; if less, let'm know
       MUL     D5,#12          ; multiply it by 10
       MOVB    (A4)+,D0        ; move MONTH's 2nd digit to D0
       SUB     #60,D0          ; convert it to Octal
       ADDB    D0,D5           ; save it in D5!
;::::::::::::::::::::::::::::::::::::::::::::
;       find DAYS in and before MONTH       :
;::::::::::::::::::::::::::::::::::::::::::::
MONTH:  CMPB    D5,#14          ; MONTH greater than 12?
       JGT     MERROR          ; yes, let'm know
       CMPB    D5,#1           ; MONTH less than 1?
       JLT     MERROR          ; yes, let'm know
       MOV     #37,D2          ; start number of days
       MOV     #0,D4           ; days before January
       CMPB    D5,#1           ; is it January?
       JEQ     DAY             ; if yes, do DAY
       MOV     D2,D4           ; days before February
       MOV     #35,D2          ; maximum days in February
       CMPB    D5,#2           ; is it February?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; maximum days in March
       CMPB    D5,#3           ; is it March?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #36,D2          ; maximum days in April
       CMPB    D5,#4           ; is it April?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; maximum days in May
       CMPB    D5,#5           ; is it May?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #36,D2          ; maximum days in June
       CMPB    D5,#6           ; is it June?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; maximum days in July
       CMPB    D5,#7           ; is it July?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; maximum days in August
       CMPB    D5,#10          ; is it August?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #36,D2          ; maximum days in September
       CMPB    D5,#11          ; is it September?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; maximum days in October
       CMPB    D5,#12          ; is it October?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #36,D2          ; maximum days in November
       CMPB    D5,#13          ; is it November?
       JEQ     DAY             ; if yes, do DAY
       CALL    ACCUM           ; accumulate days
       MOV     #37,D2          ; Maximum days in December
;::::::::::::::::::::::::::::::::
;       get and edit DAY        :
;::::::::::::::::::::::::::::::::
DAY:    CLR     D1              ; setup D1
       MOVB    (A4)+,D1        ; move DAY's 1st digit to D1
       SUB     #60,D1          ; convert it to Octal
       MUL     D1,#12          ; multiply by 10
       MOVB    (A4)+,D0        ; move DAY's 2nd digit to D0
       SUB     #60,D0          ; convert it to Octal
       ADDB    D0,D1           ; D1 = (1st digit) * 10 + 2nd digit
       CMPB    D1,D2           ; compare with maximum in month
       JGT     DERROR          ; if greater, let'm know!
       CMPB    D1,#1           ; compare it with 1!
       JLT     DERROR          ; if less, let'm know!
       ADD     D1,D4           ; add DAY (days in month) to days before
       MOV     D1,D2           ; move DAY to D2
;::::::::::::::::::::::::::::::::
;       get and edit YEAR       :
;::::::::::::::::::::::::::::::::
YEAR:   CLR     D1              ; clear D1
       MOVB    (A4)+,D1        ; move YEAR's 1st digit to D1
       CMPB    D1,#60          ; compare it with 0!
       JLT     YERROR          ; if less, let'm know!
       CMPB    D1,#71          ; compare it with 9!
       JGT     YERROR          ; if greater, let'm know!
       SUB     #60,D1          ; convert it to Octal
       MUL     D1,#12          ; multiply by 10
       MOVB    (A4)+,D0        ; move YEAR's 2nd digit to D0
       SUB     #60,D0          ; convert it to Octal
       ADDB    D0,D1           ; D1 = (1st digit) * 10 + 2nd digit
       CMPB    D1,#0           ; compare it with 0!
       JLT     YERROR          ; if less, let'm know!
       CMPB    D1,#143         ; compare it with 99!
       JGT     YERROR          ; if greater, let'm know!
       MOVB    D1,D0           ; put it in D0
       DIV     D0,#4           ; divide it by 4
       MOVB    D0,D3           ; add number of leap days since
       MUL     D0,#4           ; multiply it by 4
       CMPB    D0,D1           ; is it leap year?
       BEQ     SKPINC          ; if not, don't add
       CMP     D5,#2           ; compare it with February?
       BNE     SKPCHK          ; if not, go to SKPCHK
       CMP     D2,#34          ; compare it to maximum (28) in a leap year!
       JGT     DERROR          ; if greater,let'm know!
SKPCHK: CMP     D4,#74          ; and Jan or Feb?
       BGE     SKPINC          ; if not, go to SKPINC
       INC     D4              ; increment by one
SKPINC: MUL     D1,#555         ; multiply by 365
       ADD     D1,D4           ; add MMDD
       ADD     D3,D4           ; leap days
       DEC     D4              ; decrement by one
;::::::::::::::::::::::::::::
;       get back to BASIC   :
;::::::::::::::::::::::::::::
EXT:    MOV     D4,D1           ; move number of days since 01/01/00 to D1
       FLTOF   D1,@A5          ; convert it to floating point in RCVDTE!
       MOVB    #0,@A2          ; tell'm it all went ok!!
       RTN                     ; go back to BASIC
;:::::::::::::::::::::::::::::::::::
;       accumulate DAYs corner     :
;:::::::::::::::::::::::::::::::::::
ACCUM:  ADD     D2,D4           ; add D2 to D4
       RTN                     ; fetch next instruction from PC
;:::::::::::::::::::::::::::
;       error routines     :
;:::::::::::::::::::::::::::
LESARG: CALL    SETUP
       TYPE    <Arguments are LT 3.>
       JMP     PROMPT
NOSTR:  CALL    SETUP
       TYPE    <SNDDTE is not string.>
       JMP     PROMPT
SERROR: CALL    SETUP
       TYPE    <SNDDTE is LT 6 bytes.>
       JMP     PROMPT
NOFLT:  CALL    SETUP
       TYPE    <RCVDTE is not floating point.>
       JMP     PROMPT
NOBIN:  CALL    SETUP
       TYPE    <FLGDTE is not binary.>
       JMP     PROMPT
MERROR: CALL    SETUP
       TYPE    <Month>
       BR      BPROMPT
DERROR: CALL    SETUP
       TYPE    <Day>
       BR      BPROMPT
YERROR: CALL    SETUP
       TYPE    <Year>
BPROMPT:TYPE    < is invalid.>
PROMPT: MMCRT   #30,#63         ; set up line 24
       TYPE    <Press [RETURN] to redo!>
       TIN                     ; one key stroke
       MMCRT   #30,#1          ; set up line 24
       MOV     #177411,D1      ; ? TAB(-1,9);
       TCRT                    ; do it!
       MOVB    #1,@A2          ; let'm know it all did not go ok!
       RTN                     ; go back to BASIC
SETUP:  MOV     #7,D1           ; set up bell
       TTY                     ; do it
       MMCRT   #30,#1          ; set up line 24
       RTN                     ; fetch next instruction from PC
       END                     ; end of source program

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.