Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/today.mac
There are 16 other files named today.mac in the archive. Click here to see a list.
; UPD ID= 948 on 4/1/83 at 4:06 PM by NIXON
TITLE TODAY - DAY, DATE, TIME, and DAY-OF-WEEK for COBOL
SUBTTL D. M. NIXON/DMN
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1978, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH INTERM
IFN TOPS20,<SEARCH MONSYM>
IFE TOPS20,<SEARCH UUOSYM>
SALL
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
AC0=0 ;YYMMDD
AC1=1 ;HHMMSS
AC2=2
AC3=3
AC4=4 ;TEMP
AC5=AC4+1 ;TEMP
AC6=AC5+1 ;TEMP
PP=17 ;
SUBTTL TODAY.
ENTRY TODAY.,TODA1.,TODA2.
;Called by PUSHJ PP,TODAY.
;Exit with DATE in AC0 YYMMDD
; TIME in AC1 HHMMSS
IFN MCS,<
ENTRY MCSTIM ;CMCS (LCM) USES THIS ROUTINE
>
TODAY.: CALLI AC4,14 ;DATE UUO ((Y-64)*12+(M-1))*31+D-1
TODA1.: IDIVI AC4,^D31 ;PICK OFF THE DAY
ADDI AC5,1 ;MAKE IT RIGHT
PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS
DPB AC5,DAY ;XXXXDD
IDIVI AC4,^D12 ;PICK OFF THE MONTH
ADDI AC5,1 ;MAKE IT RIGHT
PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS
DPB AC5,MONTH ;XXMMDD
MOVEI AC5,^D64 ;GET THE BASE YEAR
ADD AC5,AC4 ;PLUS YEARS SINCE THEN
CAIL AC5,^D100 ;CK FOR YEAR 2000+
SUBI AC5,^D100 ;IF SO, CONVERT TO 00+
PUSHJ PP,TODA4. ;SIXBIT
DPB AC5,YEAR ;YYMMDD-DATE FINISHED
CALLI AC4,23 ;TIME UUO GETS TIME IN MILLISECONDS
IDIVI AC4,^D1000 ;CONVERT TO SECONDS
MCSTIM: PUSHJ PP,TODA3. ;PICK OFF SECONDS IN SIXBIT
DPB AC5,SECOND ;XXXXSS
TODA2.: PUSHJ PP,TODA3. ;PICK OFF MINUTES IN SIXBIT
DPB AC5,MINUTE ;XXMMSS
MOVE AC5,AC4 ;WHAT'S LEFT IS HOURS
PUSHJ PP,TODA4. ;TO SIXBIT
DPB AC5,HOUR ;HHMMSS-TIME FINISHED
POPJ PP, ;RETURN
TODA3.: IDIVI AC4,^D60 ;DIVIDE BY 60 FOR TIME
TODA4.: IDIVI AC5,^D10 ;DIVIDE OUT A DECIMAL NUMBER
LSH AC5,6 ;MAKE ROOM FOR THE REMIANDER
ADDI AC5,2020(AC6) ;CONVERT TO SIXBIT
POPJ PP, ;RETURN
SUBTTL DATE
ENTRY DATE.,DATE1.
;Called by PUSHJ PP,DATE.
;Exit with DATE in AC0 YYMMDD
IFN TOPS20,<
DATE.: SETO AC2, ;Get current time
SETZ AC4, ;Nothing special
ODCNV% ;Time
HLRZ AC0,AC3 ;Get day of month
ADDI AC0,1 ;Start at 1
IDIVI AC0,^D10 ;Get two digits
LSH AC0,6 ;Make room
ADDI AC0,'00'(AC1) ;Convert both to sixbit
HRRZI AC5,1(AC2) ;Get month starts at zero
PUSHJ PP,TODA4. ;Return two sixbit numbers
DPB AC5,MONTH ;Accumulate result
HLRZ AC4,AC2 ;Get year
IDIVI AC4,^D100 ;Just get last two digits of year
PUSHJ PP,TODA4. ;Return two sixbit numbers
DPB AC5,YEAR ;Full result now
POPJ PP,
>
IFE TOPS20,<
DATE.: CALLI AC4,14 ;DATE UUO ((Y-64)*12+(M-1))*31+D-1
>
DATE1.: IDIVI AC4,^D31 ;PICK OFF THE DAY
ADDI AC5,1 ;MAKE IT RIGHT
PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS
DPB AC5,DAY ;XXXXDD
IDIVI AC4,^D12 ;PICK OFF THE MONTH
ADDI AC5,1 ;MAKE IT RIGHT
PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS
DPB AC5,MONTH ;XXMMDD
MOVEI AC5,^D64 ;GET THE BASE YEAR
ADD AC5,AC4 ;PLUS YEARS SINCE THEN
CAIL AC5,^D100 ;CK FOR YEAR 2000+
SUBI AC5,^D100 ;IF SO, CONVERT TO 00+
PUSHJ PP,TODA4. ;SIXBIT
DPB AC5,YEAR ;YYMMDD-DATE FINISHED
POPJ PP,
SUBTTL TIME
ENTRY TIME.
;Called by PUSHJ PP,TIME.
;Exit with TIME in AC0 HHMMSS
; AC1 CC
IFN TOPS20,<
TIME.: SETO AC2, ;Get current time
SETZ AC4, ;Nothing special
ODCNV% ;Time
HRRZ AC4,AC4 ;Get seconds since midnight
SETZB AC0,AC1 ;Initialize the result
>
IFE TOPS20,<
ENTRY TIME1.
TIME.: CALLI AC4,23 ;TIME UUO GETS TIME IN MILLISECONDS
TIME1.: IDIVI AC4,^D10 ;CONVERT TO HUNDREDTHS OF SECONDS
IDIVI AC4,^D100 ;GET HUNDREDTHS
PUSHJ PP,TODA4. ;RETURN TWO SIXBIT NUMBERS
DPB AC5,HSECS ;CCXXXX
>
PUSHJ PP,TODA3. ;PICK OFF SECONDS IN SIXBIT
DPB AC5,SECS ;XXXXSS
PUSHJ PP,TODA3. ;PICK OFF MINUTES IN SIXBIT
DPB AC5,MINS ;XXMMSS
MOVE AC5,AC4 ;WHAT'S LEFT IS HOURS
PUSHJ PP,TODA4. ;TO SIXBIT
DPB AC5,HOURS ;HHMMSS-TIME FINISHED
POPJ PP, ;RETURN
SUBTTL DAY
ENTRY DAY.
;CALLED BY PUSHJ PP,DAY.
;RETURNS WITH DATE IN AC0
;AS SIXBIT YYDDD
IFN TOPS20,<
DAY.: SETO AC2, ;GET CURRENT TIME
MOVSI AC4,(IC%JUD) ;IN JULIAN FORMAT
ODCNV% ;TIME
HLRZ AC3,AC2 ;GET YEAR
IDIVI AC3,^D100 ;GET RID OF 1900
IDIVI AC4,^D10 ;INTO TENS AND UNITS
LSH AC4,6 ;MAKE SPACE
ADDI AC4,' 00'(AC5) ;SIXBITIZE YEAR
HRLZ AC0,AC4 ;PUT YEAR IN LHS OF AC0
HRRZ AC2,AC2 ;DAY ONLY
IDIVI AC2,^D100 ;HUNDREDS, REMAINDER IN AC3
IDIVI AC3,^D10 ;TENS AND UNITS
LSH AC2,^D12 ;MAKE SPACE
LSH AC3,6 ;...
ADD AC3,AC4 ;TENS AND UNITS
ADDI AC2,'000'(AC3) ;SIXBITIZE DAY
HRR AC0,AC2 ;DAY IN RHS
LSH AC0,6 ;LEFT JUSTIFY
POPJ PP,
>
IFE TOPS20,<
DAY.: SETZ AC0, ;
CALLI AC4,14 ;GET DATE
IDIVI AC4,^D31 ;PICK OFF DAY-1
ADDI AC5,1 ;DAY OF THE MONTH
MOVE AC1,AC5 ;SAVE THE DAY
IDIVI AC4,^D12 ;PICK OFF MONTH - 1
ADDI AC4,^D64 ;GET YEAR IN AC4
PUSH PP,AC4 ;SAVE YEAR INCASE LEAP
EXCH AC4,AC5 ;SWAP WITH MONTH INDEX
PUSHJ PP,TODA4. ;STORE THE SIXBIT YEAR
DPB AC5,YEAR ; IN AC0
ADD AC1,DAYTAB(AC4) ;ADD PREVIOUS DAYS TO DAY OF MONTH
POP PP,AC5 ;RECOVER YEAR
CAIGE AC4,2 ;PAST FEBRUARY?
JRST DAY.A ;NO
MOVE AC4,AC5 ;YES
IDIVI AC4,4 ;CHECK FOR LEAP YEAR
CAIG AC5,0 ;LEAP YEAR?
ADDI AC1,1 ;YES
DAY.A: MOVE AC4,AC1 ;
IDIVI AC4,^D10 ;DIVIDE OUT THE
MOVE AC1,AC5 ; UNITS AND
IDIVI AC4,^D10 ; THE TENS
LSH AC4,6 ;SHIFT OVER THE HUNDREDS
ADD AC5,AC4 ;ADD IN THE TENS
LSH AC5,6 ;MAKE ROOM FOR THE UNITS
ADDI AC5,'000'(AC1) ;ADDEM IN AND SIXBITIZE
LSH AC5,6 ;GET THEM NEXT TO THE YEAR POSITION
ADD AC0,AC5 ; YYDDD
POPJ PP,
DAYTAB: EXP ^D0 ;JAN
EXP ^D31 ;FEB
EXP ^D59 ;MAR
EXP ^D90 ;APR
EXP ^D120 ;MAY
EXP ^D151 ;JUN
EXP ^D181 ;JUL
EXP ^D212 ;AUG
EXP ^D243 ;SEP
EXP ^D273 ;OCT
EXP ^D304 ;NOV
EXP ^D334 ;DEC
>
SUBTTL DAY-OF-WEEK
ENTRY D.O.W.
;Called by PUSHJ PP,D.O.W.
;Returns with DAY-OF-WEEK in AC0
;As 1=Monday, 2=Tuesday, ..., 7=Sunday
IFN TOPS20,<
D.O.W.: SETO AC2, ;Get current time
SETZ AC4, ;Nothing special
ODCNV% ;Time
HRRZ AC0,AC3 ;Get day of week
AOJA AC0,RET.1## ;In form COBOL expects
>
IFE TOPS20,<
D.O.W.: MOVX AC0,%CNDTM ;Universal Date/Time
GETTAB AC0, ;Get it
JFCL ;Never fails
HLRZ AC0,AC0 ;Get the day part
ADDI AC0,2 ;Change base from Wednesday=0 to Monday=0
IDIVI AC0,7 ;Get day of week
MOVEI AC0,1(AC1) ;Monday = 1
POPJ PP,
>
SUBTTL CONSTANTS AND POINTERS
YEAR: POINT 12,AC0,11
MONTH: POINT 12,AC0,23
DAY: POINT 12,AC0,35
HOUR: POINT 12,AC1,11
MINUTE: POINT 12,AC1,23
SECOND: POINT 12,AC1,35
HOURS==YEAR
MINS==MONTH
SECS==DAY
HSECS==HOUR
END