Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
today.mac
There are 16 other files named today.mac in the archive. Click here to see a list.
; UPD ID= 2671 on 3/23/80 at 11:38 AM by NIXON
TITLE TODAY. - DAY, DATE, AND TIME FOR COBOL
SUBTTL D. M. NIXON/DMN 30-DEC-78
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1978, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH INTERM,UUOSYM
IFN TOPS20,<SEARCH MONSYM>
SALL
TWOSEG
.COPYRIGHT ;Put 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., TIME.
ENTRY DATE., TIME.,TIME1.
;CALLED BY PUSHJ PP,DATE.
;EXIT WITH DATE IN AC0 YYMMDD
DATE.: CALLI AC4,14 ;DATE UUO ((Y-64)*12+(M-1))*31+D-1
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,
;CALLED BY PUSHJ PP,TIME.
;EXIT WITH TIME IN AC0 HHMMSS
; AC1 CC
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 EBCLBL,<
ENTRY DAY.SK
DAY.SK: AOS (PP) ;TAKE A SKIP EXIT
>
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
>
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,
>
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