/*************************************************************
* str$find_first_in_set
*
* This function searches a string, one character at a time, from
* the left to right, comparing each character in the string to
* every character in a specified set of characters for which it
* is searching.
*
* Returns:
* 0 if no match found, otherwise returns the position
* in the source string where the first match is found.
*
*/
long str$find_first_in_set(
const struct dsc$descriptor_s* first_source_string,
const struct dsc$descriptor_s* second_source_string)
{
char* s1_ptr; /* Pointer to first string */
unsigned short s1_length; /* Length of first string */
char* s2_ptr; /* Pointer to second string */
unsigned short s2_length; /* Length of second string */
int loop1; /* Outer loop */
int loop2; /* Inner loop */
/*
* Analyze source strings
*/
str$analyze_sdesc(first_source_string, &s1_length, &s1_ptr);
str$analyze_sdesc(second_source_string, &s2_length, &s2_ptr);
/*
* Quick exit when goofy stuff passed
*/
if ((s1_length == 0) || (s2_length == 0))
{
return 0;
}
/*
* I'm going to do it using a double loop. If the strings
* passed are long, then it might be better to create an
* aray[256] of matching characters and we could then loose
* the inner loop.
*
* The tradeoff comes in initializing the test table vs
* using an inner loop.
*/
/*
* Outer loop
*/
for (loop1 = 0; loop1 < s1_length; loop1++)
{
/*
* Inner loop
*/
for (loop2 = 0; loop2 < s2_length; loop2++)
{
/*
* Compare the characters
*/
if (s1_ptr[loop1] == s2_ptr[loop2])
{
return loop1 + 1;
}
}
}
/*
* If we get here, we don't have a match
*/
return 0;
}
int str$$ncompare ( struct dsc$descriptor_s *sd1,
struct dsc$descriptor_s *sd2)
{
unsigned short s1_len, s2_len;
char *s1_ptr, *s2_ptr;
int min_len, max_len, i;
str$$lzerotrim (sd1);
str$$lzerotrim (sd2);
str$analyze_sdesc (&*sd1,&s1_len, &s1_ptr);
str$analyze_sdesc (&*sd2,&s2_len, &s2_ptr);
min_len = ( s1_len < s2_len) ? s1_len : s2_len;
max_len = ( s1_len > s2_len) ? s1_len : s2_len;
if ( s1_len > s2_len )
return 1;
if ( s1_len < s2_len )
return -1;
// The string are of equal length
for (i = 0; i < max_len; i++)
{ if ( s1_ptr[i] > s2_ptr[i] )
return 1;
if ( s1_ptr[i] < s2_ptr[i] )
return -1;
}
return 0;
}
// LIB$COMPARE_NODENAME
unsigned long lib$compare_nodename (const struct dsc$descriptor_s *nodename1,
const struct dsc$descriptor_s *nodename2,
unsigned long *result)
{
unsigned short name1_len, name2_len, expandlen;
unsigned long result_code;
char *name1_ptr, *name2_ptr;
struct dsc$descriptor_s node1, node2;
str$analyze_sdesc (nodename1,&name1_len, &name1_ptr);
if ( name1_len > 1024 )
return LIB$_INVSTRDES;
if ( not_valid_node_name (nodename1) )
return LIB$_INVARG;
str$analyze_sdesc (nodename2,&name2_len, &name2_ptr);
if ( name2_len > 1024 )
return LIB$_INVSTRDES;
if ( not_valid_node_name (nodename2) )
return LIB$_INVARG;
lib$expand_nodename (nodename1, &node1, &expandlen);
lib$expand_nodename (nodename2, &node2, &expandlen);
*result = (unsigned long) str$compare (&node1, &node2 );
return result_code;
}
void str$$print_sd (const struct dsc$descriptor_s *sd1 )
{
unsigned short s1_len;
char *s1_ptr;
int i, qmark;
qmark = '?';
str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
if ( s1_len >= 65500 )
{ printf ("%.20s ... %20s",s1_ptr,&s1_ptr[s1_len-20]);
return;
}
if ( ( s1_len == 0) && ( s1_ptr == NULL ))
{ printf ("null");
return;
}
for (i = 0; i < s1_len; i++ )
{
if (isprint (s1_ptr[i]) )
putchar (s1_ptr[i]);
else if ( s1_ptr[i] == '\t' )
putchar ('\t');
else
putchar (qmark);
}
return;
}
int str$$lzerotrim (struct dsc$descriptor_s *sd1)
{
int i,j,count;
char *s1_ptr;
unsigned short s1_len;
str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
i = 0;
while ( (s1_ptr[i] == '0') && ( i < s1_len-1 ) ) // while leading zero
{
if (s1_ptr[i] == '0' ) // have leading zero
{
for (j = i; j < s1_len; j++) // shuffle string
{
s1_ptr[j] = s1_ptr[j+1];
}
i=0;
s1_len--;
count--;
}
else
{
i++;
}
}
// Resize descriptor if needed
str$get1_dx (&s1_len, &*sd1);
return count;
}
/*************************************************************
* str$trim
*
*/
unsigned long str$trim(struct dsc$descriptor_s* destination_string,
const struct dsc$descriptor_s* source_string,
unsigned short* resultant_length)
{
char* s2_ptr; /* Pointer to string */
unsigned short s2_length; /* Length of string */
unsigned long result; /* Result */
/*
* Look at the original string
*/
str$analyze_sdesc(source_string, &s2_length, &s2_ptr);
/*
* Determine the end of the string
*/
while ((s2_length > 0) &&
((s2_ptr[s2_length-1] == ' ') || (s2_ptr[s2_length-1] == '\t')))
{
s2_length--;
}
/*
* Now, copy that much to the destination
*/
result = str$copy_r(destination_string, &s2_length, s2_ptr);
*resultant_length = s2_length;
/*
* Done
*/
return result;
}
/*
**++
** ROUTINE: netlib_write
**
** FUNCTIONAL DESCRIPTION:
**
** tbs
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** tbs
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
**
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib_write (struct CTX **xctx, struct dsc$descriptor *dsc,
struct SINDEF *sa, unsigned int *salen,
struct NETLIBIOSBDEF *iosb,
void (*astadr)(), void *astprm) {
struct CTX *ctx;
void *bufptr;
unsigned int status;
unsigned short buflen;
ITMLST2 sname, *snaddr;
int argc;
VERIFY_CTX(xctx, ctx);
SETARGCOUNT(argc);
status = lib$analyze_sdesc(dsc, &buflen, &bufptr);
if (!OK(status)) return status;
if (argc > 3 && salen != 0) {
ITMLST2_INIT(sname, 0, *salen, sa);
snaddr = &sname;
} else snaddr = 0;
if (argc > 5 && astadr != 0) {
struct IOR *ior;
GET_IOR(ior, ctx, iosb, astadr, (argc > 6) ? astprm : 0);
if (buflen == 0) {
ior->iosb.iosb_w_status = SS$_NORMAL;
ior->iosb.iosb_w_count = 0;
ior->iosb.iosb_l_unused = 0;
status = sys$dclast(io_completion, ior, 0);
} else {
status = sys$qio(netlib_asynch_efn, ctx->chan, IO$_WRITEVBLK,
&ior->iosb,
io_completion, ior, bufptr, buflen, snaddr,
0, 0, 0);
if (!OK(status)) FREE_IOR(ior);
}
} else {
struct NETLIBIOSBDEF myiosb;
if (buflen == 0) {
status = myiosb.iosb_w_status = SS$_NORMAL;
myiosb.iosb_w_count = 0;
myiosb.iosb_l_unused = 0;
} else {
status = sys$qiow(netlib_synch_efn, ctx->chan, IO$_WRITEVBLK,
&myiosb, 0, 0, bufptr, buflen, snaddr,
0, 0, 0);
if (OK(status)) status = netlib___cvt_status(&myiosb);
}
if (argc > 4 && iosb != 0) netlib___cvt_iosb(iosb, &myiosb);
}
return status;
} /* netlib_write */
unsigned long lib$locc( const struct dsc$descriptor_s* char_string,
const struct dsc$descriptor_s* source_string)
{
char *s1_ptr, *s2_ptr;
unsigned short s1_len, s2_len;
unsigned long i;
lib$analyze_sdesc(char_string, &s1_len, &s1_ptr);
lib$analyze_sdesc(source_string, &s2_len, &s2_ptr);
if (s1_len > 0 )
{
for (i = 0; i < s2_len ; i++)
{
if ( s1_ptr[0] == s2_ptr[i])
return i+1;
}
}
return 0;
}
int str$$rzerotrim (struct dsc$descriptor_s *sd1, long *exp)
{
int i, status;
char *s1_ptr;
unsigned short s1_len;
status = str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
i = s1_len-1;
while ( (s1_ptr[i] == '0') && (i > 0 ) )
{
if (s1_ptr[i] == '0' )
{ s1_ptr[i] = ' ';
(*exp)++;
s1_len--;
}
i--;
}
// Resize descriptor
status = str$get1_dx (&s1_len, sd1);
str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
return status;
}
int str$$iszero (const struct dsc$descriptor_s *sd1)
{
int i, c_not_zero;
char *s1_ptr;
unsigned short s1_len;
str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
c_not_zero = FALSE;
for (i=0; i < s1_len; i++)
if (s1_ptr[i] != '0')
c_not_zero = TRUE;
return c_not_zero;
}
/*************************************************************
* str$copy_r
*
*/
unsigned long str$copy_r(struct dsc$descriptor_s* destination_string,
const unsigned short* word_integer_source_length,
const void *source_string_address)
{
unsigned short s1_length;
int s2_length;
unsigned long length; /* Length of first string */
unsigned long result = STR$_NORMAL; /* Working result */
char* s1_ptr; /* Pointer to first string */
if (source_string_address != NULL )
s2_length = * word_integer_source_length;
else
s2_length = 0;
/*
* Do the normal sort of tests
*/
if ((result = str$$is_string_class(destination_string)) != STR$_NORMAL)
{
DOSIGNAL(result);
return result;
}
/*
* Try to resize the destination
*/
length = *word_integer_source_length;
result = str$$resize(destination_string, *word_integer_source_length);
if (result == STR$_NORMAL)
{
/*
* Analyze the string we now have
*/
str$analyze_sdesc(destination_string, &s1_length, &s1_ptr);
/*
* Jam in the text
*/
result = str$$copy_fill(s1_ptr,(unsigned int) s1_length,
source_string_address, (unsigned int) s2_length,' ' );
}
/*
* If we get here, it must have worked
*/
return result;
}
/************************************************************
* str$compare_eql
*
* Compares two strings for equality, in both length
* and contents.
*/
long str$compare_eql(
const struct dsc$descriptor_s* first_source_string,
const struct dsc$descriptor_s* second_source_string)
{
char* s1_ptr; /* Pointer to first string */
unsigned short s1_length; /* Length of first string */
char* s2_ptr; /* Pointer to second string */
unsigned short s2_length; /* Length of second string */
/*
* Analyze source strings
*/
str$analyze_sdesc(first_source_string, &s1_length, &s1_ptr);
str$analyze_sdesc(second_source_string, &s2_length, &s2_ptr);
/*
* Failure if not same length
*/
if (s1_length != s2_length)
{
return 1;
}
/*
* Failure if not identical contents
*/
if (memcmp(s1_ptr, s2_ptr, s2_length) != 0)
{
return 1;
}
/*
* Must be equal
*/
return 0;
}
/*
**++
** ROUTINE: netlib_strtoaddr
**
** FUNCTIONAL DESCRIPTION:
**
** tbs
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** tbs
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
**
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib_strtoaddr (struct dsc$descriptor *dsc, struct INADDRDEF *a) {
unsigned short len;
char *cp, *anchor;
unsigned int status, parts[4], val;
int i;
status = lib$analyze_sdesc(dsc, &len, &cp);
if (!OK(status)) return status;
for (i = 0; len > 0 && i < 4; i++) {
val = 0;
while (*cp != '.' && len > 0) {
if (!isdigit(*cp)) return SS$_IVADDR;
val = val * 10 + (*cp - '0');
cp++; len--;
}
parts[i] = val;
if (len > 0) {
cp++; len--;
}
}
switch (i) {
case 0: return SS$_IVADDR;
case 1: val = parts[0];
break;
case 2: val = (parts[0] << 24) | (parts[1] & 0xffffff);
break;
case 3: val = (parts[0] << 24) | ((parts[1] & 0xff) << 16) |
(parts[2] & 0xffff);
break;
case 4: if (len > 0)
return SS$_IVADDR;
val = (parts[0] << 24) | ((parts[1] & 0xff) << 16) |
((parts[2] & 0xff) << 8) | (parts[3] & 0xff);
break;
}
a->inaddr_l_addr = netlib_long_swap(val);
return SS$_NORMAL;
} /* netlib_strtoaddr */
/*************************************************************
* str$upcase
*
*/
unsigned long str$upcase(struct dsc$descriptor_s* destination_string,
const struct dsc$descriptor_s* source_string)
{
char* s1_ptr; /* Pointer to string */
unsigned short s1_length; /* Length of string */
unsigned long result; /* Working result */
/*
* Copy over the string, retaining original case
*/
result = str$copy_dx(destination_string, source_string);
/*
* Analyze destination string
*/
if ((result & 1) == 1)
{
/*
* Analyse the copies string
*/
str$analyze_sdesc(destination_string, &s1_length, &s1_ptr);
/*
* Transform it to upper case
*/
while(s1_length > 0)
{
*s1_ptr = toupper(*s1_ptr);
s1_ptr++;
s1_length--;
}
}
/*
* Done
*/
return result;
}
/*
**++
** ROUTINE: sp_send
**
** FUNCTIONAL DESCRIPTION:
**
** Queue up some data to be sent to the subprocess.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_send(SPHANDLE *ctxpp, struct dsc$descriptor *cmdstr);
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: Normal successful completion.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int sp_send (SPHANDLE *ctxpp, void *cmdstr) {
SPHANDLE ctx;
struct SPD *spd;
unsigned int status, efstate;
unsigned short cmdlen;
char *cmdadr;
ctx = *ctxpp;
if (sys$readef(ctx->termefn, &efstate) != SS$_WASCLR) return SS$_NONEXPR;
status = lib$analyze_sdesc(cmdstr, &cmdlen, &cmdadr);
if (!OK(status)) return status;
spd = get_spd(cmdlen);
if (spd == 0) return SS$_INSFMEM;
memcpy(spd->buf, cmdadr, cmdlen);
status = sys$setast(0);
queue_insert(spd, ctx->sendque.tail);
if (status == SS$_WASSET) sys$setast(1);
sys$dclast(try_to_send, ctx, 0);
return SS$_NORMAL;
} /* sp_send */
int str$$iszerotrim (struct dsc$descriptor_s *sd1, long *exp)
{
int i, status, is_zero;
char *s1_ptr;
unsigned short s1_len;
is_zero = TRUE;
status = str$analyze_sdesc (sd1,&s1_len, &s1_ptr);
if ( s1_ptr != NULL )
{
for ( i = 0; i < s1_len; i++)
{
if (s1_ptr[i] != '0' )
{ is_zero = FALSE;
}
}
if ( is_zero )
{ *exp = 0;
}
}
return status;
}
/*************************************************************
* str$len_extr
*
*/
unsigned long str$len_extr(struct dsc$descriptor_s* destination_string,
const struct dsc$descriptor_s* source_string,
const long* start_position,
const long* longword_integer_length)
{
char* s2_ptr; /* Pointer to second string */
unsigned short s2_length; /* Length of second string */
int final_length; /* Signed final length */
unsigned short real_final_length; /* Usable final length */
unsigned long result; /* Result */
unsigned long second_result = STR$_NORMAL; /* Another possible result */
int start_offset = *start_position; /* Real start character */
/*
* Validate input
*/
if (start_offset <= 0)
{
start_offset = 1;
second_result = STR$_STRTOOLON;
}
/*
* Determine how much we can use
*/
str$analyze_sdesc(source_string, &s2_length, &s2_ptr);
if (*longword_integer_length < s2_length - (start_offset - 1))
{
final_length = *longword_integer_length;
}
else
{
final_length = s2_length - (start_offset - 1);
}
/*
* Now validate the final; length
*/
if (final_length < 0)
{
real_final_length = 0;
second_result = STR$_STRTOOLON;
}
else
{
real_final_length = (unsigned short) final_length;
}
/*
* Move over the left part of the string
*/
s2_ptr += start_offset - 1;
result = str$copy_r(destination_string,
&real_final_length, s2_ptr);
/*
* Done
*/
if (result == STR$_NORMAL)
{
return second_result;
}
else
{
return result;
}
}
/*
**++
** ROUTINE: netlib_connect_by_name
**
** FUNCTIONAL DESCRIPTION:
**
** Connects to a remote host/port by name. The name is looked up,
** then a connection is tried to each address until a connection is
** established, or we run out of addresses.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** NETLIB_CONNECT_BY_NAME ctxptr, namdsc, port [,iosb] [,astadr] [,astprm]
**
** ctxptr: NETLIB context, longword (unsigned), read only, by reference
** namdsc: char_string, character string, read only, by descriptor
** port: word_unsigned, word (unsigned), read only, by reference
** iosb: io_status_block, quadword (unsigned), write only, by reference
** astadr: ast_procedure, procedure value, call, by reference
** astprm: user_arg, longword (unsigned), read only, by value
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: normal successful completion
** SS$_INSFARG: not enough arguments
** SS$_BADPARAM: invalid argument
** Codes from LIB$GET_VM, LIB$ANALYZE_SDESC, and
** other NETLIB network status codes.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib_connect_by_name (struct CTX **xctx,
struct dsc$descriptor *dsc, unsigned short *port,
struct NETLIBIOSBDEF *iosb, void (*astadr)(), void *astprm) {
struct Connect_Context *con;
struct CTX *ctx;
struct INADDRDEF addr;
unsigned int status, size;
unsigned short namlen;
char *namp;
int argc;
/*
** Verify the arguments
*/
VERIFY_CTX(xctx, ctx);
SETARGCOUNT(argc);
if (argc < 3) return SS$_INSFARG;
if (dsc == 0 || port == 0) return SS$_BADPARAM;
/*
** Allocate and fill in the connection context
*/
status = lib$analyze_sdesc(dsc, &namlen, &namp);
if (!OK(status)) return status;
size = namlen + sizeof(struct Connect_Context);
status = lib$get_vm(&size, &con);
if (!OK(status)) return status;
memset(con, 0, size);
con->name = (char *) (con + 1);
memcpy(con->name, namp, namlen);
INIT_SDESC(con->dsc, namlen, con->name);
con->ctx = ctx;
con->sin.sin_w_family = NETLIB_K_AF_INET;
con->sin.sin_w_port = netlib_word_swap(*port);
con->ctxsize = size;
size = sizeof(con->htadrlst)/sizeof(con->htadrlst[0]);
if (argc > 3 && iosb != 0) con->user_iosb = iosb;
if (argc > 4 && astadr != 0) {
con->astadr = astadr;
if (argc > 5) con->astprm = astprm;
}
/*
** If they provided us with a dotted-decimal IP address, fake
** out do_connect to make it look like we looked up the address
** via DNS.
*/
if (OK(netlib_strtoaddr(&con->dsc, &addr))) {
con->iosb.iosb_w_status = SS$_NORMAL;
con->nsadrcnt = 1;
con->nsadrlst[0] = addr;
if (con->astadr != 0) return sys$dclast(do_connect, con, 0);
return do_connect(con);
}
/*
** Make lookup via host table synchronous and in main-line thread
** because we can't call it from AST level for all packages
*/
status = netlib_name_to_address(&con->ctx, &useht, &con->dsc,
con->htadrlst, &size, &con->htadrcnt, &con->iosb);
if (!OK(status)) con->htadrcnt = 0;
size = sizeof(con->nsadrlst)/sizeof(con->nsadrlst[0]);
/*
** For an asynch call, do the DNS lookup and have DO_CONNECT invoked
** as the AST routine
*/
if (argc > 4 && astadr != 0) {
status = netlib_name_to_address(&con->ctx, &usedns, &con->dsc,
con->nsadrlst, &size, &con->nsadrcnt, &con->iosb,
do_connect, con);
if (!OK(status)) lib$free_vm(&con->ctxsize, &con);
return status;
}
/*
** Synchronous call: do the DNS lookup...
*/
status = netlib_name_to_address(&con->ctx, &usedns, &con->dsc,
con->nsadrlst, &size, &con->nsadrcnt, &con->iosb);
/*
** ... if it failed, fall back on the host table lookup info we got
*/
if (!OK(status)) {
con->iosb.iosb_w_status = SS$_ENDOFFILE;
con->nsadrcnt = 0;
}
/*
** Just call DO_CONNECT to complete this for us
*/
return do_connect(con);
} /* netlib_connect_by_name */
unsigned long str$match_wild ( const struct dsc$descriptor_s *candidate_string,
const struct dsc$descriptor_s *pattern_string)
{
int s1_pos, s2_pos;
char *s1_ptr, *s2_ptr, *s1_copy, *s2_copy;
unsigned short s1_len, s2_len;
unsigned long result;
result = 0;
str$analyze_sdesc ( candidate_string, &s1_len, &s1_ptr);
str$analyze_sdesc ( pattern_string, &s2_len, &s2_ptr);
s1_copy = calloc (s1_len,1);
s2_copy = calloc (s2_len,1);
strcpy (s1_copy,s1_ptr);
strcpy (s2_copy,s2_ptr);
s1_pos = 0;
s2_pos = 0;
result = STR$_MATCH;
for ( s1_pos = 0; s1_pos < s1_len; s1_pos++ )
{
if ( s1_copy[s1_pos] == s2_copy[s2_pos] )
{
result = STR$_MATCH;
s2_pos++;
}
else if ( s2_copy[s2_pos] == '%' )
{
result = STR$_MATCH;
s2_pos++;
}
else if ( s2_copy[s2_pos] == '*' )
{
if (s2_pos+1 >= s2_len ) // wild card last char
{
s1_pos = s1_len;
s2_pos++;
result = STR$_MATCH;
}
else // wild card not last character
{ if ( s1_copy[s1_pos] == s2_copy[s2_pos+1] )
{
s2_pos += 2;
}
}
}
else
{
result = STR$_NOMATCH;
s1_pos = s1_len;
}
} // end for
// Special case last char is * which can represent nothing
if (( s2_copy[s2_pos] == '*' ) && ( s2_pos+1 == s2_len ))
s2_pos++;
// we left uncheck characters in the candidate string
if ( s2_pos != s2_len )
{
result = STR$_NOMATCH;
}
free (s1_copy);
free (s2_copy);
return result;
}
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;
}
/*************************************************************
* str$case_blind_compare
*
* Compares two strings without regard to case.
* The contents of the strings are not modified.
*
* Return:
*
* -1 = str1 < str2
* 0 = str1 == str2
* 1 = str1 > str2
*/
long str$case_blind_compare(
const struct dsc$descriptor_s* first_source_string,
const struct dsc$descriptor_s* second_source_string)
{
char* s1_ptr; /* Pointer to first string */
unsigned short s1_length; /* Length of first string */
char* s2_ptr; /* Pointer to second string */
unsigned short s2_length; /* Length of second string */
unsigned short min_length; /* length of shortest string */
long result; /* Result of comparison */
/*
* Analyze source strings
*/
str$analyze_sdesc(first_source_string, &s1_length, &s1_ptr);
str$analyze_sdesc(second_source_string, &s2_length, &s2_ptr);
/*
* Calculate length to compare
*/
min_length = (s1_length < s2_length) ? s1_length : s2_length;
/*
* Compare the two strings.
* Use 'memcmp' instead of 'strncmp' because we may have NULL's
* in our strings.
*/
result = str__memicmp(s1_ptr, s2_ptr, min_length);
/*
* Work on the result in case of equal in first part, but
* different total lengths.
*/
if (result == 0)
{
if (s1_length < s2_length)
{
result = -1;
}
else
{
if (s1_length > s2_length)
{
result = 1;
}
}
}
/*
* Normalize the result
*/
if (result < -1)
{
result = -1;
}
if (result > 1)
{
result = 1;
}
/*
* Return the answer
*/
return result;
}
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;
}
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;
}
