Trailing-Edge
-
PDP-10 Archives
-
bb-m080u-sm_t20_v7_0_23_mon_src_mod
-
monitor-sources/datime.mac
There are 50 other files named datime.mac in the archive. Click here to see a list.
; Edit= 9107 to DATIME.MAC on 14-Jun-89 by GSCOTT
;Fix rude timezone output code at OTT5.
; Edit= 9098 to DATIME.MAC on 8-Jun-89 by GSCOTT
;Support OT%822 for RFC 822 times, make a table for DST changes, allow 2400 as
;a time meaning midnight.
; UPD ID= 8500, RIP:<7.MONITOR>DATIME.MAC.6, 9-Feb-88 14:51:35 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8394, RIP:<7.MONITOR>DATIME.MAC.5, 27-Jan-88 11:09:59 by GSCOTT
;More of TCO 7.1183 - Bad optimization of a JRST .+3 at ODB5-4.
; UPD ID= 8363, RIP:<7.MONITOR>DATIME.MAC.4, 21-Jan-88 19:22:21 by GSCOTT
;More of TCO 7.1183 - Remove extra SWAPCD, EA.ENT, etc.
; UPD ID= 8351, RIP:<7.MONITOR>DATIME.MAC.3, 19-Jan-88 13:52:48 by GSCOTT
;TCO 7.1183 - Monitor needs more section 0/1 space, move this to XCDSEC.
; *** Edit 7482 to DATIME.MAC by RASPUZZI on 18-May-87
; Fix problem with edit 7110 (mainly when first of April is on a Sunday). Done
; for Brian Lilja who did the work.
; *** Edit 7388 to DATIME.MAC by WONG on 10-Nov-86 (TCO NONE)
; Implement new DST law for 1987 (1st Sunday in April) and maintain the old law
; for date from 1975 to 1986.
; Edit 7110 to DATIME.MAC by WAGNER on 26-Jul-85, for SPR #16981 (TCO 6-1-1497)
; Fix ODCNV% so that Julian dates calculate correctly in non-leap years in
; which either April or October end on a Saturday
; UPD ID= 2061, SNARK:<6.1.MONITOR>DATIME.MAC.14, 3-Jun-85 14:28:03 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1814, SNARK:<6.1.MONITOR>DATIME.MAC.13, 24-Apr-85 15:17:48 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1537, SNARK:<6.1.MONITOR>DATIME.MAC.12, 19-Feb-85 16:54:38 by PALMIERI
;TCO 6.1.1206 - IDTIM returns wrong error code if IDCNV fails
;IDTNCS used by IDTIM returns garbage if date and time supression requested
; UPD ID= 4642, SNARK:<6.MONITOR>DATIME.MAC.11, 31-Jul-84 16:00:40 by PURRETTA
;Update copyright notice, remove brackets in comments.
; UPD ID= 3955, SNARK:<6.MONITOR>DATIME.MAC.10, 21-Mar-84 13:15:04 by LOMARTIRE
;More TCO 6.1970 - Handle the other literal where the JRST .+1 is missing
; UPD ID= 3690, SNARK:<6.MONITOR>DATIME.MAC.9, 15-Feb-84 11:17:02 by TGRADY
;TCO 6.1970 - Fix previous edit to include JRST .+1 in literal (was left out)
; UPD ID= 3374, SNARK:<6.MONITOR>DATIME.MAC.8, 27-Dec-83 13:36:25 by TSANG
;TCO 6.1918 - Make .IDCNV work properly with non-full year in AC2
; UPD ID= 2641, SNARK:<6.MONITOR>DATIME.MAC.7, 27-Jun-83 16:40:55 by CHALL
;TCO 6.1707 ITN8- Fix: IDTNC interprets "1200midnight" as noon.
; UPD ID= 2407, SNARK:<6.MONITOR>DATIME.MAC.6, 3-May-83 16:03:18 by COBB
;TCO 6.1639 - %s and ?s in PRINTX messages...
; UPD ID= 1840, SNARK:<6.MONITOR>DATIME.MAC.5, 20-Feb-83 22:17:03 by MURPHY
;TCO 6.1514 - No error code in AC if ERJMP/ERCAL.
; UPD ID= 1782, SNARK:<6.MONITOR>DATIME.MAC.4, 10-Feb-83 13:13:05 by WEETON
;TCO 6.1487 - Allow customers to modify DST conversions
; UPD ID= 129, SNARK:<6.MONITOR>DATIME.MAC.3, 19-Oct-81 14:47:00 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 1504, SNARK:<5.MONITOR>DATIME.MAC.2, 27-Jan-81 14:03:11 by ZIMA
;TCO 5.1253 - Fix output for OT%SPA+OT%DAM and fix termination of null strings.
;<4.MONITOR>DATIME.MAC.7, 19-Oct-79 08:53:15, EDIT BY ENGEL
;TCO #4.2535 - RETURN -1 IN A & B FOR IDTNC WHEN CLOCK IS NOT ON YET (AT IDTN11)
;<4.MONITOR>DATIME.MAC.6, 13-Sep-79 06:44:46, EDIT BY R.ACE
;TAKE OUT EXTERN'S TO GET CHECKSUMS RIGHT ON .REL FILES
;<4.MONITOR>DATIME.MAC.5, 14-Aug-79 14:28:20, EDIT BY GRADY
;<4.MONITOR>DATIME.MAC.4, 2-Aug-79 10:57:08, EDIT BY GRADY
;tco 4.2369 - fix .odtim @ ott5+6 to not return "unprintable time zone" error
;<4.MONITOR>DATIME.MAC.3, 4-Mar-79 14:58:01, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>DATIME.MAC.2, 11-Oct-78 08:29:09, EDIT BY R.ACE
;TCO 4.2032 - FIX BUGS IN IDCNV JULIAN DAY VALIDATION
;<4.MONITOR>DATIME.MAC.1, 30-Sep-78 21:33:31, EDIT BY ZIMA
;TCO 4.2029 SPR 20-11913 MAKE IDTNC RETURN CURRENT DATE VALUES
; WHEN IT%NDA GIVEN TO SUPPRESS DATE INPUT
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; 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 AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE DATIME
;TIME AND DATE ROUTINES
;JSYS'S HEREIN
; ODTIM
; IDTIM
; ODTNC
; IDTNC
; ODCNV
; IDCNV
INTERN .ODTIM,.IDTIM,.ODTNC,.IDTNC,.ODCNV,.IDCNV ;JSYS'S
Subttl Table of Contents
; Table of Contents for DATIME
;
; Section Page
;
;
; 1. Parameters . . . . . . . . . . . . . . . . . . . . . . 4
; 2. ODTIM JSYS . . . . . . . . . . . . . . . . . . . . . . 7
; 3. IDTIM JSYS . . . . . . . . . . . . . . . . . . . . . . 11
; 4. ODTNC JSYS . . . . . . . . . . . . . . . . . . . . . . 14
; 5. IDTNC JSYS . . . . . . . . . . . . . . . . . . . . . . 24
; 6. ODCNV JSYS . . . . . . . . . . . . . . . . . . . . . . 45
; 7. IDCNV JSYS . . . . . . . . . . . . . . . . . . . . . . 50
; 8. Subroutines . . . . . . . . . . . . . . . . . . . . . 53
; 9. End of DATIME . . . . . . . . . . . . . . . . . . . . 62
SUBTTL Parameters
XSWAPCD ;[7.1183]
;[9098] The following parameter controls the application of Daylight Saving
;Time. There are three possibilities:
; 1. DST never used (set .DSTNV into DSTFLG).
; 2. DST always used (set .DSTAL into DSTFLG).
; 3. DST used according to some rule (set .DSTAU into DSTFLG) (default).
;[9098] Following code and comments come from MRC via the SRI NIC. This
;represents an attempt to make it easier to change the summer time rules to
;reflect the latest games Congress chooses to play with when summer time starts
;and ends. In theory, you should be able to make an appropriate addition to
;the RULES macro. Of course, if your country doesn't play along by US law, you
;will have to make some additional modifications. Note that VAX/VMS doesn't
;(yet) have any algorithm for summer time!
RADIX <5+5> ;[9098] Decimal radix
;[9098] First and last Sundays of certain useful months
FSTJAN==7-1 ;[9098] First Sunday in January
LSTFEB==31+29-1 ;[9098] Last Sunday in February
LSTMAR==31+29+31-1 ;[9098] Last Sunday in March
FSTAPR==31+29+31+7-1 ;[9098] First Sunday in April
LSTAPR==31+29+31+30-1 ;[9098] Last Sunday in April
LSTSEP==31+29+31+30+31+30+31+31+30-1 ;[9098] Last Sunday in September
LSTOCT==31+29+31+30+31+30+31+31+30+31-1 ;[9098] Last Sunday in October
DWFUDG==2 ;Constant to normalize day of week
; = day of week of 17 November 1858
;[9098] Define a macro to expand into tables for DST rules.
; Still in RADIX <5+5>
;Notes: contrary to what some people (and certain operating systems) believe,
;there was not year-round DST in 1974. At the last minute Congress restored
;the end-of-October restoration of standard time.
;Prior to 1967 there was no uniform application of DST in the USA, although
;many areas used the "last Sunday in April until last Sunday in October" rule.
;These entries cannot be taken seriously. Change the "1946" line below to make
;dates from 1946 to 1967 to NOT use DST.
DEFINE RULES < ;[9098] Macro to define by-year rules for DST
XLIST ;[9098] No mess when macro expanded
DST 1987,FSTAPR,LSTOCT ;[9098] Changed again
DST 1976,LSTAPR,LSTOCT ;[9098] Energy conservation legislation expired
DST 1975,LSTFEB,LSTOCT ;[9098] Rule changed in October 1974
DST 1974,FSTJAN,LSTOCT ;[9098] Energy conservation emergency
DST 1967,LSTAPR,LSTOCT ;[9098] Congress established national standard
; DST 1946,LSTAPR,LSTOCT ;[9098] Entry if you had DST from 1946-1966
DST 1946,400,400 ;[9098] Assume you didn't have DST 1946-1966
DST 1945,0,LSTSEP ;[9098] WWII "War Time" ended Sunday 30 Sep 45
DST 1943,0,400 ;[9098] WWII "War Time" was all year 1943-1944
DST 1942,31+9,400 ;[9098] WWII "War Time" started Monday 9 Feb 42
DST 1920,400,400 ;[9098] no real standard existed
DST 1918,LSTMAR,LSTOCT ;[9098] temporary summer time during WWI
LIST ;[9098] Resume listing
> ;[9098] End of DEFINE RULES
DEFINE DST(YEAR,START,END) <YEAR> ;[9098]
DSTBGN::RULES ;[9098] Year for DST rule
DEFINE DST(YEAR,START,END) <START> ;[9098]
DSTON:: RULES ;[9098] First day to apply DST for that year
DEFINE DST(YEAR,START,END) <END> ;[9098]
DSTOFF::RULES ;[9098] Ending day to apply DST for that year
NRULES==.-DSTOFF ;[9098] Number of years to check
IFE NRULES,<PASS2 ;[9098] If no DST rules
PRINTX ?DATIME - There must be at least one DST rule
END> ;[9098] Sanity check
RADIX <4+4> ;[9098] Back to octal radix
;ACCUMULATORS
Z=0
A=1
B=2
C=3
D=4
E=5
F=6
G=7
AA=10
BB=11
CC=12
DD=13
EE=14
FF=15
GG=16
P=17
;HALF-WORD BIT SYMBOLS
B0==1B18
B1==1B19
B2==1B20
B3==1B21
B4==1B22
B5==1B23
B6==1B24
B7==1B25
B8==1B26
B9==1B27
B10==1B28
B11==1B29
B12==1B30
B13==1B31
B14==1B32
B15==1B33
B16==1B34
B17==1B35
SUBTTL ODTIM JSYS
REPEAT 0, <
ODTIM
OUTPUT DATE AND TIME
CONVERTS INTERNAL DATE AND TIME TO TEXT
TAKES: 1: TENEX DESTINATION DESIGNATOR
2: LEFT HALF: INTERNAL DATE
RIGHT HALF: INTERNAL TIME
OR ENTIRE WORD -1 TO USE CURRENT DATE AND TIME
3: FORMAT FLAGS, DESCRIBED BELOW
RETURNS: +1 ALWAYS: UPDATED STRING POINTER (IF PERTINENT) IN 1.
GENERATES ILLEGAL INSTRUCTION PSEUDO-INTERRUPT ON
ERROR CONDITIONS GIVEN BELOW.
ODTIM FORMAT FLAGS (AC 3):
B0: OFF, OUTPUT DATE
ON, OMIT DATE AND IGNORE B1-B8
B1: ON, OUTPUT DAY OF WEEK
OFF, OMIT DAY OF WEEK AND IGNORE B4
B2: ON, USE FULL TEXT FOR WEEKDAY
OFF, USE 3-LETTER ABBREVIATION FOR WEEKDAY
B3: ON, OUTPUT MONTH AS NUMBER AND IGNORE B4
OFF, OUTPUT MONTH AS TEXT
B4: ON, USE FULL TEXT FOR MONTH
OFF, USE 3-LETTER ABBREVIATION FOR MONTH
B5: ON, OUTPUT 4-DIGIT YEAR
OFF, OUTPUT 2-DIGIT YEAR IF BETWEEN 1900 AND 1999
B6: ON, OUTPUT DAY OF MONTH AFTER MONTH
OFF, OUTPUT DAY OF MONTH BEFORE MONTH
B7 AND B8: DATE PUNCTUATION CONTROL:
BOTH OFF, PUNCTUATE WITH DASHES, AS 13-APR-70
B7 ON, PUNCTUATE WITH SPACES, AS 13 APR 70.
A COMMA IS ALSO USED IF B6 IS ON, AS APRIL 13, 1970
B8 ON, PUNCTUATE WITH SLASHES, AS 5/13/70
BOTH B7 AND B8 ON, UNSPECIFIED
B9: OFF, OUTPUT TIME
ON, OMIT TIME AND IGNORE B10-B13
B10: OFF, INCLUDE SECONDS, PRECEDED BY A COLON
ON, OMIT SECONDS
B11: OFF, USE 24-HOUR TIME
ON, USE 12-HOUR TIME AND AM-PM
B12: OFF, COLON BETWEEN HOURS AND MINUTES
ON, NO COLON
B13: OFF, NO TIME ZONE GARBAGE
ON, ADD "-" AND TIME ZONE TO TIME, EG "-EDT" OR "-PST"
B17: OFF, COLUMNATE: USE LEADING SPACES AND ZEROES SO THAT
TTME AND DATE PRINTOUT IS CONSTANT-WIDTH REGARDLESS OF THE
PARTICULAR DATE AND TIME (NOTE: FULL MONTH AND WEEKDAY TEXTS
ARE NOT COLUMNATED).
ON, DON'T COLUMNATE.
NOTE: COLUMNATION WILL GENERALLY BE DESIRED IF THE PRINTOUT
IS PART OF A TABLE, BUT NO COLUMNATION PRODUCES A
SLIGHTLY BETTER LOOKING PRINTOUT WHEN PART OF A SENTENCE.
B35: Off, no RFC 822
B35: On, ignore other flags and output date in RFC 822 format which is
"Day, dd Mmm yy hh:mm:ss TMZ" [9098]
FOR CONVENIENCE, -1 IN 3 IS TAKEN AS EQUIVALENT TO 336001000000,
WHICH PRODUCES, FOR EXAMPLE, FRIDAY, APRIL 13, 1970 1:06:03.
EXAMPLES:
CONTENTS OF 3 TYPICAL TEXT
0 3-APR-70 1:06:03
202201000000 FRI 3 APR 70 1:06
336321000000 FRIDAY, APRIL 3, 1970 1:06AM-EST
041041000000 3/4/70 106:03
041040000000 3/04/70 106:03
ODTIM ERROR MNEMONICS:
STIMEX: SYSTEM HAS NO DATE AND TIME
TIMEX1: ILLEGAL TIME (GREATER THAN 24 HOURS)
ODCNV ERRORS (LIST THEM ALL HERE)
ODTNC ERRORS
FILE ERRORS
DESXN ERRORS
>
;NOTE: JSYS'S USING STRING I/O CANNOT BE NESTED BECAUSE STRING
;POINTER WOULD ALWAYS REFER TO MONITOR ADDR SPACE EVEN IF OUTER JSYS
;CALLED FROM USER SPACE.
;HENCE SUBROUTINE ENTRIES ARE USED FOR ODTNC AND IDTNC WHEN USED
;IN ODTIM AND IDTIM, AND SUBROUTINE ENTRIES ARE ALSO PROVIDED
;TO ODTIM AND IDTIM FOR USE ELSEWHERE IN THE MONITOR.
;ODTIM JSYS
.ODTIM: MCENT ;BECOME SLOW, ETC.
CALL ODTIMS ;ODTIM SUBROUTINE
MRETNG ;RETURN TO CALLER
;ODTIM SUBROUTINE, FOR ODTIM JSYS
; AND POSSIBLE OTHER FUTURE USES IN MONITOR INVOLVING STRING
; IN USER SPACE.
;TAKES: CALLER'S A: DESTINATION
; ACTUAL B: DATE & TIME OR -1
; ACTUAL C: FORMAT OPTION FLAGS
;RETURNS +1: WITH CALLERS A UPDATED (IF STRING POINTER)
;CLOBBERS MOST OR ALL OF AC'S B-DD.
ODTIMS: PUSH P,C ;SAVE FORMAT OPTION FLAGS
SETZ D, ;DEFUALT ZONE & DAYLIGHT STUFF
ODCNV ;CONVERT INTERNAL TO LOCAL DATE & TIME
POP P,F ;GET FORMAT OPTION FLAGS BACK INTO F
CALL ODTNCS ;SUBR ENTRY TO ODCNV JSYS (BELOW)
;CONVERTS LOCAL DATE & TIME TO STRING
RET ;RETURN
SUBTTL IDTIM JSYS
REPEAT 0, <
IDTIM
INPUT DATE AND TIME
CONVERTS TEXT TO INTERNAL DATE AND TIME
TAKES: 1: TENEX SOURCE DESIGNATOR
2: FORMAT OPTION FLAGS, DESCRIBED BELOW, 0 FOR NORMAL CASE
RETURNS: +1: FAIL, ERROR NUMBER IN 2,
UPDATED STRING PTR (IF PERTINENT) IN 1
+2: SUCCESS, 1: UPDATED STRING PTR (IF PERTINENT)
2: LH: DATE IN SYSTEM INTERNAL FORMAT (GREENWICH)
RH: TIME IN SYSTEM INTERNAL FORMAT
(GREENWICH MEAN TIME)
IDTIM DOES NOT ADMIT OF DOING CONVERSIONS FOR OTHER THAN THE
LOCAL TIME ZONE OR FOR DAYLIGHT SAVINGS TIME IF APPROPRIATE, EXCEPT IF
THE INPUT STRING CONTAINS A TIME ZONE CODE. HOWEVER, THE CALLER MAY
ADD OR SUBTRACT HOURS TO ADJUST TO OTHER TIME ZONES; HE MAY
DETERMINE THE LOCAL TIME ZONE USING "ODCNV" (BELOW).
IDTIM DOES NOT ADMIT OF INPUTTING EITHER THE DATE OR THE TIME ALONE.
SEE IDTNC, BELOW, FOR THIS.
IDTIM FORMAT OPTIONS (AC 2):
B1: ON, DISALLOW NUMERIC MONTH IN INPUT AND IGNORE B2-B3
B2: OFF, IF MONTH IS NUMERIC, AS IN "1/2/70", CONSIDER
THE FIRST NUMBER TO BE THE MONTH
ON, CONSIDER THE SECOND NUMBER TO BE THE MONTH. IE "1/2/70"
MEANS 1 FEB NOT JAN 2, AS IS CUSTOMARY IN ENGLAND.
B3: OFF, IF AN INVALID DATE CAN BE INTERPRETED SUCESSFULLY BY
ASSUMING MONTH AND DAY ARE IN OPPOSITE ORDER THAN
THAT SPECIFIED BY B2, INTERPRET IT THUS.
THIS WOULD APPLY, FOR EXAMPLE, TO "31/1/70" WITH B2 OFF.
ON, GIVE AN ERROR RETURN FOR SUCH DATES.
B7 AND B8 GOVERN INCLUSION OF SECONDS (PRECEDED BY COLON)
IN TIME.
BOTH OFF, SECONDS ARE OPTIONAL.
B7 ON, SECONDS ILLEGAL.
B8 ON, SECONDS MANDATORY.
B9 AND B10 GOVERN USE OF COLON BETWEEN HOURS AND MINUTES.
BOTH OFF, OPTIONAL
B9 ON, ILLEGAL.
B10 ON, MANDATORY.
B11 AND B12: WHEN BITS 7 THRU 10 ARE ALL OFF, THESE
BITS DETERMINE WHETHER A TIME WITH ONE COLON IS
INTERPRETED AS HOURS AND MINUTES OR HOURS, MINUTES,
AND SECONDS WITH NO COLON BETWEEN THE FORMER.
BOTH OFF, TAKE AS HH:MM IF FIRST FIELD IS SMALL ENOUGH,
ELSE AS HHMM:SS.
B11 ON, ALWAYS TAKE AS HHMM:SS.
B12 ON, ALWAYS TAKE AS HH:MM (GIVING AN ERROR IF
FIRST FIELD IS TOO BIG). THIS DIFFERS FROM
B7 ON IN THAT SECONDS CAN BE INCLUDED IF
PRECEDED BY A SECOND COLON.
B14: ON TO DISALLOW 24-HOUR TIME AND MAKE AM-PM MANDATORY
B15: ON TO DISALLOW AM-PM
B16: ON TO DISALLOW TIME ZONE
IDTIM ERROR MNEMONICS
IDTNC ERRORS
IDCNV ERRORS
FILE ERRORS
DESXN ERRORS
>
;IDTIM JSYS
.IDTIM: MCENT
CALL IDTIMS ;IDTIM SUBROUTINE
JRST [ CALLX (MSEC1,TSTERJ) ;[7.1183] ERJMP/ERCAL PRESENT?
UMOVEM B,B ;NO, RETURN CODE IN B
MOVE A,B ;GET ERROR CODE IN A
EMRETN()] ;GIVE +1 ERROR RETURN TO CALLER
UMOVEM B,B ;RETURN INTERNAL DATE & TIME IN B
SMRETN ;RETURN +2
;IDTIM SUBROUTINE, FOR IDTIM JSYS AND POSSIBLE OTHER USES
; (SEE NOTES WITH ODTIM)
;TAKES: CALLERS A: SOURCE
; ACTUAL B: FORMAT OPTION FLAGS
;RETURNS +1: ERROR CODE IN ACTUAL B, CALLERS A UPDATED
; +2: DATE & TIME IN ACTUAL B, CALLERS A UPDATED
;CLOBBERS C-DD.
IDTIMS: CALL IDTNCS ;SUBR ENTRY TO IDTNC JSYS (BELOW)
;INPUTS DATE & TIME AND RETURNS AS LOCAL NUMBERS
RET ;ERROR. # IN B.
IDCNV ;CONVERT LOCAL TO INTERNAL
TRNA
RETSKP
MOVE B,A ;IDCNV returns error code in A
RET
SUBTTL ODTNC JSYS
;ODTNC
; OUTPUT DATE AND/OR TIME WITHOUT CONVERSION FROM INTERNAL
;A SUBSET OF ODTIM, USED INTERNALLY BY ODTIM.
;TAKES: 1: TENEX DESTINATION DESIGNATOR
; 2: LH: REAL YEAR
; RH: MONTH (JANUARY=0)
; 3: LH: DAY OF MONTH
; RH: DAY OF WEEK IF PRINTOUT THEREOF REQUESTED
; 4: LH: NEEDED ONLY IF TIME ZONE PRINTOUT REQUESTED:
; B1: ON FOR DAYLIGHT SAVINGS
; B12-17: TIME ZONE
; RH: LOCAL TIME (SECONDS SINCE MIDNITE)
; 5: FORMAT OPTION FLAGS, SAME AS FOR ODTIM (ABOVE).
; NOTE: THE ONLY TIME ZONES WHICH CAN BE PRINTED (FLAG B13)
; ARE THOSE IN THE USA AND GREENWICH.
;RETURNS +1 WITH UPDATED STRING POINTER (IF PERTINENT) IN 1.
;TRAPS ON ERRORS.
;ERROR MNEMONICS
;DATEX1: ILLEGAL YEAR
;DATEX2: MONTH TOO LARGE
;DATEX3: DAY OF MONTH TOO LARGE
;DATEX4: DAY OF WEEK TOO LARGE
;ZONEX1: ILLEGAL TIME ZONE VALUE (NOT BETWEEN -12 AND 12)
;ODTNX1: UNPRINTABLE TIME ZONE
;FILE ERRORS
;DESXN ERRORS
;ODTNC JSYS
.ODTNC: MCENT
UMOVE F,E
CALL ODTNCS ;CALL ODTNC SUBROUTINE (NEXT IN LISTING)
MRETNG ;GIVE SUCCESSFUL RETURN
;ODTNCS
;ODTNC SUBROUTINE FOR ODTNC AND ODTIM JSYS'S
;CALL: ALL AC'S ARE ACTUAL EXCEPT THOSE NOTED AS "CALLER" WHICH ARE
; USER IF LAST JSYS WAS FROM USER SPACE.
;TAKES: CALLER A: DESTINATION
; B: YEAR,,MONTH
; C: MONTHDAY,,WEEKDAY
; D: TIME STUFF
; F: FORMAT OPTION FLAGS
;RETURNS +1: ON SUCCESS WITH CALLER A UPDATED,
; B-E,G,AA,BB,DD CLOBBERED
;TRAPS ON ERRORS
;INTERNAL AC USE
; D,E,AA: ARGS FROM B,C,D
; BB: LOCAL TIME FROM RH D, LH 0.
ODTNCS: MOVE DD,P ;SAVE PD LEVEL TO RESTORE BEFORE ERROR RETURN
CAMN F,[-1]
HRLZI F,336001 ; DEFAULT FORMAT FOR -1
TXNE F,OT%822 ;[9098] RFC 822 format?
MOVX F,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ;[9098] Yes, set up flags
MOVE AA,D ;TIME STUFF TO AA
TLZ AA,B3 ;DISALLOW JULIAN FORMAT
MOVEI BB,(D) ;TIME ONLY, WITH LH 0, TO BB
CALL CKYMDT ;CHECK MOST ARGUMENTS. THIS SUBR IS WITH
;"IDCNV" BELOW. USES B,C,AA.
JRST ODTNCE ;BAD ARGUMENT. ERROR CODE IN B.
MOVE D,B ;LOCAL YEAR,,LOCAL MONTH TO D.
MOVE E,C ;LOCAL DAY OF MONTH,,DAY OF WEEK TO E.
MOVEI G,^D10 ;SET G FOR USE IN C FOR MOST NOUTS: DECIMAL,
TLNN F,B17 ;COLUMNATION SUPPRESSED?
HRLI G,B2+2 ;NO, 2 COLUMNS, LEADING SPACE.
TLNE F,B0 ;ARE WE GOING TO PRINT DATE?
JRST OTT1 ;NO, DATE SUPPRESSION REQUESTED.
;ODTNCS...
;DATE
TLNN F,B1
JRST ODB2
;DAY OF WEEK
HRRZ B,E
CAIL B,7
JRST [ MOVEI B,DATEX4 ;"DAY OF WEEK TOO LARGE"
JRST ODTNCE]
PUSH P,E ;SAVE E
HRRZS E ;GET RID OF HIGH ORDER BITS
HRROI B,[ASCIZ /Mon/
ASCIZ /Tue/
ASCIZ /Wed/
ASCIZ /Thu/
ASCIZ /Fri/
ASCIZ /Sat/
ASCIZ /Sun/](E)
TLNE F,B2 ;ON FOR VERBOSE
HRRO B,[[ASCIZ /Monday,/]
[ASCIZ /Tuesday,/]
[ASCIZ /Wednesday,/]
[ASCIZ /Thursday,/]
[ASCIZ /Friday,/]
[ASCIZ /Saturday,/]
[ASCIZ /Sunday,/] ] (E)
POP P,E ;RESTORE E
CALL SOUTA
MOVEI B,"," ;[9098] Load a comma
TXNE F,OT%822 ;[9098] RFC 822 format?
CALLX (MSEC1,BOUTA) ;[9098] (A,B/A) Yes, output the comma next
MOVEI B," " ;ALWAYS A SPACE AFTER WEEKDAY
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the space
;ODTNCS...
;DAY # IF BEFORE MONTH
ODB2: TLNE F,B6
JRST ODB3
HLRZ B,E
ADDI B,1 ;REAL DAY IS ARG +1.
MOVE C,G
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the day
;SEPERATOR
CALL ODTMSP ;DASH, SPACE, OR SLASH, DEPENDING ON FLAGS.
;MONTH
ODB3: TLNN F,B3
JRST ODB3A
;MONTH AS NUMBER
HRRZ B,D
ADDI B,1
MOVE C,G ;NOUT FORMAT
TLNN F,B6 ;IF DAY # WAS FIRST,
TLO C,B3 ;USE LEADING 0 NOT SPACE FOR MONTH
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the month
JRST ODB3B
;[7.1183] ODTNCS...
;MONTH AS CONCISE OR VERBOSE TEXT
ODB3A: PUSH P,D ;SAVE D
HRRZS D ;GET RID OF HIGH ORDER BITS
HRROI B,[ASCIZ /Jan/
ASCIZ /Feb/
ASCIZ /Mar/
ASCIZ /Apr/
ASCIZ /May/
ASCIZ /Jun/
ASCIZ /Jul/
ASCIZ /Aug/
ASCIZ /Sep/
ASCIZ /Oct/
ASCIZ /Nov/
ASCIZ /Dec/ ] (D)
TLNE F,B4 ;ON FOR VERBOSE
HRRO B,[[ASCIZ /January/]
[ASCIZ /February/]
[ASCIZ /March/]
[ASCIZ /April/]
[ASCIZ /May/]
[ASCIZ /June/]
[ASCIZ /July/]
[ASCIZ /August/]
[ASCIZ /September/]
[ASCIZ /October/]
[ASCIZ /November/]
[ASCIZ /December/] ] (D)
POP P,D ;RESTORE D
CALL SOUTA
;SEPERATOR
ODB3B: CALL ODTMSP ;DASH, SLASH, OR SPACE PER FLAGS
;ODTNCS...
;DAY OF MONTH IF AFTER MONTH
TLNN F,B6
JRST ODB5
HLRZ B,E
ADDI B,1
MOVE C,G
TLNE F,B3 ;IF MONTH WAS NUMBER,
TLO C,B3 ;USE LEADING 0 NOT SPACE
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the month
;SEPERATOR: FIRST A COMMA IF MONTH WAS VERBOSE TEXT
TXNN F,OT%NMN ;NO COMMA IF NUMERIC MONTH
TXNN F,OT%FMN+OT%SPA ;BUT DO ONE IF FULL NAME OR OT%SPA
IFSKP. ;[7.1183] We want a comma
MOVEI B,"," ;[7.1183] Load a comma
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the comma
ENDIF. ;[7.1183]
CALL ODTMSP ;DASH, SLASH, OR SPACE PER FLAGS
;YEAR
ODB5: HLRZ B,D
TLNE F,B5
JRST ODB5A ;VERBOSE YEAR REQUESTED
IDIVI B,^D100 ;SEPERATE CENTURY AND YEAR WITHIN CENTURY
EXCH B,C ;CONCISE YEAR: LAST 2 DIGITS ONLY
CAIE C,^D19
HLRZ B,D ;MAKE YEAR ALWAYS VERBOSE IF NOT 19XX
ODB5A: MOVE C,[1B2+1B3+2B17+^D10] ;NOUT FORMAT: 2 COLS, LEADING 0S.
CAIL B,^D100
HRLI C,B2+B3+4 ;BUT USE 4 COLS IF VERBOSE
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the year
;SPACE BETWEEN DATE AND TIME,
;NOT PRINTED IF EITHER IS SUPPRESSED.
TLNE F,B9
JRST OTT1
MOVEI B," "
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the space
;ODTNCS...
OTT1: TLNE F,B9
JRST ODT8 ;TIME SUPPRESSED
;TIME
MOVEI D,(BB) ;MASK RH: LOCAL TIME IN MIUTES SINCE MIDNITE
IDIVI D,^D3600
MOVE B,D
TLNN F,B11 ;PRINTING 12-HOUR TIME?
JRST OTT2 ;NO
CAIGE B,1 ;12-HOUR PRINTOUT IS ALWAYS BETWEEN 1:00:00
ADDI B,^D12 ;...AND 12:59:59. SO ADD 12 IF BEFORE 1:00:00
CAILE B,^D12
SUBI B,^D12 ;SUBTRACT 12 HOURS IF AFTER 12:59:59
OTT2: MOVE C,G ;NOUT FORMAT SET UP AT ENTRY TO ODTIM.
TLNN F,(1B11) ;PRINTING AM/PM?
TLO C,(1B2+1B3+2B17) ;NO, USE LEADING 0 ON HOURS
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the hours
MOVEI B,":"
TLNN F,B12 ;COLON REQUESTED BETWEEN HOURS AND MINUTES?
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the colon
MOVE D,E
IDIVI D,^D60
MOVE B,D
TLO C,B2+B3+2 ;ALWAYS LEADING 0 ON MINUTE AND SECONDS
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the minutes
TLNE F,B10
JRST OTT4 ;SECONDS SUPPRESSED
MOVEI B,":"
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the colon
MOVE B,E
CALLX (MSEC1,NOUTXX) ;[7.1183] (A,B,C/A) Output the seconds
;ODTNCS...
OTT4: TLNN F,B11 ;12-HOUR TIME REQUESTED?
JRST OTT5 ;NO
HRROI B,[ASCIZ /AM/] ;YES, PRINT AM, PM, N, OR M.
CAIL BB,^D<12*3600>
HRROI B,[ASCIZ /PM/]
CAIN BB,^D<12*3600>
HRROI B,[ASCIZ /N/] ;"N" FOR NOON
CAIN BB,0
HRROI B,[ASCIZ /M/] ;"M" FOR MIDNITE
CALL SOUTA
;ODTNCS...
OTT5: TXNN F,OT%TMZ ;[9098] Printing time zone or RFC 822 format?
JRST OTT6 ;[9107] No, do not output a time zone
LDB B,[POINT 6,AA,17] ;[9107] Load the time zone
IFE. B ;[9107] Is it Greenwich time?
MOVEI E,"G" ;[9107] Yes load the code for that zone
ELSE. ;[9107] Otherwise it might be one we know
CAIG B,^D11 ;[9107] Is it a time zone
CAIGE B,^D4 ;[9107] for which we have text to print?
JRST OTT6 ;[9107] If time zone is wierd, don't print it
MOVE E,["A" ;[9107] Atlantic
"E" ;[9107] Eastern
"C" ;[9107] Central
"M" ;[9107] Mountain
"P" ;[9107] Pacific
"Y" ;[9107] Yukon
"H" ;[9107] Alaska-Hawaii
"B"]-4(B) ;[9107] Bering
ENDIF. ;[9107] Now the first letter is in E
TXNE F,OT%822 ;[9098] RFC 822 format desired?
SKIPA B,[" "] ;[9098] Yes, output leading space
MOVEI B,"-" ;[9098] No, output leading hyphen
CALLX (MSEC1,BOUTA) ;[9098] (A,B/A) Output the space or hyphen
MOVE B,E ;[9107] Load first character time zone string
CALLX (MSEC1,BOUTA) ;[9107] (A,B/A) Output the first character
TLNE AA,B1 ;[9107] Daylight savings for this date?
SKIPA B,["D"] ;[9107] Yes, load middle character of D
MOVEI B,"S" ;[9107] No, load middle character of S
CALLX (MSEC1,BOUTA) ;[9107] (A,B/A) Output the D or S
MOVEI B,"T" ;[9107] Load the final character
CALLX (MSEC1,BOUTA) ;[9107] (A,B/A) Output the T
OTT6: TLNE F,B11 ;12-HOUR TIME REQUESTED?
TLNE F,B17 ;COLUMNATION SUPPRESSED?
JRST OTT9 ;NO OR YES
;IF N FOR NOON OR M FOR MIDNITE PRINTED WITH COLUMNATION,
;PRINT SPACE AFTER TIME ZONE, BECAUSE SPACE BEFORE TIME ZONE
;IS A FORMAT THAT CAN'T BE TYPED INTO "IDTIM".
MOVEI B," "
CAIE BB,^D<12*3600>
CAIN BB,0
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the space
OTT9:
;ODTNCS...
;EXIT
ODT8: UMOVE A,1 ;FETCH USER'S OUTPUT DESIGNATOR
TXC F,OT%NDA+OT%NTM ;CHECK FOR BOTH NO DATE AND
TXCN F,OT%NDA+OT%NTM ; NO TIME BEING SET
TLNN A,777777 ;PLUS A STRING POINTER DESIGNATOR
RET ;NOT THE ABOVE, DONE
TLC A,777777 ;CHECK FOR AND CONVERT
TLCN A,777777 ;-1,,ADR
HRLI A,(<POINT 7,0>) ;MAKE REAL BYTE POINTER
SETZ B, ;GET A NULL
XCTBU [ IDPB B,A] ;END THE STRING PROPERLY
RET ;AND DONE
ODTNCC: MOVE B,C ;HERE WHEN ERROR CODE IS IN C, AS AFTER "NOUT"
;ODTNC ERROR RETURN. ERROR CODE IN B.
ODTNCE: MOVEM B,LSTERR ;SAVE ERROR CODE IN PSB FOR "GETER"
MOVE P,DD ;CLEAR PD
ITERX ;GENERATE ITRAP
;SUBROUTINE TO OUTPUT APPROPRIATE SEPERATOR PER FLAGS 7 AND 8.
ODTMSP: MOVEI B,"-"
TLNE F,B7
MOVEI B," "
TLNE F,B8
MOVEI B,"/"
XJRST [MSEC1,,BOUTA] ;[7.1183] (A,B/A) Output the character
SUBTTL IDTNC JSYS
REPEAT 0, <
IDTNC
INPUT DATE AND/OR TIME WITHOUT CONVERSION TO INTERNAL
THIS JSYS IS A SUBSET OF IDTIM AND WILL ONLY BE OF INTEREST TO THOSE
WHO WISH TO INPUT THE DATE AND TIME WITHOUT CONVERTING TO
INTERNAL, OR WHO WISH TO INPUT THE TWO QUANTITIES SEPERATELY, EG
BECAUSE OF INTERVENING TYPEOUT. (IDTIM CANNOT iNPUT EITHER
ALONE BECAUSE IT IS IMPOSSIBLE TO CONVERT ONE TO INTERNAL WITHOUT
THE OTHER.) IDTNC RETURNS VALUES SUITABLE FOR USE AS ARGUMENTS TO
IDCNV. IDTNC IS USED INTERNALLY BY IDTIM.
TAKES: 1: TENEX SOURCE DESIGNATOR
2: FORMAT OPTION FLAGS, DESCRIBED BELOW
RETURNS: +1: FAILURE, ERROR CODE IN 1,
UPDATED STRING POINTER (IF PERTINENT) IN 4
+2: SUCCESS, VALUES IN ACCUMULATORS:
1: UPDATED STRING POINTER IF PERTINENT
IF DATE INPUT WAS NOT SUPPRESSED:
2: LH: REAL YEAR
RH: MONTH (JANUARY=0)
3: LH: DAY OF MONTH (FIRST DAY=0)
RH: DAY OF WEEK (MONDAY=0)
IF TIME INPUT WAS NOT SUPPRESSED:
4: RH: TIME AS SECONDS SINCE MIDNIGHT
LH: B0: OFF UNLESS A TIME ZONE WAS INPUT
B1: ON IF A DAYLIGHT SAVING TIME ZONE
(EG EDT) WAS INPUT.
B2: OFF UNLESS A TIME ZONE WAS INPUT
B12-17: TIME ZONE, IF ONE WAS INPUT, ELSE
LOCAL TIME ZONE.
(SEE DESCRIPTION OF TIME ZONeS UNDER
IDCNV)
(REDUNDANT BITS B0 AND B2 ARE FOR
COMPATIBILITY WITH ODCNV)
IDTNC FORMAT OPTION FLAGS (AC 2):
ALL OF THOSE DESCRIBED ABOVE UNDER IDTIM APPLY, AND ALSO:
B0 ON, DON'T INPUT DATE, IGNORE B1-B3
B6 ON, DON'T INPUt TIME, IGNORE B8-B16
IDTNC ERROR MNEMONICS:
DILFX1: ILLEGAL FORMAT FOR DATE
TILFX1: ILLEGAL FORMAT FOR TIME
NOTE: IDTNC DOES NOT DETECT CERTAIN ERRORS IN DATE INPUT, SUCH AS
DAY 31 OF A 30-DAY MONTH. SUCH ERRORS ARE DETECTED IN IDCNV.
>
;IDTNC JSYS
.IDTNC: MCENT
CALL IDTNCS ;IDTNC SUBROUTINE, NEXT
JRST [ CALLX (MSEC1,TSTERJ) ;[7.1183] ERJMP/ERCAL present?
UMOVEM B,B ;NO, RETURN CODE IN CALLER'S B.
MOVE A,B ;GET ERROR CODE IN A
EMRETN()] ;GIVE +1 ERROR RETURN TO CALLER
UMOVEM B,B ;RETURN RESULTS
UMOVEM C,C
UMOVEM D,D
SMRETN ;GIVE SKIP RETURN
;IDTNCS
;IDTNC SUBROUTINE, FOR IDTIM AND IDTNC JSYS'S
;CALL SAME AS JSYS EXCEPT ALL AC'S ACTUAL EXCEPT A IS CALLER
; (IE CALLER OF JSYS THAT CALLS SUBROUTINE)
;CLOBBERS B-DD.
;IDTNC INTERNAL AC USE
; A: SOURCE DESIGNATOR
; B,C,D,E: TEMPS
; F: FLAGS
; G: LAST CHARACTER READ
; AA, BB, CC: WHAT WILL BE RETURNED IN B, C, D
; DD: SAVED P
;IDTNCS
IDTNCS: MOVE DD,P ;SAVE P: USED WHEN MAKING AN ERROR RETURN
MOVE F,B ;FLAGS REMAIN IN F THROUGHOUT
MOVEI G," " ;G CONTAINS CHARACTER: PRESET TO SPACE SO
;"GNSC" SUBR WILL READ FIRST CHARACTER
TLNE F,B0 ;ON TO SUPPRESS DATE INPUT
JRST ITN1 ;DATE INPUT SUPPRESSED
;INPUT DATE
CALL MONTH ;TRY INPUTTING ALPHA MONTH
JRST IDN2 ;NOT A LETTER, GO TRY NUMBER
;PROCESS REST OF DATE WHICH BEGINS WITH ALPHABETIC MONTH
CALL DNIN ;INPUT NUMBER FOR DAY OF MONTH -1 INTO B
HRL BB,B ;RETURN DAY OF MONTH IN LH C
CALL GNSC ;NON-SPACE CHARACTER
CAIN G,"," ;COMMA ALLOWED IN THIS CONTEXT ONLY
JRST [ CALL IDCHAR ;PASS THE COMMA. "YEAR" PASSES SPACES.
JRST .+2]
CALL IDSEP ;SEPERATING DASH OR SLASH AND SPACES
CALL YEAR ;INPUT YEAR
JRST IDN7
;IDTNCS...
;DATE MUST BEGIN WITH A NUMBER
IDN2: CALL DNIN ;READ NUMBER: VALUE-1 TO B
HRL BB,B ;STORE VALUE IN DAY OF MONTH
CALL IDSEP ;SEPERATING DASH OR SLASH AND SPACES
CALL MONTH ;ALPHANUMERIC MONTH NEXT?
JRST IDN3 ;NO, GO TRY NUMBER
CALL YEAR ;INPUT YEAR
JRST IDN7
;SECOND FIELD OF DATE MUST ALSO BE A NUMBER
IDN3: TLNE F,B1 ;NUMERIC MONTH ALLOWED?
JRST IDILF ;NO, "ILLEGAL FORMAT" ERROR
CALL DNIN ;GET SECOND NUMBER -1 INTO B.
HLRZ C,BB ;FIRST NUMBER TO C
TLNE F,B2 ;IS FIRST NUMBER SUPPOSED TO BE MONTH?
EXCH C,B ;NO, SWAP. MONTH TO C, DAY TO B.
CAIG C,^D11 ;IS "MONTH" TOO LARGE
JRST IDN4 ;OK
CAIG B,^D11 ;IS OTHER NUMBER ALSO TO LARGE TO BE MONTH?
TLNE F,B3 ;WILL CALLER LET US SWAP THEM?
JRST IDILF ;YES OR NO, ERROR.
EXCH B,C
IDN4: HRR AA,C ;RETURN MONTH IN RH B
HRL BB,B ;RETURN DAY IN RH C
CALL IDSEP ;SEPERATING SPACES, DASH OR SLASH, SPACES.
CALL YEAR ;GET YEAR
IDN7: TLNE F,B6 ;ON TO SUPPRESS TIME INPUT
JRST IDTNC8 ;TIME INPUT SUPPRESSED
;SEPERATOR BETWEEN DATE AND TIME: ONE TAB, ANY NUMBER OF SPACES.
CALL GNSC
CAIN G,11 ;ASCII TAB
CALL IDCHAR
;IDTNCS...
;INPUT TIME
ITN1: TLNE F,B6
JRST IDTNC8 ;BOTH TIME AND DATE SUPPRESSED, JSYS IS NOP.
SETZ E, ;ZERO FOR SECONDS IF OMITTED
CALL IDNIN ;PASS SPACES, READ NUMBER
JRST ITILF ;NO NUMBER, "ILLEGAL FORMAT FOR TIME" ERROR
PUSH P,B
;THIS NUMBER MAY BE HOURS OR HOURS AND MINUTES.
CAILE B,^D2400 ;BUT CAN NEVER BE GREATER THAN 2400.
JRST ITILF
;MAKE SURE MINUTES PART OK (THIS ALWAYS SUCCEEDS IF ITS
;JUST HOURS)
IDIVI B,^D100
CAIL C,^D60
JRST ITILF
;DON'T CHECK HOURS PART YET - ITS MAX VALUE DEPENDS ON
;MANY THINGS INCLUDING FOLLOWING INPUT, AND THIS FIELD
;(ONLY) CAN BE CHECKED AFTER CASES CONVERGE AND VALUES ARE
;COMBINED.
POP P,C ;FIRST VALUE IN C
CAIE G,":" ;COLON AFTER NUMBER?
JRST ITN4 ;NO, ONLY ONE NUMBER IN INPUT.
;COLON SEEN IN TIME, THERE WILL BE AT LEAST TWO NUMBERS
TLNE F,B7 ;SECONDS ILLEGAL?
TLNN F,B9 ;COLON ILLEGAL BETWEEN HRS AND MINS ALSO?
JRST .+2
JRST ITILF ;BOTH TRUE, NO COLONS ALLOWED
CALL TNIN ;PASS SPACES, READ NUMBER LESS THAN 60.
MOVE D,B ;VALUE OF SECOND NUMBER IN D
CAIE G,":"
JRST ITN5 ;TIME CONSISTS OF TWO NUMBERS
;SECOND COLON SEEN, THERE WILL BE THREE NUMBERS
TLNN F,B7 ;SECONDS ILLEGAL?
TLNE F,B9 ;COLON ALLOWED BETWEEN HOURS AND MINS?
JRST ITILF ;TWO COLONS NOT ALLOWED
CALL TNIN ;PASS SPACES, READ THIRD NUMBER
MOVE E,B ;THIRD VALUE IN E
JRST ITN7 ;GO COMBINE VALUES
;ONLY ONE NUMBER IN TIME
ITN4: TLNN F,B10 ;COLON MANDATORY BETWEEN HOURS AND MINS?
TLNE F,B8 ;SEcONDS MANDATORY?
JRST ITILF
JRST ITN5B ;GO SEPERATE HOURS AND MINUTES.
;SECONDS ALREADY ZEROED.
;IDTNCS...
;TWO NUMBERS IN TIME
ITN5: TLNE F,B8 ;SECONDS REQUIRED?
TLNN F,B10 ;COLON REQUIRED BETWEEN HOURS AND MINUTES?
JRST .+2
JRST ITILF ;YES AND YES, TWO COLONS REQUIRED.
TLNN F,B9 ;COLON ILLEGAL?
TLNE F,B8 ;SECONDS REQUIRED?
JRST ITN5A ;YES OR YES, TAKE IT AS HHMM:SS
TLNN F,B7 ;SECONDS ILLEGAL?
TLNE F,B10+B12 ;COLON REQ'D OR "TAKE AS HH:MM IF B7-10 OFF"?
JRST ITN7 ;YES, YES, OR YES, TAKE AS HH:MM
TLNE F,B11 ;"TAKE AS HHMM:SS IF B7-B10 OFF"?
JRST ITN5A ;YES. THIS TEST MUST BE AFTER B7-10!
;B7-B12 ALL OFF, TAKE AS HH:MM IF POSSIBLE, ELSE HHMM:SS.
;WE MUST SEE WHETHER AM-PM IS PRESENT TO KNOW MAXIMUM
;HOUR VALUE IN ORDER TO DECIDE WHETHER WE CAN TAKE IT AS
;HH:MM.
TLNE F,B14
JRST ITN58 ;24-HOUR TIME ILLEGAL, 12 HOURS.
TLNE F,B15
JRST ITN59 ;AM-PM ILLEGAL, 24 HOURS.
CAIG G,"Z"
CAIGE G,"A"
JRST ITN59 ;NO LETTER, NO AM-PM.
ITN58: CAILE C,^D12 ;AM-PM WILL BE PRESENT, MAX TIME 12:59.
JRST ITN5A ;HOURS TOO BIG, HHMM:SS.
;JRST ITN7 ;HH:MM. FALLING THRU WILL GET TO ITN7.
ITN59: CAIN C,^D24 ;NO AM-PM, MAX TIME 24:00
JUMPE D,ITN7 ;HOURS=24, HH:MM IF MINS =0.
CAIGE C,^D24
JRST ITN7 ;FIRST NUMBER SMALL ENOUGH FOR HH:MM.
;TWO NUMBERS IN TIME, TO BE TAKEN AS HHMM:SS
ITN5A: MOVE E,D ;SECONDS
ITN5B: IDIVI C,^D100 ;SEPERATE HOURS AND MINUTES.
;IDTNCS...
;COMBINE HOURS, MINUTES, SECONDS INTO C.
ITN7: IMULI C,^D60
ADD C,D
IMULI C,^D60
ADD C,E
CAILE C,^D<24*3600> ;[9098] Allow max value 2400 in any case
JRST ITILF
TLNE F,B14 ;24-HOUR TIME DISALLOWED?
JRST ITN8 ;YES, AM-PM MANDATORY.
TLNE F,B15 ;AM-PM ALLOWED?
JRST ITN9 ;NO
CAIG G,"Z" ;AM-PM OPTIONAL. LETTER NEXT?
CAIGE G,"A" ;..
JRST ITN9 ;NO
;IDTNCS...
;INPUT AM-PM AND MAKE APPROPRIATE CHECKS AND ADJUSTMENTS TO YIELD
;24-HOUR TIME.
;THE TIMES PRECEDING AM-PM MUST BE BETWEEN 1:00:00 AND 12:59:59.
ITN8: CAIG C,^D<<12*60+59>*60+59>
CAIA C,^D3600 ;NO, ALSO ALLOW 0:00:00 TO 0:59:59
JRST ITILF
CALL AMPM ;READ STRING, SEARCH TABLE, RETURN +1 - +4.
ITN8A: JRST [ CAIL C,^D<12*3600> ;+1: AM
SUBI C,^D<12*3600> ;12AM=MIDNITE, AFTER 12=MORNING
JRST ITN9]
JRST [ CAIGE C,^D<12*3600> ;+2: PM
ADDI C,^D<12*3600> ;BEFORE 12=AFTERNOON, 12PM=NOON
JRST ITN9]
JRST [ CAIE C,^D<12*3600> ;+3: NOON
JRST ITILF ;ONLY 12 NOON ALLOWED
JRST ITN9]
JRST [ CAIE C,^D<12*3600> ;+4: MIDNITE
JRST ITILF ;ONLY 12 MIDNIGHT ALLOWED
JRST ITN8A] ;GO SUBTRACT 12 HOURS
;ABOVE MANIPULATIONS CAN MAKE MIDNITE COME OUT 24:00:00
;AS OPPOSED TO 0:00:00. THE FOLLOWING FIXES THAT,
;AND ALSO CHANGES 24:00:00 (WHICH IS OK TO INPUT WITHOUT
;AM-PM) TO 0.
ITN9: HRR CC,C ;RETURN LOCAL TIME IN RH D.
SETZ C, ;IF NO TIME ZONE, RETURN LH D ZERO
;EXCEPT FOR LOCAL TIME ZONE (BELOW).
TLNE F,B16 ;TIME ZONE ALLOWED IN INPUT?
JRST ITN10
CAIE G,"-" ;"-" PRECEDES TIME ZONE
JRST ITN10 ;NO TIME ZONE
CALL IDCHAR ;NEXT CHARACTER
CAIG G,"Z" ;LETTER NEXT?
CAIGE G,"A" ;..
JRST ITN10 ;NO, NO TIME ZONE (EXTRA CHAR READ)
CALL ZONE ;INPUT STRING, SEARCH TIME ZONES TABLE,
;RETURN THE RIGHT THING IN C (INCL B2 ON).
;(NOTE THAT "DAYL" OR "STD" CAN BE INPUT,
;WHICH LEAVES B2 OFF.)
ITN10: MOVE B,TIMZON ;LOCAL TIME ZONE
TRNN C,B2 ;UNLESS A TIME ZONE WAS INPUT,
DPB B,[POINT 6,C,35] ;RETURN LOCAL TIME ZONE IN C B12-17
HRL CC,C ;RETURN THIS STUFF IN LH D.
;IDTNCS...
;NOW DONE DECODING DATE AND TIME.
;CHECK TERMINATOR: IT SHOULD BE NON-ALPHANUMERIC
IDTNC8: CAIG G,"Z"
CAIGE G,"A"
JRST [ CAIG G,"9"
CAIGE G,"0"
JRST .+2
JRST .+1]
JRST [ TLNN F,B6
JRST ITILF
JRST IDILF]
;GIVE GOOD RETURN
TLNE F,B0 ;ON TO SUPPRESS DATE INPUT
JRST IDTN11 ;DATE INPUT SUPPRESSED
MOVE B,AA ;B/YEAR,,MONTH
HLLZ C,BB ;C/DAY OF MONTH,,0
MOVE D,CC ;FIRST ASSUME USER TYPED IN A TIME
TXNE F,IT%NTI ;SKIP IF WE'RE RIGHT
HRRI D,1 ;NO TIME INPUT, SO PICK ONE
IDCNV ;GET INTERNAL DATE AND TIME
RETBAD (,<MOVE B,A>) ;RETURN WITH ERROR (THIS CAN OCCUR WITH BAD DATE TO IDTIM ETC.)
ODCNV ;THIS IS JUST TO GET DAY OF THE WEEK
RETSKP
;HERE WHEN DATE INPUT SUPPRESSED--RETURN CURRENT DATE VALUES
IDTN11: SETO B, ;-1=CURRENT DATE/TIME
SETZ D, ;DEFAULT TIME ZONE HANDLING
ODCNV ;GET TODAYS VALUE
ERJMP [MOVE B,LSTERR ;SEE IF CLOCK NOT TURNED ON YET
CAIE B,DATEX6 ;CLOCK ON?
RETBAD ;YES - FAIL
SETOB B,C ;[7.1183] No - return -1 for date
JRST .+1] ;NOW GIVE TIME IN SECONDS
TLNN F,B6 ;Asking for time suppression?
MOVE D,CC ;No, then return time input in proper AC
RETSKP ;SKIP RETURN
;IDTNCS...
;ERROR RETURN STUFF
IDILF: SKIPA B,[DILFX1] ;"ILLEGAL FORMAT FOR DATE"
ITILF: MOVEI B,TILFX1 ;"ILLEGAL FORMAT FOR TIME"
;COME HERE WITH ERROR CODE IN B
MOVE P,DD ;RESTORE P (CAN GET HERE FROM SUBRS WITH AN
;INDEFINITE NUMBER OF EXTRANEOUS WORDS IN PD).
MOVEM B,LSTERR ;SAVE ERR CODE IN PSB FOR "GETER", ETC
RET ;RETURN +1 WITH ERROR CODE IN ACTUAL B
;SUBROUTINES FOR IDTNCS
;INPUT ALPHANUMERIC MONTH
;ACCEPTS ANY "UNIQUE SUBSTRING" OF A MONTH NAME.
;IGNORES PRECEDING SPACES AND (ON R2) PASSES FOLLOWING SEPERATING CHARS.
;R1: NEXT NON-SPACE CHAR NOT A LETTER.
;R2: SUCCESS, MONTH # IN RH AA.
;CLOBBERSS B,C,D,E.
MONTH: CALL GNSC ;GET NON-SPACE CHARACTER
CAIG G,"Z"
CAIGE G,"A"
RET ;NO LETTER: R1
CALL IDSTR ;READ STRING. BUFFERS IT IN PD. PUTS OLD
;P VALUE IN E.
XMOVEI C,MONTHS ;TABLE ADDRESS
CALL FSYM ;SEARCH TABLE
JRST IDILF ;NOT FOUND, ILLEGAL DATE FORMAT
HRR AA,C ;RETURN MONTH
MOVE P,E ;DEALLOCATE STRING SPACE IN PD
AOS (P) ;SKIP
JRST IDSEP ;RETURN VIA SUBR TO PASS SEPERATING CHARS
;MACRO FOR TABLES OF MONTHS, AM-PM'S, TIME ZONES
DEFINE TM (TEXT,VALUE)
<XWD VALUE,[ASCIZ /TEXT/]>
;MONTH TEXTS TABLE, IN FSYSM FORMAT
MONTHS: ^D12 ;WORD 0 OF TABLES IS NUMBER OF ENTRIES
TM APRIL,3
TM AUGUST,7
TM DECEMBER,^D11
TM FEBRUARY,1
TM JANUARY,0
TM JULY,6
TM JUNE,5
TM MARCH,2
TM MAY,4
TM NOVEMBER,^D10
TM OCTOBER,^D9
TM SEPTEMBER,^D8
;IDTNCS SUBROUTINES...
;SUBROUTINE TO INPUT YEAR
;RETURNS YEAR IN LH AA
YEAR: CALL IDNIN ;INPUT NUMBER
JRST IDILF ;NONE, ILLEGAL DATE FORMAT ERROR
CAIGE B,^D100
ADDI B,^D1900
CAIL B,^D1858
CAILE B,^D2576
JRST IDILF ;OUT OF RANGE, "ILLEGAL FORMAT"
HRL AA,B
RET
;AM-PM LOOKUP ROUTINE. FIRST CHARACTER MUST BE IN G.
;ACCEPTS ONE OF MORE LETTERS OF -- AND RETURNS + --
; AM 1
; PM 2
; NOON 3
; MIDNIGHT 4
;CLOBBERS B,D,E
;ONLY CALLED IN ONE PLACE; CODED AS A SUBR TO FACILITATE CHANGE SUCH
;AS SUBSTITUTION OF A SIMPLER SYMBOL TABLE SEARCH.
AMPM: PUSH P,C
CALL IDSTR
XMOVEI C,AMPMS
CALL FSYM
JRST ITILF
MOVE P,E
ADDM C,-1(P) ;INCREMENT RETURN BY VALUE FROM TABLE
POP P,C
RET
AMPMS: 4
TM AM,0
TM MIDNIGHT,3
TM NOON,2
TM PM,1
;IDTNCS SUBROUTINES...
;TIME ZONE LOOKUP SUBROUTINE. FIRST CHAR MUST BE IN G.
;ACCEPTS ANY UNIQUE SUBSTRING OF ANY OF THE US STANDARD OR
;DAYLIGHT TIME ZONE ABBREVIATIONS, ALSO "STANDARD" AND "DAYLIGHT".
;RETURNS IN RH C WHAT IDTNC SHOULD RETURN IN LH D,
;EXCEPT THAT LOCAL TIME ZONE ISN'T FILLED IN FOR "DAY" OR "STD".
;CLOBBERS B,D,E.
;LIKE "AMPM", THIS SUBR IS ONLY USED IN ONE PLACE.
ZONE: CALL IDSTR
XMOVEI C,ZONES
CALL FSYM
JRST ITILF
MOVE P,E
RET
ZONES: EXP ZONSIZ
TM ADT,B0+B1+B2+4 ;ATLANTIC DAYLIGHT TIME
TM AST,B0+B2+4 ;ATLANTIC STANDARD TIME
TM BDT,B0+B1+B2+^D11 ;BERING DAYLIGHT TIME
TM BST,B0+B2+^D11 ;BERING STANDARD TIME
TM CDT,B0+B1+B2+6 ;CENTRAL DAYLIGHT TIME
TM CST,B0+B2+6 ;CENTRAL STANDARD TIME
TM DAYLIGHT,B0+B1 ;LOCAL DAYLIGHT TIME
TM EDT,B0+B1+B2+5 ;EASTERN DAYLIGHT TIME
TM EST,B0+B2+5 ;EASTERN STANDARD TIME
TM GDT,B0+B1+B2+0 ;GREENWICH DAYLIGHT TIME
TM GMT,B0+B2+0 ;GREENWICH MEAN TIME
TM GST,B0+B2+0 ;GREENWICH STANDARD TIME
TM HDT,B0+B1+B2+^D10 ;ALASKA-HAWAII DAYLIGHT TIME
TM HST,B0+B2+^D10 ;ALASKA-HAWAII STANDARD TIME
TM MDT,B0+B1+B2+7 ;MOUNTAIN DAYLIGHT TIME
TM MST,B0+B2+7 ;MOUNTAIN STANDARD TIME
TM PDT,B0+B1+B2+^D8 ;PACIFIC DAYLIGHT TIME
TM PST,B0+B2+^D8 ;PACIFIC STANDARD TIME
TM ST,B0 ;"ST" OK FOR "STANDARD"
TM STANDARD,B0
TM STD,B0 ;"STD" OK FOR "STANDARD"
TM YDT,B0+B1+B2+^D9 ;YUKON DAYLIGHT TIME
TM YST,B0+B2+^D9 ;YUKON STANDARD TIME
ZONSIZ==.-ZONES
;IDTNCS SUBROUTINES...
;SUBROUTINE FOR "MONTH", "AMPM", AND "ZONE" TO READ A STRING OF LETTERS.
;FIRST CHARACTER MUST BE IN G. STORES IN ASCIZ FORM IN PUSHDOWN,
;RETURNING PREVIOUS P VALUE IN E AND STRING POINTER IN B.
;CLOBBERS C,D.
IDSTR: MOVE E,P ;SAVE PUSHDOWN LEVEL
SUB E,BHC+1 ;...BEFORE THIS ROUTINE WAS CALLED
HRRI C,1(P)
HRLI C,<POINT 7,0,-1>B53 ;FORM BYTE PTR INTO PUSHDOWN
MOVEI D,^D14 ;MAX LENGTH 3 WORDS
PUSH P,[0] ;ALLOCATE 3 WORD OF BUFFER SPACE, ALSO
PUSH P,[0] ;ZEROS REST OF LAST WORD
PUSH P,[0] ;(NEEDED FOR SEARCH ROUTINE "FSYM")
IDSTR2: IDPB G,C ;STORE CHARACTER
CALL IDCHAR
CAIG G,"Z"
CAIGE G,"A"
JRST IDSTR9 ;NON-LETTER ENDS STRING
SOJG D,IDSTR2 ;GO STORE CHARACTER
;STOP ANYWAY AT 14 CHARS. THE APPROPRIATE "ILLEGAL FORMAT"
;ERROR WILL HAPPEN IN CALLING ROUTINE BECUASE NOTHING
;14 CHARS LONG IS IN TABLES.
IDSTR9: HRRI B,2(E) ;RETURN BYTE PTR TO STRING IN B
HRLI B,<POINT 7,0,-1>B53
MOVE C,1(E) ;FETCH RETURN ADDR FROM PD
JRST (C) ;RETURN
;IDTNCS SUBROUTINES...
;TABLE SEARCH FOR "MONTH", "AMPM", "ZONE"
;TAKES IN B: POINTER TO LEFT ADJUSTED ASCIZ STRING
; C: POINTER TO TABLE OF THE FORM:
; WORD 0: N=NUMBER OF ENTRIES
; WORDS 1-N: LH: V=VALUE
; RH: POINTER TO ASCIZ STRING
; ENTRIES MUST BE IN ALPHABETICAL ORDER
;RETURNS +1: NO MATCH OR AMBIGUOUS
; +2: UNIQUE SUBSET OR EXACT MATCH, VALUE "V" IN RH C.
;AC USE
; A POINTS AT LAST ENTRY IN TABLE
; B POINTER WHICH IS INDEXED THRU INPUT TEXT
; C POINTER INTO TABLE
; D WORD OF INPUT TEXT
; E POINTER WHICH IS INDEXED THROUGH THE TEXT OF A TABLE ENTRY
; F WORD OF TEXT FROM TABLE ENTRY
; G "DELTA" - THE BINARY SEARCH INCREMENT
IFN E-D-1,<PRINTX ?FSYM WON'T WORK CAUSE E IS NOT D+1
>
;IDTNCS SUBROUTINE FSYM...
FSYM: PUSH P,A ;SAVE AC'S
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,G
MOVE A,C ;TABLE LOCATION
;INIT DELTA TO HIGHEST POWER OF 2 IN TABLE LENGTH
MOVE D,(A) ;TABLE LENGTH
JFFO D,.+2
JRST NOMAT ;0 LENGTH: NO MATCH
MOVEI G,1
MOVN E,E
LSH G,43(E) ;SHIFT BY 35 - # OF 0 BITS TO GET POWER
MOVEI C,(A) ;INIT POINTER THAT RUNS OVER TABLE
ADD A,(A) ;LOCATION OF LAST USED ENTRY IN TABLE
;IDTNCS SUBROUTINE FSYM...
; BINARY SEARCH. STOPS AT = ENTRY OR SMALLEST GTR ENTRY.
FSRC1: ADDI C,(G) ;ADD DELTA TO TABLE POINTER
FSRC1A: LSH G,-1 ;HALVE DELTA FOR NEXT TIME AROUND
CAILE C,(A)
JRST FSRC4 ;POINTS BEYOND END OF TABLE, GO BACK UP.
;COMPARE THE INPUT TEXT TO A TEXT IN THE TABLE
MOVE B,-5(P) ;GET VALUE THAT CAME IN B AS PTR TO INPUT TEXT
HRRZ E,(C) ;POINTER INTO TABLE TEXT FROM TABLE WORD
FSRC2: MOVE D,(B) ;GET AN INPUT WORD
LSH D,-1 ;POSITION SO DATA ISN'T IN SIGN BIT
MOVEI B,1(B) ;INDEX INPUT POINTER
MOVE F,(E) ;GET A WORD OF TABLE TEXT
LSH F,-1
CAMGE F,D
JRST FSRC3 ;TABLE ENTRY LESS THAN INPUT
CAME F,D
JRST FSRC4 ;TABLE ENTRY GREATER THAN INPUT
TRNE D,177 ;THESE WORDS EQUAL, AT END OF INPUT?
AOJA E,FSRC2 ;NO, INDEX TABLE TEXT PTR, CONTINUE COMPARE.
;MATCH FOUND.
;CODE FOR EXITS, SEARCH STUFF CONTINUES AFTER THIS.
UPAR: AOS -7(P)
HLRZ D,(C) ;VALUE FIELD FROM TABLE ENTRY WHICH MATCHED
MOVEM D,-4(P) ;RETURN SAME IN C
APAR:
NOMAT: POP P,G ;RESTORE AC'S
POP P,F
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
RET ;RETURN
;THE TEXT OF THIS TABLE ENTRY IS LESS THAN INPUT STRING
FSRC3: JUMPN G,FSRC1 ;DELTA NOT 0, GO MOVE DOWN AND CONTINUE SEARCH
AOJA C,NEM1 ;DONE SEARCH. NEXT ENTRY IN TABLE IS THE
;SMALLEST LARGER ENTRY. IF THERE IS NO NEXT ENTRY, THEN
;THERE IS NO MATCH. "SBST" SUBR IS CODED TO HANDLE THIS CASE.
;THIS TABLE ENTRY GREATER THAN INPUT, OR POINTER IS OF END OF TABLE
FSRC4: SUBI C,(G) ;MOVE UP IN TABLE
JUMPN G,FSRC1A ;UNLESS DELTA=0, CONTINUE SEARCH.
;IDTNCS SUBROUTINE FSYM...
;WE GET TO "NEM1" WHEN THE SEARCH COMPLETES WITHOUT FINDING AN EXACT
;MATCH. C POINTS TO SMALLEST TABLE ENTRY GREATER THAN INPUT.
;THIS ENTRY MAY OR MAY NOT BE A SUBSET MATCH; IF IT IS, THEN IT IS
;AMBIGUOUS IF AND ONLY IF NEXT ENTRY IS ALSO A SUBSET MATCH.
;NOTE ALSO THAT WE CAN TEST NEXT ENTRY FIRST, AND IF IT IS SUBSET,
;THEN WE KNOW INPUT IS AMBIGUOUS WITHOUT TESTING THIS ENTRY.
;TEST NEXT ENTRY
NEM1: ADDI C,1 ;POINT C AT NEXT ENTRY
CALL SBST ;SUBSET TEST SUBR COMPARES ENTRY C TO INPUT
SOJA C,NEM2 ;R1: NOT A SUBSET (INCLUDES NO NEXT ENTRY)
SOJA C,APAR ;R2: IS A SUBSET, SO INPUT IS AMBIG. GIVE R2.
;NOT AMBIGUOUS, SO TEST THIS ENTRY
NEM2: CALL SBST
JRST NOMAT ;INPUT NOT SUBSET THIS ENTRY, NO MATCH
JRST UPAR
;IDTNCS SUBROUTINE FSYM...
;SUBSET TEST SUBROUTINE FOR "FSYM".
;COMPARES INPUT STRING AND STRING FOR TABLE ENTRY C POINTS TO,
; SKIPS IF FORMER IS INITIAL SUBSTRING OF LATTER.
;ON R2, RETURNS IN E A BYTE POINTER TO REST OF TABLE ENTRY STRING
;MUST BE CALLED ONLY WHEN INPUT STRING IS LESS THAN TABLE STRING
;SEE "FSYM"'S COMMENTS ON AC USE. CLOBBERS B,D,E,F,G.
SBST: CAILE C,(A) ;C BEYOND END OF TABLE?
RET ;YES, NO ENTRY, INPUT ISN'T SUBSET, RETURN.
;FIND FIRST WORD OF STRINGS IN WHICH THEY DIFFER
MOVE B,-6(P) ;POINTER TO INPUT TEXT
HRRZ E,(C) ;POINTER TO TABLE ENTRY'S TEXT
SBST1: MOVE D,(B) ;WORD OF INPUT
LSH D,-1 ;POSITION FOR COMPARE
MOVEI B,1(B) ;INDEX INPUT POINTER
MOVE F,(E) ;WORD OF TABLE ENTRY
LSH F,-1 ;POSITION
CAMG F,D
AOJA E,SBST1 ;IF ITS = IT MUST NOT BE END.
TRNE D,177 ;IS DIFFERENCE IN LAST WORD OF INPUT?
RET ;NO, INPUT CAN'T BE SUBSTRING OF TABLE ENTRY.
;MASK OFF TABLE TEXT TO LENGTH OF INPUT
HRLZI G,-4
TDNE D,TBLBTS(G) ;LOOP TO SEE HOW MANY BYTEST OF D ARE 0
AOBJN G,.-1
ANDCM F,TBLBTS(G) ;THIS CLEARS F WHERE THERE ARE BITS IN TABLE
;CONVERT WORD PTR IN E TO BYTE POINTER AS REQUIRED ON R2.
HLL E, [POINT 7,0,-1
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27 ] (G)
;NOW IF MASKED PART OF TABLE WORD = INPUT WORD, INPUT IS SUBSET.
CAMN F,D
RETSKP
RET
TBLBTS:-1
1777777777
7777777
37777
177
;IDTNCS SUBROUTINES...
;NUMBER INPUT CONVERSION: CAN'T USE SYSTEM'S NIN BECAUSE STRING
;POINTER MUST ADDRESS CALLER'S, NOT CURRENT PC'S, ADDRESS SPACE,
; AND IN ANY CASE NOT UNTIL BKJFN
; WORKS FOR ALL DEVICES OR ANOTHER MEANS OF RETURNING TERMINATOR
; IS ESTABLISHED.
;R1: NO DIGIT OR OVERFLOW (18 BITS)
;R2: VALUE IN B
IDNIN: CALL GNSC ;GET NON-SPACE CHARACTER
CAIG G,"9"
CAIGE G,"0"
RET
MOVEI B,-60(G)
NIN1: CALL IDCHAR
CAIG G,"9"
CAIGE G,"0"
RETSKP
IMULI B,^D10
ADDI B,-60(G)
TLNN B,-1
JRST NIN1
RET ;OVERFLOW
;NIN FOR MONTH OR DAY OF MONTH
;ERROR IF NOT IN RANGE 1 TO 31.
;RETURNS VALUE -1 IN B.
DNIN: CALL IDNIN
JRST IDILF
SOJL B,IDILF
CAIL B,^D31
JRST IDILF
RET
;NIN FOR MINUTES OR SECONDS: ERROR IF GREATER OR EQUAL TO 60
TNIN: CALL IDCHAR ;PASS PRECEDING SEPARATOR
CALL IDNIN
JRST ITILF
CAIL B,^D60
JRST ITILF
RET
;IDTNCS SUBROUTINES...
;SEPERATOR BETWEEN DATE FIELDS:
;ANY NUMBER OF SPACES, DASH OR SLASH, ANY NUMBER OF SPACES.
IDSEP: CALL GNSC
CAIE G,"-"
CAIN G,"/"
CALL IDCHAR
JRST GNSC
;GET NON-SPACE CHARACTER INTO G
GNSC: CAIE G," "
RET
CALL IDCHAR
JRST GNSC
;GET NEXT INPUT CHARACTER INTO G
IDCHAR: PUSH P,B
CALLX (MSEC1,BIN1) ;[7.1183] (A/A,B) Input to B from source in A
MOVEI B,0 ;EOF SEEN
CAIL B,141
CAILE B,172
JRST .+2
SUBI B,40 ;CONVERT LOWER CASE TO UPPER
MOVE G,B
POP P,B
RET
SUBTTL ODCNV JSYS
;ODCNV
; OUTPUT DATE AND TIME CONVERT
; BREAKS DOWN INTERNAL DATE AND TIME TO LOCAL WEEKDAY, DAY, MONTH,
; AND YEAR, BUT DOES NOT CONVERT TO TEXT.
;TAKES: 2: LEFT HALF: INTERNAL DATE
; RIGHT HALF: INTERNAL TIME
; OR ENTIRE WORD -1 FOR CURRENT DATE AND TIME
; 4: (0 FOR NORMAL CASE)
; B0: OFF, USE DAYLIGHT SAVINGS OR NOT AS APPROPRIATE FOR
; GIVEN DATE
; ON, USE DAYLIGHT SAVINGS IF AND ONLY IF B1 IS ON.
; B2: OFF, USE LOCAL TIME ZONE
; ON, USE TIME ZONE IN B12-B17
;RETURNS +1: 2: LEFT HALF: REAL YEAR (IE SINCE THE YEAR 0)
; RIGHT HALF: MONTH (0=JANUARY)
; 3: LEFT HALF: DAY OF MONTH (FIRST DAY = 0)
; RIGHT HALF: DAY OF WEEK (MONDAY = 0)
; 4: B0: ON
; B1: ON IF DAYLIGHT SAVING TIME WAS USED
; B2: ON
; B12-17: TIME ZONE USED: NUMBER OF HOURS WEST OF
; GREENWICH, EG EST = 5.
; RH: LOCAL TIME IN SECONDS SINCE MIDNITE
;ODCNV ERROR MNEMONICS (TRAP)
;DATEX6: SYSTEM HAS NO DATE AND TIME (AND -1 WAS GIVEN)
;TIMEX1: ILLEGAL TIME (GREATER THAN 24 HOURS)
;ZONEX1: ILLEGAL TIME ZONE
;INTERNAL AC USE
; B: YEAR,,MONTH
; C: SYSTEM INTERNAL TIME, THEN LOCAL TIME
; D: DAY OF YEAR
; AA: TIME STUFF FROM, THEN TO, D.
; BB: SYSTEM INTERNAL, LATER LOCAL, DATE (MUST BE A FULL WORD
; QUANTITY BECAUSE TIME ZONE CAN TAKE IT OVER 18 BITS.)
;ODCNV JSYS
.ODCNV: MCENT
MOVE AA,D ;TIME ZONE AND DAYLIGHT GARBAGE
;GET INTERNAL (GREENWICH) DATE & TIME TO CONVERT INTO BB AND C
CAME B,[-1]
JRST ODC2 ;DATE & TIME GIVEN
PUSH P,A ;SAVE DESTINATION
CALLX (MSEC1,LGTAD) ;[7.1183] (/A) Get system time and date
CAMN A,[-1]
JRST [ POP P,A
MOVEI B,DATEX6 ;SYSTEM HAS NO DATE AND TIME
JRST ODCER]
MOVE B,A
POP P,A
ODC2: HRRZ C,B ;TIME IN C
MULI C,^D<24*3600> ;CONVERT TO SECONDS/DAY
DIV C,[1B17] ;SHIFT BINARY POINT
CAIL D,400000 ;ROUND
AOS C
HLRZ BB,B ;DATE IN BB
;CHECK FOR REASONABLE ARGUMENT: ANY 18 BITS OK FOR DATE;
;[9098] Time must be .LE. 2400.
CAILE C,^D<24*3600> ;[9098] Up to and including 2400
JRST [ AOS BB ;OVERFLOWED INTO NEXT DAY
SETZ C, ;MAKE IT BE SECOND # 0
HRLZ B,BB ;OF THE NEXT DAY
JRST .+1]
;CONVERT TIME TO LOCAL STD AND ADJUST INTERNAL FORMAT DATE TO LOCAL.
;THIS MUST BE DONE FIRST BECAUSE IT CAN CHANGE YEAR
CALL CNVZON ;GET TIME ZONE AS SECONDS EARLIER THAN GMT
JRST ODCER ;BAD ZONE, GIVE ERR RET
SUB C,E ;ADJUST TIME FOR TIME ZONE
CALL FIXDT ;IF TIME NOW OUT OF RANGE 0 TO 23:59:59,
;ADD OR SUBTRACT 24 HOURS AND ADJUST DATE
;CORRESPONDINGLY.
;ODCNV...
;CONVERT SYSTEM DATE (DAY 1=18 NOV 1858) IN LH C
; TO YEAR IN LH A AND DAY OF YEAR IN D.
;ALLOW FOR LEAP YEARS, WHICH RUN IN CYCLES OF:
; 4 YEARS, EG 1961-64, LAST YEAR NORMALLY LEAP.
; "CENTURIES", EG 1801-1900, LAST YEAR NORMALLY NON-LEAP.
; "QUADRACENTURIES", EG 1501-1900, FIRST "CENTURY" THEREOF
; 1 DAY LONGER THAN OTHERS CUASE ITS LAST YEAR IS LEAP.
;NOTE: DATE IS TREATED AS 18-BIT MAGNITUDE --
; DATES BEFORE 18 NOV 1858 CANNOT BE REPRESENTED.
MOVE D,BB ;INTERNAL DATE
;SCALE SO DAY 0 IS 1/1/1501,
;THE BEGINNING OF A QUADRACENTURY.
;DERIVATION OF NUMBER ADDED:
; 365*358 YEARS 1501 TO 1859
; 89-2 LEAP YEARS IN THAT INTERVAL
; -12-31-1 DAYS 1 JAN 1859 TO 18 NOV 1858
; -1 BASE DAY IS 0 NOT 1
ADDI D,^D<365*358+89-2-12-31-1-1>
;DO THREE DIVIDES, 1 FOR EACH CYCLE,
;ACCUMULATING # YEARS IN D.
IDIVI D,^D<400*365+97> ;# DAYS / QUADRACENTURY
IMULI D,^D400 ;CONVERT # QUADRACENTURIES TO YEARS
;DAY OF QUADRACENTURY IS IN E. SCALE TO QUARTER-DAYS AND
;DIVIDE BY N+1/4 DAYS SO THAT FIRST CENTURY OF QUADRACENTURY
;GETS EXTRA DAY.
LSH E,2
IDIVI E,<^D<100*365+24>>B33+1 ;# QUARTER-DAYS / CENTURY
IMULI E,^D100 ;CONVERT # CENTURIES TO YEARS
ADD D,E ;ADD TO # YEARS FOR QUADRACENTURIES
LSH F,-2 ;SCALE BACK TO DAYS
;DAY OF CENTURY IS IN F
IDIVI F,^D365*4+1 ;# DAYS IN A 4-YEAR CYCLE
LSH F,2 ;CONVERT # 4-YEAR CYCLES TO YEARS
ADD D,F ;ADD TO YEARS SO FAR
MOVE F,G ;DAY WITHIN 4-YEAR CYCLE
IDIVI F,^D365 ;DIVIDE BY NUMBER OF DAYS IN REGULAR YEAR
CAIE F,4 ;IF WE GOT 5TH YEAR, IT IS REALLY...
IFSKP. ;[7.1183]
MOVEI G,^D365 ;[7.1183] 366th day of...
SUBI F,1 ;[7.1183] 4th (leap) year of 4-year cycle.
ENDIF. ;[7.1183]
ADD D,F ;ADD YEAR OF 4-YEAR CYCLE TO YEARS SO FAR
;ODCNV...
;EXCEPTION FOR THE LAST YEAR OF MOST CENTURIES IS HANDLED BY
;THE FACT THAT DAY 365 OF YEAR 99 CAN GET HERE ONLY FOR
;CENTURY 0 OF A QUADRACENTURY. (OTHERWISE ABOVE DIVIDE
;YIELDS DAY 0 OF NEXT CENTURY.)
;NOW HAVE CORRECT YEAR. SCALE IT TO YEARS SINCE 0AD AND RETURN IT.
ADDI D,^D1501
HRL B,D ;RETURN YEAR IN LH B
MOVE D,G ;DAY OF YEAR TO D
;FOR NON-LEAP YEARS INCREMENT DAY OF YEAR IF AFTER FEB 28
CALL NLEAP ;SKIP IF NOT LEAP YEAR (USES LH B)
JRST ODLEAP
CAIL D,^D<31+28>
ADDI D,1
;ADJUST FOR DAYLIGHT SAVING
ODLEAP: CALL ODAYL ;SKIP IF DAYL SAVINGS APPLIES (USES C,D,AA,BB)
JRST ODCSTD ;NOT DAYLIGHT SAVINGS
ADDI C,^D3600 ;ADD AN HOUR
CAIGE C,^D<24*3600> ;DID IT RUN ACCROSS MIDNITE?
JRST ODC7
ADDI D,1 ;NEXT DAY OF YEAR
ADDI BB,1 ;NEXT LOCAL DATE (USED FOR DAY OF WEEK)
SUBI C,^D<24*3600> ;24 HOURS EARLIER
TLNN AA,B3 ;SKIP IF JULIAN FORMAT
CALL NLEAP ;LEAP YEAR?
JRST ODC8 ;YES
CAIN D,^D<31+28> ;NO, DID DST MAKE IT FEB 29?
ADDI D,1 ;YES, BUMP DAY
ODC8: CAIL D,^D366 ;DID IT RUN OVER END OF YEAR?
JRST [ SETZ D, ;YES, SOME NUT IS LOOKING FOR A BUG
;OR IS IN SOUTHERN HEMISPHERE.
ADD B,[1B17] ;NEXT YEAR
JRST .+1]
;[7.1183] ODCNV...
ODC7:
ODCSTD:
;NOW DONE WITH TIME AND YEAR. YEAR ALREADY IN LH B.
HRR AA,C ;SAVE TIME FOR RETURN IN C.
;MONTH AND DAY OF MONTH
TXNN AA,IC%JUD ;[7482] If julian format ...
IFSKP. ;[7482]
HRLI C,0 ;[7482]
CALL NLEAP ;[7482] (B/) ... and not a leap year ...
IFSKP. ;[7482]
CAIL D,^D<31+28> ;[7482] ... and after FEB 28 ...
SUBI D,1 ;[7482] ... back out FEB 29
ENDIF. ;[7482]
HRRI B,1(D) ;[7482] January 1st is 1
ELSE. ;[7482]
SETZ A, ;[7482] GENERATE MONTH NUMBER IN RH A
CAML D,DAYS+1(A) ;[7482] FIND MONTH WITH MORE DAYS BEFORE IT
AOJA A,.-1 ;[7482]
SUB D,DAYS(A) ;[7482] SUBTRACT DAYS IN PRECEDING MONTH
HRR B,A ;[7482]
HRL C,D ;[7482] RETURN DAY OF MONTH
ENDIF. ;[7482]
;DAY OF WEEK
ODCJ: MOVE E,BB ;LOCAL DATE IN SYSTEM FORMAT
ADDI E,DWFUDG
IDIVI E,7
HRR C,F ;RETURN IT
;EXIT
UMOVEM B,B
UMOVEM C,C
UMOVEM AA,D
MRETNG
;ERROR RETURN, ERROR CODE MUST BE IN B
ODCER: MOVEM B,LSTERR ;SAVE ERROR CODE IN PSB
ITERX ;GENERATE ITRAP
SUBTTL IDCNV JSYS
;IDCNV
; INPUT DATE CONVERT
; TAKES LOCAL YEAR, MONTH, DAY, AND TIME (AS NUMBERS) AND
; GENERATES INTERNAL DATE AND TIME
;THIS JSYS IS A SUBSET OF IDTIM AND WILL ONLY BE USED BY THOSE WHO
;WISH TO MANIPULATE HOURS, DAY OF WEEK, ETC AS SEPERATE NUMBERS,
;OR WHO WISH TO INPUT DATE AND/OR TIME IN A FORMAT NOT ACCEPTED BY
;IDTIM, THEN CONVERT TO STANDARD INTERNAL FORMAT.
;TAKES: 2: LH: REAL YEAR
; RH: MONTH (JANUARY = 0)
; 3: LH: DAY OF MONTH
; 4: LH (0 FOR NORMAL CASE):
; B0: OFF, USE DAYLIGHT SAVING IF APPROPRIATE FOR GIVEN DATE
; ON, SEE B1
; B1: ON TO USE DAYLIGHT SAVING IF B0 ON
; B2: OFF, USE LOCAL TIME ZONE
; ON, USE TIME ZONE IN B12-17
; B12-B17: IF B2 ON, TIME ZONE TO USE, AS NUMBER OF HOURS
; WEST OF GREENWICH.*
; RH: LOCAL TIME IN SECONDS SINCE MIDNITE
;RETURNS +1: FAILURE, ERROR NUMBER IN A (SEE BELOW)
; +2: SUCCESS:
; 2: LH: INTERNAL DATE (DAYS SINCE 18 NOV 1858, GREENWICH)
; RH: INTERNAL TIME (SECONDS SINCE MIDNITE AT GREENWICH)
; 3: B0: ON
; B1: ON IF DAYLIGHT SAVINGS WAS APPLIED
; B2: ON
; B12-17: TIME ZONE USED
;IDCNV ERROR MNEMONICS:
;TIMEX1
;DATEX1: ILLEGAL YEAR (OUT OF RANGE 1858 TO 2576)
;DATEX2: MONTH TOO LARGE
;DATEX3: DAY OF MONTH TOO LARGE
;DATEX5: ILLEGAL DATE (OUT OF RANGE 17 NOV 1858 TO 7 AUG 2576 GMT)
;ZONEX1: ILLEGAL TIME ZONE
;INTERNAL AC USE
; B-C: ARGUMENTS; C: LOCAL TIME.
; D: DAY OF YEAR
; AA: ARGUMENT FROM D, THEN RESULT TO, D
; BB: LOCAL DATE
;* TIME ZONE IS NUMBER OF HOURS WEST OF GREENWICH AND CAN RANGE FROM
; -12 TO 12 (DECIMAL). THE ZONES -12 AND +12 REPRESENT THE SAME
; TIME DIFFERENCE BUT ON OPPOSITE SIDES OF THE INTERNATIONAL DATE
; LINE.
;IDCNV
.IDCNV: MCENT
MOVE AA,D ;TIME ETC FROM D IN AA THRUOUT IDCNV
;CHECK ARGUMENTS, GET DAY OF YEAR IN D
CALL CKYMDT ;CHECK YEAR, MONTH, DAY OF MONTH, TIME, AND
;COMPUTE DAY OF YEAR WHILE SO DOING.
;USES B,C,AA.
JRST IDCE ;BAD ARG, ERROR CODE IN B.
;CONVERT YEAR TO DAYS SINCE 1/1/1601 IN BB
HLRZ BB,B ;YEAR
CAIG BB,^D99 ;DOES AC2 CONTAIN FULL YEAR?
JRST [ADDI BB,^D1900 ;NO, CONVERT IT TO FULL YEAR
HRL B,BB
JRST .+1]
SUBI BB,^D1601
MOVE F,BB
IMULI BB,<^D365>B33+1 ;365 1/4 DAYS PER YEAR
LSH BB,-2
IDIVI F,^D100
SUB BB,F ;MINUS ONE DAY PER CENTURY
LSH F,-2
ADD BB,F ;BUT ADD BACK ONE DAY PER 4 CENTURIES
;COMBINE DATE, SCALE TO DAYS SINCE 11/17/1858
ADD BB,D ;ADD DAY IN YEAR TO DAYS IN PRECEDING YEARS
SUBI BB,^D<365*258+64-2-12-31-1-1>
;SCALE SO DAY 1 IS 18 NOV 1858
;THERE'S AN EXPLAINATION OF NUMBER ADDED
;IN ODCNV
;FOR DATES AFTER FEB 28 IN NON-LEAP YEARS REMOVE THE DAY ALLOWED
;IN DATE FOR FEB 29.
TLNE AA,B3 ;USER GAVE JULIAN?
JRST IDC6 ;YES - SKIP THIS
CAIL D,^D31+^D28 ;BEFORE FEB 29?
CALL NLEAP ;LEAP YEAR?
JRST IDC6 ;YES OR YES
CAIN D,^D31+^D28 ;FEB 29?
JRST [ MOVEI B,DATEX3 ;YES, "ILLEGAL DAY OF MONTH"
JRST IDCE]
SUBI BB,1 ;NOT LEAP YEAR, REMOVE FEB 29
;THE DAY FOR 2/29 IS INTENTIONALLY LEFT IN THE QUANTITY IN D,
;BECAUSE THE SUBROUTINE "IDAYL", CALLED BELOW, REQUIRES IT.
IDC6:
;IDCNV...
MOVEI C,(AA) ;TIME WITH LH 0 TO C
;ADJUST FOR DAYLIGHT SAVING IF IN EFFECT
CALL IDAYL ;SKIP IF IN EFFECT (USES C,D,AA,BB)
JRST .+2
SUBI C,^D3600 ;REAL TIME IS AN HOUR EARLIER
;DON'T BOTHER TO CORRECT UNDERFLOW YET.
;CONVERT TIME TO GREENWICH AND ADJUST DATE IF NECESSARY
CALL CNVZON ;GET TIME ZONE IN E AS SECS BEHIND GREENWICH
JRST IDCE ;BAD ZONE, GIVE ERROR RETURN
ADD C,E ;ADD TIME ZONE LAG TO TIME
CALL FIXDT ;IF TIME NOW NEGATIVE OR TOO BIG,
;FIX IT BY ADDING OR SUBTRACTING 24 HOURS AND
;ADJUSTING DATE CORRESPONDINGLY.
TLNE BB,-1 ;CHECK FOR DATE OUT OF 18-BIT RANGE
JRST [ MOVEI B,DATEX5 ;"DATE OUT OF LEGAL RANGE"
JRST IDCE]
;EXITS
MUL C,[1B17] ;SHIFT BINARY POINT
DIVI C,^D<24*3600> ;CONVERT TO FRACTION/DAY
CAIL D,^D<24*3600/2> ;ROUND
AOS C
HRL C,BB ;RETURN DATE IN LH B,
UMOVEM C,B ;TIME IN RH C.
UMOVEM AA,C ;TIME ZONE STUFF IN LH C
SMRETN ;GIVE +2 RETURN TO CALLER
;ERRORS COME HERE, ERROR CODE IN B
IDCE: CALLX (MSEC1,TSTERJ) ;[7.1183] ERJMP/ERCAL PRESENT?
UMOVEM B,A ;NO, RETURN ERROR CODE IN A
MOVE A,B ;GET ERROR CODE IN A
EMRETN() ;GIVE +1 ERROR RETURN TO CALLER
SUBTTL Subroutines
;SUBROUTINES FOR IDCNV, ODCNV, ETC
;SUBROUTINE TO CHECK VALUES GIVEN FOR YEAR, MONTH, DAY OF MONTH,
; AND TIME, FOR IDCNV AND ODTNC.
;TAKES: B: YEAR,,MONTH OR YEAR,,JULIAN-DAY
; LH C: DAY OF MONTH OR 0
; RH AA: TIME LH AA: FLAGS
;IF BAD, R1 WITH ERROR CODE IN B
;IF OK, R2 WITH DAY OF YEAR IN D (ASSUMING ITS A LEAP YEAR AT THIS
; POINT), E CLOBBERED.
CKYMDT: HLRZ E,B ;YEAR
CAIG E,^D99 ;DOES AC2 CONTAIN FULL YEAR?
JRST [ADDI E,^D1900 ;NO, CONVERT IT TO FULL YEAR
HRL B,E
JRST .+1]
CAIL E,^D1858
CAILE E,^D2576
JRST [ MOVEI B,DATEX1 ;"ILLEGAL YEAR"
RET]
TLNE AA,B3 ;JULIAN GIVEN?
JRST [ MOVEI E,^D365 ;YES, ASSUME IT'S NOT A LEAP YEAR
CALL NLEAP ;IS IT A LEAP YEAR?
MOVEI E,^D366 ;YES, FIX # OF DAYS
HRRZ D,B ;GET JULIAN DAY
CAMG D,E ;TOO BIG?
SKIPG D ; OR ZERO?
SKIPA ;YES, ERROR
SOJA D,CKMDT1 ;JULIAN DAY IS OK, MAKE RELATIVE TO 0
MOVEI B,DATEX7 ;ERROR - JULIAN DAY IS OUT OF RANGE
RET]
HRRZ E,B ;MONTH
CAIL E,^D12
JRST [ MOVEI B,DATEX2 ;"MONTH TOO LARGE"
RET]
HLRZ D,C ;DAY OF MONTH
ADD D,DAYS(E) ;ADD DAYS IN PRECEDING MONTHS (ALLOWS A DAY FOR
;FEB 29 - ADJUSTED LATER IN IDCNV FOR NON-LEAP
;YEARS)
CAML D,DAYS+1(E);RESULT MUST NOT BE GREATER THAN NUMBER OF DAYS
;IN MONTHS INCLUDING THIS ONE
JRST [ MOVEI B,DATEX3 ;"DAY OF MONTH TOO LARGE"
RET]
CKMDT1: HRRZ E,AA
CAIG E,^D<24*3600> ;[9098] Allow 2400 as a legal time
RETSKP
MOVEI B,TIMEX1 ;"ILLEGAL TIME"
RET
;TABLE OF NUMBER OF DAYS IN MONTHS PRECEDING MONTH USED AS TABLE INDEX
;USED BY IDCNV, ODCNV.
DAYS: EXP 0,^D31,^D60,^D91,^D121,^D152
EXP ^D182,^D213,^D244,^D274,^D305,^D335,^D366
;SUBROUTINE TO SKIP IF YEAR IN LH B IS NOT A LEAP YEAR
;ALL AC'S PRESERVED. USED BY IDCNV, ODCNV.
NLEAP: SAVEAC <E,F>
HLRZ E,B
CAIG E,^D99
ADDI E,^D1900
IDIVI E,^D4
JUMPN F,RSKP ;NOT DIVISIBLE BY 4, NOT LEAP YEAR
IDIVI E,^D25
JUMPN F,R ;DIVISIBLE BY 4, NOT 100, IS LEAP YEAR
IDIVI E,^D4
JUMPN F,RSKP ;DIVISIBLE BY 100, NOT 400, NOT LEAP
RET ;DIVISIBLE BY 400, IS LEAP YEAR
;SOUTA
;MONITOR TO CALLER'S ADDRESS SPACE STRING OUTPUT SUBROUTINE
;FOR ODTNCS
;B POINTS TO SOURCE STRING; LH -1 =) 440700
;CALLERS A IS DESTINATION. BOTH ARE UPDATED.
SOUTA: PUSH P,C
HLRZ C,B
CAIN C,-1
HRLI B,<POINT 7,0,-1>B53
MOVE C,B
SOUTA1: ILDB B,C
JUMPE B,[MOVE B,C
POP P,C
RET]
CALLX (MSEC1,BOUTA) ;[7.1183] (A,B/A) Output the colon
JRST SOUTA1
;[9098] Subroutine to determine whether Daylight Saving Time should be applied
;to date being output converted. It may be possible to add entries in the
;RULES macro rather than changing this routine for local variations in daylight
;savings.
;Call with B/ year,,
; C/ localized system format time
; D/ day of year (allowing a day for feb 29 always)
; AA/ what came in lh D (format flags)
; BB/ localized system format date
;Clobbers E, F, G.
;Returns+1 always, AA/ what to return in lh AC4: B1 on for daylight savings.
;This version puts DST into effect based on the tables built by the RULES macro
;and setting of DSTFLG.
;If DST is never used DSTFLG will contain .DSTNV. If DST is always used,
;DSTFLG will contain .DSTAL. If DST used according to the rules defined in the
;RULES macro, DSTFLG will be set to .DSTAU (default). Any other values in
;DSTFLG will result in a BUGCHK.
;[9098] At DSTBGN is a list of NRULES years, starting with the most recent
;year. The DSTBGN table is searched to find the year .GE. the desired year.
;The last entry is used for years older than the ones in the table. Paralell
;entries in DSTON and DSTOFF contain the first and last day to apply DST for
;that range of years. DST is applied starting at 2AM on the Sunday preceeding
;the day in DSTON. DST ends at 2AM (standard time) on the Sunday preceeding
;the day in DSTOFF.
ODAYL: SAVEAC <T1> ;Save an AC
TLOE AA,B0 ;THIS BIT ON IF CALLER SPECIFIED WHETHER OR
;NOT TO USE DAYLIGHT SAVING IN B1.
JRST ODAY9 ;CALLER SPECIFIED, GO USE CURRENT B1 VALUE.
TLZ AA,B1 ;CLEAR DAYL BIT
CALL DSTCHK ;(/T1) Get DST flag
CAIN T1,.DSTAL ;DST always in use?
JRST ODAY8 ;Yes
CAIN T1,.DSTNV ;DST never in use?
JRST ODAY9 ;Yes
CALL NLSS ;[9098] (B,C,D,AA,BB/E,F) Get DST dates this yr
JUMPL E,ODAY9 ;[9098] Jump if no DST for that year
;Check for it being the first or last day of DST but before or after 2AM.
CAMN BB,F ;Is it the last day of DST for this year?
CAIGE C,^D<2*3600> ;YES, 2AM OR AFTER STD TIME?
JRST ODAY6 ;[9098] No or no, check beginning time
RET ;YES AND YES, STD TIME APPLIES.
ODAY6: CAMN BB,E ;Is it the first day of DST for this year?
CAIL C,^D<2*3600> ;YES, BEFORE 2AM?
JRST .+2 ;No or no, just check range of dates instead
RET ;YES AND YES, STD TIME.
;At this point we would have returned if it was the first or last day of DST
;for this year and the time of day was such that standard time applied. Hence,
;if the day is now between the first and last day inclusive, daylight saving
;applies.
CAML BB,E ;Date before first day of DST?
CAMLE BB,F ; or date after last day of DST?
RET ;Yes to both, standard time applies
;Enter at ODAY8 if DST is to be used, enter at ODAY9 to use it only if user
;specified it should be used for this conversion, skip return to use DST.
ODAY8: TLO AA,B1 ;SAY USE DAYLIGHT SAVINGS
ODAY9: TLNE AA,B1 ;Should daylight savings be used
RETSKP ;SKIP IF DAYLIGHT SAVINGS SHOULD BE USED
RET ;Daylight savings should not be used
;[9098] Subroutine to skip if daylight saving time should be applied to date
;being input converted. It may be possible to add entries in the RULES macro
;rather than changing this routine for local variations in daylight savings.
;
;This routine is the same as ODAYL (preceding) except that time for switching
;back to standard time is 3AM rather than 2AM because time in hand is daylight
;if before 3am on last day of DST of the year.
;
;Call with B/ year,,
; C/ localized system format time
; D/ day of year (allowing a day for feb 29 always)
; AA/ what came in lh D (format flags)
; BB/ localized system format date Clobbers E, F, G. Returns+1 always,
;AA/ what to return in lh AC4: B1 on for daylight savings.
IDAYL: TLOE AA,B0 ;Caller wants state of B1 to be used?
JRST ODAY9 ;Yes, that was quick
TLZ AA,B1 ;Assume DST not to be used
CALL DSTCHK ;(/T1) Get DST flag
CAIN T1,.DSTAL ;DST always in use?
JRST ODAY8 ;Yes
CAIN T1,.DSTNV ;DST never in use?
JRST ODAY9 ;Yes
CALL NLSS ;[9098] (B,C,D,AA,BB/E,F) Get DST dates this yr
JUMPL E,ODAY9 ;[9098] Jump if no DST for that year
CAMN BB,F ;Is it the last day of DST?
CAIGE C,^D<3*3600> ;YES, 3AM OR AFTER?
JRST ODAY6 ;[9098] Nope, rest is same as output case
RET ;YES AND YES, STANDARD TIME APPLIES.
;[9098] Routine to compute the first and last day of DST for any year for
;routines ODAYL and IDAYL. This routine is called after it has been determined
;that one of the DST law does apply. This routine uses the tables generated by
;the RULES macro (DSTBGN, DSTOFF, DSTON) to make its calculations.
;
;Call with B/ year,,<trash>
; C/ localized system format time
; D/ day of year (allowing a day for Feb 29 always)
; AA/ what came in left half of user AC4
; BB/ localized system format date
;Smashes A
;Returns+1 with E/ first day to apply DST (or -1 to never apply)
; F/ last day to apply DST
NLSS: HLRZ E,B ;[9098] Get year specified
MOVSI F,-NRULES ;[9098] Load the index into rules table
DO. ;[9098] For each year with a ruld
CAML E,DSTBGN(F) ;[9098] Is this rule valid for this year?
EXIT. ;[9098] Yes, use it
AOBJN F,TOP. ;[9098] Try next rule
SETO E, ;[9098] Return saying that DST not wanted now
RET ;[9098] Return +1
OD. ;[9098] Now F/ index into rules tables
;[9098] NLSS...
;Get first Sunday to apply DST in E.
MOVE E,BB ;[9098] Get localized system date
SUB E,D ;[9098] less the day of year gets beg of year
ADD E,DSTON(F) ;[9098] Get last possible day for DST start
TXNE AA,IC%JUD ;[9098] Is this julian dates?
CALL NLEAP ;[9098] (B/) Yes, is it a leap year?
CAIA ;[9098] Leap year or not Julian date
SUBI E,1 ;[9098] No it cannot be Sunday, May 1st
MOVE A,DSTBGN(F) ;[9098] Load the year back
CAIE A,^D1942 ;[9098] Is it the start of war time?
IFSKP. ;[9098] Yes it is
ADDI E,DWFUDG+^D700 ;[9098] So don't adjust for Sunday
IDIVI E,7 ;[9098] for this year because
IMULI E,7 ;[9098] war time started on
SUBI E,DWFUDG+^D700 ;[9098] a Monday not Sunday
ELSE. ;[9098] Not 1942
ADDI E,DWFUDG+^D701 ;+1 TO MAKE SUNDAY, NOT MONDAY, =0.
;700 IS ARBITRARY MULTIPLE OF 7 TO MAKE SURE
;QUANTITY IS POSITIVE DURING DIVISION EVEN
;IN 1858, WHEN NLSAPR AND NLSOCT ARE NEGATIVE.
IDIVI E,7 ;DIVIDE INTO WEEKS AND DAY OF WEEKS
IMULI E,7 ;CONVERT BACK, DISCARDING DAY OF WEEK
SUBI E,DWFUDG+^D701 ;UNFUDGE AND WE'VE GOT IT!
ENDIF. ;[9098] Now E/ first day to apply DST
;Now get date of last Sunday for DST to return in F.
MOVE F,DSTOFF(F) ;[9098] Get last day for DST in this year
ADD F,BB ;[9098] then add the day number for this date
SUB F,D ;[9098] less current day to get last DST day
TXNE AA,IC%JUD ;[9098] Was a Julian day specified?
CALL NLEAP ;[9098] (B/) Is this a leap year?
CAIA ;[9098] Not Julian or Julian with leap year
SUBI F,1 ;[9098] Can't be Sunday November 1
ADDI F,DWFUDG+^D701 ;[9098] Add in multiple of 7, make Sunday 0
IDIVI F,7 ;[9098] Get week number
IMULI F,7 ;[9098] Get the "first" day number back
SUBI F,DWFUDG+^D701 ;[9098] Remove fudge factor to get that day
RET ;[9098] Return E/ first and F/ last day for DST
;TIME ZONE SUBR FOR IDCNV, ODCNV
;GETS TIME ZONE GIVEN BY CALLER, OR DEFAULTS TO LOCAL AND RETURNS
; THAT TO CALLER OF IDCNV/ODCNV.
;TAKES: AA: WHAT CAME IN LH D. UPDATES SAME.
;RETURNS TIME ZONE, CONVERTED TO MINUTES, IN E.
;SKIP EXCEPT ON ILLEGAL TIME ZONE (ERROR CODE IN B).
CNVZON: MOVE E,TIMZON ;LOCAL TIME ZONE
TLOE AA,B2 ;SKIP IF CALLER DIDN'T SPEciFY ZONE
LDB E,[POINT 6,AA,17] ;GET CALLER-SPECIFIED ZONE
DPB E,[POINT 6,AA,17] ;RETURN ZONE USED TO CALLER
TRNE E,1B30
ORCMI E,77 ;EXTEND SIGN
CAML E,[-^D12]
CAILE E,^D12
JRST [ MOVEI B,ZONEX1 ;"ILLEGAL TIME ZONE"
RET]
IMULI E,^D3600 ;CONVERT HOURS TO SECONDS
RETSKP
;SUBROUTINE TO FIX TIME AND ADJUST DATE APPROPRIATELY IF TIME IS
; NEGATIVE OR 24 HOURS OR MORE.
;CALLED IN IDCNV, ODCNV AFTER ADJUSTING FOR TIME ZONE.
;TAKES AND RETURNS: C: TIME
; BB: DATE
FIXDT: JUMPGE C,.+3 ;IS TIME NEGATIVE?
SUBI BB,1 ;YES, ITS YESTERDAY, SUBTRACT A DAY FROM DATE,
ADDI C,^D<24*3600> ;AND ADD A DAY TO TIME.
CAIGE C,^D<24*3600> ;IS TIME MIDNITE OR AFTER?
IFSKP. ;[7.1183] (midnite today is 0)
ADDI BB,1 ;[7.1183] Yes, its tomorrow, add a day to date,
SUBI C,^D<24*3600> ;[7.1183] and subtract a day from time.
ENDIF. ;[7.1183]
RET
; Subroutine to check if the value in DSTFLG is legal, and return
; its value.
;
; calling sequence:
; CALL DSTCHK
;
; returns:
; +1 always with t1 containing the method type.
DSTCHK::MOVE T1,DSTFLG ;[7.1183] Get DST flag
CAIL T1,.DSTAU ;[7.1183] Is it
CAILE T1,.DSTAL ;[7.1183] in range?
JRST [BUG.(INF,ILDSTF,DATIME,SOFT,<Illegal Daylight Saving Time flag>,<<T1,DSTFLG>>,<
Cause: Location DSTFLG contains an illegal value. The most likely case of
this bug is a new way of confusing DST that subroutine DSTCHK wasn't
informed about.
Action: If this BUGINF occurs, the Daylight Saving Time flag is reset
to zero, using the default system in the monitor. Patch DSTFLG
to a legal value in your monitor to avoid this BUGCHK.
Data: DSTFLG - Daylight savings time flag
>) ;[7.1183] No, issue a BUGINF
SETZB T1,DSTFLG ;[7.1183] use default method
RET] ;[7.1183] Continue
RET ;return
SUBTTL End of DATIME
TNXEND
END