/*
**++
** ROUTINE: sp_once
**
** FUNCTIONAL DESCRIPTION:
**
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_once(struct dsc$descriptor *cmd, struct dsc$descriptor *rcvstr,
** int *rcvlen)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: normal successful completion
** SS$_NONEXPR: subprocess doesn't exist any more
**
** SIDE EFFECTS: None.
**
**--
*/
void sp_once (void *cmd, void (*actrtn)(void *, struct dsc$descriptor *),
void *param) {
struct ONCE ctx;
int status;
struct dsc$descriptor eomcmd;
static char *eom = "MMK___SP_ONCE_EOM";
static $DESCRIPTOR(eomfao, "WRITE SYS$OUTPUT \"!AZ\"");
memset(&ctx, 0, sizeof(struct ONCE));
ctx.actrtn = actrtn;
ctx.param = param;
ctx.eom = eom;
ctx.eom_len = sizeof(eom)-1;
INIT_DYNDESC(eomcmd);
lib$sys_fao(&eomfao, 0, &eomcmd, eom);
status = sp_open(&ctx.spctx, cmd, sp_once_ast, &ctx);
if (OK(status)) {
status = sp_send(&ctx.spctx, &eomcmd);
if (OK(status)) {
do {
sys$hiber();
} while (!ctx.command_complete);
}
sp_close(&ctx.spctx);
}
str$free1_dx(&eomcmd);
} /* sp_once */
/*
**++
** ROUTINE: sp_once_ast
**
** FUNCTIONAL DESCRIPTION:
**
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_once(struct ONCE *ctx)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: normal successful completion
** SS$_NONEXPR: subprocess doesn't exist any more
**
** SIDE EFFECTS: None.
**
**--
*/
static unsigned int sp_once_ast(void *once) {
struct ONCE *ctx = once;
struct dsc$descriptor rcvstr;
INIT_DYNDESC(rcvstr);
while (OK(sp_receive(&ctx->spctx, &rcvstr, 0))) {
if (rcvstr.dsc$w_length > ctx->eom_len &&
strncmp(rcvstr.dsc$a_pointer, ctx->eom, ctx->eom_len) == 0) {
ctx->command_complete = 1;
sys$wake(0,0);
break;
}
(ctx->actrtn)(ctx->param, &rcvstr);
}
str$free1_dx(&rcvstr);
return SS$_NORMAL;
} /* sp_once_ast */
char *mylocalhost ()
{
int status;
char tmp[MAILTMPLEN];
if (!myLocalHost) { /* have local host yet? */
/* receives local host name */
struct dsc$descriptor LocalhostDesc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,NULL};
if (!((status = net_get_hostname (&LocalhostDesc)) & 0x1)) {
sprintf (tmp,"Can't get local hostname, status=%d",status);
mm_log (tmp,ERROR);
return "UNKNOWN";
}
strncpy (tmp,LocalhostDesc.dsc$a_pointer,LocalhostDesc.dsc$w_length);
tmp[LocalhostDesc.dsc$w_length] = '\0';
str$free1_dx (&LocalhostDesc);
myLocalHost = cpystr (tmp);
}
return myLocalHost;
}
const char *LP_find_file(LP_DIR_CTX **ctx, const char *directory)
{
int status;
char *p, *r;
size_t l;
unsigned long flags = 0;
/* Arrange 32-bit pointer to (copied) string storage, if needed. */
#if __INITIAL_POINTER_SIZE == 64
# pragma pointer_size save
# pragma pointer_size 32
char *ctx_filespec_32p;
# pragma pointer_size restore
char ctx_filespec_32[NAMX_MAXRSS + 1];
#endif /* __INITIAL_POINTER_SIZE == 64 */
#ifdef NAML$C_MAXRSS
flags |= LIB$M_FIL_LONG_NAMES;
#endif
if (ctx == NULL || directory == NULL) {
errno = EINVAL;
return 0;
}
errno = 0;
if (*ctx == NULL) {
size_t filespeclen = strlen(directory);
char *filespec = NULL;
if (filespeclen == 0) {
errno = ENOENT;
return 0;
}
/* MUST be a VMS directory specification! Let's estimate if it is. */
if (directory[filespeclen - 1] != ']'
&& directory[filespeclen - 1] != '>'
&& directory[filespeclen - 1] != ':') {
errno = EINVAL;
return 0;
}
filespeclen += 4; /* "*.*;" */
if (filespeclen > NAMX_MAXRSS) {
errno = ENAMETOOLONG;
return 0;
}
*ctx = malloc(sizeof(**ctx));
if (*ctx == NULL) {
errno = ENOMEM;
return 0;
}
memset(*ctx, 0, sizeof(**ctx));
strcpy((*ctx)->filespec, directory);
strcat((*ctx)->filespec, "*.*;");
/* Arrange 32-bit pointer to (copied) string storage, if needed. */
#if __INITIAL_POINTER_SIZE == 64
# define CTX_FILESPEC ctx_filespec_32p
/* Copy the file name to storage with a 32-bit pointer. */
ctx_filespec_32p = ctx_filespec_32;
strcpy(ctx_filespec_32p, (*ctx)->filespec);
#else /* __INITIAL_POINTER_SIZE == 64 */
# define CTX_FILESPEC (*ctx)->filespec
#endif /* __INITIAL_POINTER_SIZE == 64 [else] */
(*ctx)->filespec_dsc.dsc$w_length = filespeclen;
(*ctx)->filespec_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
(*ctx)->filespec_dsc.dsc$b_class = DSC$K_CLASS_S;
(*ctx)->filespec_dsc.dsc$a_pointer = CTX_FILESPEC;
}
(*ctx)->result_dsc.dsc$w_length = 0;
(*ctx)->result_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
(*ctx)->result_dsc.dsc$b_class = DSC$K_CLASS_D;
(*ctx)->result_dsc.dsc$a_pointer = 0;
status = lib$find_file(&(*ctx)->filespec_dsc, &(*ctx)->result_dsc,
&(*ctx)->VMS_context, 0, 0, 0, &flags);
if (status == RMS$_NMF) {
errno = 0;
vaxc$errno = status;
return NULL;
}
if (!$VMS_STATUS_SUCCESS(status)) {
errno = EVMSERR;
vaxc$errno = status;
return NULL;
}
/*
* Quick, cheap and dirty way to discard any device and directory, since
* we only want file names
*/
l = (*ctx)->result_dsc.dsc$w_length;
p = (*ctx)->result_dsc.dsc$a_pointer;
r = p;
for (; *p; p++) {
if (*p == '^' && p[1] != '\0') { /* Take care of ODS-5 escapes */
p++;
} else if (*p == ':' || *p == '>' || *p == ']') {
l -= p + 1 - r;
r = p + 1;
} else if (*p == ';') {
l = p - r;
break;
}
}
strncpy((*ctx)->result, r, l);
(*ctx)->result[l] = '\0';
str$free1_dx(&(*ctx)->result_dsc);
return (*ctx)->result;
}
/*
**++
** ROUTINE: sp_open
**
** FUNCTIONAL DESCRIPTION:
**
** Spawns a subprocess, possibly passing it an initial command.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_open(SPHANDLE *ctxpp, struct dsc$descriptor *inicmd,
** unsigned int (*rcvast)(void *), void *rcvastprm);
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: Normal successful completion.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int sp_open (SPHANDLE *ctxpp, void *inicmd, unsigned int (*rcvast)(void *), void *rcvastprm) {
SPHANDLE ctx;
unsigned int dvi_devnam = DVI$_DEVNAM, dvi_devbufsiz = DVI$_DEVBUFSIZ;
unsigned int spawn_flags = CLI$M_NOWAIT|CLI$M_NOKEYPAD;
unsigned int status;
struct dsc$descriptor inbox, outbox;
status = lib$get_vm(&spb_size, &ctx);
if (!OK(status)) return status;
/*
** Assign the SPHANDLE address for the caller immediately to avoid timing issues with
** WRTATTN AST that passes the ctx as rcvastprm (which sp_once does).
*/
*ctxpp = ctx;
ctx->sendque.head = ctx->sendque.tail = &ctx->sendque;
ctx->ok_to_send = 0;
/*
** Create the mailboxes we'll be using for I/O with the subprocess
*/
status = sys$crembx(0, &ctx->inchn, 1024, 1024, 0xff00, 0, 0, 0);
if (!OK(status)) {
lib$free_vm(&spb_size, &ctx);
return status;
}
status = sys$crembx(0, &ctx->outchn, 1024, 1024, 0xff00, 0, 0, 0);
if (!OK(status)) {
sys$dassgn(ctx->inchn);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Now that they're created, let's find out what they're called so we
** can tell LIB$SPAWN
*/
INIT_DYNDESC(inbox);
INIT_DYNDESC(outbox);
lib$getdvi(&dvi_devnam, &ctx->inchn, 0, 0, &inbox);
lib$getdvi(&dvi_devnam, &ctx->outchn, 0, 0, &outbox);
lib$getdvi(&dvi_devbufsiz, &ctx->outchn, 0, &ctx->bufsiz);
/*
** Create the output buffer for the subprocess.
*/
status = lib$get_vm(&ctx->bufsiz, &ctx->bufptr);
if (!OK(status)) {
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Set the "receive AST" routine to be invoked by SP_WRTATTN_AST
*/
ctx->rcvast = rcvast;
ctx->astprm = rcvastprm;
sys$qiow(0, ctx->outchn, IO$_SETMODE|IO$M_WRTATTN, 0, 0, 0,
sp_wrtattn_ast, ctx, 0, 0, 0, 0);
sys$qiow(0, ctx->inchn, IO$_SETMODE|IO$M_READATTN, 0, 0, 0,
sp_readattn_ast, ctx, 0, 0, 0, 0);
/*
** Get us a termination event flag
*/
status = lib$get_ef(&ctx->termefn);
if (OK(status)) lib$get_ef(&ctx->inefn);
if (OK(status)) lib$get_ef(&ctx->outefn);
if (!OK(status)) {
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Now create the subprocess
*/
status = lib$spawn(inicmd, &inbox, &outbox, &spawn_flags, 0, &ctx->pid,
0, &ctx->termefn);
if (!OK(status)) {
lib$free_ef(&ctx->termefn);
lib$free_ef(&ctx->outefn);
lib$free_ef(&ctx->inefn);
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Set up the exit handler, if we haven't done so already
*/
status = sys$setast(0);
if (!exh_declared) {
sys$dclexh(&exhblk);
exh_declared = 1;
}
if (status == SS$_WASSET) sys$setast(1);
/*
** Save the SPB in our private queue
*/
queue_insert(ctx, spque.tail);
/*
** Clean up and return
*/
str$free1_dx(&inbox);
str$free1_dx(&outbox);
return SS$_NORMAL;
} /* sp_open */
unsigned long str$mul (const unsigned long *asign,
const long *aexp,
const struct dsc$descriptor_s *adigits,
const unsigned long *bsign,
const long *bexp,
const struct dsc$descriptor_s *bdigits,
unsigned long *csign,
long *cexp,
struct dsc$descriptor_s *cdigits)
{
unsigned short s1_len, s2_len, s3_len, temp_len;
char *s1_ptr, *s2_ptr, *s3_ptr;
unsigned long index, max_len, min_len;
int i,j,k;
unsigned long status;
int sum,carry;
char *a,*b,*c;
status = STR$_NORMAL;
index = 0;
a = (char *) calloc(MAXSTR,1);
b = (char *) calloc(MAXSTR,1);
c = (char *) calloc(MAXSTR,1);
if ( a == NULL )
{
status = STR$_INSVIRMEM;
}
if ( b == NULL )
{
status = STR$_INSVIRMEM;
}
if ( c == NULL )
{
status = STR$_INSVIRMEM;
}
// Check the sign field is 1 or 0
if ( *asign == 1 || *asign == 0 )
;
else
status = LIB$_INVARG;
if ( *bsign == 1 || *bsign == 0)
;
else
status = LIB$_INVARG;
if (( *asign == 0 ) && ( *bsign == 0 )) *csign = 0;
if (( *asign == 0 ) && ( *bsign == 1 )) *csign = 1;
if (( *asign == 1 ) && ( *bsign == 0 )) *csign = 1;
if (( *asign == 1 ) && ( *bsign == 1 )) *csign = 0;
// Get the length of the input strings and how much room for the output
str$analyze_sdesc (adigits, &s1_len, &s1_ptr);
str$analyze_sdesc (bdigits, &s2_len, &s2_ptr);
str$analyze_sdesc (cdigits, &s3_len, &s3_ptr);
strcpy (s3_ptr,"0");
// Quick abort
if (status != STR$_NORMAL)
{
return status;
}
// zero out the accumulator
for (i=0; i < MAXSTR; i++ )
{
a[i] = '0';
b[i] = '0';
c[i] = 0;
}
// Move in the largest number - we need to keep the alignment correct
// char string is "right to left" alignment
// start at location specified by the exponent
max_len = ( s1_len > s2_len ) ? s1_len : s2_len;
min_len = ( s1_len > s2_len) ? s2_len : s1_len;
// Copy input strings to working storage
for (i = 0; i < s1_len; i++ )
{
a[i] = s1_ptr[i];
}
for (i = 0; i < s2_len; i++ )
{
b[i] = s2_ptr[i];
}
// Set the output exponent
*cexp = *aexp + *bexp;
max_len = s1_len + s2_len;
sum = 0;
carry = 0;
k = max_len;
for (j = s2_len; j > 0; j--)
{
k = max_len - s2_len + j;
for ( i = s1_len; i > 0; i-- )
{
sum = ( b[j-1] - '0' ) * ( a[i-1] - '0');
sum += carry;
carry = 0;
c[k] += sum % 10;
if (c[k] > 9 )
{
c[k] -= 10;
c[k-1] += 1;
}
sum -= sum % 10;
carry = sum / 10;
sum = 0;
k--;
}
}
c[k] = carry;
// Truncate output sum string to 65536 MAXUINT16
if ( max_len > MAXUINT16 )
{
status = STR$_TRU;
max_len = MAXUINT16;
}
// Free any memory that is passed into us.
str$free1_dx (cdigits);
temp_len = (unsigned short) max_len + 1;
str$get1_dx(&temp_len, cdigits);
str$analyze_sdesc (cdigits,&s3_len, &s3_ptr);
for (i = 0; i <= max_len; i++)
{
s3_ptr[i] = (c[i] + '0');
}
free (a);
free (b);
free (c);
str$$lzerotrim (cdigits);
str$$rzerotrim (cdigits,cexp);
str$$iszerotrim(cdigits,cexp);
return status;
}
unsigned long str$find_first_substring (const struct dsc$descriptor_s *s1,
long *index, long *subindex,
struct dsc$descriptor_s *sub, ...)
{
int i, status, result;
long j;
char *s1_ptr,*s2_ptr;
struct dsc$descriptor_s *sd_ptr, temp_sd, temp2_sd;
unsigned short s1_len, s2_len,temp_len;
va_list ap;
*index = 0;
sd_ptr = 0;
*subindex = 0;
str$analyze_sdesc (s1,&s1_len,&s1_ptr);
str$analyze_sdesc (sub,&s2_len,&s2_ptr);
va_start(ap,sub); // make ap point to first unnamed arg
sd_ptr = sub;
do
{
++*subindex;
str$analyze_sdesc (sd_ptr,&s2_len,&s2_ptr);
if ( (s1_len >= s2_len ) && (s2_len != 0 ))
{
for (i = 1; i < (s1_len - s2_len + 2); i++ )
{
j = i;
temp_len = s2_len;
temp_sd.dsc$w_length = 0;
temp_sd.dsc$b_class = DSC$K_CLASS_D;
temp_sd.dsc$b_dtype = DSC$K_DTYPE_D;
temp_sd.dsc$a_pointer = NULL;
temp2_sd.dsc$w_length = 0;
temp2_sd.dsc$b_class = DSC$K_CLASS_D;
temp2_sd.dsc$b_dtype = DSC$K_DTYPE_D;
temp2_sd.dsc$a_pointer = NULL;
str$get1_dx (&temp_len,&temp_sd);
str$get1_dx (&temp_len,&temp2_sd);
str$right (&temp_sd,s1,&j);
j = s2_len;
str$left(&temp2_sd,&temp_sd,&j);
result = str$compare(&temp2_sd,sd_ptr);
str$free1_dx (&temp_sd);
str$free1_dx (&temp2_sd);
if (result == 0)
{
*index = i;
i = s1_len - s2_len + 2;
va_end(ap);
return 1;
}
}
}
else
{
status = 0;
}
sd_ptr = va_arg(ap,struct dsc$descriptor_s *);
}
while ( sd_ptr != NULL );
va_end(ap); // clean up argument pointer
*subindex = 0; // not found set back to zero
return 0;
}
static unsigned long
get_time (struct dsc$descriptor_s *qual, char *timearg)
{
/*
** Routine: get_time
**
** Function: This routine reads the argument string of the qualifier
** "qual" that should be a VMS syntax date-time string. The
** date-time string is converted into the standard format
** "mmddyyyy", specifying an absolute date. The converted
** string is written into the 9 bytes wide buffer "timearg".
**
** Formal parameters:
**
** qual - Address of descriptor for the qualifier name
** timearg - Address of a buffer carrying the 8-char time string returned
**
*/
register unsigned long status;
struct dsc$descriptor_d time_str;
struct quadword {
long high;
long low;
} bintimbuf = {0,0};
#ifdef __DECC
#pragma member_alignment save
#pragma nomember_alignment
#endif /* __DECC */
struct tim {
short year;
short month;
short day;
short hour;
short minute;
short second;
short hundred;
} numtimbuf;
#ifdef __DECC
#pragma member_alignment restore
#endif
init_dyndesc(time_str);
status = cli$get_value(qual, &time_str);
/*
** If a date is given, convert it to 64-bit binary.
*/
if (time_str.dsc$w_length) {
status = sys$bintim(&time_str, &bintimbuf);
if (!(status & 1)) return (status);
str$free1_dx(&time_str);
}
/*
** Now call $NUMTIM to get the month, day, and year.
*/
status = sys$numtim(&numtimbuf, (bintimbuf.low ? &bintimbuf : NULL));
/*
** Write the "mmddyyyy" string to the return buffer.
*/
if (!(status & 1)) {
*timearg = '\0';
} else {
sprintf(timearg, "%02d%02d%04d", numtimbuf.month,
numtimbuf.day, numtimbuf.year);
}
return (status);
}
const char *LP_find_file(LP_DIR_CTX **ctx, const char *directory)
{
int status;
char *p, *r;
size_t l;
unsigned long flags = 0;
#ifdef NAML$C_MAXRSS
flags |= LIB$M_FIL_LONG_NAMES;
#endif
if (ctx == NULL || directory == NULL)
{
errno = EINVAL;
return 0;
}
errno = 0;
if (*ctx == NULL)
{
size_t filespeclen = TINYCLR_SSL_STRLEN(directory);
char *filespec = NULL;
/* MUST be a VMS directory specification! Let's estimate if it is. */
if (directory[filespeclen-1] != ']'
&& directory[filespeclen-1] != '>'
&& directory[filespeclen-1] != ':')
{
errno = EINVAL;
return 0;
}
filespeclen += 4; /* "*.*;" */
if (filespeclen >
#ifdef NAML$C_MAXRSS
NAML$C_MAXRSS
#else
255
#endif
)
{
errno = ENAMETOOLONG;
return 0;
}
*ctx = (LP_DIR_CTX *)OPENSSL_malloc(sizeof(LP_DIR_CTX));
if (*ctx == NULL)
{
errno = ENOMEM;
return 0;
}
TINYCLR_SSL_MEMSET(*ctx, '\0', sizeof(LP_DIR_CTX));
TINYCLR_SSL_STRCPY((*ctx)->filespec,directory);
TINYCLR_SSL_STRCAT((*ctx)->filespec,"*.*;");
(*ctx)->filespec_dsc.dsc$w_length = filespeclen;
(*ctx)->filespec_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
(*ctx)->filespec_dsc.dsc$b_class = DSC$K_CLASS_S;
(*ctx)->filespec_dsc.dsc$a_pointer = (*ctx)->filespec;
(*ctx)->result_dsc.dsc$w_length = 0;
(*ctx)->result_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
(*ctx)->result_dsc.dsc$b_class = DSC$K_CLASS_D;
(*ctx)->result_dsc.dsc$a_pointer = 0;
}
(*ctx)->result_dsc.dsc$w_length = 0;
(*ctx)->result_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
(*ctx)->result_dsc.dsc$b_class = DSC$K_CLASS_D;
(*ctx)->result_dsc.dsc$a_pointer = 0;
status = lib$find_file(&(*ctx)->filespec_dsc, &(*ctx)->result_dsc,
&(*ctx)->VMS_context, 0, 0, 0, &flags);
if (status == RMS$_NMF)
{
errno = 0;
vaxc$errno = status;
return NULL;
}
if(!$VMS_STATUS_SUCCESS(status))
{
errno = EVMSERR;
vaxc$errno = status;
return NULL;
}
/* Quick, cheap and dirty way to discard any device and directory,
since we only want file names */
l = (*ctx)->result_dsc.dsc$w_length;
p = (*ctx)->result_dsc.dsc$a_pointer;
r = p;
for (; *p; p++)
{
if (*p == '^' && p[1] != '\0') /* Take care of ODS-5 escapes */
{
p++;
}
else if (*p == ':' || *p == '>' || *p == ']')
{
l -= p + 1 - r;
r = p + 1;
}
else if (*p == ';')
{
l = p - r;
break;
}
}
TINYCLR_SSL_STRNCPY((*ctx)->result, r, l);
(*ctx)->result[l] = '\0';
str$free1_dx(&(*ctx)->result_dsc);
return (*ctx)->result;
}
unsigned long str$add ( const unsigned long *asign,
const long *aexp,
const struct dsc$descriptor_s *adigits,
const unsigned long *bsign,
const long *bexp,
const struct dsc$descriptor_s *bdigits,
unsigned long *csign,
long *cexp,
struct dsc$descriptor_s *cdigits)
{
unsigned short s1_len, s2_len, s3_len, temp_len;
char *s1_ptr, *s2_ptr, *s3_ptr;
unsigned long index,max_len,min_len;
int i,j,k;
unsigned long status;
signed long min_exp,max_exp, a_size, b_size, max_size, min_size;
char ctemp;
int sum,carry;
char *a,*b,*c;
status = STR$_NORMAL;
index = 0;
a = (char *) calloc(MAXSTR,1);
b = (char *) calloc(MAXSTR,1);
c = (char *) calloc(MAXSTR,1);
if ( a == NULL )
{
status = STR$_INSVIRMEM;
}
if ( b == NULL )
{
status = STR$_INSVIRMEM;
}
if ( c == NULL )
{
status = STR$_INSVIRMEM;
}
// Check the sign field is 1 or 0
if ( *asign == 1 || *asign == 0 )
;
else
status = LIB$_INVARG;
if ( *bsign == 1 || *bsign == 0)
;
else
status = LIB$_INVARG;
// If we have a negative sign then call str$subtract
// c = -a + b
if (( *asign == 1 ) && (*bsign == 0 ))
{
status = str$sub(asign,aexp,adigits,bsign,bexp,bdigits,csign,cexp,cdigits);
return status;
}
// c = a - b
if (( *asign == 0 ) && (*bsign == 1 ))
{
status = str$sub(asign,aexp,adigits,bsign,bexp,bdigits,csign,cexp,cdigits);
return status;
}
// c = -a + -b
*csign = 0;
if (( *asign == 1 ) && ( *bsign == 1))
{
*csign = 1;
}
// Get the length of the input strings and how much room for the output
str$analyze_sdesc (adigits, &s1_len, &s1_ptr);
str$analyze_sdesc (bdigits, &s2_len, &s2_ptr);
str$analyze_sdesc (cdigits, &s3_len, &s3_ptr);
if ( s3_ptr != NULL )
{
str$free1_dx (cdigits);
printf ("Destination must be NULL\n");
return STR$_FATINTERR;
}
// Quick abort
if (status != STR$_NORMAL)
{
return status;
}
// Move in the largest number - we need to keep the alignment correct
// char string is "right to left" alignment
// start at location specified by the exponent
max_exp = ( *aexp > *bexp ) ? *aexp : *bexp; // get largest exp
min_exp = ( *aexp > *bexp ) ? *bexp : *aexp;
max_len = ( s1_len > s2_len ) ? s1_len : s2_len;
min_len = ( s1_len > s2_len) ? s2_len : s1_len;
a_size = ( *aexp + s1_len );
b_size = ( *bexp + s2_len );
max_size= ( a_size > b_size ) ? a_size : b_size;
min_size= ( a_size > b_size ) ? b_size : a_size;
// The strings don't overlap just return the largest
if ( max_size - min_size > UINT16_MAX )
{
//Don't Overlap returning largest
if ( *aexp > *bexp )
{
*cexp = *aexp;
str$copy_dx (cdigits,adigits);
}
else
{
*cexp = *bexp;
str$copy_dx(cdigits,bdigits);
}
return STR$_TRU;
}
// Copy input strings to working storage
for (i = 0; i < s1_len; i++ )
{
a[i] = s1_ptr[i];
}
for (j = 0; j < s2_len; j++ )
{
b[j] = s2_ptr[j];
}
// Set the output exponent
*cexp = min_exp;
// Add zero's to the end of the number for remaining exponent
if ( *aexp > *bexp )
{
for ( i = s1_len; i < s1_len + max_exp - min_exp; i++)
a[i] = '0';
s1_len += max_exp - min_exp;
}
if ( *aexp < *bexp )
{
for ( i = s2_len; i < s2_len + max_exp - min_exp; i++)
b[i] = '0';
s2_len += max_exp - min_exp;
}
sum = 0;
carry = 0;
ctemp = '0';
i = s1_len;
j = s2_len;
// New max string length
max_len = ( s1_len > s2_len ) ? s1_len : s2_len ;
for (k =(int) max_len; k > 0; k-- )
{
if ( i > 0 )
{
sum += a[i-1] - '0';
}
if ( j > 0 )
{
sum += b[j-1] - '0';
}
sum += carry;
carry = 0;
if ( sum > 9 )
{
carry = 1;
sum -= 10;
}
ctemp = sum + '0';
sum = 0;
c[k-1] = ctemp;
i--;
j--;
}
if ( carry == 1 )
{
for (i = max_len-1; i >= 0; i-- )
{
c[i+1] = c[i];
}
c[0] = (char) (carry + '0');
max_len++;
}
// Truncate output sum string to 65536 MAXUINT16
if ( max_len > MAXUINT16 )
{
status = STR$_TRU;
max_len = MAXUINT16;
}
// Free any memory that is passed into us.
temp_len = max_len;
str$free1_dx(cdigits);
str$get1_dx(&temp_len,cdigits);
str$analyze_sdesc (cdigits,&s3_len,&s3_ptr);
for (i = 0; i < max_len; i++)
{
s3_ptr[i] = c[i];
}
free (a);
free (b);
free (c);
str$$lzerotrim (&*cdigits);
str$$rzerotrim (&*cdigits,&*cexp);
str$$iszerotrim (&*cdigits,&*cexp);
return status;
}
