Post by Paul RaulersonPost by Jim Dufferm, see TPU procedure CALL_USER? It's trivial to implement logical
name and symbol functions using a user written program.
<http://h71000.www7.hp.com/doc/73final/6020/6020pro_002.html#6020built1
_12>
Jim.
LOL! Whatever else TPU may be- "trivial" is definitely the wrong word.
"Easy" would not work there either --- "arcane" comes to mind. :)
Rexx and Perl and so forth can be just as arcane though.
-Paul
Arcane as opposed to say, lisp? That's what people are forced to
program in to extend emacs.
And perhaps I should have said "trivial for a programmer that can spend
20 minutes reading the manual". Having never programmed in TPU before
today, that's about how long it took me to figure out how to do this.
(Although my original statement re: trivial was referring to writing the
user routine to perform the logical name translation, the TPU code was
even simpler).
All up, 130 lines of C code (not including comments) and 27 lines of TPU
would be considered trivial for any accomplished programmer.
Conversion of the C code to your preferred language is left as an
exercise for the student.
$create log.c
$deck
#include <stdio.h>
#include <stdlib.h>
#include <ssdef.h>
#include <string.h>
#include <descrip.h>
#include <lnmdef.h>
#include <lib$routines.h>
#pragma environment save
#pragma extern_model globalvalue
extern unsigned long int tpu$_success;
#pragma environment restore
extern int decc$crtl_init (void);
static int rtl_init = 0;
/******************************************************************************/
extern int tpu$calluser (int *int_param,
struct dsc$descriptor *str_param,
struct dsc$descriptor *result_param) {
/*
** Translate, delete, or set a logical name via TPU's CALL_USER
** interface.
**
** If the int_param is zero, the logical name is deleted. If it's one,
** the logical name is set. If it's two, the logical name is translated
** and the equivalence name is returned in result_param.
**
** The str_param contains the logical name to delete or translate, or a
** logical name / equivalence name pair separated by a tilde (~).
**
** Example TPU code to call this routine would be:
**
** ! Get the physical terminal name
** result_string := CALL_USER (2, "TT");
**
** The result string can return three strings other than the equivalence
** name:
**
** SUCCESS indicates the routine deleted or set the logical correctly,
** PARAM_ERROR indicates a parameter error (you didn't set the integer
** parameter to 0, 1, or 2; you passed in a zero length
** string parameter; you passed in a string parameter that
** either did not contain a tilde when you specified "set
** logical"; or the logical or equivalence names exceeded
** 31 ot 255 characters respectively.
** ERROR indicates an unexpected error occurred.
*/
static char *success = "SUCCESS";
static char *error = "ERROR";
static char *param_error = "PARAM_ERROR";
static char *result_p;
static char *p;
static unsigned long int r0_status;
static unsigned long int flags = LNM$M_CASE_BLIND;
static int result_len;
static short int i;
static short int j;
static char log[31];
static char eqv[255];
static char seen_tilde;
static struct dsc$descriptor_s log_d = { sizeof (log),
DSC$K_DTYPE_T,
DSC$K_CLASS_S,
log };
static struct dsc$descriptor_d eqv_d = { sizeof (eqv),
DSC$K_DTYPE_T,
DSC$K_CLASS_S,
eqv };
/*
** Because we are not being called by a C main(), initialize the
** C RTL.
*/
(void)decc$crtl_init ();
rtl_init = 1;
/*
** Assume success status.
*/
result_len = strlen (success);
result_p = success;
if (str_param->dsc$w_length == 0) {
/*
** Zero length string. Parameter error.
*/
result_len = strlen (param_error);
result_p = param_error;
} else {
log_d.dsc$w_length = sizeof (log);
eqv_d.dsc$w_length = sizeof (eqv);
switch (*int_param) {
case 0:
/*
** Delete the logical name
*/
r0_status = lib$delete_logical (str_param);
if (r0_status != SS$_NORMAL) {
result_len = strlen (error);
result_p = error;
}
break;
case 1:
/*
** Set the logical name
*/
/*
** Break the string up into the logical and equiv names.
*/
seen_tilde = FALSE;
p = str_param->dsc$a_pointer;
for (i = j = 0; i < str_param->dsc$w_length; i++) {
if (p[i] == '~') {
seen_tilde = TRUE;
log_d.dsc$w_length = j;
j = 0;
continue;
} else {
if (seen_tilde) {
if (j > sizeof (eqv)) {
result_len = strlen (param_error);
result_p = param_error;
break;
} else {
eqv[j] = p[i];
}
} else {
if (j > sizeof (log)) {
result_len = strlen (param_error);
result_p = param_error;
break;
} else {
log[j] = p[i];
}
}
j++;
}
}
eqv_d.dsc$w_length = j;
if (i == str_param->dsc$w_length && seen_tilde) {
/*
** Actually set the logical.
*/
r0_status = lib$set_logical (&log_d, &eqv_d);
if (r0_status != SS$_NORMAL) {
result_len = strlen (error);
result_p = error;
}
}
if (!seen_tilde) {
result_len = strlen (param_error);
result_p = param_error;
}
break;
case 2:
/*
** Translate the logical name
*/
r0_status = lib$get_logical (str_param,
&eqv_d,
&eqv_d.dsc$w_length,
0,
0,
0,
0,
&flags);
if (r0_status != SS$_NORMAL) {
result_len = strlen (error);
result_p = error;
} else {
result_len = eqv_d.dsc$w_length;
result_p = eqv_d.dsc$a_pointer;
}
break;
default:
/*
** Parameter error
*/
result_len = strlen (param_error);
result_p = param_error;
break;
}
}
/*
** Set up the results string descriptor and copy the result to it.
*/
r0_status = lib$sget1_dd (&result_len, result_param);
if (r0_status != SS$_NORMAL) {
return r0_status;
}
(void)memcpy (result_param->dsc$a_pointer,
result_p,
result_len);
return tpu$_success;
}
$eod
$cc log
$link/share log,sys$input/opt
$deck
symbol_vector=(tpu$calluser=procedure)
$eod
$loc = f$environment ("default")
$define tpu$calluser 'loc'log.exe
$create x.x
$deck
PROCEDURE set_logical
LOCAL result,
log,
eqv;
log := READ_LINE ("Logical name to define> ", 31);
eqv := READ_LINE ("Value> ");
EDIT (log, TRIM);
EDIT (eqv, TRIM);
result := CALL_USER (1, log + "~" + eqv);
MESSAGE (result);
ENDPROCEDURE;
PROCEDURE del_logical
LOCAL result,
log;
log := READ_LINE ("logical name to delete> ", 31);
EDIT (log, TRIM);
result := CALL_USER (0, log);
MESSAGE (result);
ENDPROCEDURE;
PROCEDURE show_logical
LOCAL result,
log;
log := READ_LINE ("show logical> ", 31);
EDIT (log, TRIM);
result := CALL_USER (2, log);
MESSAGE (result);
ENDPROCEDURE;
$eod
To use, edit X.X and at the command prompt, type "extend all". To demo
the functionality, you can then type "tpu show_logical", "tpu
set_logical", or "tpu del_logical" at the command prompt.
Jim.
--
www.eight-cubed.com