From ca40fe497003abfacd4354515838e1c3b79d0ceb Mon Sep 17 00:00:00 2001 From: Charles Lane Date: Sat, 27 Oct 2001 18:28:44 -0500 Subject: [PATCH] Time::HiRes ualarm for VMS without one Message-Id: <011027232650.19ae30@DUPHY4.Physics.Drexel.Edu> p4raw-id: //depot/perl@12722 --- ext/Time/HiRes/HiRes.xs | 199 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 08fe5cc..952544e 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -324,6 +324,205 @@ hrt_ualarm(int usec, int interval) } #endif +#if !defined(HAS_UALARM) && defined(VMS) +#define HAS_UALARM +#define ualarm vms_ualarm + +#include +#include +#include +#include +#include +#include +#include + +#define VMSERR(s) (!((s)&1)) + +static void +us_to_VMS(useconds_t mseconds, unsigned long v[]) +{ + int iss; + unsigned long qq[2]; + + qq[0] = mseconds; + qq[1] = 0; + v[0] = v[1] = 0; + + iss = lib$addx(qq,qq,qq); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$addx(qq,qq,qq); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); +} + +static int +VMS_to_us(unsigned long v[]) +{ + int iss; + unsigned long div=10,quot, rem; + + iss = lib$ediv(&div,v,",&rem); + if (VMSERR(iss)) lib$signal(iss); + + return quot; +} + +typedef unsigned short word; +typedef struct _ualarm { + int function; + int repeat; + unsigned long delay[2]; + unsigned long interval[2]; + unsigned long remain[2]; +} Alarm; + + +static int alarm_ef; +static Alarm *a0, alarm_base; +#define UAL_NULL 0 +#define UAL_SET 1 +#define UAL_CLEAR 2 +#define UAL_ACTIVE 4 +static void ualarm_AST(Alarm *a); + +static int +vms_ualarm(int mseconds, int interval) +{ + Alarm *a, abase; + struct item_list3 { + word length; + word code; + void *bufaddr; + void *retlenaddr; + } ; + static struct item_list3 itmlst[2]; + static int first = 1; + unsigned long asten; + int iss, enabled; + + if (first) { + first = 0; + itmlst[0].code = JPI$_ASTEN; + itmlst[0].length = sizeof(asten); + itmlst[0].retlenaddr = NULL; + itmlst[1].code = 0; + itmlst[1].length = 0; + itmlst[1].bufaddr = NULL; + itmlst[1].retlenaddr = NULL; + + iss = lib$get_ef(&alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + a0 = &alarm_base; + a0->function = UAL_NULL; + } + itmlst[0].bufaddr = &asten; + + iss = sys$getjpiw(0,0,0,itmlst,0,0,0); + if (VMSERR(iss)) lib$signal(iss); + if (!(asten&0x08)) return -1; + + a = &abase; + if (mseconds) { + a->function = UAL_SET; + } else { + a->function = UAL_CLEAR; + } + + us_to_VMS(mseconds, a->delay); + if (interval) { + us_to_VMS(interval, a->interval); + a->repeat = 1; + } else + a->repeat = 0; + + iss = sys$clref(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$dclast(ualarm_AST,a,0); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$waitfr(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + if (a->function == UAL_ACTIVE) + return VMS_to_us(a->remain); + else + return 0; +} + + + +static void +ualarm_AST(Alarm *a) +{ + int iss; + unsigned long now[2]; + + iss = sys$gettim(now); + if (VMSERR(iss)) lib$signal(iss); + + if (a->function == UAL_SET || a->function == UAL_CLEAR) { + if (a0->function == UAL_ACTIVE) { + iss = sys$cantim(a0,PSL$C_USER); + if (VMSERR(iss)) lib$signal(iss); + + iss = lib$subx(a0->remain, now, a->remain); + if (VMSERR(iss)) lib$signal(iss); + + if (a->remain[1] & 0x80000000) + a->remain[0] = a->remain[1] = 0; + } + + if (a->function == UAL_SET) { + a->function = a0->function; + a0->function = UAL_ACTIVE; + a0->repeat = a->repeat; + if (a0->repeat) { + a0->interval[0] = a->interval[0]; + a0->interval[1] = a->interval[1]; + } + a0->delay[0] = a->delay[0]; + a0->delay[1] = a->delay[1]; + + iss = lib$subx(now, a0->delay, a0->remain); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$setimr(0,a0->delay,ualarm_AST,a0); + if (VMSERR(iss)) lib$signal(iss); + } else { + a->function = a0->function; + a0->function = UAL_NULL; + } + iss = sys$setef(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + } else if (a->function == UAL_ACTIVE) { + if (a->repeat) { + iss = lib$subx(now, a->interval, a->remain); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$setimr(0,a->interval,ualarm_AST,a); + if (VMSERR(iss)) lib$signal(iss); + } else { + a->function = UAL_NULL; + } + iss = sys$wake(0,0); + if (VMSERR(iss)) lib$signal(iss); + lib$signal(SS$_ASTFLT); + } else { + lib$signal(SS$_BADPARAM); + } +} + +#endif /* !HAS_UALARM && VMS */ + + + #ifdef HAS_GETTIMEOFDAY static int -- 2.7.4