.TITLE CATDT, ; $BEGIN CATDT, ; ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ; BE USED OR COPIED ONLY IN ACCORDANCE WITH THE TERMS ; OF SUCH LICENSE. ; ; COPYRIGHT (c) 1982 BY DIGITAL EQUIPMENT CORPORATION. ; ALL RIGHTS RESERVED. ; ; $VERSION 03.01 .IDENT /04.01/ ; ; STEVE RUZICH 07-JUN-82 ; ; MOST OF THIS ROUTINE IS TAKEN FROM RMS-11 ROUTINE GETDAT IN MODULE R0DPYC ; ; BRAD L. TINNEY 26-OCT-84 Routine taken from [13,10] of the M-Plus ; V2.1 distribution source disk and modified ; to run directly from F77 with the call ; CALL CATDT(ascii_string, clunks_returned) ; Used SUPMAC from Spring '79 [321,7]. ; ; ; MACRO CALLS ; SMACIT ;INITIALIZE SUPERMAC .NLIST BEX ; $PDATA RANGET: .WORD 365.,24.,60.,60.,0 ; RANGE CHECK TABLE FOR YEARS, HOURS... .PAGE ;+ ; *** CATDT - CONVERT ASCII DATE STRING TO 64-BIT FORMAT ; ; INPUT IS ASSUMED TO BE AN ASCII DATE/TIME STRING IN THE FORMAT OF THE ; DATES IN THE FILES-11 STRUCTURE LEVEL 1 (ODS1) FILE HEADER. THESE ARE ; THE CASES OF CORRECT INPUT STRING FORMAT: ; ; -- FORMAT -- -- MAY BE FOUND IN THESE ODS1 FIELDS -- ; (1) DDMMMYYHHMMSS - CREATION, REVISION DATE AND TIME ; (2) DDMMMYY - EXPIRATION DATE (ALWAYS ZERO TIME) ; (3) EIGHT NUL BYTES - CREATE/REV/EXP DATE, (NULL VALUE) ; ; A LEADING SPACE ON THE "DD" FIELD IS REWRITTEN AS AN ASCII ZERO. ; I. E., WRITE ACCESS TO THE INPUT FIELD IS REQUIRED IN THIS CASE. ; (A LEADING SPACE IS NOT REALLY CORRECT, BUT THEY EXIST OCCASIONALLY, ; SO WE MIGHT AS WELL BE FORGIVING AND ALLOW IT.) ; ; THE INPUT STRING IS VALIDATED: MOST NONSENSE IS INTERCEPTED. ; ; A CREATION OR REVISION DATE OF THE FOLLOWING FORMAT IS NOT INTERCEPTED AS AN ; ERROR; IT IS CONSIDERED TO BE A DATE WITH A ZERO TIME. THIS IS EQUIVALENT ; TO THE PROCESSING OF SUCH A STRING BY THE VMS ODS1 ACP. (SUCH A CASE COULD ; ONLY OCCUR IN A FILE HEADER IN THE EVENT OF A WILDLY UNLIKELY ACP ERROR, OR ; A USER DELIBERATELY WRITING GARBAGE VIA ATTRIBUTE #13.) ; ; DDMMMYY FOLLOWED BY ANYTHING OTHER THAN NULLS ; ; THE OUTPUT BUFFER IS ALWAYS ALTERED: ; ; INPUT DATE AND TIME ARE VALID: OUTPUT BUFFER WILL HAVE CONVERTED DATA ; INPUT DATE OR TIME ARE INVALID: OUTPUT BUFFER WILL CONTAIN ZEROES ; INPUT FIELD IS NULL: OUTPUT BUFFER WILL CONTAIN ZEROES ; ; THIS ROUTINE GOES THROUGH THE STRING "BACKWARDS", PUTTING SECONDS, MINUTES, ; HOURS, AND YEARS INTO DECREASING ADDRESSES IN THE OUTPUT FIELD. THEN IT DOES ; A CHECK ON MONTH FOR MATCH, ACCUMULATING THE DAYS FOR PREVIOUS MONTHS AS IT ; GOES ALONG. A CHECK TO SEE IF THE CURRENT DATE IS A LEAP YEAR IS DONE (WITH ; APPROPRIATE ADJUSTMENT IF SO), AND THEN THE TOTAL NUMBER OF LEAP-DAYS IN ; PRECEDING LEAP YEARS IS ADDED. SINCE EACH YEAR STARTS WITH DAY '1' (NOT DAY ; '0'), THERE IS ONE EXTRA DAY TO GET RID OF. RANGE CHECKS ON HOUR, MINUTE, ; AND SECOND VALUES ARE PERFORMED. FINALLY, BINARY YEARS ARE IN A REGISTER ; AND THE FOUR WORDS OF THE OUTPUT BLOCK USED FOR DAYS, HOURS, ; MINUTES, AND SECONDS. WE ADD IN EACH IN ORDER, MULTIPLYING BEFORE GOING ON ; TO THE NEXT VALUE, TO GET THE TOTAL ELAPSED SECONDS SINCE THE BEGINNING OF ; THE YEAR 1900 (WHICH WAS NOT A LEAP YEAR). A FINAL MULTIPLY AND ADD (TO THE ; 64-BIT VALUE REPRESENTING 1900) AND WE'RE DONE. ; ; INPUT: ; R0 - ADDRESS OF ASCII INPUT STRING ; R1 - ADDRESS OF OUTPUT BUFFER FOR 64 BIT DATE/TIME ; ; OUTPUT: ; R0 DESTROYED ; ALL OTHER REGISTERS PRESERVED ;- ; $CODE2 CATDT:: JSR R5,.SAVR1 ; SAVE REGISTERS R1-R5 MOV 2(R5),R0 ; F77 interface BLT MOV 4(R5),R1 ; F77 interface BLT MOV R1,R5 ; R5 IS USED FOR OUTPUT POINTER ADD #8.,R5 ; POINT R5 PAST THE BUFFER MOV R0,R1 ; R1 USED FOR INPUT POINTER HEREAFTER IFB (R1) EQ #40 ; LEADING SPACE IN DAY FIELD? MOVB #'0,(R1) ; IF EQ YES, MAKE IT AN ASCII ZERO END THRU R3 := #8. ; EXAMINE EACH BYTE OF DATE, 1ST OF TIME TSTB (R1)+ IF RESULT IS NE GOTO CNVRT1 ; IF NOT ASCII THEN NORMAL CONVERT END ; INPUT FIELD IS ALL ASCII NULL. GOTO ZEROEX ; ZERO OUTPUT BLOCK & EXIT CNVRT1: MOV R0,R1 ; RESUME NORMAL DATE/TIME CONVERSION ADD #7,R1 ; POINT PAST THE YEAR IFB (R1) NE #0 ; IF TIME FIELD EXISTS, CONVERT IT ADD #6,R1 ; POINT PAST THE SECONDS (R5 ALL SET) $CALL DIGITS ; CONVERT SECONDS, MINUTES, ... $CALL DIGITS ; ...HOURS TO BINARY IN OUTPUT FIELD $CALL DIGITS ELSE CLR -(R5) ; NO TIME SPECIFIED ON INPUT: CLR -(R5) ; ERASE ANY GARBAGE IN OUTPUT FIELD CLR -(R5) ; POSITION R5 TO YEAR (R1 ALL SET) END ; $CALL DIGITS ; CONVERT YEAR IN ANY CASE SUB #3,R1 ; POINT TO BEGINNING OF MONTH ; MOV #.MONTB,R4 ;GET ADDRESS OF MONTH TABLE MOV #$MONTB,R4 ;GET ADDRESS OF MONTH TABLE ; MOV #.DAYTB,R2 ;GET ADDRESS OF DAY TABLE MOV #$DAYTB,R2 ;GET ADDRESS OF DAY TABLE CLR R3 ;INIT TOTAL DAYS MOVB (R2)+,R0 ;GET FIRST MONTH COUNT ; ; LOOK FOR MATCH ON MONTH TABLE, ACCUMULATING DAYS ; REPEAT IFB (R4)+ EQ (R1) ;MATCH ON FIRST CHARACTER? IFB (R4) EQ 1(R1) ;MATCH ON SECOND?? IFB 1(R4) EQ 2(R1) GOTO LEAPYR ;MATCH ON THIRD??? END ;IF NO MATCH, ADD MONTH'S DAY END ;COUNT TO R3 ADD R0,R3 ;ACCUMULATE DAYS CMPB (R4)+,(R4)+ ;ADVANCE MONTH TABLE POINTER MOVB (R2)+,R0 ;GET NEXT MONTH MAX DAYS UNTIL RESULT IS EQ ;UNLESS WE HIT THE TABLE STOPPER ;NO MATCH IF WE FALL THROUGH ; ; EITHER THE INPUT WAS NULL OR AN ERROR WAS ENCOUNTERED: ; ZERO THE OUTPUT BUFFER AND RETURN. ; ZEROEX: MOV 2(SP),R5 ; GET R1 (OUT BUF PTR) STACKED BY SAVR1 CLR (R5)+ ; ZERO THE OUTPUT FIELD CLR (R5)+ ; CLR (R5)+ CLR (R5)+ RETURN ; ; ; WE HAVE A MONTH MATCH, NOW CORRECT FOR LEAP YEAR. ; R3 = ACCUMULATED DAY TOTAL, @R2 = MAX DAYS IN CURRENT MONTH ; LEAPYR: ;REF TAG: LEAP YEAR CORRECTION MOV @R5,R2 ;SAVE THE YEAR IF RESULT IS NE ;IF NOT 1900, IS IT A LEAP YEAR? IF #3 OFF.IN @R5 ;IF SO, HAVE WE PASSED JANUARY? IF R3 NE #0 ;IF SO, ARE WE IN FEBRUARY? IF #28. EQ R0 ;IF YES, BUMP THE DAY COUNT; INC R0 ;IF NOT, BUMP THE TOTAL DAY ELSE ;COUNT. INC R3 END END END DEC @R5 ;DEC IF NOT 1900. END ASR @R5 ;NOW GET TOTAL PRECEDING NUMBER ASR @R5 ;OF LEAP-DAYS, AND ADD IT TO ADD (R5)+,R3 ;CURRENT DAY TOTAL. $CALL DIGITS ;NOW GET DAY OF MONTH: 0 IS TST @R5 ;ILLEGAL, AS IS ANYTHING MORE IF RESULT IS EQ GOTO ZEROEX ;THAN THE NUMBER OF DAYS IN CMP R0,(R5) ;THE MONTH. IF GOOD, ADD IN IF RESULT IS CS GOTO ZEROEX ;TOTAL PRECEDING DAYS. WE NOW ADD R3,@R5 ;HAVE ONE EXTRA 'ELAPSED' DAY: DEC (R5)+ ;ZAP IT. MOV #RANGET+2,R4 ;ADDRESS OF MAX HRS IN RANGE CHK TABLE CMP (R4)+,(R5)+ ;WE NOW VERIFY RANGE OF HRS, IF RESULT IS LE GOTO ZEROEX ;MINS, AND SECS VALUES. CMP @R4,(R5)+ IF RESULT IS LE GOTO ZEROEX CMP @R4,@R5 IF RESULT IS LE GOTO ZEROEX CMP -(R4),-(R4) ;POINT BACK AT TABLE'S START, SUB #6,R5 ;POINT AT DAYS VALUE MOV R2,R3 ;GET YEAR TO SET UP FOR MULTIPLY LOOP CLR R2 REPEAT MOV (R4)+,R0 IF RESULT IS EQ LEAVE LOOP ;GET OUT ON TERMINATOR CHAR. $CALL $DMUL ;GET RESULT IN R0, R1. ADD (R5)+,R1 ;ADD IN NEXT VALUE. ADC R0 MOV R0,R2 MOV R1,R3 END ;R2, R3 NOW = 32. BITS OF SECS. MOV #72215,-(R5) ;HERE WE GO! MOVE IN 64-BIT CLR -(R5) ;1900-CONSTANT, ROTATED 32. BITS MOV #56,-(R5) ;TO ADJUST FOR LATER ROTATION. MOV #15304,-(R5) MOV #32.,R0 ;SET THE LOOP COUNT. REPEAT ;THIS LOOP MULTIPLIES THE SECS MOV R5,-(SP) ;VALUE BY 10000000., AND ADDS ROL (R5)+ ;THE RESULT TO THE CONSTANT IN ROL (R5)+ ;THE OUTPUT FIELD. ROL (R5)+ ROL @R5 MOV @SP,R5 ADC (R5)+ ASL R3 ROL R2 IF RESULT IS CS ADD #230,(R5)+ ADC (R5)+ ADC @R5 MOV @SP,R5 ADD #113200,(R5)+ ADC (R5)+ ADC (R5)+ ADC @R5 END MOV (SP)+,R5 DEC R0 UNTIL RESULT IS EQ RETURN ; ; THE FOLLOWING SUBROUTINE CONVERTS TWO ASCII DIGITS (CHECKING THEM ; FOR CORRECT RANGE) TO A BINARY NUMBER IN THE OUTPUB FIELD. ; THE ERROR EXIT POPS THE STACK, RETURNING TO THE CALLER'S CALLER. ; ; INPUT: ; R1 - ADDRESS AFTER ASCII DIGITS ; R5 - ADDRESS OF OUTPUT BLOCK ; ; OUTPUT: ; R1, R5 - DECREMENTED BY 2 ; R4 - ALTERED ; R0, R2, R3 - PRESERVED ; DIGITS: ;REF TAG. MOVB -(R1),R4 ;GET LOW DIGIT (SIGN EXTDED). SUB #'0,R4 ;GET ACTUAL BINARY VALUE. CMP #9.,R4 ;IS IT A REAL DIGIT? ON.ERROR GOTO DIGERR ;IF NOT, GET OUT. MOV R4,-(R5) ;PUT IT IN OUTPUT FIELD MOVB -(R1),R4 ;GET HIGH DIGIT. SUB #'0,R4 ;CONVERT IT, AND CHECK CMP #9.,R4 ;VALUE. ON.ERROR GOTO DIGERR ASL R4 ;ADD 10. X HIGH DIGIT TO ADD R4,@R5 ;PARTIAL TOTAL TO GET ENTIRE ASL R4 ;NUMBER. ASL R4 ADD R4,@R5 RETURN ;AND RETURN. DIGERR: TST (SP)+ ;POP RETURN ADDRESS GOTO ZEROEX ;ZERO OUTPUT BLOCK & EXIT ; ; ; $END CATDT ; ; .END