zOs/REXX/EXTIME
/* rexx ---------------------------------------------------------------
different time helpers
1) tod: conversion years, days, seconds ==> tod
to compare to z/architecture, chap 4->timing->time-of-day
==> tod[0..51] contains Milliseconds since 1.1.1900
without any Leapseconds (TAI time scale)
2) conversions stck/stckE <=> timestamp
stck <==> timestamp TAI10 ==> BLSUXTOD <== BLSUXTID
stckE <==> timestamp TAI10 ==> BLSUETOD <== BLSUETID
see z/OS MVS Interactive Problem Control System (IPCS) Customization
---------------------------------------------------------------------*/
call todList
exit
call timeStckE2TAI10EE x2c(left('00', 32, 'f'))
do i=4 to 20
call timeStckE2TAI10EE x2c('0'd2x(i)'0')
end
do i=0 to 20
call timeStckE2TAI10EE x2c(left(left('00D', 14, 0)d2x(i), 32, '0'))
end
call timetai102stckEEE '1966-06-12-10.00.00.0000'right(i, 2, 0)
call timetai102stckEEE '2047-06-12-10.00.00.0000'right(i, 2, 0)
do i=0 to 20
call timetai102stckEEE '2015-06-12-10.00.00.0000'right(i, 2, 0)
end
exit
todList: procedure expose m.
say ' y day secs > days seconds 64 bit tod' ,
'timestamp tai-10 by BLSUETOD'
say ' 1 3 4 6'
say ' 5 1 7 3'
call tod 0, 0, 0
call tod 0, 0, 2.5e-10
call tod 0, 0, 1e-9
call tod 0, 0, 1e-6
call tod 0, 0, 16e-6
call tod 0, 0, 1
call tod 0, 1, 0
call tod 1, 0, 0
call tod 72, 17, 0
call tod 72, 17+182, 1
call tod 73, 18, 2
call tod 109, 27, 24
call tod 112, 27+182, 25
return
tod: procedure expose m.
parse arg y, d, s
numeric digits 30
t64 = format(((y * 365 + d) * 86400 +s) * 1000000 * 4096, , 0)
stcE = right(d2c(t64), 9, '00'x) || copies('00'x, 7)
eDATE = left('', 26)
ADDRESS LINKPGM "BLSUETOD stcE EDATE"
say right(y, 3) right(d, 3) right(s, 7),
right( y * 365 + d, 6) ,
left(format((y * 365 + d) * 86400 + s, , 3, 2, 2 ), 9) ,
right(d2x(t64), 16) ,
eDate
return
timetai102stckEEE: procedure expose m.
parse arg tst
tDate = translate('56/78/yz34 hi:mn:st.abcdef', tst ,
, 'yz34-56-78-hi.mn.st.abcdef')
ACC=left('', 8, '00'x)
AEE=left('', 16, '00'x)
ADDRESS LINKPGM "BLSUXTID TDATE ACC"
ADDRESS LINKPGM "BLSUETID TDATE AEE"
say tst 'Etid' c2x(aee)
if acc \== substr(Aee, 2, 8) then
say tst 'Xtid ' c2x(acc) '||||||||'
RETURN acc
endProcedure timetai102stckE
timeStckE2TAI10EE: PROCEDURE expose m.
parse arg stcE
stcE = left(stcE, 16, '00'x)
stck = substr(stcE, 2, 8)
TDATE = left('', 26)
eDATE = left('', 26)
ADDRESS LINKPGM "BLSUXTOD stck TDATE"
ADDRESS LINKPGM "BLSUETOD stcE EDATE"
say c2x(stcE) eDate
if eDate \== tDate then
say ' 'c2x(stck)left('',14, '*')tDate
return
endProcedure timeStckE2TAI10
/* copy time begin ****************************************************
timestamp format yz34-56-78-hi.mn.st.abcdef
11.12.14 wk: added lrsn2uniq
11.05.13 wk: numeric digits transparent: in jeder Procedure drin
time2jul, tst externalisiert
**********************************************************************/
/*--- timestamp to julian --------------------------------------------*/
time2jul: procedure expose m.
parse arg yyyy '-' mm '-' dd '-'
if yyyy < 1100 then
yyyy = 11 || right(yyyy, 2, 0)
/* date function cannot convert to julian, only from julian
use b (days since start of time epoch) instead */
return right(yyyy, 2) ,
|| right(date('b', yyyy || mm || dd, 's') ,
- date('b', yyyy-1 || '1231', 's') , 3, 0)
endProcedure time2jul
/*--- timestamp expand: expand to timestamp of 26 chars -------------*/
timestampExp: procedure expose m.
parse arg tst .
if length(tst) < length(m.time_tst01) then
return overlay(tst, m.time_tst01)
else
return left(tst, length(m.time_tst01))
endProcedure tiemstampExp
/*--- timestamp check return '' if correct or error text ------------*/
timestampcheck: procedure expose m.
parse arg tst
tt = translate(tst, '000000000', '123456789')
if \(abbrev(tt,m.time_tst00)&abbrev(m.time_tst00'.000000',tt)) then
return 'bad timestamp' tst
parse arg yyyy '-' mo '-' dd '-' hh '.' mm '.' ss '.' u
if mo < 1 | mo > 12 then
return 'bad month in timestamp' tst
if dd < 1 | dd > 3 || substr('101010110101', mo, 1) then
return 'bad day in timestamp' tst
if mo = 2 then
if dd > date('d', yyyy'0301', 's') - 32 then
return 'bad day in timestamp' tst
if hh > 23 & \ abbrev(24 00 00 000000, hh mm ss u) then
return 'bad hour in timestamp' tst
if mm > 59 then
return 'bad minute in timestamp' tst
if ss > 59 then
return 'bad second in timestamp' tst
return ''
endProcedure timestampCheck
/*--- timestamp to days since 1.1.0001 ------------------------------*/
timestamp2days: procedure expose m.
parse arg yyyy '-' mo '-' dd '-' hh '.' mm '.' ss
numeric digits 15
return date('b', yyyy || mo || dd, 's') ,
+ (((hh * 60) + mm) * 60 + ss) / 86400
/*--- timestamp diff in days ----------------------------------------*/
timestampDiff: procedure expose m.
parse arg t1, t2
numeric digits 15
return timestamp2days(t1) - timestamp2Days(t2)
/*--- convert 2 digit year to 4 digit -------------------------------*/
timeYear24: procedure expose m.
parse arg s
y = left(date('S'), 4)
s4 = left(y, 2)right(s, 2, 0)
if s4 > y + 30 then
return (left(y, 2) - 1)substr(s4, 3)
else if s4 < y - 69 then
return (left(y, 2) + 1)substr(s4, 3)
else
return s4
endProcedure timeYear24
/*--- convert 2 or 4 digit year Y (A=0...T=19) ----------------------*/
timeYear2Y: procedure expose m.
parse arg y
return substr('ABCDEFGHIJKLMNOPQRST' , ((y + 10) // 20) + 1, 1)
/*--- convert 2 or 4 digit year Y (A=0...T=19) ----------------------*/
timeY2Year: procedure expose m.
parse arg i
j = pos(i, 'ABCDEFGHIJKLMNOPQRST') - 1
if j < 0 then
call err 'timeYearY24 bad input' i
y = left(date('S'), 4)
r = y - (y+10) // 20 + j
if r < y - 15 then
return r + 20
else if r > y + 4 then
return r - 20
else
return r
endProcedure timeY2Year
/*--- convert numeric month to M (Jan=B=1, dec=12=M) ----------------*/
timeMonth2M: procedure expose m.
parse arg m
return substr('BCDEFGHIJKLM', m, 1)
/*--- convert M to numeric Month (Jan=B=1, dec=12=M) ----------------*/
timeM2Month: procedure expose m.
parse arg m
p = pos(m, 'BCDEFGHIJKLM')
if p= 0 then
call err 'bad M month' m
return right(p, 2, 0)
/*--- convert numeric hour 78 to H8 (A=0..D=3) ----------------------*/
timeHour2H: procedure expose m.
parse arg h
h = right(h, 2, 0)
return substr('ABCD', left(h, 1)+1, 1)substr(h, 2)
/*--- convert H8 to numeric Hour 78 (A=0..D=3) ----------------------*/
timeH2Hour: procedure expose m.
parse arg h
p = pos(left(h, 1), 'ABCD') - 1
if p < 0 | length(h) \== 2 then
call err 'bad H hour' h
return p || substr(h, 2)
/*--- read timeZoneOffset and leapSeconds registers
and set variables for uniq ----------------------------------*/
timeIni: procedure expose m.
parse arg debug
numeric digits 25
/* offsets documented in z/OS Data Areas Vol.1 */
cvtOH = '00000010' /* cvt control block Address */
cvtext2O = x2d('00000560') /* offset to extension 2 */
cvtldtoO = x2d('00000038') /* offset to timezone */
cvtlsoO = x2d('00000050') /* offset to leapSeconds */
/* CVT CB address + extention2 */
cvtExt2A = C2D(STORAGE(cvtOH,4)) + cvtext2O
/* cvtLdto timeZone address +offset */
m.time_Zone = c2d(STORAGE(d2x(cvtext2A+cvtldtoO, 8), 8))
m.time_StckUnit = 1e-6 / 256 / 16
/* cvtLso LeapSecs address +offset */
m.time_Leap = c2d(STORAGE(d2x(cvtext2A+cvtlsoO, 8), 8))
m.time_UQDigits = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345678'
/* find lrsn of day 0, 0 out last 6 bits */
m.time_UQZero = x2d(left(timeTAI102Lrsn( ,
'2004-12-31-00.00.22.000000'), 14)) % 64 * 64
m.time_tst00 = '0000-00-00-00.00.00'
m.time_tst01 = '0001-01-01-00.00.00.000000'
m.time_tst99 = '9999-12-31-24.00.00.000000'
m.time_ini = 1
return
endSubroutine timeIni
/*--- TAi10 timestamp yyyy-mm.... -> stckE value char(16)
BLSUETID is described in z/OS MVS IPCS Customization
BLSUETID format : mo/dd/yyyy hh:mm:ss.ffffff ---------------*/
timetai102stckE: procedure expose m.
parse arg year'-'mo'-'da'-'hh'.'mm'.'secs
tDate = mo'/'da'/'year hh':'mm'.'secs
ACC=left('', 16, '00'x)
ADDRESS LINKPGM "BLSUETID TDATE ACC"
RETURN acc
endProcedure timetai102stckE
/*--- expand lrsn to 20 hexDigits -------------------------------*/
timeLrsnExp: procedure expose m.
parse arg s
return left(copies('00', length(s) <= 12 & s >>= '08')s, 20, 0)
/*--- expand stcK(e) to 16 Byte ---------------------------------*/
timeStckExp: procedure expose m.
parse arg s
return left(copies('00'x, length(s) <= 8 & s >>= '08'x)s, 16,'00'x)
/*--- TAI10 timestamp yyyy-mm.... -> stck value in hex(16) ----------*/
timeTAI102LRSN: procedure expose m.
return c2x(left(timetai102stckE(arg(1)), 10))
/*--- LZT (Locale Zurich Tst -> stck value in hex(16) ---------------*/
timeLZT2LRSN: procedure expose m.
parse arg tst
numeric digits 23
return d2x(c2d(left(timetai102stckE(tst), 9)) ,
- m.time_Zone + m.time_Leap, 18)'0000'
endProcedure timeLZT2LRSN
/*--- conversion from StckE Clock Value to TAI10 Timestamp
BLSUETOD is described in z/OS MVS IPCS Customization
input -> + leapseconds -> output ----------------------------*/
timeStckE2TAI10: PROCEDURE expose m.
parse arg stck /* must be 16 characters ||||| */
stck = left(stck, 16, '00'x)
TDATE = left('' , 26)
ADDRESS LINKPGM "BLSUETOD stck TDATE"
/* return format : mo/dd/yyyy hh:mm:ss.ffffff */
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
parse var TDATE mo '/' dd '/' yyyy hh ':' mm ':' secs
RETURN yyyy'-'mo'-'dd'-'hh'.'mm'.'secs
endProcedure timeStckE2TAI10
/*--- conversion from Lrsn Clock Value to TAI10 Timestamp ----------*/
timeLrsn2TAI10:
return timeStckE2TAI10(x2c(timeLrsnExp(arg(1)))'000000000000'x)
endProcedure timeLrsn2TAI10
/*--- conversion from Lrsn Clock Value to LZT Local Zurich Time -----*/
timeLrsn2LZT: procedure expose m.
parse arg lrsn
numeric digits 23
return timeStckE2TAI10(d2c(x2d(left(timeLrsnExp(lrsn), 18)) ,
+ m.time_Zone-m.time_Leap))
endProcedure timeLrsn2LZT
/* convert a lrsn to the uniq variable ********************************/
timeLrsn2uniq: procedure expose m.
parse arg lrsn
/* unique are bits 0:41 of the TodClock value
minus 31.12.2004 represented
by base 35 by 'ABC...YZ01..8'
*/
lrsn = left(timeLrsnExp(lrsn), 14)
numeric digits 25
diff = x2d(lrsn) - m.time_UQZero
if diff < 0 then
return'< 2005'
return right(i2q(diff % 64, m.time_UQDigits), 8, 'A')
endProcedure timeLrsn2Uniq
/* convert a uniq variable to lrsn ************************************/
timeUniq2lrsn: procedure expose m.
parse arg uniq
numeric digits 15
u1 = q2i(left(uniq, 8, 'A'), m.time_UQDigits) * 64
lrsn = '00'right(d2x(u1 + m.time_UQZero), 12, 0)'000000'
return lrsn
endProcedure uniq2lrsn
/*--- translate a number in q-system to decimal
arg digits givs the digits corresponding to 012.. in the q sysem
q = length(digits) --------------------------------------------*/
q2i: procedure expose m.
parse arg v, digits
b = length(digits)
i = 0
do x = 1 to length(v)
q = substr(v, x, 1)
r = pos(q, digits)
if r < 1 then
call err 'bad digit' q 'in' v 'valid digits' digits
i = i * b + r - 1
end
return i
endProcedure q2i
/*--- translate a decimal number to q-system - inverse of q2i --------*/
i2q: procedure expose m.
parse arg i, digits
if i = 0 then
return left(digits, 1)
b = length(digits)
v = ''
do while i > 0
v = substr(digits, 1 + (i // b), 1) || v
i = i % b
end
return v
endProcedure i2q
/* copy time end -----------------------------------------------------*/