APDL Public Domain 1/APDL_PD1A.iso/program/language/icon/Source/Iconx/C/Rlocal

Text File | 1990-07-19 | 23.8 KB | 1,007 lines

/*
 * Routines needed for different systems.
 */

#include <math.h>
#include "../h/config.h"
#include "../h/rt.h"
#include "rproto.h"
#include <ctype.h>

/*
 * The following code is operating-system dependent [@rlocal.01].
 *  Routines needed by different systems.
 */

#if PORT
   /* place for anything system-specific */
Deliberate Syntax Error
#endif                    /* PORT */

#if ARM
#include "kernel.h"

int unlink (const char *name)
{
    _kernel_osfile_block blk;

    return (_kernel_osfile(6,name,&blk) <= 0);
}

int getch (void)
{
    return _kernel_osrdch();
}

int getche (void)
{
    int ch = _kernel_osrdch();

    _kernel_oswrch(ch);

    return ch;
}

int kbhit (void)
{
    return ((_kernel_osbyte(152,0,0) & 0x00FF0000) != 0x00010000);
}

char *ecvt(double number, int ndigit, int *decpt, int *sign)
{
    int n = 0;
    static char buf[30];

    /* Sort out the sign */
    if (number >= 0)
        *sign = 0;
    else
    {
        *sign = 1;
        number = -number;
    }

    /* Normalise the number to 0.1 <= number < 1, setting decpt */
    if (number >= 1)
    {
        while (number >= 1)
        {
            ++n;
            number /= 10.0;
        }
    }
    else if (number != 0.0 && number < 0.1)
    {
        while (number < 0.1)
        {
            --n;
            number *= 10.0;
        }
    }
    *decpt = n;

    sprintf(buf, "%#.*f", ndigit, number);

    /* Skip the leading "0." */
    return (buf+2);
}
#endif

#if AMIGA
#if AZTEC_C
/*
 * abs
 */
abs(i)
int i;
{
    return ((i<0)? (-i) : i);
}

/*
 * ldexp
 */
double ldexp(value,exp)
double value;
{
  double retval = 1.0;
  if(exp>0) {
    while(exp-->0) retval *= 2.0;
  } else if (exp<0) {
    while(exp++<0) retval = retval / 2.0;
  }
  return value * retval;
}

/*
 *  abort()
 */
novalue abort()
{
  fprintf(stderr,"ICON ERROR WITH ICONCORE SET\n");
  fflush(stderr);
  exit(1);
}

#ifdef SystemFnc

/*
 * Aztec C version 3.6 does not support system(), but here is a substitute.
 * This is a bonafide untested-original-it-just-compiles routine.
 * Manx will probably implement system() before we fix this version...
 */
#include <ctype.h>

#define KLUDGE1 256
#define KLUDGE2 64
int system(s)
char *s;
{
   char text[KLUDGE1], *cp=text;
   char **av[KLUDGE2];
   int ac = 0;
   int l  = strlen(s);

   if (l >= KLUDGE1)
      return -1;
   strcpy(text,s);
   av[ac++] = text;
   while(*cp && ac<KLUDGE2-1) {
      if (isspace(*cp)) {
         *cp++ = '\0';
     while(isspace(*cp))
        cp++;
         if (*cp)
        av[ac++] = cp;
         }
      else {
         cp++;
         }
      }
    av[ac] = NULL;
    return fexecv(av[0], av);
}
#endif                    /* SystemFnc */
#endif                    /* AZTEC_C */
#endif                    /* AMIGA */

#if ATARI_ST
#if LATTICE

long _STACK = 10240;
long _MNEED = 200000;    /* reserve space for allocation (may be too large) */

#include <osbind.h>

/*  Structure necessary for handling system time. */
   struct tm {
       short tm_year;
       short tm_mon;
       short tm_wday;
       short tm_mday;
       short tm_hour;
       short tm_min;
       short tm_sec;
   };

