sys.c File Reference

system functions More...

Go to the source code of this file.

Data Structures
struct	a_stream
struct	psi_feature

Macros
#define	BYTEDATA_SIZE(X)   (*(unsigned long *)(X->value_3))
#define	BYTEDATA_DATA(X)   ((char*)((char*)X->value_3 + sizeof(unsigned long)))
#define	BV_AND   0
#define	BV_OR   1
#define	BV_XOR   2
#define	BV_NOT   0
#define	BV_COUNT   1
#define	BV_GET   0
#define	BV_SET   1
#define	BV_CLEAR   2
#define	FP_NONE   0
#define	FP_INPUT   1
#define	FP_OUTPUT   2
#define	FP_PREPARE(s, OP)
#define	SEEK_SET   0
#define	SEEK_CUR   1
#define	SEEK_END   2
#define	SETFEATURE(lst, n, nam, val)   ((lst[n].name_str=nam),(lst[n].value_str=val))

Typedefs
typedef struct a_stream *	ptr_stream

Functions
long	call_primitive (long(*fun)(), int num, psi_arg argi[], GENERIC info)
	call_primitive More...
static ptr_psi_term	make_bytedata (ptr_definition sort, unsigned long bytes)
	make_bytedata( More...
static long	make_bitvector_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	make_bitvector_internal More...
static long	c_make_bitvector ()
	c_make_bitvector More...
static long	bitvector_binop_code (unsigned long *bv1, unsigned long *bv2, ptr_psi_term result, GENERIC op)
	bitvector_binop_code More...
static long	bitvector_binop_internal (ptr_psi_term *args, ptr_psi_term result, ptr_psi_term funct, GENERIC op)
	bitvector_binop_internal More...
static long	bitvector_binop (long op)
	bitvector_binop More...
static long	c_bitvector_and ()
	c_bitvector_and More...
static long	c_bitvector_or ()
	c_bitvector_or More...
static long	c_bitvector_xor ()
	c_bitvector_xor More...
static long	bitvector_unop_code (unsigned long *bv1, ptr_psi_term result, int op)
	bitvector_unop_code More...
static long	bitvector_unop_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, int op)
	bitvector_unop_internal More...
static long	bitvector_unop (GENERIC op)
	bitvector_unop More...
static long	c_bitvector_not ()
	c_bitvector_not More...
static long	c_bitvector_count ()
	c_bitvector_count More...
static long	bitvector_bit_code (unsigned long *bv1, long idx, ptr_psi_term result, int op, ptr_psi_term funct)
	bitvector_bit_code More...
static long	bitvector_bit_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, int op)
	bitvector_bit_internal More...
static long	bitvector_bit (long op)
	bitvector_bit More...
static long	c_bitvector_get ()
	c_bitvector_get More...
static long	c_bitvector_set ()
	c_bitvector_set More...
static long	c_bitvector_clear ()
	c_bitvector_clear More...
void	regerror (char *s)
	regerror More...
static long	regexp_compile_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	regexp_compile_internal More...
static long	c_regexp_compile ()
	c_regexp_compile More...
static long	regexp_execute_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	regexp_execute_internal More...
static long	c_regexp_execute ()
	c_regexp_execute More...
ptr_psi_term	fileptr2stream (FILE *fp, ptr_definition typ)
	fileptr2stream More...
static long	int2stream_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	int2stream_internal More...
static long	c_int2stream ()
	c_int2stream More...
static long	fopen_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	fopen_internal More...
static long	c_fopen ()
	c_fopen More...
static long	fclose_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	fclose_internal More...
static long	c_fclose ()
	c_fclose More...
static long	fwrite_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	fwrite_internal More...
static long	c_fwrite ()
	c_fwrite More...
static long	fflush_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	fflush_internal More...
static long	c_fflush ()
	c_fflush More...
static long	get_buffer_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	get_buffer_internal More...
static long	c_get_buffer ()
	c_get_buffer More...
int	text_buffer_next (struct text_buffer *buf, int idx, char c, struct text_buffer **rbuf, int *ridx)
	text_buffer_next More...
char *	text_buffer_cmp (struct text_buffer *buf, int idx, char *str)
	text_buffer_cmp More...
void	text_buffer_push (struct text_buffer **buf, char c)
	text_buffer_push More...
void	text_buffer_free (struct text_buffer *buf)
	text_buffer_free More...
static long	get_record_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	get_record_internal More...
static long	c_get_record ()
	c_get_record More...
static long	get_code_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	get_code_internal More...
static long	c_get_code ()
	c_get_code More...
static long	ftell_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	ftell_internal More...
static long	c_ftell ()
	c_ftell More...
static long	fseek_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	fseek_internal More...
static long	c_fseek ()
	c_fseek More...
static long	stream2sys_stream_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	stream2sys_stream_internal More...
static long	c_stream2sys_stream ()
	c_stream2sys_stream More...
static long	sys_stream2stream_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	sys_stream2stream_internal More...
static long	c_sys_stream2stream ()
	c_sys_stream2stream More...
static long	socket_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	socket_internal More...
static long	c_socket ()
	c_socket More...
int	is_ipaddr (char *s)
	is_ipaddr More...
static long	bind_or_connect_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, void *info)
	bind_or_connect_internal More...
static long	c_bind ()
	c_bind More...
static long	c_connect ()
	c_connect More...
static long	listen_internal (args, result, funct)
static long	c_listen ()
	c_listen More...
static long	accept_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	accept_internal More...
static long	c_accept ()
	c_accept More...
static long	errno_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	errno_internal More...
static long	c_errno ()
	c_errno More...
static long	errmsg_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	errmsg_internal More...
static long	c_errmsg ()
	c_errmsg More...
static long	import_symbol_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	import_symbol_internal More...
static long	c_import_symbol ()
	c_import_symbol More...
static long	fork_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
static long	c_fork ()
	c_fork More...
static long	unify_pterm_result (ptr_psi_term t, ptr_definition sym, psi_feature lst[], int n)
	unify_pterm_result More...
char *	get_numeric_feature (long n)
	get_numeric_feature More...
static long	unify_wait_result (ptr_psi_term result, pid_t id, int status)
	unify_wait_result More...
static long	wait_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	wait_internal More...
static long	c_wait ()
	c_wait More...
static long	waitpid_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	waitpid_internal More...
static long	c_waitpid ()
	c_waitpid More...
static long	kill_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	kill_internal More...
static long	c_kill ()
	c_kill More...
static long	cuserid_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	cuserid_internal More...
static long	c_cuserid ()
	c_cuserid More...
static long	gethostname_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	gethostname_internal More...
static long	c_gethostname ()
	c_gethostname More...
static long	lazy_project_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	lazy_project_internal More...
static long	c_lazy_project ()
	c_lazy_project More...
static long	wait_on_feature_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	wait_on_feature_internal More...
static long	c_wait_on_feature ()
	c_wait_on_feature More...
static long	my_wait_on_feature_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	my_wait_on_feature_internal More...
static long	c_my_wait_on_feature ()
	c_my_wait_on_feature More...
static long	call_once_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	call_once_internal More...
static long	c_call_once ()
	c_call_once More...
static long	apply1_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	apply1_internal More...
static long	c_apply1 ()
	c_apply1() More...
static long	getpid_internal (ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
	getpid_internal More...
static long	c_getpid ()
	c_getpid More...
void	make_sys_type_links ()
	make_sys_type_links More...
void	check_sys_definitions ()
	check_sys_definitions More...
void	insert_sys_builtins ()
	insert_sys_builtins More...

Detailed Description

system functions

All new system utilities and extensions to Wild LIFE 1.01 are implemented in this file and made available in LIFE module "sys"

Definition in file sys.c.

Macro Definition Documentation

#define BV_AND   0

Definition at line 181 of file sys.c.

#define BV_CLEAR   2

Definition at line 383 of file sys.c.

#define BV_COUNT   1

Definition at line 287 of file sys.c.

#define BV_GET   0

Definition at line 381 of file sys.c.

#define BV_NOT   0

Definition at line 286 of file sys.c.

#define BV_OR   1

Definition at line 182 of file sys.c.

#define BV_SET   1

Definition at line 382 of file sys.c.

#define BV_XOR   2

Definition at line 183 of file sys.c.

#define BYTEDATA_DATA

(

X

)

((char*)((char*)X->value_3 + sizeof(unsigned long)))

Definition at line 139 of file sys.c.

#define BYTEDATA_SIZE

(

X

)

(*(unsigned long *)(X->value_3))

Definition at line 138 of file sys.c.

#define FP_INPUT   1

Definition at line 669 of file sys.c.

#define FP_NONE   0

Definition at line 668 of file sys.c.

#define FP_OUTPUT   2

Definition at line 670 of file sys.c.

#define FP_PREPARE	(		s,
			OP
	)

Value:

if (s->op != OP && s->op != FP_NONE) fflush(s->fp); \
  s->op = OP;

Definition at line 677 of file sys.c.

#define SEEK_CUR   1

Definition at line 1155 of file sys.c.

#define SEEK_END   2

Definition at line 1158 of file sys.c.

#define SEEK_SET   0

Definition at line 1152 of file sys.c.

#define SETFEATURE	(		lst,
			n,
			nam,
			val
	)		((lst[n].name_str=nam),(lst[n].value_str=val))

Definition at line 1665 of file sys.c.

Typedef Documentation

typedef struct a_stream * ptr_stream

Function Documentation

static long accept_internal ( ptr_psi_term  args[], ptr_psi_term  argsresult, ptr_psi_term  argsfunct  )

static

accept_internal

Parameters

args	- ptr_psi_term args[]
argsresult	- ptr_psi_term argsresult
argsfunct	- ptr_psi_term argsfunct

(FILE**)BYTEDATA_DATA(args[0]));

Definition at line 1476 of file sys.c.

References BYTEDATA_DATA, Errorline(), FALSE, fileptr2stream(), NULL, push_goal(), sys_socket_stream, TRUE, and unify.

{
  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp); 
  int s;

  if ((s=accept(fd,NULL,NULL)) < 0) return FALSE;
  else {
    FILE * fp = fdopen(s,"r+");
    //    ptr_psi_term t;

    if (fp==NULL) {
      Errorline("fdopen failed on socket in %P.\n",funct);
      return FALSE;
    }

    /*    t = make_bytedata(sys_socket_stream,sizeof(fp));
     *(FILE**)BYTEDATA_DATA(t) = fp;*/
    push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
    return TRUE;
  }
}

