regina/rexxbif.c

   1
   2 #include <stdio.h>
   3 #include "rexxbif.h"
   4
   5 #ifdef EXTERNAL_TO_REGINA
   6 #define exiterror __regina_exiterror
   7 void DropStreng( streng *str )
   8 {
   9    if ( str )
  10       free( str );
  11 }
  12
  13 streng *MakeStreng( int num )
  14 {
  15    streng *out = (streng *)malloc( sizeof(streng) + num );
  16    if ( out != NULL )
  17    {
  18       out->len = out->max = num;
  19       if ( num )
  20       {
  21 memset( out->value, '$', num );
  22       }
  23    }
  24 if ( out == NULL ) fprintf(stderr,"ERROR allocating RXSTRING\n");
  25    return out;
  26 }
  27 void exiterror( int errorno, int suberrorno, ... )
  28 {
  29 }
  30 #endif
  31
  32 int Rexx_x2d( const tsd_t *TSD, streng *hex )
  33 {
  34    int dec=0,i;
  35    char c;
  36
  37    TSD = TSD; /* keep compiler happy */
  38
  39    for ( i = 0; i < PSTRENGLEN(hex); i++ )
  40    {
  41       dec <<= 4;
  42       c = hex->value[i];
  43       if ( c >='0'&& c<='9')
  44          dec += c-'0';
  45       else if ( c >= 'A' &&c <= 'F' )
  46          dec += c-'A'+10;
  47       else if( c >='a' && c <='f' )
  48          dec += c-'a'+10;
  49       else
  50       {
  51          dec = -1;
  52          break;
  53       }
  54    }
  55    return dec;
  56 }
  57
  58 streng *Rexx_right( const tsd_t *TSD, streng *str, int length, char padch )
  59 {
  60    streng *out = MAKESTRENG( length );
  61    int i,j;
  62    if ( out )
  63    {
  64       for ( j = 0; PSTRENGLEN(str) > j; j++) ;
  65       for (i=length-1,j--;(i>=0)&&(j>=0);out->value[i--]=str->value[j--]) ;
  66       for (;i>=0;out->value[i--]=padch) ;
  67       out->len = length;
  68    }
  69    return out;
  70 }
  71
  72 streng *Rexx_d2x( const tsd_t *TSD, int num )
  73 {
  74    streng *out;
  75    out = MAKESTRENG( (2+(num/16)) );
  76    if ( out )
  77    {
  78       sprintf( PSTRENGVAL(out), "%X", num );
  79       out->len = strlen( PSTRENGVAL(out) );
  80    }
  81    return out;
  82 }