struct tm *localtime(clock)   /* fill structure with clock time */
int clock;     /* millisecond timer value, if supplied; not used */
{
  static struct tm tv;
  unsigned int time, date;

  time = Tgettime();
  date = Tgetdate();
  tv.tm_year = ((date >> 9) & 0x7f) + 80;
  tv.tm_mon  = ((date >> 5) & 0xf) - 1;
  tv.tm_mday = date & 0x1f;
  tv.tm_hour = (time >> 11) & 0x1f;
  tv.tm_min  = (time >> 5)  & 0x3f;
  tv.tm_sec  = 2 * (time & 0x1f);

  tv.tm_wday = weekday(tv.tm_mday,tv.tm_mon+1,tv.tm_year);
  return(&tv);
}


weekday(day,month,year)   /* find day of week from    */
short day, month, year;   /* day, month, and year     */
{                         /* Sunday..Saturday is 0..6 */
  int index, yrndx, mondx;

  if(month <= 2) {   /* Jan or Feb month adjust */
      month += 12;
      year  -=  1;
  }

  yrndx = year + (year / 4) - (year / 100) + (year / 400);
  mondx = 2 * month + (3 * (month + 1)) / 5;
  index = day + mondx + yrndx + 2;
  return(index % 7);
}



time(ptime)   /* return value of millisecond timer */
int  *ptime;
{
  int  tmp, ssp;   /* value of supervisor stack pointer */
  static int  *tmr = (int *) 0x04ba;   /* addr of timer */

  ssp = gemdos(0x20,0);   /* enter supervisor mode */
  tmp = *tmr * 5;         /* get millisecond timer */
  ssp = gemdos(0x20,ssp); /* enter programmer mode */

  if(ptime != NULL)
      *ptime = tmp;

  return(tmp);
}

int brk(p)
char *p;
{
  char *sbrk();
  long int l, m;

  l = (long int)p;
  m = (long int)sbrk(0);

  return((lsbrk((long) (l - m)) == 0) ? -1 : 0);
}


#ifdef LocalQsort
/* Shell sort with some enhancements from Knuth.. */

void qsort( base, nel, width, cmp )   /* was llqsort( ... */
char *base;                           /*-also kqsort( ...-*/
int nel;
int width;
int (*cmp)();
{
   register int i, j;
   long int gap;
   int k, tmp ;
   char *p1, *p2;

   for( gap=1; gap <= nel; gap = 3*gap + 1 ) ;

   for( gap /= 3;  gap > 0  ; gap /= 3 )
       for( i = gap; i < nel; i++ )
           for( j = i-gap; j >= 0 ; j -= gap ) {
                p1 = base + ( j     * width);
                p2 = base + ((j+gap) * width);

                if( (*cmp)( p1, p2 ) <= 0 ) break;

                for( k = width; --k >= 0 ;) {
                   tmp   = *p1;
                   *p1++ = *p2;
                   *p2++ = tmp;
                }
           }
}
#endif                    /* LocalQsort */

#endif                    /* LATTICE */
#endif                    /* ATARI_ST */

#if HIGHC_386
#endif                    /* HIGHC_386 */

#if MACINTOSH
#if MPW
/*
**  Special routines for Macintosh Programmer's Workshop
**  implementation of the Icon Programming Language
*/

#include <Types.h>
#include <Events.h>
#include <OSUtils.h>
#define MaxBlockX MaxBlock /* MaxBlock Icon definition conflicts */
#undef MaxBlock           /* with Mac Toolbox routine */
#include <Memory.h>
#define MaxBlock MaxBlockX
#undef MaxBlockX
#include <Errors.h>

/*
**  Initialization and Termination Routines
*/
/*
**  MacExit -- This function is installed by an onexit() call in MacInit
**  -- it is called automatically when the program terminates.
*/
void
MacExit()
{
  void ResetStack();
  extern Ptr MemBlock;

  ResetStack();
  if (MemBlock != NULL) DisposPtr(MemBlock);
}

/*
**  MacInit -- This function is called near the beginning of execution of
**  iconx.  It is called by our own brk/sbrk initialization routine.
*/
void
MacInit()
{
  atexit(MacExit);
}


/*
**  Brk and Sbrk Equivalents
*/

typedef Ptr caddr_t;

static caddr_t MemBlock, Break, Limit;
word xcodesize;

