; $BEGIN CDTTA, .TITLE CDTTA, ; ; ; 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 03-JUN-82 ; ; MOST OF THIS ROUTINE IS BORROWED FROM ANDREW C. GOLDSTEIN'S DCATDT ; ; Modified from [13,10] of distribution kit. BRAD L. TINNEY ; Supports my SUPERMAC from Sprint '79 [321,7] ; Interfaces directly to F77 with the call: ; CALL CDTTA(Clunks, Ascii_string) SMACIT ; INITIALIZE SUPERMAC .MACRO .QUAD WORD $$$B1=0 $$$B2=0 $$$B3=0 $$$B4=0 $$$B5=0 $$$B6=0 $$$B7=0 $$$B8=0 .IRPC D,WORD $$$B1=$$$B1*10.+D'. $$$C=$$$B1/256. $$$B1=$$$B1&^O377 $$$B2=$$$B2*10.+$$$C $$$C=$$$B2/256. $$$B2=$$$B2&^O377 $$$B3=$$$B3*10.+$$$C $$$C=$$$B3/256. $$$B3=$$$B3&^O377 $$$B4=$$$B4*10.+$$$C $$$C=$$$B4/256. $$$B4=$$$B4&^O377 $$$B5=$$$B5*10.+$$$C $$$C=$$$B5/256. $$$B5=$$$B5&^O377 $$$B6=$$$B6*10.+$$$C $$$C=$$$B6/256. $$$B6=$$$B6&^O377 $$$B7=$$$B7*10.+$$$C $$$C=$$$B7/256. $$$B7=$$$B7&^O377 $$$B8=$$$B8*10.+$$$C $$$C=$$$B8/256. $$$B8=$$$B8&^O377 .ENDM $$$W1=$$$B2*256.+$$$B1 $$$W2=$$$B4*256.+$$$B3 $$$W3=$$$B6*256.+$$$B5 $$$W4=$$$B8*256.+$$$B7 .LIST MEB .WORD $$$W1,$$$W2 .WORD $$$W3,$$$W4 .NLIST MEB .ENDM .QUAD ; ; SOME CONSTANTS ; ; $PDATA .RADIX 10 QNS: .QUAD 10000000 ; TENTHS OF MICROSECONDS IN A SECOND QND: .QUAD 864000000000 ; TENTHS OF MICROSECONDS IN A DAY FDAYS = 365*4+1 ; NUMBER OF DAYS IN 4 YEARS ; AND NUMBER OF QUARTER DAYS IN A YEAR CDAYS = FDAYS*25-1 ; NUMBER OF DAYS IN A CENTURY QDAYL = 15025 ; NUMBER OF DAYS IN QUADRICENTURY, LOW QDAYH = 2 ; NUMBER OF DAYS IN QUADRICENTURY, HIGH DS15L = 65176 ; NUMBER OF DAYS BETWEEN 1-JAN-1501 AND DS15H = 1 ; 17-NOV-1858, LOW AND HIGH .RADIX ;+ ; ; *** - CDTTA CONVERT DATE/TIME TO ASCII ; ; THIS ROUTINE CONVERTS THE 64 BIT DATE/TIME REPRESENTATION INTO AN ASCII ; STRING. TWO OUTPUT FORMATS EXIST, THOSE OF THE DATES IN THE ODS1 FILE HEADER: ; "DDMMMYYHHMMSS" AND "DDMMMYY". THE COMPLEMENTARY CATDT CONVERSION REQUIRES ; THAT A "DDMMMYY" DATE MUST BE FOLLOWED BY A BYTE OF BINARY ZERO; CDTTA WILL ; ALWAYS WRITE THAT ZERO, A TOTAL OF 8. BYTES. ; ; A SPECIAL CASE EXISTS WHEN THE INPUT FIELD IS ALL ZEROES. THIS MEANS THAT ; THE DATE IS NULL. THE OUTPUT FIELD IS THEN FILLED WITH BINARY ZEROES. THIS ; SPECIAL CASE PROCESSING ACCOMMODATES THE TWO DATE FORMATS: EITHER 8 OR 13. ; BYTES OF ZERO ARE OUTPUT, DEPENDING ON THE OPTION FLAG. ; ; OTHER THAN THE ABOVE SPECIAL CASE, THE YEAR MUST BE FROM 1900 TO 1999 ; INCLUSIVE, BECAUSE THE "YY" OF THE OUTPUT FORMAT PRESUMES THE 20TH CENTURY. ; OTHERWISE, NO DATA IS WRITTEN TO THE OUTPUT FIELD. ; ; THIS ROUTINE HAS BEEN TAILORED TO THE NEEDS OF F11ACP. F11ACP IS INTENDED ; TO IGNORE DATE/TIME CONVERSION ERRORS. ; ; INPUTS: ; ; R0 = ADDRESS OF OUTPUT ASCII STRING ; R1 = ADDRESS OF INPUT 64 BIT DATE/TIME ; R2 = OPTION FLAG: ; 0 - DATE AND TIME WANTED (13. BYTES OUTPUT) ; ELSE ONLY DATE WANTED (8. BYTES OUTPUT) ; ; OUTPUTS: ; ; R0 DESTROYED ; ALL OTHER REGISTERS PRESERVED ; ; THE DATE ALGORITHM BELOW ACCOUNTS FOR THE COMMON LEAP YEAR CYCLES - ; EVERY FOURTH YEAR IS, EXCEPT EVERY 100TH ISN'T, EXCEPT EVERY 400TH ; IS. YEAR 2000 IS A LEAP YEAR. THE CODE IS BASED ON ALGORITHMS ; WRITTEN BY PETER CONKLIN, JOHN BARNABY, DAVID ROSENBERG, AND MIKE SPEIR. ;- ; $CODE2 CDTTA:: JSR R5,.SAVR1 ; SAVE REGISTERS R1-R5 MOV 2(R5),R1 ; Let F77 call directly BLT MOV 4(R5),R0 CLR R2 PUSH R1,R2 LET R5 := R0 ; R5 IS POINTER TO OUTPUT THROUGHOUT LET SP := SP - #16. ; ALLOCATE TWO QUAD SLOTS CLR R3 ; CHECK FOR DATE OF ALL ZEROES ADD #8.,R1 ; POINT AFTER INPUT 64-BIT DATE FIELD BIS -(R1),R3 ; OBTAIN LOGICAL "OR" OF INPUT FIELD BIS -(R1),R3 ; BIS -(R1),R3 ; BIS -(R1),R3 ; BNE 10$ ; NOT ALL ZEROES - PROCEED MOV #8.,R3 ; PREPARE TO ZERO OUTPUT, TRY DATE ONLY TST R2 ; DATE OR DATE & TIME? BNE 5$ ; IF NE DATE ONLY MOV #13.,R3 ; DATE & TIME 5$: CLRB (R5)+ ; ZERO A BYTE OF OUTPUT FIELD DEC R3 ; BNE 5$ ; IF NE MORE WORK TO DO (R1 ALL SET) JMP CLEAN ; CLEAN STACK AND EXIT 10$: LET R3 := SP + #8. ; POINT TO 2ND QUAD SLOT $CALL $DIVQ <#QND,R1,SP,R3> ; SPLIT DATE/TIME INTO DAY AND TIME ; ; TOP OF STACK CONTAINS DAYS SINCE 17-NOV-1858. CONVERT THIS TO A ; REAL DATE. ; LET R3 := (SP) ; DAY SINCE 17-NOV-1858 IS LET R2 := 2(SP) ; LESS THAN 32 BITS ; ADD THE OFFSET SO WE HAVE THE NUMBER ; OF DAYS SINCE 1-JAN-1501. THIS ALIGNS ; LEAP YEAR CYCLES SO THAT THE SUBSEQUENT ; TRUNCATIONS AND ROUND-OFFS WORK. LET R3 := R3 + #DS15L LET R2 := R2 + CARRY + #DS15H ; DIVIDE BY THE NUMBER OF DAYS IN ; A QUADRICENTURY $CALL $DIVD <#QDAYH,#QDAYL,R2,R3> ; R0,R1 = DAYS INTO THIS QUADRICENTURY ; R3 = QUADRICENTURIES SINCE 1501 LET R3 := R3 L.SHIFT 2 ; CONVERT TO CENTURIES PUSH R3 ; AND SAVE ASL R1 ; CONVERT NUMBER OF DAYS INTO ROL R0 ; NUMBER OF QUARTER DAYS ASL R1 ; BY MULTIPLYING BY 4 ROL R0 LET R3 := R1 LET R2 := R0 ; DIVIDE BY THE AVERAGE NUMBER OF ; QUARTER DAYS IN A CENTURY $CALL $DIVD <#QDAYH,#QDAYL,R2,R3> ; R0,R1 = QUARTER DAYS INTO CENTURY ; R3 = CENTURIES IN THIS QUAD CENTURY LET (SP) := (SP) + R3 ; ADD TO ACCUMULATED TIME ; ; BY BASING THE TIME AT 1501, WE HAVE PLACED THE CENTURY WITH THE EXTRA ; LEAP DAY INTO THE FIRST CENTURY OF THE QUADRICENTURY. NOW DISCARD ANY ; FRACTION OF A DAY LEFT FROM THE PREVIOUS DIVISION AND ADD IN 3/4 ; OF A DAY TO FORCE THE LEAP YEAR INTO THE LAST YEAR OF EACH 4 YEAR ; CYCLE. ; LET R1 := R1 SET.BY #3 LET R3 := R1 ; NOW DIVIDE BY THE AVERAGE NUMBER OF LET R2 := R0 ; QUARTER DAYS IN A YEAR $CALL $DIVD <#0,#FDAYS,R2,R3> LET R2 := R1 R.SHIFT 2 + #1 ; NUMBER OF DAY IN YEAR $CALL $MUL <#100.,(SP)+> ; COMPUTE # YEARS IN CENTURIES LET R1 := R1 + R3 + #<1501.-1900.> ; COMPUTE CALENDAR YEAR... ; ...RELATIVE TO 1900. TST R1 BLT CLEAN ; 1900 <= YEAR < 2000 ELSE ERROR CMP R1,#100. BGT CLEAN ; PUSH R1 ; SAVE FOR FINAL OUTPUT ; ; FIND OUT WHETHER THIS YEAR IS A LEAP YEAR. IF YES, BIAS THE DAY IF ; IT IS PAST FEBRUARY SINCE THE MONTH TABLE IS NOT WRITTEN FOR A LEAP YEAR. ; (TABLE ASSUMES NO LEAP YEAR - THEREFORE WE MAY HAVE TO DECREMENT THE ; DAY COUNT FOR A LEAP YEAR, ACCOUNTING FOR FEB 29.) ; LET R4 := #0 ; INIT LEAP YEAR FLAG TO NO IF (SP) NE #0 ; 1900 IS NOT A LEAP YEAR... $CALL $DIV <(SP),#4> ; BUT EVERY 4TH YEAR IS IF R1 EQ #0 THEN LET R4 := #-1 ; OTHERS ARE NOT - CORRECT FLAG END ; IF THIS IS A LEAP YEAR, ; BIAS THE DAY DOWN ONE IF IT IS ; PAST FEBRUARY. IF R2 HI #31.+29. THEN LET R2 := R2 + R4 ; ; SCAN THE MONTH TABLE AND FIND OUT WHAT MONTH THIS IS. ; FOR R1 := #0 TO #11. ; LET R0 :B= .DAYTB(R1) ; GET NUMBER OF DAYS IN MONTH LET R0 :B= $DAYTB(R1) ; GET NUMBER OF DAYS IN MONTH IF R2 LOS R0 LEAVE LOOP LET R2 := R2 - R0 END LOOP ; ; R2 = DAY, R1 = MONTH ; START TO CRANK OUT THE ASCII DATE ; PUSH R1 $CALL C2D ; DAY NUMBER ; INDEX INTO THE MONTH NAME TABLE ; LET R1 := (SP) L.SHIFT 1 + (SP)+ + #.MONTB LET R1 := (SP) L.SHIFT 1 + (SP)+ + #$MONTB LET (R5)+ :B= (R1)+ ; FILL IN MONTH NAME LET (R5)+ :B= (R1)+ LET (R5)+ :B= (R1)+ $CALL C2D <(SP)+> ; ADD YEAR CLRB (R5) ; ZERO OUT THE BYTE FOLLOWING THE YEAR ; IN CASE NO TIME FIELD IS REQUESTED ; ; NOW CONVERT THE TIME OF DAY TO ASCII ; ; IF 16.(SP) EQ #0 ; DO IF TIME REQUESTED - DO ALWAYS LET R1 := SP + #8. ; POINT TO TIME ON STACK LET R3 := SP LET SP := SP - #8. ; ALLOCATE ONE MORE QUAD $CALL $DIVQ <#QNS,R1,SP,R3> ; REDUCE TO TIME IN SECONDS POP R3,R2 ; WHICH IS EXPRESSIBLE IN 32 BITS CMP (SP)+,(SP)+ ; CLEAN GARBAGE FROM STACK $CALL $DIVD <#0,#60.,R2,R3> ; DIVIDE OUT SECONDS PUSH R1 ; AND SAVE THEM $CALL $DIVD ; DIVIDE OUT MINUTES PUSH R1 ; AND SAVE $CALL $DIVD ; AND DIVIDE OUT HOURS ; OUTPUT ASCII TIME OF DAY $CALL C2D $CALL C2D <(SP)+> POP R0 ; GET SECONDS $CALL C2D ; END ; ALWAYS TIME CLEAN: LET SP := SP + #20. ; FINAL STACK CLEANUP ; (16. + SAVED R1 AND R2) RETURN ;+ ; ; *** - C2D CONVERT BINARY TO 2 DECIMAL ASCII DIGITS ; ; CONVENIENTLY, ALL NUMBERS TO BE OUTPUT ARE 2 DIGIT NUMBERS, WITH NO ZERO ; SUPPRESSION. ; ; INPUTS: ; ; R0 = BINARY VALUE ; R5 = ADDRESS OF OUTPUT FIELD ; ; OUTPUTS: ; ; TWO DIGITS STORED AT R5 ; R5 BUMPED BY 2 ; R0,R1 CLOBBERED ; ;- C2D: $CALL $DIV ; SPLIT THE DIGITS LET R0 := R0 + #'0 ; CONVERT TO ASCII LET R1 := R1 + #'0 LET (R5)+ :B= R0 ; AND STORE LET (R5)+ :B= R1 RETURN ; ; ; $END CDTTA ; ; .END