(George Source)
Macros used: ACROSS, BS, BXE, BXGE, BXL, BXU, CHNUMCOD, COMERRX, ENDCOM, JBSC, MHUNT, NAME, PARAPASS, SEG, SEGENTRY, TRACE, UP, 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