init_brk()
{
  static short init = 0;
  Size max, grow, size;
  char *v;
  extern word mstksize, statsize, ssize, abrsize;

  if (!init) {
    init = 1;
    MacInit();
    if ((v = getenv("ICONSIZE")) != NULL) {    /* if ICONSIZE defined */
      if ((size = atol(v)) <= 0) {        /* if ICONSIZE negative */
    max = MaxMem(&grow);
    size = max + grow - (size < 0 ? -size : max / 4);
      }
    }
    else {                    /* if ICONSIZE undefined */
      size = xcodesize + mstksize + statsize + ssize + abrsize + 512;
    }
    if ((MemBlock = NewPtr(size)) == NULL) {
      syserr("problem allocating Mac memory");
    }
    Break = MemBlock;
    Limit = MemBlock + size;
  }
  return 1;
}

caddr_t
brk(addr)
caddr_t addr;
{
  Size newsize;

  if (!init_brk()) return (caddr_t)-1;
  if (addr < MemBlock) return (caddr_t)-1;
  if (addr < Limit) Break = addr;
  else {
    newsize = addr - MemBlock;
    SetPtrSize(MemBlock, newsize);
    if (MemError() != noErr) return (caddr_t)-1;
    Break = Limit = addr;
  }
  return (caddr_t)0;
}

caddr_t
sbrk(incr)
int incr;
{
  caddr_t start;

  if (!init_brk()) return (caddr_t)-1;
  start = Break;
  if (incr != 0) {
    if (brk(start + incr) == (caddr_t)-1) return (caddr_t)-1;
  }
  return start;
}

#endif                    /* MPW */
#endif                    /* MACINTOSH */

#if MSDOS

#if TURBO
extern unsigned _stklen = 8 * 1024;
#endif                    /* TURBO */

#if LATTICE

#include <error.h>

int _stack = (8 * 1024);
long int _mneed = (20 * 1024);

extern long int *sp;
long int **xsp = &sp;  /* Used for rswitch.asm .. since 'sp' is a reserved */
               /* symbol for the assembler.. */

extern char *statend;  /* Indicator for when to use malloc for _GETBF */

int brk(p)
char *p;
{
   char *sbrk();
   long int l, m;

   l = (long int)p;
   m = (long int)sbrk((word)0);

   if( lsbrk((long) (l - m) ) == 0) return -1;
   else return 0;
}

novalue abort()    /* Abort set to 'dump' icon data area.. */
{
#ifdef DeBugIconx
   blkdump();
#endif                    /* DeBugIconx */
   fflush(stderr);
   fcloseall();
   _exit(1);
}
#endif                    /* LATTICE */
#endif                    /* MSDOS */

#if MVS || VM
#if SASC
#include <options.h>
char _linkage = _OPTIMIZE;

#if MVS
char *_style = "tso:";          /* use dsnames as file names */
#define SYS_OSVS
#else                    /* MVS */
#define SYS_CMS
#endif                    /* MVS */
int _mneed = 512000;            /* size of sbrk-managed region */

#define RES_SIGNAL
#define RES_COPROC
#define RES_IOUTIL
#define RES_DSNAME
#define RES_FILEDEF
#define RES_UNITREC
#if VM
#define BIMODAL_CMS
#endif                    /* VM */

#include <resident.h>

#endif                    /* SASC */
#ifdef WATERLOO_C_V3_0
const int _staksize = (64*1024);
#endif                    /* WATERLOO_C_V3_0 */
#endif                    /* MVS || VM */

#if OS2
novalue abort()
{
#ifdef DeBugIconx
    blkdump();
#endif
    fflush(stderr);
    fcloseall();
    _exit(1);
}
/* Pipe support for OS/2 */
#include <stddef.h>
#include <process.h>
#include <errno.h>

#define INCL_DOS
#include <os2.h>

static int _pipes[_NFILE];

/*
 * popen("command",mode)
 *
 * mode = "r" | "w"
 */