static long apply1_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

apply1_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 2099 of file sys.c.

References wl_psi_term::attr_list, clear_copy(), distinct_copy(), Errorline(), eval, FALSE, FEATCMP, function_it, get_numeric_feature(), heap_copy_string(), integer, push_goal(), quoted_string, REAL, residuate(), wl_definition::rule, stack_insert(), sub_type(), top, TRUE, and wl_psi_term::type.

{
  long success=TRUE;
  if (args[0]->type==top) residuate(args[0]);
  else if (args[0]->type->type_def!=(def_type)function_it) {
    Errorline("1st arg not a function in %P.\n",funct);
    success=FALSE;
  }
  else {
    //    char buffer_loc[1000];
    char * feat;
    ptr_psi_term fun;
    if (sub_type(args[1]->type,integer) && args[1]->value_3)
      feat = get_numeric_feature((long)*(REAL*)args[1]->value_3);
    else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
      feat = (char *)args[1]->value_3;
    else
      feat = (char *)heap_copy_string(args[1]->type->keyword->symbol);
    clear_copy();
    fun=distinct_copy(args[0]);
    (void)stack_insert(FEATCMP,(char *)feat,&(fun->attr_list),(GENERIC)args[2]);
    push_goal(eval,fun,result,(GENERIC)fun->type->rule);
  }
  return success;
}

static long bind_or_connect_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct, void *  info  )

static

bind_or_connect_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct
info	- void *info

(FILE**)BYTEDATA_DATA(args[0]));

Definition at line 1351 of file sys.c.

References BYTEDATA_DATA, Errorline(), FALSE, is_ipaddr(), NULL, REAL, and TRUE.

{
  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp); 
  int do_bind = info==NULL;

  if (args[1] || args[2]) {
    /* bind or connect in the internet domain */
    struct sockaddr_in name_loc;
    char* hostname = args[1]?(char*)args[1]->value_3:NULL;
    if (!args[2]) {
      Errorline("Missing port number in %P.\n",funct);
      return FALSE;
    }

    bzero((char*)&name_loc,sizeof(name_loc));
    name_loc.sin_family = AF_INET;
    name_loc.sin_port = htons((unsigned short)*(REAL*)args[2]->value_3);

    if (!hostname || *hostname=='\0' || !strcasecmp(hostname,"localhost"))
      name_loc.sin_addr.s_addr = INADDR_ANY;
    else {
      struct hostent * h;
      int ipaddr;
      if ((ipaddr=is_ipaddr(hostname))) {
    int i = inet_addr(hostname);
    h = gethostbyaddr((char*)&i,sizeof(i),AF_INET);
      } else h = gethostbyname(hostname);
      if (h==NULL) {
    Errorline("%s failed for %P.\n",
          ipaddr?"gethostbyaddr":"gethostbyname",funct);
    return FALSE;
      }
      bcopy(h->h_addr,(char*)&(name_loc.sin_addr.s_addr),h->h_length);
    }
    if ((do_bind?
     bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
     connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
      Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
      return FALSE;
    }
  }
  else if (args[3]) {
    /* bind in the unix domain */
    struct sockaddr_un name_loc;
    char* path = (char*)args[3]->value_3;

    name_loc.sun_family = AF_UNIX;
    strcpy(name_loc.sun_path,path);

    if ((do_bind?
     bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
     connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
      Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
      return FALSE;
    }
  }
  else {
    Errorline("Too few arguments in %P.\n",funct);
    return FALSE;
  }
  return TRUE;
}

static long bitvector_binop ( long  op )

static

bitvector_binop

Parameters

op

- long op

Definition at line 248 of file sys.c.

References bitvector_binop_internal(), call_primitive(), NARGS, REQUIRED, SETARG, and sys_bitvector.

{
  psi_arg args[2];
  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
  SETARG(args,1, "2" , sys_bitvector , REQUIRED );
  return call_primitive(bitvector_binop_internal,NARGS(args),args,(GENERIC)op);
}

static long bitvector_binop_code ( unsigned long *  bv1, unsigned long *  bv2, ptr_psi_term  result, GENERIC  op  )

static

bitvector_binop_code

Parameters

bv1	- unsigned long *bv1
bv2	- unsigned long *bv2
result	- ptr_psi_term result
op	- GENERIC op changed to GENERIC 2.16 no effect DJD

Definition at line 194 of file sys.c.

References BV_AND, BV_OR, BV_XOR, c_abort(), make_bytedata(), NULL, push_goal(), sys_bitvector, TRUE, unify, and wl_psi_term::value_3.

{
  unsigned long size1 = *bv1;
  unsigned long size2 = *bv2;
  unsigned long size3 = (size1>size2)?size1:size2;
  ptr_psi_term temp_result = make_bytedata(sys_bitvector,size3);
  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
  unsigned char *s2 = ((unsigned char*)bv2)+sizeof(size2);
  unsigned char *s3 = ((unsigned char *) temp_result->value_3) + sizeof(size3);
  unsigned long i;
  switch ((long)op) {   // added cast DJD 2.16
  case BV_AND:
    for(i=0;i<size3;i++) s3[i] = s1[i] & s2[i];
    if (size1<size2) for(;i<size2;i++) s3[i] = 0;
    else             for(;i<size1;i++) s3[i] = 0;
    break;
  case BV_OR:
    for(i=0;i<size3;i++) s3[i] = s1[i] | s2[i];
    if (size1<size2) for(;i<size2;i++) s3[i] = s2[i];
    else             for(;i<size1;i++) s3[i] = s1[i];
    break;
  case BV_XOR:
    for(i=0;i<size3;i++) s3[i] = s1[i] ^ s2[i];
    if (size1<size2) for(;i<size2;i++) s3[i] = (unsigned char) 0 ^ s2[i];
    else             for(;i<size1;i++) s3[i] = s1[i] ^ (unsigned char) 0;
    break;
  default: return (c_abort());
  }
  push_goal(unify,temp_result,result,NULL);
  return TRUE;
}

static long bitvector_binop_internal ( ptr_psi_term *  args, ptr_psi_term  result, ptr_psi_term  funct, GENERIC  op  )

static

bitvector_binop_internal

Parameters

args	- ptr_psi_term *args
result	- ptr_psi_term result
funct	- ptr_psi_term funct
op	- GENERIC op changed to GENERIC 2.16 DJD

BITVECTOR_BINOP

Definition at line 235 of file sys.c.

References bitvector_binop_code().

{
  return bitvector_binop_code((unsigned long *)args[0]->value_3,
                  (unsigned long *)args[1]->value_3,
                  result,(GENERIC)op);
}

static long bitvector_bit ( long  op )

static

bitvector_bit

Parameters

op

- long op

Definition at line 449 of file sys.c.

References bitvector_bit_internal(), call_primitive(), integer, NARGS, REQUIRED, SETARG, and sys_bitvector.

{
  psi_arg args[2];
  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
  SETARG(args,1, "2" , integer       , REQUIRED );
  return call_primitive(bitvector_bit_internal,NARGS(args),args,(GENERIC)op);
}

static long bitvector_bit_code ( unsigned long *  bv1, long  idx, ptr_psi_term  result, int  op, ptr_psi_term  funct  )

static

bitvector_bit_code

Parameters

bv1	- unsigned long *bv1
idx	- long idx
result	- ptr_psi_term result
op	- int op
funct	- ptr_psi_term funct

Definition at line 395 of file sys.c.

References BV_CLEAR, BV_GET, BV_SET, Errorline(), FALSE, make_bytedata(), NULL, push_goal(), REAL, sys_bitvector, TRUE, unify, unify_real_result(), and wl_psi_term::value_3.

{
  unsigned long size1 = *bv1;
  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
  unsigned long i = idx / sizeof(char);
  int j = idx % sizeof(char);
  ptr_psi_term temp_result;
  unsigned char *s2;
  if (idx<0 || idx>=size1) {
    Errorline("Index out of bound in %P.\n",funct);
    return FALSE; }
  switch (op) {
  case BV_GET:
    return unify_real_result(result,(REAL)((s1[i] & (1<<j))?1:0));
    break;
  case BV_SET:
    temp_result = make_bytedata(sys_bitvector,size1);
    s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
    bcopy(s1,s2,size1);
    s2[i] |= 1<<j;
    break;
  case BV_CLEAR:
    temp_result = make_bytedata(sys_bitvector,size1);
    s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
    bcopy(s1,s2,size1);
    s2[i] &= ~ (1<<j);
    break;
  }
  push_goal(unify,temp_result,result,NULL);
  return TRUE;
}

static long bitvector_bit_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct, int  op  )

static

bitvector_bit_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct
op	- int op 12/10/2016 changed from GENERIC to int 2.29 DJD

Definition at line 436 of file sys.c.

References bitvector_bit_code(), and REAL.

{
  return bitvector_bit_code((unsigned long *)args[0]->value_3,
                (long)*((REAL*)args[1]->value_3),
                result,op,funct);
}

static long bitvector_unop ( GENERIC  op )

static

bitvector_unop

Parameters

op	- GENERIC op 12/10/2016 changed from long to GENERIC (2.29) DJD

Definition at line 354 of file sys.c.

References bitvector_unop_internal(), call_primitive(), NARGS, REQUIRED, SETARG, and sys_bitvector.

{
  psi_arg args[1];
  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
  return call_primitive(bitvector_unop_internal,NARGS(args),args,op);
}

static long bitvector_unop_code ( unsigned long *  bv1, ptr_psi_term  result, int  op  )

static

bitvector_unop_code

Parameters

bv1	- unsigned long *bv1
result	- ptr_psi_term result
op	- int op

Definition at line 297 of file sys.c.

References BV_COUNT, BV_NOT, c_abort(), make_bytedata(), NULL, push_goal(), REAL, sys_bitvector, TRUE, unify, unify_real_result(), and wl_psi_term::value_3.

