.TITLE CDATEI .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 14-Jul-80 Phil Stephensen-Payne ; ; Calling Sequence: ; ; This subroutine is called via the standard FORTRAN calling sequence as: ; ; CALL CDATEI (ENCDAT,DAY,MONTH,YEAR [,STATUS]) ; or ; STATUS = CDATEI (ENCDAT,DAY,MONTH,YEAR) ; ; or ; CALL CDATEI from MACRO-11 with ; R5 = 0 ; R1 = ENCDAT ; R0 = STATUS on output ; R1 = DAY on output ; R2 = MONTH on output ; R3 = YEAR on output ; ; Where: ; DAY = Number of day (1-31) ; MONTH = Number of month (1-12) ; YEAR = Year since 1950 (1950=0) ; ENCDAT = Encoded Date ; 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 ; ; ; CDATEI:: 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 BIT #1,(R5) ; Parameter a word? BEQ 15$ ; If eq yes - carry on OK MOV #-1,R0 ; No - parameter error BR END ; Exit ; 15$: MOV @(R5)+,R1 ; Get Encoded Date ; 20$: MOV R1,R3 ; Get the year ASH #-9.,R3 ; BIC #177600,R3 ; Isolate it SUB #50.,R3 ; Get into range BGE 30$ ; If GE OK - carry on ADD #100.,R3 ; Else adjust to range 50 - 99 ; 30$: MOV R1,R2 ; Get the month ASH #-5.,R2 ; Shift it to the bottom BIC #177760,R2 ; Isolate it BIC #177740,R1 ; Isolate the day number CALL CDCHKI ; Check the date is valid BCS ERR ; If CS it isn't - return error TST R5 ; Was it a MACRO-11 call? BEQ 60$ ; Yes - just return MOVB R1,@(R5)+ ; No - return it normally MOVB R2,@(R5)+ ; MOVB R3,@(R5)+ ; ; 60$: CLR R0 ; END: RETURN ; ERR: MOV #-2,R0 ; Invalid date RETURN ; .END