FILE *
popen(cmd, mode)
char *cmd;
char *mode;
{

    int whandle, rhandle;
    int phandle, chandle, shandle;
    int rc;

    /* Validate */
    if(cmd == NULL || mode == NULL) return NULL;
    if(tolower(*mode) != 'r' && tolower(*mode) != 'w')
    return NULL;

    /* Create the pipe */
    if (DosMakePipe(&rhandle, &whandle, BUFSIZ) < 0)
    return NULL;

    /* Dup STDIN or STDOUT to the pipe */
    if (*mode == 'r') {
    /* Dup stdout */
    phandle = rhandle;
    chandle = whandle;
    shandle = dup(1);    /* Save STDOUT */
    rc = dup2(chandle, 1);
    } else {
    /* Dup stdin */
    phandle = whandle;
    chandle = rhandle;
    shandle = dup(0);    /* Save STDIN */
    rc = dup2(chandle, 0);
    }
    if (rc < 0) {
    perror("dup2");
    return NULL;
    }
    close(chandle);

    /* Make sure that we don't pass this handle on */
    DosSetFHandState(phandle, OPEN_FLAGS_NOINHERIT);

    /* Invoke the child, remember its processid */
    _pipes[chandle] = spawnlp(P_NOWAIT, cmd, cmd, NULL);

    /* Clean up by reestablishing our STDIN/STDOUT */
    if (*mode == 'r')
    rc = dup2(shandle, 1);
    else
    rc = dup2(shandle, 0);
    if (rc < 0) {
    perror("dup2");
    return NULL;
    }
    close(shandle);

    return fdopen(phandle, mode);
}
pclose(ptr)
FILE *ptr;
{
    int status, pnum;

    pnum = fileno(ptr);
    fclose(ptr);

    /* Now wait for child to end */
    cwait(&status, _pipes[pnum], WAIT_GRANDCHILD);

    return status;
}

/* End of pipe support for OS/2 */
#endif                    /* OS2 */

#if UNIX
#ifdef ATTM32

/*
 * This file contains the routine necessary to allocate legal AT&T
 * 3B2/15/4000 stack space for co-expression stacks.
 *
 * Legal stack region begins at 0xC0020000, and UNIX will grow stack space
 * up to 50 Megabytes. 0xC0030000 should provide plenty of room for
 * main C stack growth.  Each time coexpr_salloc() is called, it
 * adds mstksize (max main stack size) and returns a new address,
 * meaning each coexpression stack is potentially as large as the main stack.
 */

/*
 * coexp_salloc() - return pointer in legal stack space for start
 *                  of a coexpression stack.
 */

pointer coexp_salloc()
   {
   static pointer sp = 0xC0030000 ;     /* pointer to stack region */

   sp +=  mstksize;
   return sp;
}
#endif                    /* ATTM32 */
#if CONVEX

/* replacement pow() that allows negative ** integer */

#undef pow

double pow0 (base, exp)
    double base, exp;
{   if (base >= 0) return pow (base, exp);
    else {
    long n = exp;
    if (n != exp) runerr (-206, 0);
    else if (n & 1) return -pow (-base, exp);
    else return pow (-base, exp);}}
#endif                    /* CONVEX */

#endif                    /* UNIX */

#if VMS
#include dvidef
#include iodef

typedef struct _descr {
   int length;
   char *ptr;
} descriptor;

typedef struct _pipe {
   long pid;            /* process id of child */
   long status;            /* exit status of child */
   long flags;            /* LIB$SPAWN flags */
   int channel;            /* MBX channel number */
   int efn;            /* Event flag to wait for */
   char mode;            /* the open mode */
   FILE *fptr;            /* file pointer (for fun) */
   unsigned running : 1;    /* 1 if child is running */
} Pipe;

Pipe _pipes[_NFILE];        /* one for every open file */

#define NOWAIT        1
#define NOCLISYM    2
#define NOLOGNAM    4
#define NOKEYPAD    8
#define NOTIFY        16
#define NOCONTROL    32
#define SFLAGS    (NOWAIT|NOKEYPAD|NOCONTROL)

/*
 * popen - open a pipe command
 * Last modified 2-Apr-86/chj
 *
 *    popen("command", mode)
 */