{
  unsigned long size1 = *bv1;
  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
  unsigned long i;
  ptr_psi_term temp_result;
  unsigned char *s3;
  switch (op) {
  case BV_NOT:
    temp_result = make_bytedata(sys_bitvector,size1);
    s3 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
    for(i=0;i<size1;i++) s3[i] = ~(s1[i]);
    break;
  case BV_COUNT:
    {
      int cnt = 0;
      register unsigned char c;
      for(i=0;i<size1;i++) {
    c=s1[i];
    if (c & 1<<0) cnt++;
    if (c & 1<<1) cnt++;
    if (c & 1<<2) cnt++;
    if (c & 1<<3) cnt++;
    if (c & 1<<4) cnt++;
    if (c & 1<<5) cnt++;
    if (c & 1<<6) cnt++;
    if (c & 1<<7) cnt++; }
      return unify_real_result(result,(REAL) cnt);
    }
    break;
  default: return (c_abort());
  }
  push_goal(unify,temp_result,result,NULL);
  return TRUE;
}

static long bitvector_unop_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct, int  op  )

static

bitvector_unop_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct
op	- int op 12/10/2016 changed from GENERIC to int (2.29) DJD

BITVECTOR_UNOP

Definition at line 343 of file sys.c.

References bitvector_unop_code().

{
  return bitvector_unop_code((unsigned long *)args[0]->value_3,result, op);
}

static long c_accept ( )

static

c_accept

Definition at line 1503 of file sys.c.

References accept_internal(), call_primitive(), NARGS, REQUIRED, SETARG, and sys_socket_stream.

{
  psi_arg args[1];
  SETARG(args,0,"1",sys_socket_stream,REQUIRED);
  return call_primitive(accept_internal,NARGS(args),args,0);
}

static long c_apply1 ( )

static

c_apply1()

Definition at line 2130 of file sys.c.

References apply1_internal(), call_primitive(), NARGS, NOVALUE, REQUIRED, SETARG, and top.

{
  psi_arg args[3];
  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
  SETARG(args,2,"3",top,REQUIRED|NOVALUE);
  return call_primitive(apply1_internal,NARGS(args),args,0);
}

static long c_bind ( )

static

c_bind

Definition at line 1419 of file sys.c.

References bind_or_connect_internal(), call_primitive(), integer, MANDATORY, NARGS, NULL, OPTIONAL, quoted_string, SETARG, and sys_socket_stream.

{
  psi_arg args[4];
  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
  SETARG(args,1,"host",quoted_string,OPTIONAL);
  SETARG(args,2,"port",integer,OPTIONAL);
  SETARG(args,3,"path",quoted_string,OPTIONAL);
  return call_primitive(bind_or_connect_internal,NARGS(args),args,NULL);
}

static long c_bitvector_and ( )

static

c_bitvector_and

Definition at line 261 of file sys.c.

References bitvector_binop(), and BV_AND.

{
  return bitvector_binop(BV_AND);
}

static long c_bitvector_clear ( )

static

c_bitvector_clear

Definition at line 482 of file sys.c.

References bitvector_bit(), and BV_CLEAR.

{
  return bitvector_bit(BV_CLEAR);
}

static long c_bitvector_count ( )

static

c_bitvector_count

Definition at line 376 of file sys.c.

References bitvector_unop(), and BV_COUNT.

{
  return bitvector_unop((GENERIC)BV_COUNT);  // cast added 12/10/2016 DJD 2.29
}

static long c_bitvector_get ( )

static

c_bitvector_get

Definition at line 462 of file sys.c.

References bitvector_bit(), and BV_GET.

{
  return bitvector_bit(BV_GET);
}

static long c_bitvector_not ( )

static

c_bitvector_not

Definition at line 366 of file sys.c.

References bitvector_unop(), and BV_NOT.

{
  return bitvector_unop((GENERIC)BV_NOT);  // cast added 12/10/2016 DJD 2.29
}

static long c_bitvector_or ( )

static

c_bitvector_or

Definition at line 271 of file sys.c.

References bitvector_binop(), and BV_OR.

{
  return bitvector_binop(BV_OR);
}

static long c_bitvector_set ( )

static

c_bitvector_set

Definition at line 472 of file sys.c.

References bitvector_bit(), and BV_SET.

{
  return bitvector_bit(BV_SET);
}

static long c_bitvector_xor ( )

static

c_bitvector_xor

Definition at line 281 of file sys.c.

References bitvector_binop(), and BV_XOR.

{
  return bitvector_binop(BV_XOR);
}

static long c_call_once ( )

static

c_call_once

Definition at line 2084 of file sys.c.

References call_once_internal(), call_primitive(), MANDATORY, NARGS, NOVALUE, SETARG, top, and UNEVALED.

{
  psi_arg args[1];
  SETARG(args,0,"1",top,MANDATORY|NOVALUE|UNEVALED);
  return call_primitive(call_once_internal,NARGS(args),args,0);
}

static long c_connect ( )

static

c_connect

Definition at line 1434 of file sys.c.

References bind_or_connect_internal(), call_primitive(), integer, MANDATORY, NARGS, OPTIONAL, quoted_string, SETARG, and sys_socket_stream.

{
  psi_arg args[4];
  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
  SETARG(args,1,"host",quoted_string,OPTIONAL);
  SETARG(args,2,"port",integer,OPTIONAL);
  SETARG(args,3,"path",quoted_string,OPTIONAL);
  return call_primitive(bind_or_connect_internal,NARGS(args),args,(GENERIC)1);
}

static long c_cuserid ( )

static

c_cuserid

Definition at line 1869 of file sys.c.

References call_primitive(), cuserid_internal(), and NULL.

{
  return call_primitive(cuserid_internal,0,NULL,0);
}

static long c_errmsg ( )

static

c_errmsg

Definition at line 1564 of file sys.c.

References call_primitive(), errmsg_internal(), integer, NARGS, OPTIONAL, and SETARG.

{
  psi_arg args[1];
  SETARG(args,0, "1" , integer , OPTIONAL );
  return call_primitive(errmsg_internal,NARGS(args),args,0);
}

static long c_errno ( )

static

c_errno

Definition at line 1532 of file sys.c.

References call_primitive(), errno_internal(), and NULL.

{
  return call_primitive(errno_internal,0,NULL,0);
}

static long c_fclose ( )

static

c_fclose

Definition at line 787 of file sys.c.

References call_primitive(), fclose_internal(), NARGS, REQUIRED, SETARG, and sys_stream.

{
  psi_arg args[1];
  SETARG(args,0, "1" , sys_stream , REQUIRED );
  return call_primitive(fclose_internal,NARGS(args),args,0);
}

static long c_fflush ( )

static

c_fflush

Definition at line 849 of file sys.c.

References call_primitive(), fflush_internal(), MANDATORY, NARGS, SETARG, and sys_stream.

{
  psi_arg args[1];
  SETARG(args,0,"1",sys_stream,MANDATORY);
  return call_primitive(fflush_internal,NARGS(args),args,0);
}

static long c_fopen ( )

static

c_fopen

Definition at line 758 of file sys.c.

References call_primitive(), fopen_internal(), NARGS, quoted_string, REQUIRED, and SETARG.

{
  psi_arg args[2];
  SETARG(args,0, "1" , quoted_string , REQUIRED );
  SETARG(args,1, "2" , quoted_string , REQUIRED );
  return call_primitive(fopen_internal,NARGS(args),args,0);
}

static long c_fork ( )

static

c_fork

Definition at line 1655 of file sys.c.

References call_primitive(), fork_internal(), and NULL.

{
  return call_primitive(fork_internal,0,NULL,0);
}

static long c_fseek ( )

static

c_fseek

Definition at line 1185 of file sys.c.

References call_primitive(), fseek_internal(), integer, MANDATORY, NARGS, OPTIONAL, SETARG, and sys_file_stream.

{
  psi_arg args[3];
  SETARG(args,0,"1",sys_file_stream,MANDATORY);
  SETARG(args,1,"2",integer,MANDATORY);
  SETARG(args,2,"3",integer,OPTIONAL);
  return call_primitive(fseek_internal,NARGS(args),args,0);
}

static long c_ftell ( )

static

c_ftell

Definition at line 1144 of file sys.c.

References call_primitive(), ftell_internal(), NARGS, REQUIRED, SETARG, and sys_file_stream.

{
  psi_arg args[1];
  SETARG(args,0,"1",sys_file_stream,REQUIRED);
  return call_primitive(ftell_internal,NARGS(args),args,0);
}

static long c_fwrite ( )

static

c_fwrite

Definition at line 819 of file sys.c.

References call_primitive(), fwrite_internal(), MANDATORY, NARGS, quoted_string, SETARG, and sys_stream.

{
  psi_arg args[2];
  SETARG(args,0,"1",sys_stream,MANDATORY);
  SETARG(args,1,"2",quoted_string,MANDATORY);
  return call_primitive(fwrite_internal,NARGS(args),args,0);
}

static long c_get_buffer ( )

static

c_get_buffer

Definition at line 885 of file sys.c.

References call_primitive(), get_buffer_internal(), integer, NARGS, REQUIRED, SETARG, and sys_stream.

{
  psi_arg args[2];
  SETARG(args,0,"1",sys_stream,REQUIRED);
  SETARG(args,1,"2",integer,REQUIRED);
  return call_primitive(get_buffer_internal,NARGS(args),args,0);
}

static long c_get_code ( )

static

c_get_code

Definition at line 1113 of file sys.c.

References call_primitive(), get_code_internal(), NARGS, REQUIRED, SETARG, and sys_stream.

{
  psi_arg args[1];
  SETARG(args,0,"1",sys_stream,REQUIRED);
  return call_primitive(get_code_internal,NARGS(args),args,0);
}

static long c_get_record ( )

static

c_get_record

Definition at line 1083 of file sys.c.

References call_primitive(), get_record_internal(), NARGS, quoted_string, REQUIRED, SETARG, and sys_stream.

{
  psi_arg args[2];
  SETARG(args,0,"1",sys_stream,REQUIRED);
  SETARG(args,1,"2",quoted_string,REQUIRED);
  return call_primitive(get_record_internal,NARGS(args),args,0);
}

static long c_gethostname ( )

static

c_gethostname

Definition at line 1901 of file sys.c.

References call_primitive(), gethostname_internal(), and NULL.

