.TITLE CDATID .IDENT /V01/ .ENABLE LC ; ; This module forms part of the suite of Date Routines returning the ; current date in one of the following forms, or converting one form to ; another. ; Form I - Day, Month & Year since 1950 as 3 byte values ; Form A - ASCII DD-MMM-YY ; Form D - Integer*2 days since 1st January 1950 ; Form E - Integer*2 encoded date ; Form W - Weekday Number (0 = Sunday) ; ; Author: V01 30-Jun-80 Phil Stephensen-Payne ; ; Calling Sequence: ; ; This subroutine is called via the standard FORTRAN calling sequence as: ; ; CALL CDATID (DAY,MONTH,YEAR,DAYNO [,STATUS]) ; or ; STATUS = CDATID (DAY,MONTH,YEAR,DAYNO) ; ; or ; CALL CDATID from MACRO-11 with ; R5 = 0 ; R1 = DAY ; R2 = MONTH ; R3 = YEAR ; R0 = STATUS on output ; R1 = DAYNO on output ; ; Where: ; DAY = Number of day (1-31) ; MONTH = Number of month (1-12) ; YEAR = Year since 1950 (1950=0) ; DAYNO = Number of days since 1/1/50 (1/1/50 = 1) ; STATUS = Optional error return ; ; Errors returned: ; ; STATUS = 0 if the operation was successful ; = -1 if a parameter error was detected ; = -2 if an invalid input date was specified ; ; External references: ; ; This module calls the subroutines PRMCHK & CDCHKI ; ; DAY2: .WORD 0,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334. ; ; CDATID:: TST R5 ; Called directly from MACRO-11? BEQ 20$ ; If eq yes - omit PRMCHK ; ; Specify number of parameters including error return. R5 not affected. ; MOV #5,R0 ; Check Number of Parameters CALL PRMCHK ; BCC 10$ ; If CC parameters OK - carry on JMP END ; Else error - exit immediately ; 10$: TST (R5)+ ; Ignore Number of parameters MOVB @(R5)+,R1 ; Get the parameters MOVB @(R5)+,R2 ; MOVB @(R5)+,R3 ; BIT #1,(R5) ; Next parameter a word? BEQ 20$ ; If eq yes - carry on OK MOV #-1,R0 ; No - parameter error BR END ; Exit ; 20$: CALL CDCHKI ; Check the date is valid BCS ERR ; If CS it isn't - return error CMP R3,#50. ; Really after 2000? BGE 30$ ; If GE no - carry on ADD #100.,R3 ; Yes - add on 100 years ; 30$: MOV R1,R4 ; Yes - get day since start of year ASL R2 ; ADD DAY2-2(R2),R4 ; ASR R2 ; TST R0 ; Leap year? BNE 50$ ; If ne no - carry on CMP R2,#2 ; March or later? BLOS 50$ ; If LOS no - carry on INC R4 ; Yes - allow for leap year ; 50$: SUB #49.,R3 ; Update year for leap-day calculations MOV R3,R1 ; Save it ASR R3 ; Calculate number of leap years since 1/1/50 ASR R3 ; ADD R3,R4 ; And add that on DEC R1 ; Calculate number of ordinary days since 1/1/50 MUL #365.,R1 ; ADD R4,R1 ; and end up with result in R1 TST R5 ; Was it a MACRO-11 call? BEQ 60$ ; Yes - just return MOV R1,@(R5)+ ; No - return it normally ; 60$: CLR R0 ; END: RETURN ; ERR: MOV #-2,R0 ; Invalid date RETURN ; .END