FILE *popen(cmd, mode)
char *cmd;
char *mode;
{
   FILE *pfile;            /* the Pfile */
   Pipe *pd;            /* _pipe database */
   descriptor mbxname;        /* name of mailbox */
   descriptor command;        /* command string descriptor */
   descriptor nl;        /* null device descriptor */
   char mname[65];        /* mailbox name string */
   int chan;            /* mailbox channel number */
   int status;            /* system service status */
   int efn;
   struct {
      short len;
      short code;
      char *address;
      char *retlen;
      int last;
   } itmlst;

   if (!cmd || !mode)
      return (0);
   LIB$GET_EF(&efn);
   if (efn == -1)
      return (0);
   if (_tolower(mode[0]) != 'r' && _tolower(mode[0]) != 'w')
      return (0);
   /* create and open the mailbox */
   status = SYS$CREMBX(0, &chan, 0, 0, 0, 0, 0);
   if (!(status & 1)) {
      LIB$FREE_EF(&efn);
      return (0);
   }
   itmlst.last = mbxname.length = 0;
   itmlst.address = mbxname.ptr = mname;
   itmlst.retlen = &mbxname.length;
   itmlst.code = DVI$_DEVNAM;
   itmlst.len = 64;
   status = SYS$GETDVIW(0, chan, 0, &itmlst, 0, 0, 0, 0);
   if (!(status & 1)) {
      LIB$FREE_EF(&efn);
      return (0);
   }
   mname[mbxname.length] = '\0';
   pfile = fopen(mname, mode);
   if (!pfile) {
      LIB$FREE_EF(&efn);
      SYS$DASSGN(chan);
      return (0);
   }
   /* Save file information now */
   pd = &_pipes[fileno(pfile)];    /* get Pipe pointer */
   pd->mode = _tolower(mode[0]);
   pd->fptr = pfile;
   pd->pid = pd->status = pd->running = 0;
   pd->flags = SFLAGS;
   pd->channel = chan;
   pd->efn = efn;
   /* fork the command */
   nl.length = strlen("_NL:");
   nl.ptr = "_NL:";
   command.length = strlen(cmd);
   command.ptr = cmd;
   status = LIB$SPAWN(&command,
      (pd->mode == 'r') ? 0 : &mbxname,    /* input file */
      (pd->mode == 'r') ? &mbxname : 0,    /* output file */
      &pd->flags, 0, &pd->pid, &pd->status, &pd->efn, 0, 0, 0, 0);
   if (!(status & 1)) {
      LIB$FREE_EF(&efn);
      SYS$DASSGN(chan);
      return (0);
   } else {
      pd->running = 1;
   }
   return (pfile);
}

/*
 * pclose - close a pipe
 * Last modified 2-Apr-86/chj
 *
 */
pclose(pfile)
FILE *pfile;
{
   Pipe *pd;
   int status;
   int fstatus;

   pd = fileno(pfile) ? &_pipes[fileno(pfile)] : 0;
   if (pd == NULL)
      return (-1);
   fflush(pd->fptr);            /* flush buffers */
   fstatus = fclose(pfile);
   if (pd->mode == 'w') {
      status = SYS$QIOW(0, pd->channel, IO$_WRITEOF, 0, 0, 0, 0, 0, 0, 0, 0, 0);
      SYS$WFLOR(pd->efn, 1 << (pd->efn % 32));
   }
   SYS$DASSGN(pd->channel);
   LIB$FREE_EF(&pd->efn);
   pd->running = 0;
   return (fstatus);
}