{
  return call_primitive(gethostname_internal,0,NULL,0);
}

static long c_getpid ( )

static

c_getpid

Definition at line 2157 of file sys.c.

References call_primitive(), and getpid_internal().

{
  return call_primitive(getpid_internal,0,0,0);
}

static long c_import_symbol ( )

static

c_import_symbol

C_IMPORT_SYMBOL import a public symbol from another module into the current one, optionally renaming it.

Definition at line 1624 of file sys.c.

References call_primitive(), import_symbol_internal(), MANDATORY, NARGS, NOVALUE, OPTIONAL, SETARG, top, and UNEVALED.

{
  psi_arg args[2];
  SETARG(args,0,"1",top,MANDATORY|UNEVALED);
  SETARG(args,1,"as",top,OPTIONAL|NOVALUE|UNEVALED);
  return call_primitive(import_symbol_internal,NARGS(args),args,0);
}

static long c_int2stream ( )

static

c_int2stream

Definition at line 723 of file sys.c.

References call_primitive(), int2stream_internal(), integer, NARGS, quoted_string, REQUIRED, and SETARG.

{
  psi_arg args[2];
  SETARG(args,0,"1",integer,REQUIRED);
  SETARG(args,1,"2",quoted_string,REQUIRED);
  return call_primitive(int2stream_internal,NARGS(args),args,0);
}

static long c_kill ( )

static

c_kill

Definition at line 1835 of file sys.c.

References call_primitive(), integer, kill_internal(), MANDATORY, NARGS, and SETARG.

{
  psi_arg args[2];
  SETARG(args,0,"1",integer,MANDATORY);
  SETARG(args,1,"2",integer,MANDATORY);
  return call_primitive(kill_internal,NARGS(args),args,0);
}

static long c_lazy_project ( )

static

c_lazy_project

Definition at line 1947 of file sys.c.

References call_primitive(), lazy_project_internal(), NARGS, NOVALUE, REQUIRED, SETARG, and top.

{
  psi_arg args[2];
  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
  return call_primitive(lazy_project_internal,NARGS(args),args,0);
}

static long c_listen ( )

static

c_listen

Definition at line 1460 of file sys.c.

References call_primitive(), integer, listen_internal(), MANDATORY, NARGS, SETARG, and sys_socket_stream.

{
  psi_arg args[2];
  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
  SETARG(args,1,"2",integer,MANDATORY);
  return call_primitive(listen_internal,NARGS(args),args,0);
}

static long c_make_bitvector ( )

static

c_make_bitvector

Definition at line 174 of file sys.c.

References call_primitive(), integer, make_bitvector_internal(), NARGS, REQUIRED, and SETARG.

{
  psi_arg args[1];
  SETARG(args,0, "1" , integer , REQUIRED );
  return call_primitive(make_bitvector_internal,NARGS(args),args,0);
}

static long c_my_wait_on_feature ( )

static

c_my_wait_on_feature

Definition at line 2043 of file sys.c.

References call_primitive(), MANDATORY, my_wait_on_feature_internal(), NARGS, NOVALUE, SETARG, top, and UNEVALED.

{
  psi_arg args[3];
  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
  return call_primitive(my_wait_on_feature_internal,NARGS(args),args,0);
}

static long c_regexp_compile ( )

static

c_regexp_compile

Definition at line 554 of file sys.c.

References call_primitive(), NARGS, quoted_string, regexp_compile_internal(), REQUIRED, and SETARG.

{
  psi_arg args[1];
  SETARG(args,0, "1" , quoted_string , REQUIRED );
  return call_primitive(regexp_compile_internal,NARGS(args),args,0);
}

static long c_regexp_execute ( )

static

c_regexp_execute

Definition at line 648 of file sys.c.

References call_primitive(), integer, NARGS, NOVALUE, OPTIONAL, quoted_string, regexp_execute_internal(), REQUIRED, SETARG, sys_regexp, and top.

{
  psi_arg args[4];
  SETARG(args,0, "1"      , sys_regexp    , REQUIRED );
  SETARG(args,1, "2"      , quoted_string , REQUIRED );
  SETARG(args,2, "3"      , top           , OPTIONAL|NOVALUE );
  SETARG(args,3, "offset" , integer       , OPTIONAL );
  return call_primitive(regexp_execute_internal,NARGS(args),args,0);
}

static long c_socket ( )

static

c_socket

Definition at line 1319 of file sys.c.

References call_primitive(), NARGS, OPTIONAL, quoted_string, SETARG, and socket_internal().

{
  psi_arg args[2];
  SETARG(args,0,"1",quoted_string,OPTIONAL);
  SETARG(args,1,"2",quoted_string,OPTIONAL);
  return call_primitive(socket_internal,NARGS(args),args,0);
}

static long c_stream2sys_stream ( )

static

c_stream2sys_stream

Definition at line 1214 of file sys.c.

References call_primitive(), NARGS, REQUIRED, SETARG, stream, and stream2sys_stream_internal().

{
  psi_arg args[1];
  SETARG(args,0,"1",stream,REQUIRED);
  return call_primitive(stream2sys_stream_internal,NARGS(args),args,0);
}

static long c_sys_stream2stream ( )

static

c_sys_stream2stream

Definition at line 1244 of file sys.c.

References call_primitive(), NARGS, REQUIRED, SETARG, sys_stream, and sys_stream2stream_internal().

{
  psi_arg args[1];
  SETARG(args,0,"1",sys_stream,REQUIRED);
  return call_primitive(sys_stream2stream_internal,NARGS(args),args,0);
}

static long c_wait ( )

static

c_wait

Definition at line 1782 of file sys.c.

References call_primitive(), NULL, and wait_internal().

{
  return call_primitive(wait_internal,0,NULL,0);
}

static long c_wait_on_feature ( )

static

c_wait_on_feature

Definition at line 1995 of file sys.c.

References call_primitive(), MANDATORY, NARGS, NOVALUE, SETARG, top, UNEVALED, and wait_on_feature_internal().

{
  psi_arg args[3];
  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
  return call_primitive(wait_on_feature_internal,NARGS(args),args,0);
}

static long c_waitpid ( )

static

c_waitpid

Definition at line 1808 of file sys.c.

References call_primitive(), integer, NARGS, OPTIONAL, REQUIRED, SETARG, and waitpid_internal().

{
  psi_arg args[2];
  SETARG(args,0,"1",integer,REQUIRED);
  SETARG(args,1,"2",integer,OPTIONAL);
  return call_primitive(waitpid_internal,NARGS(args),args,0);
}

static long call_once_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

call_once_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

CALL_ONCE

call_once(G) -> T | G,!,T=lf_true;T=lf_false.

Definition at line 2063 of file sys.c.

References choice_stack, DEFRULES, general_cut, lf_false, lf_true, NULL, prove, push_choice_point(), push_goal(), resid_aim, stack_psi_term(), TRUE, wl_psi_term::type, and unify.

{
  ptr_psi_term value;
  ptr_choice_point cutpt = choice_stack;
  resid_aim=NULL;
  value = stack_psi_term(4);
  value->type = lf_false;
  push_choice_point(unify,result,value,NULL);
  value = stack_psi_term(4);
  value->type = lf_true;
  push_goal(unify,result,value,NULL);
  push_goal(general_cut,(ptr_psi_term)cutpt,NULL,NULL);
  push_goal(prove,args[0],(ptr_psi_term)DEFRULES,NULL);
  return TRUE;
}

long call_primitive	(	long(*)()	fun,
		int	num,
		psi_arg	argi[],
		GENERIC	info
	)

call_primitive

Parameters

