{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: DATECON37)}}
====== DATECON37 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:JBSC|JBSC]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAME|NAME]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #OPT K0DATECON=0
22^= #LIS K0DATECON>K0ALLGEO>K0GREATGEO>K0UTILITY
2394 ... SEG DATECON,867,SECTION CENT
23DW ...
23NN ...
23YG ...
248# ...
24D6 #
24XQ # THIS SEGMENT CONTAINS CODE FOR THE DATECON,DATESET,CHADCON,
25CB # AND TIMECON MACROS
25X2 # THERE ARE THE FOLLOWING ENTRY POINTS:-
26BL SEGENTRY K1DATECON,ZEP1 [FROM DATECON MACRO
26W= SEGENTRY K2DATECON,ZEP2 [FROM CHADCON MACRO
27*W SEGENTRY K3DATECON,ZEP3 [FROM TIMESET MACRO
27TG SEGENTRY K4DATECON,ZEP4 [FROM TIMECON MACRO - NO ZERO SUPRESN
28*6 SEGENTRY K41DATECON,ZEP41 [FROM TIMECON MACRO - + ZERO SUPRESN
28JY ... SEGENTRY K52DATECON,XCS4968A [FROM ALLOWMIDN SPECIAL COMM
28NT ... SEGENTRY K60DATECON,XZT [FROM ZT SPECIAL COMMAND
28SQ #
28YM ...
294J ...
298F ...
29#B [LIST OF THE NUMBER OF DAYS IN EACH MONTH
29S2 [
2=?L PDAYS +0
2=R= NDAYS +31 [JANUARY
2?=W -1 [FEBRUARY-SPECIAL (28 OR 29)
2?QG +31 [MARCH
2#=6 +30 [APRIL
2#PQ +31 [MAY
2*9B +30 [JUNE
2*P2 +31 [JULY
2B8L +31 [AUGUST
2BN= +30 [SEPTEMBER
2C7W +31 [OCTOBER
2CMG +30 [NOVEMBER
2D76 +31 [DECEMBER
2DLQ [
2F6B [LIST OF THREE CHARACTER NAMES FOR EACH MONTH
2FL2 [
2G5L NAME 4HN JA
2GK= 4HB FE
2H4W 4HR MA
2HJG 4HR AP
2J46 4HY MA
2JHQ 4HN JU
2K3B 4HL JU
2KH2 4HG AU
2L2L 4HP SE
2LG= 4HT OC
2L^W 4HV NO
2MFG 4HC DE
2M^6 [
2N8Y ...WRONGD 4H!!!!
2NDQ TSFTF +365*4+1 [DIVISION CONSTANT FOR YEARS
2NYB YEARS +73050 [DATES <2100 ALLOWED ONLY
2PD2 TEN +10 [CONVERSION CONSTANT
2PXL P66 +66
2QC= TLM +13
2QWW XK9PERSEC +1000/K9
2RBG ONEDAY +1000/K9*60*60*24
2RW6 #
2S*Q #DEF SDAY=AWORK2
2STB #DEF SMTH=AWORK3
2T*2 #DEF SYR=AWORK4
2TSL #
2W#= # MACRO DATECON ROUTINE. CONVERTS BINARY NUMBER OF DAYS SINCE
2WRW # 31/12/1899, STORED IN ACOMMUNE7, TO A CHARACTER DATE IN FORMAT
2X?G # 'DDMMMYY' AND STORES IT IN ACOMMUNE1 & 2 OF THE CURRENT ACTIVITY
2XR6 # SPACES ARE STORED IF BINARY DATE IS ZERO, AND WE GEOERR IF IT IS
2Y=Q # > YEAR 2099. SEE GIM FOR EXPLANATION OF CALCULATION
2YQB #
2^=2 ZEP1 [DATECON ENTRY
2^PL LDX 7 ACOMMUNE7(2) [GET DATE TO BE CONVERTED
329= CALL 0 ZDATE [CONVERT IT - RESULT IN ACOM1,2
32NW UP [ AND RETURN
338G #
33N6 # MACRO CHADCON ROUTINE. CONVERTS CHARACTER DATE STORED IN 1ST CPB/C
347Q # IN 'DD/MM/YY' FORMAT TO BINARY NUMBER OF DAYS SINCE 1/1/1900. ONLY
34MB # BETWEEN 1/1/66 AND 31/12/2065 ARE CONVERTED. RESULT IS STORED IN E
3572 # THE FORMAT 'DDMMMYY' IS ALSO CONVERTED
35LL # IF ERROR EXITS WITH UP, ELSE EXITS UPPLUS 1.
366= #
36KW ZEP2 [CHADCON ENTRY
375G MHUNT 3,CPB,CUNI
37K6 NGX 6 ANUM(3)
384Q BPZ 6 PERR [ERROR IF CUNI NULL OR NON-EXISTENT
38JB LDEX 6 ANUM(3)
3942 ADN 3 APARA [X3-> ACTUAL PARAMETER
39HL CALL 7 NUMBER [CONVERT DD PART
3=3= STO 5 SDAY(2)
3=GW CALL 7 SLASH
3?2G BRN ZMMM [J IF NEXT CHAR NOT '/'
3?G6 CALL 7 NUMBER [CONVERT MM PART
3?^Q STO 5 SMTH(2)
3#FB CALL 7 SLASH
3#^2 BRN PERR [ERROR IF NEXT CHAR NOT '/'
3*DL BRN ZYR
3*Y= ZMMM CALL 7 ZMNTH [IF NOT 'DD/MM/YY' SHOULD BE 'DDMMMYY
3BCW STO 5 SMTH(2) [CONVERT MMM PART
3BXG ZYR CALL 7 NUMBER [CONVERT YY PART
3CC6 STO 5 SYR(2)
3CWQ BNZ 6 PERR [ERROR IF MORE CHARS
3DBB LDX 1 FX1
3DW2 LDX 3 SMTH(2)
3F*L BXGE 3 TLM(1),PERR [ERROR IF MONTH > 13
3FT= BZE 3 PERR [ OR = 0
3G#W LDX 0 SYR(2) [GET YEAR
3GSG ANDN 0 3
3H#6 LDN 4 28 [NORMAL FEBRUARY
3HRQ BNZ 0 NLP [J IF NOT LEAP YEAR
3J?B LDN 4 29
3JR2 NLP SMO 3 [GET NO OF DAYS IN MONTH
3K=L LDX 0 NDAYS-1(1)
3KQ= BPZ 0 ZNFB [J IF NOT FEBRUARY
3L9W LDX 0 4
3LPG ZNFB BXL 0 SDAY(2),PERR [ERROR IF NOT ENOUGH DAYS IN MONTH
3M96 LDX 5 SYR(2) [TEST YEAR < 2000
3MNQ TXL 5 P66(1)
3N8B BCC NOT2000 [YES
3NN2 ADN 5 100 [ADD 100 YEARS
3P7L NOT2000
3PM= MPY 5 TSFTF(1) [MPY YRS BY 365*4+1
3Q6W SRL 6 2 [DIVIDE BY 4
3QLG ADX 6 SDAY(2) [ADD IN DAYS THIS MONTH
3R66 LDN 0 PDAYS(1)
3RKQ SUM 7 0(3) [TOTAL DAYS IN PREVIOUS MONTHS
3S5B [ - EXCEPT FEBRUARY !
3SK2 SBN 3 3
3T4L BNG 3 NFEBI [J IF FEBRUARY ENTRY NOT INCLUDED
3TJ= ADX 7 4 [ELSE COMPENSATE FOR THE -1 THERE
3W3W ADN 7 1
3WHG NFEBI SBN 4 28 [IF LEAP YEAR,ALLOW FOR 1900 NOT BEIN
3X36 SBX 7 4 [ ONE-I.E.SUBTRACT 1 DAY
3XGQ ADX 6 7 [FORM REQUIRED TOTAL
3Y2B STO 6 EXEC1(2) [STORE RESULT
3YG2 #SKI K6DATECON>9999-9999
3Y^L TRACE 6,CHADCONR
3^F= UPPLUS 1 [OK
3^YW PERR UP [ERROR EXIT
42DG #
42Y6 # THIS PART IS ENTERED BY THE TIMECON MACRO TO CONVERT THE TIME
43CQ # SPECIFIED (IN K9'S SINCE MIDNIGHT ) TO CHARACTERS, IN THE FORMAT
43XB # 'HH.MM.SS'
44C2 #
44WL ZEP4 [TIMECON ENTRY IF ZERO SUPPRESSION NOT REQUIRED
45B= LDX 5 ACOMMUNE7(2) [GET TIME TO BE CONVERTED
45TW CALL 0 ZTIME [CONVERT IT - RESULT TO ACOM1,2
46*G UP [ AND RETURN
46T6 #
47#Q ZEP41 [TIMECON ENTRY IF ZERO SUPPRESSION REQUIRED
47SB LDX 5 ACOMMUNE7(2) [GET TIME TO BE CONVERTED
48#2 CALL 0 ZTIMEZS [CONVERT IT - RESULT TO ACOM1,2
48RL UP [ AND RETURN
49?= #
49QW # THIS PART IS ENTERED FROM THE TIMESET MACRO TO UPDATE THE FIXED CORE
4==G # CHARACTER FORM 'TIME NOW' AND 'DATE NOW' (IF NECESSARY) WORDS
4=Q6 #
4?9Q ZEP3 [TIMESET ENTRY
4?PB LDN 6 0
4#92 LDX 5 CLEANCT
4#NL BXL 5 ONEDAY(1),NOTMN [J IF NOT YET MIDNIGHT
4#PY ... CALL 7 TESTMDNT
4#R= ... BRN NOTMIN
4#SJ ... BRN NOTMIN
4#TW ...
4CND ...NOTMN
4CPQ ...
4CR4 ... STO 6 GEN4
4CW8 ...NOTMIN
4D62 LDX 5 CLEANCT
4DKL CALL 0 ZTIME [CONVERT TIME
4F5= MPY 5 XK9PERSEC(1)
4FJW STO 6 CLEANCTL [DUMP VALUE OF CLEANCT AT HH.MM.00
4G4G LDN 4 ACOMMUNE1(2)
4GJ6 LDN 5 FTIME
4H3Q MOVE 4 2 [SET HH.MM.SS IN FTIME
4HHB LDX 0 HALFTOP
4J32 ANDS 0 FTIME+1 [CHANGE IT TO HH.MM.00
4JGL LDX 7 EDATE
4K2= LDX 0 FDATE
4KFW BZE 0 ZNODA [J IF FDATE HASNT BEEN SET YET
4K^G LDX 0 GEN4
4LF6 BZE 0 ZDATEOK [J IF FDATE SET AND STILL VALID
4LYQ ZNODA CALL 0 ZDATE [ - UPDATE FIXED CORE CHARACTER DATE
4MDB LDN 4 ACOMMUNE1(2)
4MY2 LDN 5 FDATE
4NCL MOVE 4 2
4NX= ZDATEOK
4PBW LDX 7 GEN4 [X7 = IF MIDNIGHT THEN 1 ELSE 0
4PLN ...ZDATEOK1
4PWG ACROSS CHARGESC,7 [RETURN TO UNIQUE CALL OF TIMESET
4Q6K ...
4RX= ...TESTMDNT
4S7* ...
4SCD ...
4SMH ...
4SXL ... SEGENTRY K50DATECON
4T7P ... BRN NOTSPEC
4TCS ... LDX 0 XCS4968(1)
4TMX ... BZE 0 SPEC
4TY2 ... BXU 0 FDATE,NOTSPEC
4W85 ... LDCT 0 #770
4WD8 ... ANDX 0 FDATE+1
4WN? ... BXU 0 XCS4968+1(1),NOTSPEC
4WYB ...SPEC
4X8F ... JBSC NOTSPEC,,CS4968BIT
4XDJ ... STOZ GEN4
4XNM ... EXIT 7 1
4XYQ ... SEGENTRY K51DATECON
4Y8T ...XCS4968 +0
4YDY ... +0
4YP3 ...NOTSPEC
4Y^6 ... LDN 6 1
4^99 ... ADS 6 EDATE
4^F# ...
4^PC ... LDX 0 CLEANCT
4^^G ... SBX 0 ONEDAY(1)
529K ... BPZ 0 NOTSP1
52FN ... LDN 0 0
52PR ...NOTSP1
52^W ... STO 0 CLEANCT
539^ ...
53G4 ... LDX 0 JTIME
53Q7 ... SBX 0 ONEDAY(1)
542= ... BPZ 0 NOTSP2
54=* ... LDN 0 0
54GD ...NOTSP2
54QH ... STO 0 JTIME
552L ...
55=P ... STO 6 GEN4
55GS ... EXIT 7 0
55QX ...
5632 ...
56?5 ...#
56H8 ...#
56R? ...#
573B ...#
57?F ...#
57HJ ...#
57RM ...NUMBER
583Q ... BZE 6 PERR
58?T ... LDN 5 0
58HY ... LDN 0 2
58S3 ...ZNUM SBN 0 1
5946 ... BNG 0 ZNUM1
59#9 ... CDB 4 0(3)
59J# ... BCS ZNUM1
59SC ... BCHX 3 £
5=4G ... BCT 6 ZNUM
5=#K ...ZNUM1 EXIT 7 0
5=JN ...#
5=SR ...#
5?4W ...#
5?#^ ...#
5?K4 ...ZMNTH
5?T7 ... SBN 6 3
5#5= ... BNG 6 PERR
5#** ... LDN 1 0
5#KD ... LDN 5 3
5#TH ... LDX 4 ACES
5*5L ...ZMN1 LDCH 0 0(3)
5**P ... DCH 0 4(1)
5*KS ... BCHX 1 £
5*TX ... BCHX 3 £
5B62 ... BCT 5 ZMN1
5BB5 ... SRC 4 12
5BL8 ... LDN 5 12
5BW? ... LDX 1 FX1
5C6B ...ZMN2 SMO 5
5CBF ... BXE 4 NAME-1(1),(7)
5CLJ ... BCT 5 ZMN2
5CWM ... BRN PERR
5D6Q ...#
5DBT ...#
5DLY ...#
5DX3 ...#
5F76 ...SLASH
5FC9 ... BZE 6 PERR
5FM# ... LDCH 0 0(3)
5FXC ... SBN 0 #37
5G7G ... BNZ 0 (7)
5GCK ... BCHX 3 £
5GMN ... SBN 6 1
5GXR ... EXIT 7 1
5H7W ...#
5HC^ ...#
5HN4 ...#
5HY7 ...#
5J8= ...#
5KP6 ZTIMEZS [ENTRY FOR ZERO SUPPRESSION
5L8Q NGNC 7 1
5LNB ZTIME [ENTRY FOR NO ZERO SUPPRESSION
5M82 NGN 7 0
5NLW DVS 4 XK9PERSEC(1)
5NWN ...ZTIM2
5P6G STO 5 GEN2 [REMEMBER SECONDS
5P?N ... STO 0 GEN0
5PDW ... STO 7 GEN1
5PL6 CALL 3 RAGEN [CONVERT HOURS
5Q5Q +3600
5QKB LDN 4 #36 [SET STOP CHARACTER
5R52 DCH 4 ACOMMUNE1(2) [STORE FULL-STOP
5RJL BCHX 2 £
5S4= CALL 3 RAGEN [CONVERT MINUTES
5SHW +60
5T3G DCH 4 ACOMMUNE1(2) [STORE FULL-STOP
5TH6 BCHX 2 £
5W2Q LDX 7 5 [COPY SECONDS
5WGB CALL 3 SEND [STORE SECONDS
5X22 +0
5XFL LDX 2 FX2
5X^= NGX 5 5
5YDW ADX 5 GEN2 [X5=NO OF SECONDS FROM MIDNIGHT TO
5YYG [ HH.MM.00
5^D6 LDX 0 GEN1
5^XQ BPZ 0 ZTIM1 [J IF NO ZERO SUPPRESSION
62CB LDN 6 4 [ELSE SUPPRESS EG 00.00.01 TO 0.01
62X2 LDN 7 #20
63BL NXT LDCH 0 ACOMMUNE1(2)
63W= BZE 0 ZERO
64*W SBN 0 #36
64TG BNZ 0 ZTIM1 [FINISH AT FIRST CHAR NOT '0' OR '.'
65*6 ZERO DCH 7 ACOMMUNE1(2)
65SQ BCHX 2 £
66#B BCT 6 NXT
66S2 ZTIM1 LDX 2 FX2
67?L BRN (GEN0)
67R= #
68=W # HOURS/MINS CONVERSION.DUMPS CHARACTER FORM OF QUOTIENT OBTAINED WHEN
68QG # DIVIDING X5 BY WORD FOLLOWING CALL INTO ACOM1(2) & UPDATES X2
69=6 # ENTER WITH X5=NO OF SECS,X1=FX1,X2-> NEXT CHAR SPACE
69PQ # EXIT X6,X7 DESTROYED; X5,X2 UPDATED . LINK X3
6=9B #
6=P2 RAGEN STO 5 6 [COPY AMOUNT
6?8L DVS 5 0(3) [DIVIDE TO GET NEXT UNIT
6?N= STO 6 7
6#7W SEND DVS 6 TEN(1) [CONVERT TO CHARACTERS
6#MG SNOT
6*76 DCH 7 ACOMMUNE1(2)
6*LQ BCHX 2 £
6B6B DCH 6 ACOMMUNE1(2)
6BL2 BCHX 2 £
6C5L EXIT 3 1
6CK= #
6D4W #
6DJG # CONVERTS A BINARY NO OF DAYS SINCE 31DEC 1899 TO CHARS 'DDMMMYY'
6F46 # ON ENTRY X7=NO OF DAYS,X1=FX1, X2=FX2
6FHQ # ON EXIT X1=FX1,X2=FX2, ALL OTHER ACCS AND GEN0 DESTROYED . LINK X0
6G3B #
6GH2 ZDATE STO 0 GEN0 [DUMP LINK
6H2L BZE 7 ZEROD [J IF ZERO SPECIFIED AS DATE
6HG= BXGE 7 YEARS(1),UPERR [ERROR IF 0 OR > YEAR 2100
6H^W SLA 7 2 [DIVIDE BY 365*4+1 TO GET NUMBER OF
6JFG DVS 6 TSFTF(1) [ YEARS ALLOWING FOR LEAP YEARS
6J^6 SRL 6 2
6KDQ LDX 4 7 [TEST AND J IF THIS YEAR IS NOT A
6KYB ANDN 4 3 [LEAP YEAR
6LD2 LDN 5 28 [SET APPROPRIATE NO OF DAYS FOR FEB
6LXL BNZ 4 NLEAP
6MC= LDN 5 29
6MWW NLEAP LDX 0 NDAYS(1) [NO OF DAYS THIS MONTH
6NBG BPZ 0 NFEB [IF FEBRUARY,TAKE 28 OR 29
6NW6 LDX 0 5
6P*Q NFEB SBX 6 0
6PTB ADN 1 1
6Q*2 BPZ 6 NLEAP [J BACK IF NOT THIS MONTH
6QSL ADX 6 0 [ OTHERWISE GET BACK DAY OF THIS MNTH
6R#= LDX 4 NAME-1(1) [GET NAME OF MONTH
6RRW LDX 1 FX1
6S?G ADN 6 1
6SR6 DVS 5 TEN(1)
6T=Q BNZ 6 STORE [J MORE THAN 9
6TQB LDN 6 #20 [SET SPACE
6W=2 STORE
6WPL DCH 6 ACOMMUNE1(2) [STORE 1ST CHAR
6X9= BCHX 2 £
6XNW DCH 5 ACOMMUNE1(2) [STORE 2ND CHAR
6Y8G DSA 4 ACOMMUNE1(2) [STORE 1ST TWO CHARS OF MONTH
6YN6 STO 4 ACOMMUNE2(2) [STORE LAST CHAR OF MONTH
6^7Q DVS 6 TEN(1)
6^MB TXL 7 TEN(1)
7272 BCS X10 [J LESS THAN YEAR 2000
72LL SBN 7 10 [MINUS 100 YEARS
736= X10 DCH 7 ACOMMUNE2(2) [STORE 1ST CHAR
73KW BCHX 2 £
745G DCH 6 ACOMMUNE2(2) [STORE 2ND CHAR
74K6 BCHX 2 £
754Q LDN 6 #20 [SPACE FILL LAST CHARACTER
75JB DCH 6 ACOMMUNE2(2)
7642 LDX 2 FX2
76HL #SKI K6DATECON>9999-9999
773= (
77GW TRACE ACOMMUNE1(2),DATECON
782G TRACE ACOMMUNE2(2),RESULT
78G6 )
78^Q BRN (GEN0) [EXIT
79FB ZEROD LDX 0 ACES [IF ZERO DATE SPECIFIED, SET SPACES
79^2 ...XFILL STO 0 ACOMMUNE1(2) [ REPLY
7=DL STO 0 ACOMMUNE2(2)
7=Y= BRN (GEN0)
7?CW ...UPERR LDX 0 WRONGD(1)
7?XG ... BRN XFILL
7#5Q ...[ CODE FOR ALLOWMIDN SPECIAL COMMAND
7##2 ...XCS4968A
7#G= ... BS ,CS4968BIT
7#NG ... ENDCOM
7#NN ...# ENTERED HERE FOR SPECIAL COMMAND ZT TO ADJUST CLOCK TIME
7#NW ...XZT
7#P4 ... PARAPASS
7#P= ... MHUNT 3,CPB,CUNI
7#PD ... LDX 7 ANUM(3)
7#PL ... BNG 7 ZTER1 [ERROR NO PARAMETER
7#PS ... BZE 7 ZTER1
7#Q2 ... CHNUMCOD ,3
7#Q8 ... TESTREPN2 OK,ZT2 [CHNUMCOD OUTPUTS ERROR MESS
7#QB ... LDX 6 ACOMMUNE1(2)
7#QJ ... MPY 6 XK9PERSEC(1) [CONVERT TO SPRING CLEAN INTERVALS
7#QQ ... BNG 6 ZT1
7#QY ... ADS 7 JTIME [TURN CLOCK FORWARD
7#R6 ... ADS 7 CLEANCT
7#R# ... BRN ZT2
7#RG ...ZT1 [TURN CLOCK BACK
7#RN ... NGXC 7 7
7#RW ... TXL 7 CLEANCTL
7#S4 ... BCC ZTER2 [RESULT WOULD BE NEGATIVE
7#S= ... SBS 7 JTIME
7#SD ... SBS 7 CLEANCT
7#SL ... SBS 7 CLEANCTL [ENSURES FTIME WILL BE OUTPUT WHEN
7#SS ... [TURNING CLOCK BACKWARDS
7#T2 ...ZT2
7#T8 ... ENDCOM
7#TB ...ZTER1
7#TJ ... LDN 7 JPARMIS [ERROR PARAMETER MISSING
7#TQ ... BRN ZTER99
7#TY ...ZTER2
7#W6 ... LDN 7 ERB3 [ERROR RESULT WOULD BE NEGATIVE
7#W# ...ZTER99
7#WG ... COMERRX 7
7#WQ #END
^^^^ ...37335375001400000000