/*
 * redirect(&argc,argv,nfargs) - redirect standard I/O
 *    int *argc        number of command arguments (from call to main)
 *    char *argv[]    command argument list (from call to main)
 *    int nfargs    number of filename arguments to process
 *
 * argc and argv will be adjusted by redirect.
 *
 * redirect processes a program's command argument list and handles redirection
 * of stdin, and stdout.  Any arguments which redirect I/O are removed from the
 * argument list, and argc is adjusted accordingly.  redirect would typically be
 * called as the first statement in the main program.
 *
 * Files are redirected based on syntax or position of command arguments.
 * Arguments of the following forms always redirect a file:
 *
 *    <file    redirects standard input to read the given file
 *    >file    redirects standard output to write to the given file
 *    >>file    redirects standard output to append to the given file
 *
 * It is often useful to allow alternate input and output files as the
 * first two command arguments without requiring the <file and >file
 * syntax.  If the nfargs argument to redirect is 2 or more then the
 * first two command arguments, if supplied, will be interpreted in this
 * manner:  the first argument replaces stdin and the second stdout.
 * A filename of "-" may be specified to occupy a position without
 * performing any redirection.
 *
 * If nfargs is 1, only the first argument will be considered and will
 * replace standard input if given.  Any arguments processed by setting
 * nfargs > 0 will be removed from the argument list, and again argc will
 * be adjusted.  Positional redirection follows syntax-specified
 * redirection and therefore overrides it.
 *
 */


redirect(argc,argv,nfargs)
int *argc, nfargs;
char *argv[];
{
   int i;

   i = 1;
   while (i < *argc)  {        /* for every command argument... */
      switch (argv[i][0])  {        /* check first character */
         case '<':            /* <file redirects stdin */
            filearg(argc,argv,i,1,stdin,"r");
            break;
         case '>':            /* >file or >>file redirects stdout */
            if (argv[i][1] == '>')
               filearg(argc,argv,i,2,stdout,"a");
            else
               filearg(argc,argv,i,1,stdout,"w");
            break;
         default:            /* not recognized, go on to next arg */
            i++;
      }
   }
   if (nfargs >= 1 && *argc > 1)    /* if positional redirection & 1 arg */
      filearg(argc,argv,1,0,stdin,"r");    /* then redirect stdin */
   if (nfargs >= 2 && *argc > 1)    /* likewise for 2nd arg if wanted */
      filearg(argc,argv,1,0,stdout,"w");/* redirect stdout */
}



/* filearg(&argc,argv,n,i,fp,mode) - redirect and remove file argument
 *    int *argc        number of command arguments (from call to main)
 *    char *argv[]    command argument list (from call to main)
 *    int n        argv entry to use as file name and then delete
 *    int i        first character of file name to use (skip '<' etc.)
 *    FILE *fp        file pointer for file to reopen (typically stdin etc.)
 *    char mode[]    file access mode (see freopen spec)
 */

filearg(argc,argv,n,i,fp,mode)
int *argc, n, i;
char *argv[], mode[];
FILE *fp;
{
   if (strcmp(argv[n]+i,"-"))        /* alter file if arg not "-" */
      fp = freopen(argv[n]+i,mode,fp);
   if (fp == NULL)  {            /* abort on error */
      fprintf(stderr,"%%can't open %s",argv[n]+i);
      exit(ErrorExit);
   }
   for ( ;  n < *argc;  n++)        /* move down following arguments */
      argv[n] = argv[n+1];
   *argc = *argc - 1;            /* decrement argument count */
}