fun	- (long (*fun)(),
num	- int num
argi	- psi_arg argi[]
info	- GENERIC info

Definition at line 24 of file sys.c.

References wl_goal::aaaa_1, aim, ARGNN, wl_psi_term::attr_list, wl_goal::bbbb_1, c_abort(), curry(), wl_node::data, deref, deref_ptr, Errorline(), FALSE, FEATCMP, find(), JUSTFAIL, MANDATORY, NOVALUE, NULL, overlap_type(), POLYTYPE, REQUIRED, residuate(), sub_type(), TRUE, wl_psi_term::type, psi_arg::type, UNEVALED, and wl_psi_term::value_3.

{
  ptr_psi_term funct,arg,result,argo[ARGNN]; /* no more than 10 arguments */
  ptr_node n;
  int allargs=1,allvalues=1,i;
  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  for (i=0;i<num;i++) {
    n=find(FEATCMP,argi[i].feature,funct->attr_list);
    /* argument present */
    if (n) {
      arg = (ptr_psi_term) n->data;
      /* in case we don't want to evaluate the argument
     just follow the chain of corefs and don't do
     any of the other checks: they'll have do be done
     by fun; just go on to the next arg */
      if (argi[i].options&UNEVALED) {
    deref_ptr(arg);
    argo[i]=arg;
    continue; }
      /* this arg should be evaled */
      deref(arg);
      argo[i]=arg;
      /* arg of admissible type */
      if (argi[i].options&POLYTYPE) {
    ptr_definition *type = (ptr_definition *)argi[i].type;
    while (*type != NULL)
      if (overlap_type(arg->type,*type))
        goto admissible;
      else type++;
      }
      else {
    if (overlap_type(arg->type,argi[i].type))
      goto admissible;
      }
      /* not admissible */
      if (argi[i].options&JUSTFAIL) return FALSE;
      Errorline("Illegal argument in %P.\n",funct);
      return (c_abort());
      /* admissible */
    admissible:
      /* has value */
      if (arg->value_3) {
    ptr_definition *type = (ptr_definition *)argi[i].type;
    /* paranoid check: really correct type */
    if (argi[i].options&POLYTYPE) {
      while (*type != NULL)
        if (sub_type(arg->type,*type))
          goto correct;
        else type++;
    }
    else {
      if (sub_type(arg->type,(ptr_definition)type)) goto correct;
    }
    /* type incorrect */
    if (argi[i].options&JUSTFAIL) return FALSE;
    Errorline("Illegal argument in %P.\n",funct);
    return (c_abort());
    /* correct */
      correct:;
      }
      /* missing value - do we need it */
      else if (!(argi[i].options&NOVALUE)) allvalues=0;
    }
    /* argument missing */
    else {
      argo[i]=NULL;
      if (argi[i].options&MANDATORY) {
    Errorline("Missing argument '%s' in %P.\n",argi[i].feature,funct);
    return (c_abort());
      }
      else if (argi[i].options&REQUIRED) allargs=0;
    }
  }
  if (allargs)
    if (allvalues) {
      return fun(argo,result,funct,info);
    }
    else {
      for (i=0;i<num;i++) {
    /* if arg present and should be evaled but has no value */
    if (argo[i] && !(argi[i].options&UNEVALED) && !argo[i]->value_3)
      residuate(argo[i]);
      }
    }
  else curry();
  return TRUE;
}

void check_sys_definitions

(

)

check_sys_definitions

Definition at line 2186 of file sys.c.

References check_definition(), sys_bitvector, sys_bytedata, sys_file_stream, sys_process_continued, sys_process_exited, sys_process_no_children, sys_process_signaled, sys_process_stopped, sys_regexp, sys_socket_stream, and sys_stream.

{
  check_definition(&sys_bytedata);  /* DENYS: BYTEDATA */
  check_definition(&sys_bitvector);
  check_definition(&sys_regexp);
  check_definition(&sys_stream);
  check_definition(&sys_file_stream);
  check_definition(&sys_socket_stream);
  check_definition(&sys_process_no_children);
  check_definition(&sys_process_exited);
  check_definition(&sys_process_signaled);
  check_definition(&sys_process_stopped);
  check_definition(&sys_process_continued);
#ifdef LIFE_NDBM
  check_ndbm_definitions();
#endif
}

static long cuserid_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

cuserid_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1854 of file sys.c.

References NULL, push_goal(), stack_string(), TRUE, and unify.

{
  //  char name[L_cuserid+1];
  //  if (*cuserid(name) == '\0') return FALSE;
  //  else {
  push_goal(unify,result,stack_string(getlogin()),NULL);
  return TRUE;
  //  }
}

static long errmsg_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

errmsg_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1549 of file sys.c.

References NULL, push_goal(), REAL, stack_string(), TRUE, unify, and wl_psi_term::value_3.

{
  long n = args[0]?(long)*(REAL*)args[0]->value_3:errno;
  //  if (n<0 || n>=sys_nerr) return FALSE;
  //  else {
  push_goal(unify,stack_string(strerror(n)),result,NULL);
  return TRUE;
  //  }
}

static long errno_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

errno_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1521 of file sys.c.

References NULL, push_goal(), stack_int(), TRUE, and unify.

{
  push_goal(unify,stack_int(errno),result,NULL);
  return TRUE;
}

static long fclose_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

fclose_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 774 of file sys.c.

References BYTEDATA_DATA, FALSE, and TRUE.

{
  if (fclose(((ptr_stream)BYTEDATA_DATA(args[0]))->fp) != 0)
    return FALSE;
  else
    return TRUE;
}

static long fflush_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

fflush_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 835 of file sys.c.

References BYTEDATA_DATA, FALSE, a_stream::fp, FP_NONE, a_stream::op, and TRUE.

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
  srm->op = FP_NONE;
  if (fflush(srm->fp)!=0) return FALSE;
  return TRUE;
}

ptr_psi_term fileptr2stream	(	FILE *	fp,
		ptr_definition	typ
	)

fileptr2stream

Parameters

fp	- FILE *fp
typ	- ptr_definition typ removed * DJD = prior to 2.29

Definition at line 688 of file sys.c.

References BYTEDATA_DATA, FP_NONE, and make_bytedata().

{
  ptr_psi_term result = make_bytedata(typ,sizeof(struct a_stream));
  ((ptr_stream)BYTEDATA_DATA(result))->fp = fp;
  ((ptr_stream)BYTEDATA_DATA(result))->op = FP_NONE;
  return result;
}

static long fopen_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

fopen_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 739 of file sys.c.

References FALSE, fileptr2stream(), NULL, push_goal(), sys_file_stream, TRUE, and unify.

{
  FILE *fp = fopen((char*)args[0]->value_3,
           (char*)args[1]->value_3);
  if (fp==NULL) return FALSE;
  else {
    /*    ptr_psi_term temp_result = make_bytedata(sys_file_stream,sizeof(fp));
     *(FILE**)BYTEDATA_DATA(temp_result) = fp;
     */
    push_goal(unify,fileptr2stream(fp,sys_file_stream),result,NULL); // added & DJD
    return TRUE;
  }
}

static long fork_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

Definition at line 1643 of file sys.c.

References FALSE, REAL, and unify_real_result().

{
  pid_t id = fork();
  if (id < 0) return FALSE;
  else  return unify_real_result(result,(REAL)id);
}

static long fseek_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

fseek_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

(FILE**)BYTEDATA_DATA(args[0])

Definition at line 1169 of file sys.c.

References BYTEDATA_DATA, FALSE, a_stream::fp, FP_NONE, a_stream::op, REAL, SEEK_SET, TRUE, and wl_psi_term::value_3.

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  srm->op = FP_NONE;
  return
    (fseek(srm->fp ,
       (long)*(REAL*)args[1]->value_3,
       args[2]?(long)*(REAL*)args[2]->value_3:SEEK_SET) < 0)
    ?FALSE:TRUE;
}

static long ftell_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

ftell_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1128 of file sys.c.

References BYTEDATA_DATA, a_stream::fp, FP_INPUT, FP_NONE, a_stream::op, REAL, and unify_real_result().

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  if (srm->op != FP_NONE || srm->op != FP_INPUT) {
    fflush(srm->fp);
    srm->op = FP_NONE;
  }
  return unify_real_result(result,(REAL)ftell(srm->fp));
  /*  *(FILE**)BYTEDATA_DATA(args[0])));*/
}

static long fwrite_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

fwrite_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 802 of file sys.c.

References BYTEDATA_DATA, FALSE, a_stream::fp, FP_OUTPUT, FP_PREPARE, and TRUE.

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
  char* txt = (char*)args[1]->value_3;
  FP_PREPARE(srm,FP_OUTPUT);
  if (txt && *txt!='\0' &&
      fwrite((void*)txt,sizeof(char),strlen(txt),srm->fp)<=0)
    return FALSE;
  return TRUE;
}

static long get_buffer_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

get_buffer_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 864 of file sys.c.

References BYTEDATA_DATA, FALSE, a_stream::fp, FP_INPUT, FP_PREPARE, heap_alloc(), NULL, push_goal(), quoted_string, REAL, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
  long size = *(REAL*)args[1]->value_3;
  ptr_psi_term t = stack_psi_term(4);
  t->type = quoted_string;
  t->value_3=(GENERIC)heap_alloc(size+1);
  bzero((char*)t->value_3,size+1);
  FP_PREPARE(srm,FP_INPUT);
  if (fread((void*)t->value_3,sizeof(char),size,srm->fp) <= 0)
    return FALSE;
  push_goal(unify,t,result,NULL);
  return TRUE;
}

static long get_code_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

get_code_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1099 of file sys.c.

References BYTEDATA_DATA, FALSE, a_stream::fp, FP_INPUT, FP_PREPARE, REAL, and unify_real_result().

{
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  int c;
  FP_PREPARE(srm,FP_INPUT);
  if ((c=getc(srm->fp)) == EOF) return FALSE;
  else return unify_real_result(result,(REAL)c);
}

char * get_numeric_feature

(

long

n

)

get_numeric_feature

Parameters

n

- long n

Definition at line 1698 of file sys.c.

References heap_copy_string(), one, three, and two.

{
  if      (n==1) return one;
  else if (n==2) return two;
  else if (n==3) return three;
  else {
    char buf[100];
    (void)snprintf(buf,100,"%ld",n);
    return heap_copy_string(buf);
  }
}

static long get_record_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

get_record_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1004 of file sys.c.

References BYTEDATA_DATA, text_buffer::data, a_stream::fp, FP_INPUT, FP_PREPARE, heap_alloc(), text_buffer::next, NULL, push_goal(), quoted_string, stack_psi_term(), text_buffer_cmp(), text_buffer_free(), text_buffer_next(), text_buffer_push(), text_buffer::top, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

{
  struct text_buffer rootbuf;
  struct text_buffer *curbuf = &rootbuf;
  struct text_buffer *lastbuf = &rootbuf;
  int lastidx = 0,size;
  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
  FILE *fp = srm->fp; /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
  char *sep = (char*)args[1]->value_3;
  int c;
  ptr_psi_term t;
  char *cursep = sep;

  FP_PREPARE(srm,FP_INPUT);
  bzero((char*)&rootbuf,sizeof(rootbuf));
  if (!sep || !*sep) {
    /* no separator: just grab as much as you can */
    while ((c=getc(fp)) != EOF)
      text_buffer_push(&curbuf,(char)c);
    goto PackUpAndLeave;
  }

  if (sep[1]=='\0') {
    /* only one char in string */
    while ((c=getc(fp)) != EOF) {
      text_buffer_push(&curbuf,(char)c);
      if (c==*sep) break;
    }
    goto PackUpAndLeave;
  }

  /* general case: multicharacter separator */

 WaitForStart:
  if ((c=getc(fp)) == EOF) goto PackUpAndLeave;
  text_buffer_push(&curbuf,(char)c);
  if (c==*sep) {
    cursep = sep+1;
    lastbuf=curbuf;
    lastidx=curbuf->top - 1;
    goto MatchNext;
  }
  else goto WaitForStart;

 MatchNext:
  if (!*cursep || (c=getc(fp))==EOF) goto PackUpAndLeave;
  text_buffer_push(&curbuf,(char)c);
  if (c!=*cursep) goto TryAgain;
  cursep++;
  goto MatchNext;

 TryAgain:
  if (!text_buffer_next(lastbuf,lastidx+1,*sep,&lastbuf,&lastidx))
    goto WaitForStart;
  if (!(cursep=text_buffer_cmp(lastbuf,lastidx,sep)))
    goto TryAgain;
  goto MatchNext;

 PackUpAndLeave:
  /* compute how much space we need */
  for(lastbuf=&rootbuf,size=0;lastbuf!=NULL;lastbuf=lastbuf->next)
    size += lastbuf->top;
  t=stack_psi_term(0);
  t->type=quoted_string;
  t->value_3=(GENERIC)heap_alloc(size+1);
  for(lastbuf=&rootbuf,sep=(char*)t->value_3;
      lastbuf!=NULL;sep+=lastbuf->top,lastbuf=lastbuf->next)
    bcopy(lastbuf->data,sep,lastbuf->top);
  ((char*)t->value_3)[size]='\0';
  text_buffer_free(rootbuf.next);
  push_goal(unify,t,result,NULL);
  return TRUE;
}