/* Special versions of sbrk() and brk() for use by Icon under VMS.
 * #defines in define.h actually rename these to vms_brk and vms_sbrk.
 *
 * For historical reasons, Icon assumes it can repeatedly call brk/sbrk
 * and always get contiguous chunks.  This was made to work under Unix by
 * overloading the definitions of malloc and friends, the only other callers
 * of sbrk, and making them return Icon-managed memory.

 * Under VMS, sbrk is not the lowest-level system interface.  It gets memory
 * from underlying VMS routines such as SYS$EXPREG.  These routines are also
 * called by others, for example when a file is opened;  so successive sbrk
 * calls may return nonadjacent chunks.  This makes overloading malloc and
 * friends futile.
 *
 * The routines below replace sbrk and brk for Icon (only) under VMS.  They
 * provide the continuously growing memory Icon needs without relying on
 * special privileges or unusually large quotas.  Like the Unix solution and
 * earlier VMS attempts, this is an empirical solution and may need further
 * revision as the system changes.  But we hope not.
 *
 * The Icon interpreter is loaded beginning at address 0 and grows upward as
 * it requests more memory through sbrk.  The C stack grows downward from
 * 0x7FFFFFFF. We're going to draw a line to divide the address space, then
 * force the C and VMS runtime systems to put anything they need above it;
 * then sbrk can grow the program region unimpeded up to the line.
 *
 * The line is drawn MAXMEM bytes beyond the start of the sbrk region.  MAXMEM
 * is an environment variable (logical name to VMS) with a default as given in
 * define.h.  Large values cost CPU and real time expended at process exit; we
 * don't know why.  On an 8600 the cost was very roughly .04 CP sec / megabyte.
 *
 * When first called, sbrk expands the program region by one page to get a
 * starting address.  A limit address is calculated by adding MAXMEM.  A single
 * page created just below the limit address "draws the line" and causes the
 * VMS runtime system to allocate anything it needs above that point.  sbrk
 * creates pages between base and limit as needed.
 *
 * Possible errors and their manifestations:
 *
 *    MAXMEM too large to initialize sbrk:
 *       error in startup code: value of MAXMEM too large
 *
 *    MAXMEM too small to initialize sbrk:
 *       error in startup code: value of MAXMEM too small
 *
 *    MAXMEM too small for subsequent brk/sbrk growth
 *       Run-time error 351:  insufficient MAXMEM limit
 *
 *    MAXMEM okay but insufficient user quota for needed memory:
 *       Run-time error 303:  unable to expand memory region
 *
 *    unexpected ("can't happen") failures of system calls:
 *       these produce their standard VMS error message
 *
 *    unexpected intrusion into the sbrk region by the runtime system:
 *       unknown, but undoubtedly ugly
 */


#define PageSize 512        /* size of a VMS page */
#define MaxP0 0x40000000    /* first address beyond the P0 region */

#include <stsdef.h>

word memsize = MaxMem;        /* set from environment variable MAXMEM */


/*  sbrk(incr) - adjust the break value by incr, rounding up to a page.
 *  returns the new break value, or -1 if unsuccessful.
 */

char *
sbrk(incr)
int incr;
{
   static char *base;        /* base of the sbrk region */
   static char *curr;        /* current break value (end+1) */
   static char *limit;        /* region limit ("the line") */
   char *range[2], *p;        /* scratch for system calls */
   int s;            /* status return from calls */

   /*  initialization code */
   if (!base)  {
      s = sys$expreg(1,range,0,0);    /* expand P0 to get base address */
      if (!(s & STS$M_SUCCESS))
         exit(s);            /* couldn't get one page?! */
      base = curr = range[0];        /* initialize empty sbrk region */
      memsize = (memsize + PageSize - 1) & -PageSize;
                    /* round memsize to page boundary */
      limit = base + memsize;        /* calculate sbrk region limit*/
      if (limit > MaxP0)
     limit = MaxP0;            /* limit to legal values */
      if (limit <= base)
         error("value of MAXMEM too small");  /* can't even start */
      range[0] = range[1] = limit-1;
      s = sys$cretva(range,range,0);    /* get a page there to draw the line */
      if (!(s & STS$M_SUCCESS))
         error("value of MAXMEM too large");  /* can't even start */
   }

   if (incr > 0)  {

      /* grow the region */
      if (curr + incr > limit)        /* check address space available */
         fatalerr(-351,NULL);        /* oops, MAXMEM too small */
      range[0] = curr;
      range[1] = curr + incr - 1;
      s = sys$cretva(range,range,0);    /* ask for the pages */
      if (!(s & STS$M_SUCCESS))
         return (char *) -1;        /* failed, quota exceeded */
      curr = range[1] + 1;        /* set new break value as returned */

   } else if (incr < 0) {

      /* shrink the region (not expected to be used).  does not actually
       * return the memory, but does make it available for reuse.  */
      curr -= -incr & -PageSize;
   }

   /* return the current break value */
   return curr;
}




/*  brk(addr) - set the break address to the given value, rounded up to a page.
 *  returns 0 if successful, -1 if not.
 */

char *
brk(addr)
char *addr;
{
   return ((sbrk(addr-sbrk(0))) == (char *) -1 ? (char *) -1 : 0);
}
#endif                    /* VMS */

/*
 * End of operating-system specific code.
 */

static char x;            /* avoid empty module */