static long gethostname_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

gethostname_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1886 of file sys.c.

References FALSE, NULL, push_goal(), stack_string(), TRUE, and unify.

{
  char name_loc[MAXHOSTNAMELEN+1];
  if (gethostname(name_loc,MAXHOSTNAMELEN+1) == 0) {
    push_goal(unify,result,stack_string(name_loc),NULL);
    return TRUE;
  }
  else return FALSE;
}

static long getpid_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

getpid_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 2147 of file sys.c.

References REAL, and unify_real_result().

{
  return unify_real_result(result,(REAL)getpid());
}

static long import_symbol_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

import_symbol_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1582 of file sys.c.

References wl_keyword::combined_name, current_module, wl_keyword::definition, Errorline(), FALSE, hash_insert(), hash_lookup(), HEAP_ALLOC, heap_copy_string(), wl_definition::keyword, make_module_token(), wl_keyword::module, wl_keyword::private_feature, wl_keyword::public, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, wl_definition::type_def, and undef_it.

{
  ptr_keyword key;

  if (args[1])
    key=args[1]->type->keyword;
  else
    key=hash_lookup(current_module->symbol_table,
            args[0]->type->keyword->symbol);

  if (key)
    if (key->definition->type_def != (def_type)undef_it) {
      Errorline("symbol %s already defined in %P.",key->combined_name,funct);
      return FALSE;
    }
    else key->definition=args[0]->type;
  else {
    /* adapted from update_symbol in modules.c */
    /* Add 'module#symbol' to the symbol table */
    key=HEAP_ALLOC(struct wl_keyword);
    key->module=current_module;
    /* use same name */
    key->symbol=args[0]->type->keyword->symbol;
    key->combined_name=(char *)
      heap_copy_string(make_module_token(current_module,key->symbol));
    key->public=FALSE;
    key->private_feature=FALSE;
    key->definition=args[0]->type; /* use given definition */
    
    hash_insert(current_module->symbol_table,key->symbol,key);
  }
  return TRUE;
}

void insert_sys_builtins

(

)

insert_sys_builtins

Definition at line 2209 of file sys.c.

References bi_module, c_accept(), c_apply1(), c_bind(), c_bitvector_and(), c_bitvector_clear(), c_bitvector_count(), c_bitvector_get(), c_bitvector_not(), c_bitvector_or(), c_bitvector_set(), c_bitvector_xor(), c_call_once(), c_connect(), c_cuserid(), c_errmsg(), c_errno(), c_fclose(), c_fflush(), c_fopen(), c_fork(), c_fseek(), c_ftell(), c_fwrite(), c_get_buffer(), c_get_code(), c_get_record(), c_gethostname(), c_getpid(), c_import_symbol(), c_int2stream(), c_kill(), c_lazy_project(), c_listen(), c_make_bitvector(), c_my_wait_on_feature(), c_regexp_compile(), c_regexp_execute(), c_socket(), c_stream2sys_stream(), c_sys_stream2stream(), c_wait(), c_wait_on_feature(), c_waitpid(), current_module, function_it, insert_dbm_builtins(), new_built_in(), predicate_it, set_current_module(), sys_bitvector, sys_bytedata, sys_file_stream, sys_module, sys_process_continued, sys_process_exited, sys_process_no_children, sys_process_signaled, sys_process_stopped, sys_regexp, sys_socket_stream, sys_stream, and update_symbol().

{
  ptr_module curmod = current_module;
  (void)set_current_module(sys_module);

  sys_bytedata      =update_symbol(sys_module,"bytedata"); /* DENYS: BYTEDATA */
  sys_bitvector     =update_symbol(sys_module,"bitvector");
  sys_regexp        =update_symbol(sys_module,"regexp");
  sys_stream        =update_symbol(sys_module,"stream");
  sys_file_stream   =update_symbol(sys_module,"file_stream");
  sys_socket_stream =update_symbol(sys_module,"socket_stream");
  sys_process_no_children=update_symbol(sys_module,"process_no_children");
  sys_process_exited    =update_symbol(sys_module,"process_exited");
  sys_process_signaled  =update_symbol(sys_module,"process_signaled");
  sys_process_stopped   =update_symbol(sys_module,"process_stopped");
  sys_process_continued =update_symbol(sys_module,"process_continued");

  /* DENYS: BYTEDATA */
  /* purely for illustration
     new_built_in(sys_module,"string_to_bytedata",(def_type)function_it,c_string_to_bytedata);
     new_built_in(sys_module,"bytedata_to_string",(def_type)function_it,c_bytedata_to_string);
  */
  new_built_in(sys_module,"make_bitvector"  ,(def_type)function_it ,c_make_bitvector);
  new_built_in(sys_module,"bitvector_and"   ,(def_type)function_it ,c_bitvector_and);
  new_built_in(sys_module,"bitvector_or"    ,(def_type)function_it ,c_bitvector_or);
  new_built_in(sys_module,"bitvector_xor"   ,(def_type)function_it ,c_bitvector_xor);
  new_built_in(sys_module,"bitvector_not"   ,(def_type)function_it ,c_bitvector_not);
  new_built_in(sys_module,"bitvector_count" ,(def_type)function_it ,c_bitvector_count);
  new_built_in(sys_module,"bitvector_get"   ,(def_type)function_it ,c_bitvector_get);
  new_built_in(sys_module,"bitvector_set"   ,(def_type)function_it ,c_bitvector_set);
  new_built_in(sys_module,"bitvector_clear" ,(def_type)function_it ,c_bitvector_clear);
  new_built_in(sys_module,"regexp_compile"  ,(def_type)function_it ,c_regexp_compile);
  new_built_in(sys_module,"regexp_execute"  ,(def_type)function_it ,c_regexp_execute);
  new_built_in(sys_module,"int2stream"      ,(def_type)function_it ,c_int2stream);
  new_built_in(sys_module,"fopen"       ,(def_type)function_it ,c_fopen);
  new_built_in(sys_module,"fclose"      ,(def_type)function_it ,c_fclose);
  new_built_in(sys_module,"get_buffer"      ,(def_type)function_it ,c_get_buffer);
  new_built_in(sys_module,"get_record"      ,(def_type)function_it ,c_get_record);
  new_built_in(sys_module,"get_code"        ,(def_type)function_it ,c_get_code);
  new_built_in(sys_module,"ftell"       ,(def_type)function_it ,c_ftell);
  new_built_in(sys_module,"fseek"       ,(def_type)predicate_it,c_fseek);
  new_built_in(sys_module,"socket"      ,(def_type)function_it ,c_socket);
  new_built_in(sys_module,"bind"        ,(def_type)predicate_it,c_bind);
  new_built_in(sys_module,"connect"     ,(def_type)predicate_it,c_connect);
  new_built_in(sys_module,"fwrite"      ,(def_type)predicate_it,c_fwrite);
  new_built_in(sys_module,"fflush"      ,(def_type)predicate_it,c_fflush);
  new_built_in(sys_module,"listen"      ,(def_type)predicate_it,c_listen);
  new_built_in(sys_module,"accept"      ,(def_type)function_it ,c_accept);
  new_built_in(sys_module,"errno"       ,(def_type)function_it ,c_errno);
  new_built_in(sys_module,"errmsg"      ,(def_type)function_it ,c_errmsg);
  new_built_in(sys_module,"import_symbol"   ,(def_type)predicate_it,c_import_symbol);
  new_built_in(sys_module,"fork"        ,(def_type)function_it ,c_fork);
  new_built_in(sys_module,"wait"        ,(def_type)function_it ,c_wait);
  new_built_in(sys_module,"waitpid"     ,(def_type)function_it ,c_waitpid);
  new_built_in(sys_module,"kill"        ,(def_type)predicate_it,c_kill);
  new_built_in(sys_module,"cuserid"     ,(def_type)function_it ,c_cuserid);
  new_built_in(sys_module,"gethostname"     ,(def_type)function_it ,c_gethostname);
  new_built_in(sys_module,"lazy_project"    ,(def_type)function_it ,c_lazy_project);
  new_built_in(sys_module,"wait_on_feature" ,(def_type)predicate_it,c_wait_on_feature);
  new_built_in(sys_module,"my_wait_on_feature"  ,(def_type)function_it ,c_my_wait_on_feature);
  new_built_in(sys_module,"apply1"      ,(def_type)function_it ,c_apply1);
  new_built_in(sys_module,"getpid"      ,(def_type)function_it ,c_getpid);
  new_built_in(sys_module,"stream2sys_stream"   ,(def_type)function_it ,c_stream2sys_stream);
  new_built_in(sys_module,"sys_stream2stream"   ,(def_type)function_it ,c_sys_stream2stream);
#ifdef LIFE_DBM
  insert_dbm_builtins();
#endif
#ifdef LIFE_NDBM
  insert_ndbm_builtins();
#endif
  (void)set_current_module(bi_module);
  new_built_in(bi_module ,"call_once"       ,(def_type)function_it ,c_call_once);
  (void)set_current_module(curmod);
}

static long int2stream_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

int2stream_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 704 of file sys.c.

References FALSE, fileptr2stream(), NULL, push_goal(), REAL, sys_stream, TRUE, and unify.

{
  FILE *fp = fdopen((int)*(REAL*)args[0]->value_3,
            (char*)args[1]->value_3);
  if (fp==NULL) return FALSE;
  else {
    push_goal(unify,fileptr2stream(fp,sys_stream),result,NULL); // added & DJD
    /*    ptr_psi_term temp_result = make_bytedata(sys_stream,sizeof(fp));
     *(FILE**)BYTEDATA_DATA(temp_result) = fp;
     push_goal(unify,temp_result,result,NULL); */
    return TRUE;
  }
}

int is_ipaddr

(

char *

s

)

is_ipaddr

Parameters

s

- char *s

Definition at line 1333 of file sys.c.

References NULL.

{
  if (s==NULL) return 0;
  while (*s)
    if (!isdigit(*s) && *s!='.') return 0;
    else s++;
  return 1;
}

static long kill_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

kill_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1824 of file sys.c.

References FALSE, REAL, and TRUE.

{
  return (kill((pid_t)*(REAL*)args[0]->value_3,
           (int)*(REAL*)args[1]->value_3)==0)?TRUE:FALSE;
}

static long lazy_project_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

lazy_project_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1917 of file sys.c.

References wl_node::data, FEATCMP, find(), integer, NULL, push_goal(), quoted_string, REAL, residuate(), sub_type(), top, TRUE, and unify.

{
  ptr_node n;
  char buffer_loc[100];
  if (args[1]->type == top) {
    residuate(args[0]);
    residuate(args[1]);
    return TRUE;
  }
  if (sub_type(args[1]->type,integer) && args[1]->value_3)
    snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
    strcpy(buffer_loc,(char*)args[1]->value_3);
  else
    strcpy(buffer_loc,args[1]->type->keyword->symbol);
  n=find(FEATCMP,buffer_loc,args[0]->attr_list);
  if (n) push_goal(unify,(ptr_psi_term)n->data,result,NULL);
  /* this is all bullshit because projection should residuate
     on its 2nd arg until it becomes value.  In particular, think
     of using `int' as a feature when it is clear that `int' may
     subsequently be refined to a particular integer. */
  else residuate(args[0]);
  return TRUE;
}

static long listen_internal ( args  ,   result,   funct  )

static

(FILE**)BYTEDATA_DATA(args[0]));

Definition at line 1445 of file sys.c.

References BYTEDATA_DATA, FALSE, REAL, and TRUE.

{
  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp); 
  int n = *(REAL*)args[1]->value_3;

  if (listen(fd,n) < 0) return FALSE;
  return TRUE;
}

static long make_bitvector_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

make_bitvector_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

C_MAKE_BITVECTOR make a bitvector that can hold at least the given number of bits

Definition at line 154 of file sys.c.

References Errorline(), FALSE, make_bytedata(), NULL, push_goal(), REAL, sys_bitvector, TRUE, and unify.

{
  long bits = *(REAL *)args[0]->value_3;
  if (bits < 0) {
    Errorline("negative argument in %P.\n",funct);
    return FALSE; }
  else {
    unsigned long bytes = bits / sizeof(char);
    ptr_psi_term temp_result;
    if ((bits % sizeof(char)) != 0) bytes++;
    temp_result = make_bytedata(sys_bitvector,bytes);
    push_goal(unify,temp_result,result,NULL);
    return TRUE; }
}

static ptr_psi_term make_bytedata ( ptr_definition  sort, unsigned long  bytes  )

static

make_bytedata(

Parameters

sort	- ptr_definition sort
bytes	- unsigned long bytes

MAKE_BYTEDATA construct a psi term of the given sort whose value points to a bytedata block that can hold the given number of bytes

Definition at line 126 of file sys.c.

References heap_alloc(), stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

{
  ptr_psi_term temp_result;
  char *b = (char *) heap_alloc(bytes+sizeof(bytes));
  *((long *) b) = bytes;
  bzero(b+sizeof(bytes),bytes);
  temp_result=stack_psi_term(0);
  temp_result->type=sort;
  temp_result->value_3=(GENERIC)b;
  return temp_result;
}

void make_sys_type_links

(

)

make_sys_type_links

INITIALIZATION FUNCTIONS

Definition at line 2168 of file sys.c.

References built_in, make_type_link(), sys_bitvector, sys_bytedata, sys_file_stream, sys_regexp, sys_socket_stream, and sys_stream.

{
#ifdef LIFE_NDBM
  make_ndbm_type_links();
#endif
  make_type_link(sys_bitvector    ,sys_bytedata);
  make_type_link(sys_regexp       ,sys_bytedata);
  make_type_link(sys_stream       ,sys_bytedata);
  make_type_link(sys_file_stream  ,sys_stream);
  make_type_link(sys_socket_stream,sys_stream);
  make_type_link(sys_bytedata     ,built_in); /* DENYS: BYTEDATA */
}

static long my_wait_on_feature_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

my_wait_on_feature_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 2012 of file sys.c.

References DEFRULES, FEATCMP, find(), integer, NULL, prove, push_goal(), quoted_string, REAL, residuate(), sub_type(), top, TRUE, and unify_bool_result().

{
  char buffer_loc[100];
  if (args[1]->type == top) {
    residuate(args[0]);
    residuate(args[1]);
    return TRUE;
  }
  if (sub_type(args[1]->type,integer) && args[1]->value_3)
    snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
    strcpy(buffer_loc,(char*)args[1]->value_3);
  else
    strcpy(buffer_loc,args[1]->type->keyword->symbol);
  if (find(FEATCMP,buffer_loc,args[0]->attr_list)) {
    unify_bool_result(result,TRUE);
    push_goal(prove,args[2],(ptr_psi_term)DEFRULES,NULL);
  }
  /* this is all bullshit because projection should residuate
     on its 2nd arg until it becomes value.  In particular, think
     of using `int' as a feature when it is clear that `int' may
     subsequently be refined to a particular integer. */
  else residuate(args[0]);
  return TRUE;
}

void regerror

(

char *

s

)

regerror

Parameters

s

- char *s

Definition at line 498 of file sys.c.

{
  fprintf(stderr,"Regexp Error: %s\n",s);
}

static long regexp_compile_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

regexp_compile_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

C_REGEXP_COMPILE given a string returns, compiles it into a regexp structure, then copies that structure into a bytedata block on the heap.

Definition at line 514 of file sys.c.

References c_abort(), Errorline(), make_bytedata(), NULL, push_goal(), sys_regexp, TRUE, unify, and wl_psi_term::value_3.

{
  ptr_psi_term temp_result;
  regexp * re = regcomp((char *)args[0]->value_3);
  long bytes;
  if (re == NULL) {
    Errorline("compilation of regular expression failed in %P.\n",funct);
    return (c_abort()); }
  /* compute the size of the regexp stuff.  this is essentially the size
     of the regexp structure + the size of the program (bytecode) including
     the final END opcode (i.e. 0), hence the + 1, minus the bytes that we
     have counted twice, i.e. those between the start of the program and
     the computed end of the regexp structure (i.e. in case a regexp
     struct is larger, maybe to respect alignment constraints, than it has
     to be, and also to count the 1 byte of program included in the decl
     of struct regexp */
  bytes = last_regsize();
  temp_result = make_bytedata(sys_regexp,bytes);
  /* now let's copy the regexp stuff into the bytedata block.  The regmust
     field must be treated specially because it is a pointer into program:
     we cannot simply change it to reflect the location where the program
     will be copied to because that may well change over time: the gc may
     relocate the bytedata block.  Instead, we convert regmust into an
     offset and each time we need to pass it to regexec or regsub we must
     first convert it back into a pointer then back into an offset when we
     are done.  Note that, if regmust is NULL we must leave it that way */
  if (re->regmust != NULL)
    re->regmust = (char *) ((unsigned long) (re->regmust - (char *)re));
  bcopy((char*)re,((char*)temp_result->value_3)+sizeof(unsigned long),bytes);
  free(re);         /* free the regexp: no longer needed */
  /* return result */
  push_goal(unify,temp_result,result,NULL);
  return TRUE;
}

static long regexp_execute_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

regexp_execute_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	ptr_psi_term funct

C_REGEXP_EXECUTE Attempts to match a regexp with a string regexp_execute(RE:regexp,S:string) -> @(0=>(S0,E0),(S1,E1),...) regexp_execute(RE:regexp,S:string,@(N=>(SN,EN),...)) -> boolean 2nd form only instantiates the bounds requested in the mask (3rd arg) and returns a boolean so that it can be used as a predicate. The optional argument "offset" specifies an offset into the string.

Definition at line 576 of file sys.c.

References wl_psi_term::attr_list, c_abort(), wl_node::data, Errorline(), FALSE, FEATCMP, find(), NULL, push_goal(), REAL, stack_insert_copystr(), stack_int(), stack_pair(), stack_psi_term(), top, TRUE, wl_psi_term::type, unify, unify_bool_result(), and wl_psi_term::value_3.

{
  regexp * re = (regexp*)(((char *)args[0]->value_3)+sizeof(unsigned long));
  char * must = re->regmust;
  long offset = 0;
  //  long success = TRUE;
  /* check that args[3] aka "offset" is valid if present */
  if (args[3]) {
    offset = *(REAL*)args[3]->value_3;
    if (offset < 0 || offset > strlen((char*)args[1]->value_3)) {
      Errorline("Illegal offset in %P.\n",funct);
      return (c_abort()); }
  }
  /* convert regmust from offset into a pointer if not NULL */
  if (must != NULL)
    re->regmust = (char*)re+(unsigned long)must;
  /* perform operation */
  if (regexec(re,((char *)args[1]->value_3) + offset) == 0) {
    if (must != NULL) re->regmust = must; /* back into an offset */
    return FALSE;
  }
  else {
    /* construct result of match */
    char **sp = re->startp;
    char **ep = re->endp;
    int i;
    char buffer_loc[5];     /* in case NSUBEXP ever gets increased */
    ptr_node n3;
    if (must != NULL) re->regmust = must; /* back into an offset */
    if (args[2]) {
      /* only instantiate the numeric features present in args[2]
     then return true */
      for (i=0;i<NSUBEXP;i++,sp++,ep++) {
    if (*sp==NULL) break;
    (void)snprintf(buffer_loc,5,"%d",i);
    n3=find(FEATCMP,buffer_loc,args[2]->attr_list);
    if (n3) {
      ptr_psi_term psi = (ptr_psi_term) n3->data;
      /* need to add 1 to these offsets because somehow life strings
         are 1-based rather than 0-based.  Who is the moron who made
         that decision?  This isn't Pascal! */
      ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
                       stack_int(*ep - (char *)args[1]->value_3 + 1));
      push_goal(unify,psi,bounds,NULL);
    }
      }
      /* return true */
      unify_bool_result(result,TRUE);
    }
    else {
      /* create a term to represent all the groups and return it */
      ptr_psi_term psi = stack_psi_term(4);
      psi->type = top;
      for (i=0;i<NSUBEXP;i++,sp++,ep++) {
    if (*sp==NULL) break;
    (void)snprintf(buffer_loc,5,"%d",i);
    { ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
                       stack_int(*ep - (char *)args[1]->value_3 + 1));
      stack_insert_copystr(buffer_loc,&(psi->attr_list),(GENERIC)bounds); }
      }
      /* return the new term */
      push_goal(unify,psi,result,NULL);
    }
    return TRUE;
  }
}

static long socket_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

socket_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1269 of file sys.c.

References Errorline(), FALSE, fileptr2stream(), NULL, push_goal(), sys_socket_stream, TRUE, and unify.

{
  int addr_family=AF_INET,type=SOCK_STREAM,protocol=0;
  char *s;
  int fd;

  if (args[0]) {
    s=(char*)args[0]->value_3;
    if      (!strcmp(s,"AF_UNIX")) addr_family=AF_UNIX;
    else if (!strcmp(s,"AF_INET")) addr_family=AF_INET;
    else {
      Errorline("Unknown address family in %P.\n",funct);
      return FALSE; }
  }

  if (args[1]) {
    s=(char*)args[1]->value_3;
    if      (!strcmp(s,"SOCK_STREAM")) type=SOCK_STREAM;
    else if (!strcmp(s,"SOCK_DGRAM" )) type=SOCK_DGRAM;
    else if (!strcmp(s,"SOCK_RAW"   )) {
      Errorline("SOCK_RAW not supported in %P.\n",funct);
      return FALSE; }
    else {
      Errorline("Unknown socket type in %P.\n",funct);
      return FALSE; }
  }

  if ((fd=socket(addr_family,type,protocol))<0)
    return FALSE;

  { FILE*fp = fdopen(fd,"r+");
    //    ptr_psi_term t;

    if (fp==NULL) {
      Errorline("fdopen failed on socket in %P.\n",funct);
      return FALSE;
    }

    /*    t = make_bytedata(sys_socket_stream,sizeof(fp));
     *(FILE**)BYTEDATA_DATA(t) = fp;*/
    push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
  }
  return TRUE;
}

static long stream2sys_stream_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

stream2sys_stream_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1202 of file sys.c.

References fileptr2stream(), NULL, push_goal(), sys_stream, TRUE, and unify.

{
  push_goal(unify,fileptr2stream((FILE*)args[0]->value_3,sys_stream),
        result,NULL);  // added & DJD
  return TRUE;
}

static long sys_stream2stream_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

sys_stream2stream_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1229 of file sys.c.

References BYTEDATA_DATA, NULL, push_goal(), stack_psi_term(), stream, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

{
  ptr_psi_term tmp;
  tmp=stack_psi_term(4);
  tmp->type=stream;
  tmp->value_3=(GENERIC)((ptr_stream)BYTEDATA_DATA(args[0]))->fp;
  push_goal(unify,tmp,result,NULL);
  return TRUE;
}

char* text_buffer_cmp	(	struct text_buffer *	buf,
		int	idx,
		char *	str
	)

text_buffer_cmp

Parameters

buf	- struct text_buffer *buf
idx	- int idx
str	- char *str

compare string str with text in buffer buf starting at index idx. if the text to the end matches a prefix of the string, return pointer to remaining suffix of str to be matched, else return 0.

Definition at line 934 of file sys.c.

References text_buffer::data, text_buffer::next, and top.

{
  while (buf) {
    while (idx<buf->top)
      if (!*str || buf->data[idx] != *str)
    return 0;
      else { idx++; str++; }
    if (!*str && !buf->next) return str;
    else {
      buf=buf->next;
      idx=0;
    }
  }
  return 0;
}

void text_buffer_free

(

struct text_buffer *

buf

)

text_buffer_free

Parameters

buf	- struct text_buffer *buf

free a linked list of buffers

Definition at line 986 of file sys.c.

References text_buffer::next.

{
  struct text_buffer *next;
  while (buf) {
    next = buf->next;
    free(buf);
    buf=next;
  }
}

int text_buffer_next	(	struct text_buffer *	buf,
		int	idx,
		char	c,
		struct text_buffer **	rbuf,
		int *	ridx
	)

text_buffer_next

Parameters

buf	- struct text_buffer *buf
idx	- int idx
c	- char c
rbuf	- struct text_buffer **rbuf
ridx	- int *ridx

find the first match for character c starting from index idx in buffer buf. if found place new buffer and index in rbuf and ridx and return 1, else return 0

Definition at line 907 of file sys.c.

References text_buffer::data, text_buffer::next, and top.

{
  while (buf) {
    while (idx<buf->top)
      if (buf->data[idx] == c) {
    *rbuf=buf;
    *ridx=idx;
    return 1;
      }
      else idx++;
    buf=buf->next;
    idx=0;
  }
  return 0;
}

void text_buffer_push	(	struct text_buffer **	buf,
		char	c
	)

text_buffer_push

Parameters

buf	- struct text_buffer **buf
c	- char c

add a character at the end of a buffer. if the buffer is full, allocate a new buffer and link it to the current one, then overwrite the variable holding the pointer to the current buffer with the pointer to the new buffer.

Definition at line 961 of file sys.c.

References text_buffer::next, TEXTBUFSIZE, and text_buffer::top.

{
  if ((*buf)->top < TEXTBUFSIZE)
    (*buf)->data[(*buf)->top++] = c;
  else {
    (*buf)->next = (struct text_buffer *)
      malloc(sizeof(struct text_buffer));
    if (!(*buf)->next) {
      fprintf(stderr,"Fatal error: malloc failed in text_buffer_push\n");
      exit(EXIT_FAILURE);
    }
    bzero((char*)(*buf)->next,sizeof(struct text_buffer));
    *buf = (*buf)->next;
    (*buf)->top = 1;
    (*buf)->data[0]=c;
  }
}

static long unify_pterm_result ( ptr_psi_term  t, ptr_definition  sym, psi_feature  lst[], int  n  )

static

unify_pterm_result

Parameters

t	- ptr_psi_term t
sym	- ptr_definition sym
lst	- psi_feature lst[]
n	- int n

Definition at line 1676 of file sys.c.

References wl_psi_term::attr_list, FEATCMP, NULL, push_goal(), stack_insert(), stack_psi_term(), TRUE, wl_psi_term::type, unify, and psi_feature::value_str.

{
  ptr_psi_term u;
  int i;
  if (n<0) {
    fprintf(stderr,"unify_pterm_result called with n<0: n=%d\n",n);
    exit(EXIT_FAILURE);
  }
  u=stack_psi_term(4);
  u->type=sym;
  for(i=0;i<n;i++)
    (void)stack_insert(FEATCMP,lst[i].name_str,&(u->attr_list),(GENERIC)lst[i].value_str);
  push_goal(unify,t,u,NULL);
  return TRUE;
}

static long unify_wait_result ( ptr_psi_term  result, pid_t  id, int  status  )

static

unify_wait_result

Parameters

result	- ptr_psi_term result
id	- pid_t id
status	- int status

Definition at line 1722 of file sys.c.

References Errorline(), FALSE, one, SETFEATURE, stack_int(), sys_process_continued, sys_process_exited, sys_process_no_children, sys_process_signaled, sys_process_stopped, two, and unify_pterm_result().

{
  int n=2;
  long status2;
  ptr_definition sym;
  psi_feature lst[2];
  SETFEATURE(lst,0,one,stack_int(id));
  if (id == -1 || status == -1) {
    if (errno==ECHILD) {
      sym = sys_process_no_children;
      n=0;
    }
    else return FALSE;
  }
  else if (WIFEXITED(status)) {
    SETFEATURE(lst,1,two,stack_int(WEXITSTATUS(status)));
    sym = sys_process_exited;
  }
  else if (WIFSIGNALED(status)) {
    SETFEATURE(lst,1,two,stack_int(WTERMSIG(status)));
    sym = sys_process_signaled;
  }
  else if (WIFSTOPPED(status)) {
    SETFEATURE(lst,1,two,stack_int(WSTOPSIG(status)));
    sym = sys_process_stopped;
  }
#ifdef WIFCONTINUED
  else if (WIFCONTINUED(status)) {
    sym = sys_process_continued;
    n=1;
  }
#endif
  else {
    status2 = status;
    Errorline("Unexpected wait status: %d",status2);
    return FALSE;
  }
  return unify_pterm_result(result,sym,lst,n);
}

static long wait_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

wait_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1770 of file sys.c.

References unify_wait_result().

{
  int status;
  pid_t id = wait(&status);
  return unify_wait_result(result,id,status);
}

static long wait_on_feature_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

wait_on_feature_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1966 of file sys.c.

References DEFRULES, FEATCMP, find(), integer, NULL, prove, push_goal(), quoted_string, REAL, residuate(), sub_type(), top, and TRUE.

{
  char buffer_loc[100];
  if (args[1]->type == top) {
    residuate(args[0]);
    residuate(args[1]);
    return TRUE;
  }
  if (sub_type(args[1]->type,integer) && args[1]->value_3)
    snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
    strcpy(buffer_loc,(char*)args[1]->value_3);
  else
    strcpy(buffer_loc,args[1]->type->keyword->symbol);
  if (find(FEATCMP,buffer_loc,args[0]->attr_list))
    push_goal(prove,args[2],(ptr_psi_term)DEFRULES,NULL);
  /* this is all bullshit because projection should residuate
     on its 2nd arg until it becomes value.  In particular, think
     of using `int' as a feature when it is clear that `int' may
     subsequently be refined to a particular integer. */
  else residuate(args[0]);
  return TRUE;
}

static long waitpid_internal ( ptr_psi_term  args[], ptr_psi_term  result, ptr_psi_term  funct  )

static

waitpid_internal

Parameters

args	- ptr_psi_term args[]
result	- ptr_psi_term result
funct	- ptr_psi_term funct

Definition at line 1795 of file sys.c.

References REAL, and unify_wait_result().

{
  int status;
  pid_t id = waitpid((pid_t)(long)*(REAL*)args[0]->value_3,&status,
             args[1]?(int)(long)*(REAL*)args[1]->value_3:0);
  return unify_wait_result(result,id,status);
}