Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
sys.c
Go to the documentation of this file.
1 /* Copyright by Denys Duchier, Dec 1994
2  Simon Fraser University
3 
4  All new system utilities and extensions to Wild LIFE 1.01
5  are implemented in this file and made available in LIFE
6  module "sys"
7  */
8 /* $Id: sys.c,v 1.9 1996/01/17 00:33:09 duchier Exp $ */
9 
10 #include "defs.h"
11 
12 long call_primitive(fun,num,argi,info)
13  long (*fun)();
14  int num;
15  psi_arg argi[];
16  GENERIC info;
17 {
18  ptr_psi_term funct,arg,result,argo[ARGNN]; /* no more than 10 arguments */
19  ptr_node n;
20  int allargs=1,allvalues=1,i;
21  funct=aim->aaaa_1;
22  deref_ptr(funct);
23  result=aim->bbbb_1;
24  for (i=0;i<num;i++) {
25  n=find(FEATCMP,argi[i].feature,funct->attr_list);
26  /* argument present */
27  if (n) {
28  arg = (ptr_psi_term) n->data;
29  /* in case we don't want to evaluate the argument
30  just follow the chain of corefs and don't do
31  any of the other checks: they'll have do be done
32  by fun; just go on to the next arg */
33  if (argi[i].options&UNEVALED) {
34  deref_ptr(arg);
35  argo[i]=arg;
36  continue; }
37  /* this arg should be evaled */
38  deref(arg);
39  argo[i]=arg;
40  /* arg of admissible type */
41  if (argi[i].options&POLYTYPE) {
42  ptr_definition *type = (ptr_definition *)argi[i].type;
43  while (*type != NULL)
44  if (overlap_type(arg->type,*type))
45  goto admissible;
46  else type++;
47  }
48  else {
49  if (overlap_type(arg->type,argi[i].type))
50  goto admissible;
51  }
52  /* not admissible */
53  if (argi[i].options&JUSTFAIL) return FALSE;
54  Errorline("Illegal argument in %P.\n",funct);
55  return (c_abort());
56  /* admissible */
57  admissible:
58  /* has value */
59  if (arg->value_3) {
60  ptr_definition *type = (ptr_definition *)argi[i].type;
61  /* paranoid check: really correct type */
62  if (argi[i].options&POLYTYPE) {
63  while (*type != NULL)
64  if (sub_type(arg->type,*type))
65  goto correct;
66  else type++;
67  }
68  else {
69  if (sub_type(arg->type,(ptr_definition)type)) goto correct;
70  }
71  /* type incorrect */
72  if (argi[i].options&JUSTFAIL) return FALSE;
73  Errorline("Illegal argument in %P.\n",funct);
74  return (c_abort());
75  /* correct */
76  correct:;
77  }
78  /* missing value - do we need it */
79  else if (!(argi[i].options&NOVALUE)) allvalues=0;
80  }
81  /* argument missing */
82  else {
83  argo[i]=NULL;
84  if (argi[i].options&MANDATORY) {
85  Errorline("Missing argument '%s' in %P.\n",argi[i].feature,funct);
86  return (c_abort());
87  }
88  else if (argi[i].options&REQUIRED) allargs=0;
89  }
90  }
91  if (allargs)
92  if (allvalues) {
93  return fun(argo,result,funct,info);
94  }
95  else {
96  for (i=0;i<num;i++) {
97  /* if arg present and should be evaled but has no value */
98  if (argo[i] && !(argi[i].options&UNEVALED) && !argo[i]->value_3)
99  residuate(argo[i]);
100  }
101  }
102  else curry();
103  return TRUE;
104 }
105 
106 /* DENYS: BYTEDATA */
107 
108 /******** MAKE_BYTEDATA
109  construct a psi term of the given sort whose value points
110  to a bytedata block that can hold the given number of bytes
111  */
112 static ptr_psi_term
113 make_bytedata(sort,bytes)
114  ptr_definition sort;
115  unsigned long bytes;
116 {
117  ptr_psi_term temp_result;
118  char *b = (char *) heap_alloc(bytes+sizeof(bytes));
119  *((long *) b) = bytes;
120  bzero(b+sizeof(bytes),bytes);
121  temp_result=stack_psi_term(0);
122  temp_result->type=sort;
123  temp_result->value_3=(GENERIC)b;
124  return temp_result;
125 }
126 
127 #define BYTEDATA_SIZE(X) (*(unsigned long *)(X->value_3))
128 #define BYTEDATA_DATA(X) ((char*)((char*)X->value_3 + sizeof(unsigned long)))
129 
130 /* BIT VECTORS *
131  ***************/
132 
133 /******** C_MAKE_BITVECTOR
134  make a bitvector that can hold at least the given number of bits
135 */
136 
137 static long
138 make_bitvector_internal(args,result,funct)
139  ptr_psi_term args[],result,funct;
140 {
141  long bits = *(REAL *)args[0]->value_3;
142  if (bits < 0) {
143  Errorline("negative argument in %P.\n",funct);
144  return FALSE; }
145  else {
146  unsigned long bytes = bits / sizeof(char);
147  ptr_psi_term temp_result;
148  if ((bits % sizeof(char)) != 0) bytes++;
149  temp_result = make_bytedata(sys_bitvector,bytes);
150  push_goal(unify,temp_result,result,NULL);
151  return TRUE; }
152 }
153 
154 static long
156 {
157  psi_arg args[1];
158  SETARG(args,0, "1" , integer , REQUIRED );
159  return call_primitive(make_bitvector_internal,NARGS(args),args,0);
160 }
161 
162 #define BV_AND 0
163 #define BV_OR 1
164 #define BV_XOR 2
165 
166 static long
167 bitvector_binop_code(bv1,bv2,result,op)
168  unsigned long *bv1,*bv2;
169  ptr_psi_term result;
170  GENERIC op; // changed to GENERIC 2.16 no effect DJD
171 {
172  unsigned long size1 = *bv1;
173  unsigned long size2 = *bv2;
174  unsigned long size3 = (size1>size2)?size1:size2;
175  ptr_psi_term temp_result = make_bytedata(sys_bitvector,size3);
176  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
177  unsigned char *s2 = ((unsigned char*)bv2)+sizeof(size2);
178  unsigned char *s3 = ((unsigned char *) temp_result->value_3) + sizeof(size3);
179  unsigned long i;
180  switch ((long)op) { // added cast DJD 2.16
181  case BV_AND:
182  for(i=0;i<size3;i++) s3[i] = s1[i] & s2[i];
183  if (size1<size2) for(;i<size2;i++) s3[i] = 0;
184  else for(;i<size1;i++) s3[i] = 0;
185  break;
186  case BV_OR:
187  for(i=0;i<size3;i++) s3[i] = s1[i] | s2[i];
188  if (size1<size2) for(;i<size2;i++) s3[i] = s2[i];
189  else for(;i<size1;i++) s3[i] = s1[i];
190  break;
191  case BV_XOR:
192  for(i=0;i<size3;i++) s3[i] = s1[i] ^ s2[i];
193  if (size1<size2) for(;i<size2;i++) s3[i] = (unsigned char) 0 ^ s2[i];
194  else for(;i<size1;i++) s3[i] = s1[i] ^ (unsigned char) 0;
195  break;
196  default: return (c_abort());
197  }
198  push_goal(unify,temp_result,result,NULL);
199  return TRUE;
200 }
201 
202 /******** BITVECTOR_BINOP
203 */
204 // DJD
205 static long
206 bitvector_binop_internal(args,result,funct,op)
207  ptr_psi_term *args,result,funct;
208  GENERIC op; // changed to GENERIC 2.16 DJD
209 {
210  return bitvector_binop_code((unsigned long *)args[0]->value_3,
211  (unsigned long *)args[1]->value_3,
212  result,(GENERIC)op);
213 }
214 
215 static long
217  long op;
218 {
219  psi_arg args[2];
220  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
221  SETARG(args,1, "2" , sys_bitvector , REQUIRED );
222  return call_primitive(bitvector_binop_internal,NARGS(args),args,(GENERIC)op);
223 }
224 
225 static long
227 {
228  return bitvector_binop(BV_AND);
229 }
230 
231 static long
233 {
234  return bitvector_binop(BV_OR);
235 }
236 
237 static long
239 {
240  return bitvector_binop(BV_XOR);
241 }
242 
243 #define BV_NOT 0
244 #define BV_COUNT 1
245 
246 static long
247 bitvector_unop_code(bv1,result,op)
248  unsigned long *bv1;
249  ptr_psi_term result;
250  int op;
251 {
252  unsigned long size1 = *bv1;
253  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
254  unsigned long i;
255  ptr_psi_term temp_result;
256  unsigned char *s3;
257  switch (op) {
258  case BV_NOT:
259  temp_result = make_bytedata(sys_bitvector,size1);
260  s3 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
261  for(i=0;i<size1;i++) s3[i] = ~(s1[i]);
262  break;
263  case BV_COUNT:
264  {
265  int cnt = 0;
266  register unsigned char c;
267  for(i=0;i<size1;i++) {
268  c=s1[i];
269  if (c & 1<<0) cnt++;
270  if (c & 1<<1) cnt++;
271  if (c & 1<<2) cnt++;
272  if (c & 1<<3) cnt++;
273  if (c & 1<<4) cnt++;
274  if (c & 1<<5) cnt++;
275  if (c & 1<<6) cnt++;
276  if (c & 1<<7) cnt++; }
277  return unify_real_result(result,(REAL) cnt);
278  }
279  break;
280  default: return (c_abort());
281  }
282  push_goal(unify,temp_result,result,NULL);
283  return TRUE;
284 }
285 
286 /******** BITVECTOR_UNOP
287 */
288 
289 static long
290 bitvector_unop_internal(args,result,funct,op)
291  ptr_psi_term args[],result,funct;
292  GENERIC op;
293 {
294  return bitvector_unop_code((unsigned long *)args[0]->value_3,
295  result,(GENERIC) op);
296 }
297 
298 static long
300  long op;
301 {
302  psi_arg args[1];
303  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
304  return call_primitive(bitvector_unop_internal,NARGS(args),args,(GENERIC)op);
305 }
306 
307 static long
309 {
310  return bitvector_unop(BV_NOT);
311 }
312 
313 static long
315 {
316  return bitvector_unop(BV_COUNT);
317 }
318 
319 #define BV_GET 0
320 #define BV_SET 1
321 #define BV_CLEAR 2
322 
323 static long
324 bitvector_bit_code(bv1,idx,result,op,funct)
325  unsigned long * bv1;
326  long idx;
327  ptr_psi_term result,funct;
328  int op;
329 {
330  unsigned long size1 = *bv1;
331  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
332  unsigned long i = idx / sizeof(char);
333  int j = idx % sizeof(char);
334  ptr_psi_term temp_result;
335  unsigned char *s2;
336  if (idx<0 || idx>=size1) {
337  Errorline("Index out of bound in %P.\n",funct);
338  return FALSE; }
339  switch (op) {
340  case BV_GET:
341  return unify_real_result(result,(REAL)((s1[i] & (1<<j))?1:0));
342  break;
343  case BV_SET:
344  temp_result = make_bytedata(sys_bitvector,size1);
345  s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
346  bcopy(s1,s2,size1);
347  s2[i] |= 1<<j;
348  break;
349  case BV_CLEAR:
350  temp_result = make_bytedata(sys_bitvector,size1);
351  s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
352  bcopy(s1,s2,size1);
353  s2[i] &= ~ (1<<j);
354  break;
355  }
356  push_goal(unify,temp_result,result,NULL);
357  return TRUE;
358 }
359 
360 static long
361 bitvector_bit_internal(args,result,funct,op)
362  ptr_psi_term args[],result,funct;
363  GENERIC op;
364 {
365  return bitvector_bit_code((unsigned long *)args[0]->value_3,
366  (long)*((REAL*)args[1]->value_3),
367  result,(GENERIC)op,funct);
368 }
369 
370 static long
372  long op;
373 {
374  psi_arg args[2];
375  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
376  SETARG(args,1, "2" , integer , REQUIRED );
377  return call_primitive(bitvector_bit_internal,NARGS(args),args,(GENERIC)op);
378 }
379 
380 static long
382 {
383  return bitvector_bit(BV_GET);
384 }
385 
386 static long
388 {
389  return bitvector_bit(BV_SET);
390 }
391 
392 static long
394 {
395  return bitvector_bit(BV_CLEAR);
396 }
397 
398 /* REGULAR EXPRESSIONS *
399  ***********************/
400 
401 #include "regexp/regexp.h"
402 
403 void
405  char*s;
406 {
407  fprintf(stderr,"Regexp Error: %s\n",s);
408 }
409 
410 /******** C_REGEXP_COMPILE
411  given a string returns, compiles it into a regexp structure,
412  then copies that structure into a bytedata block on the heap.
413  */
414 
415 static long
416 regexp_compile_internal(args,result,funct)
417  ptr_psi_term args[],result,funct;
418 {
419  ptr_psi_term temp_result;
420  regexp * re = regcomp((char *)args[0]->value_3);
421  long bytes;
422  if (re == NULL) {
423  Errorline("compilation of regular expression failed in %P.\n",funct);
424  return (c_abort()); }
425  /* compute the size of the regexp stuff. this is essentially the size
426  of the regexp structure + the size of the program (bytecode) including
427  the final END opcode (i.e. 0), hence the + 1, minus the bytes that we
428  have counted twice, i.e. those between the start of the program and
429  the computed end of the regexp structure (i.e. in case a regexp
430  struct is larger, maybe to respect alignment constraints, than it has
431  to be, and also to count the 1 byte of program included in the decl
432  of struct regexp */
433  bytes = last_regsize();
434  temp_result = make_bytedata(sys_regexp,bytes);
435  /* now let's copy the regexp stuff into the bytedata block. The regmust
436  field must be treated specially because it is a pointer into program:
437  we cannot simply change it to reflect the location where the program
438  will be copied to because that may well change over time: the gc may
439  relocate the bytedata block. Instead, we convert regmust into an
440  offset and each time we need to pass it to regexec or regsub we must
441  first convert it back into a pointer then back into an offset when we
442  are done. Note that, if regmust is NULL we must leave it that way */
443  if (re->regmust != NULL)
444  re->regmust = (char *) ((unsigned long) (re->regmust - (char *)re));
445  bcopy((char*)re,((char*)temp_result->value_3)+sizeof(unsigned long),bytes);
446  free(re); /* free the regexp: no longer needed */
447  /* return result */
448  push_goal(unify,temp_result,result,NULL);
449  return TRUE;
450 }
451 
452 static long
454 {
455  psi_arg args[1];
456  SETARG(args,0, "1" , quoted_string , REQUIRED );
457  return call_primitive(regexp_compile_internal,NARGS(args),args,0);
458 }
459 
460 /******** C_REGEXP_EXECUTE
461  Attempts to match a regexp with a string
462  regexp_execute(RE:regexp,S:string) -> @(0=>(S0,E0),(S1,E1),...)
463  regexp_execute(RE:regexp,S:string,@(N=>(SN,EN),...)) -> boolean
464  2nd form only instantiates the bounds requested in the mask (3rd arg)
465  and returns a boolean so that it can be used as a predicate.
466  The optional argument "offset" specifies an offset into the string.
467  */
468 
469 static long regexp_execute_internal(args,result,funct)
470  ptr_psi_term args[],result,funct;
471 {
472  regexp * re = (regexp*)(((char *)args[0]->value_3)+sizeof(unsigned long));
473  char * must = re->regmust;
474  long offset = 0;
475  // long success = TRUE;
476  /* check that args[3] aka "offset" is valid if present */
477  if (args[3]) {
478  offset = *(REAL*)args[3]->value_3;
479  if (offset < 0 || offset > strlen((char*)args[1]->value_3)) {
480  Errorline("Illegal offset in %P.\n",funct);
481  return (c_abort()); }
482  }
483  /* convert regmust from offset into a pointer if not NULL */
484  if (must != NULL)
485  re->regmust = (char*)re+(unsigned long)must;
486  /* perform operation */
487  if (regexec(re,((char *)args[1]->value_3) + offset) == 0) {
488  if (must != NULL) re->regmust = must; /* back into an offset */
489  return FALSE;
490  }
491  else {
492  /* construct result of match */
493  char **sp = re->startp;
494  char **ep = re->endp;
495  int i;
496  char buffer_loc[5]; /* in case NSUBEXP ever gets increased */
497  ptr_node n3;
498  if (must != NULL) re->regmust = must; /* back into an offset */
499  if (args[2]) {
500  /* only instantiate the numeric features present in args[2]
501  then return true */
502  for (i=0;i<NSUBEXP;i++,sp++,ep++) {
503  if (*sp==NULL) break;
504  (void)snprintf(buffer_loc,5,"%d",i);
505  n3=find(FEATCMP,buffer_loc,args[2]->attr_list);
506  if (n3) {
507  ptr_psi_term psi = (ptr_psi_term) n3->data;
508  /* need to add 1 to these offsets because somehow life strings
509  are 1-based rather than 0-based. Who is the moron who made
510  that decision? This isn't Pascal! */
511  ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
512  stack_int(*ep - (char *)args[1]->value_3 + 1));
513  push_goal(unify,psi,bounds,NULL);
514  }
515  }
516  /* return true */
517  unify_bool_result(result,TRUE);
518  }
519  else {
520  /* create a term to represent all the groups and return it */
521  ptr_psi_term psi = stack_psi_term(4);
522  psi->type = top;
523  for (i=0;i<NSUBEXP;i++,sp++,ep++) {
524  if (*sp==NULL) break;
525  (void)snprintf(buffer_loc,5,"%d",i);
526  { ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
527  stack_int(*ep - (char *)args[1]->value_3 + 1));
528  stack_insert_copystr(buffer_loc,&(psi->attr_list),(GENERIC)bounds); }
529  }
530  /* return the new term */
531  push_goal(unify,psi,result,NULL);
532  }
533  return TRUE;
534  }
535 }
536 
537 static long
539 {
540  psi_arg args[4];
541  SETARG(args,0, "1" , sys_regexp , REQUIRED );
542  SETARG(args,1, "2" , quoted_string , REQUIRED );
543  SETARG(args,2, "3" , top , OPTIONAL|NOVALUE );
544  SETARG(args,3, "offset" , integer , OPTIONAL );
545  return call_primitive(regexp_execute_internal,NARGS(args),args,0);
546 }
547 
548 /* FILE STREAMS *
549  ****************/
550 
551 /* when a fp is opened for updating an input operation
552  should not follow an output operation without an intervening
553  flush or file positioning operation; and the other way around
554  too. I am going to keep track of what operations have been
555  applied so that flush will be automatically invoked when
556  necessary */
557 
558 #define FP_NONE 0
559 #define FP_INPUT 1
560 #define FP_OUTPUT 2
561 
562 typedef struct a_stream {
563  FILE *fp;
564  int op;
565 } *ptr_stream;
566 
567 #define FP_PREPARE(s,OP) \
568  if (s->op != OP && s->op != FP_NONE) fflush(s->fp); \
569  s->op = OP;
570 
572  FILE*fp;
573  ptr_definition typ; // removed * DJD
574 {
575  ptr_psi_term result = make_bytedata(typ,sizeof(struct a_stream));
576  ((ptr_stream)BYTEDATA_DATA(result))->fp = fp;
577  ((ptr_stream)BYTEDATA_DATA(result))->op = FP_NONE;
578  return result;
579 }
580 
581 static long
582 int2stream_internal(args,result,funct)
583  ptr_psi_term args[],result,funct;
584 {
585  FILE *fp = fdopen((int)*(REAL*)args[0]->value_3,
586  (char*)args[1]->value_3);
587  if (fp==NULL) return FALSE;
588  else {
589  push_goal(unify,fileptr2stream(fp,sys_stream),result,NULL); // added & DJD
590 /* ptr_psi_term temp_result = make_bytedata(sys_stream,sizeof(fp));
591  *(FILE**)BYTEDATA_DATA(temp_result) = fp;
592  push_goal(unify,temp_result,result,NULL); */
593  return TRUE;
594  }
595 }
596 
597 static long
599 {
600  psi_arg args[2];
601  SETARG(args,0,"1",integer,REQUIRED);
602  SETARG(args,1,"2",quoted_string,REQUIRED);
603  return call_primitive(int2stream_internal,NARGS(args),args,0);
604 }
605 
606 static long
607 fopen_internal(args,result,funct)
608  ptr_psi_term args[],result,funct;
609 {
610  FILE *fp = fopen((char*)args[0]->value_3,
611  (char*)args[1]->value_3);
612  if (fp==NULL) return FALSE;
613  else {
614 /* ptr_psi_term temp_result = make_bytedata(sys_file_stream,sizeof(fp));
615  *(FILE**)BYTEDATA_DATA(temp_result) = fp;
616 */
617  push_goal(unify,fileptr2stream(fp,sys_file_stream),result,NULL); // added & DJD
618  return TRUE;
619  }
620 }
621 
622 static long
624 {
625  psi_arg args[2];
626  SETARG(args,0, "1" , quoted_string , REQUIRED );
627  SETARG(args,1, "2" , quoted_string , REQUIRED );
628  return call_primitive(fopen_internal,NARGS(args),args,0);
629 }
630 
631 static long
632 fclose_internal(args,result,funct)
633  ptr_psi_term args[],result,funct;
634 {
635  if (fclose(((ptr_stream)BYTEDATA_DATA(args[0]))->fp) != 0)
636  return FALSE;
637  else
638  return TRUE;
639 }
640 
641 static long
643 {
644  psi_arg args[1];
645  SETARG(args,0, "1" , sys_stream , REQUIRED );
646  return call_primitive(fclose_internal,NARGS(args),args,0);
647 }
648 
649 static long
650 fwrite_internal(args,result,funct)
651  ptr_psi_term args[],result,funct;
652 {
653  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
654  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
655  char* txt = (char*)args[1]->value_3;
656  FP_PREPARE(srm,FP_OUTPUT);
657  if (txt && *txt!='\0' &&
658  fwrite((void*)txt,sizeof(char),strlen(txt),srm->fp)<=0)
659  return FALSE;
660  return TRUE;
661 }
662 
663 static long
665 {
666  psi_arg args[2];
667  SETARG(args,0,"1",sys_stream,MANDATORY);
668  SETARG(args,1,"2",quoted_string,MANDATORY);
669  return call_primitive(fwrite_internal,NARGS(args),args,0);
670 }
671 
672 static long
673 fflush_internal(args,result,funct)
674  ptr_psi_term args[],result,funct;
675 {
676  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
677  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
678  srm->op = FP_NONE;
679  if (fflush(srm->fp)!=0) return FALSE;
680  return TRUE;
681 }
682 
683 static long
685 {
686  psi_arg args[1];
687  SETARG(args,0,"1",sys_stream,MANDATORY);
688  return call_primitive(fflush_internal,NARGS(args),args,0);
689 }
690 
691 static long
692 get_buffer_internal(args,result,funct)
693  ptr_psi_term args[],result,funct;
694 {
695  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
696  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
697  long size = *(REAL*)args[1]->value_3;
699  t->type = quoted_string;
700  t->value_3=(GENERIC)heap_alloc(size+1);
701  bzero((char*)t->value_3,size+1);
702  FP_PREPARE(srm,FP_INPUT);
703  if (fread((void*)t->value_3,sizeof(char),size,srm->fp) <= 0)
704  return FALSE;
705  push_goal(unify,t,result,NULL);
706  return TRUE;
707 }
708 
709 static long
711 {
712  psi_arg args[2];
713  SETARG(args,0,"1",sys_stream,REQUIRED);
714  SETARG(args,1,"2",integer,REQUIRED);
715  return call_primitive(get_buffer_internal,NARGS(args),args,0);
716 }
717 
718 
719 /* find the first match for character c starting from index idx in
720  buffer buf. if found place new buffer and index in rbuf and
721  ridx and return 1, else return 0
722  */
723 int
724 text_buffer_next(buf,idx,c,rbuf,ridx)
725  struct text_buffer *buf,**rbuf;
726  char c;
727  int idx,*ridx;
728 {
729  while (buf) {
730  while (idx<buf->top)
731  if (buf->data[idx] == c) {
732  *rbuf=buf;
733  *ridx=idx;
734  return 1;
735  }
736  else idx++;
737  buf=buf->next;
738  idx=0;
739  }
740  return 0;
741 }
742 
743 /* compare string str with text in buffer buf starting at index idx.
744  if the text to the end matches a prefix of the string, return
745  pointer to remaining suffix of str to be matched, else return 0.
746  */
747 char*
748 text_buffer_cmp(buf,idx,str)
749  struct text_buffer *buf;
750  int idx;
751  char *str;
752 {
753  while (buf) {
754  while (idx<buf->top)
755  if (!*str || buf->data[idx] != *str)
756  return 0;
757  else { idx++; str++; }
758  if (!*str && !buf->next) return str;
759  else {
760  buf=buf->next;
761  idx=0;
762  }
763  }
764  return 0;
765 }
766 
767 /* add a character at the end of a buffer. if the buffer is
768  full, allocate a new buffer and link it to the current one,
769  then overwrite the variable holding the pointer to the
770  current buffer with the pointer to the new buffer.
771  */
772 void
774  struct text_buffer **buf;
775  char c;
776 {
777  if ((*buf)->top < TEXTBUFSIZE)
778  (*buf)->data[(*buf)->top++] = c;
779  else {
780  (*buf)->next = (struct text_buffer *)
781  malloc(sizeof(struct text_buffer));
782  if (!(*buf)->next) {
783  fprintf(stderr,"Fatal error: malloc failed in text_buffer_push\n");
784  exit(EXIT_FAILURE);
785  }
786  bzero((char*)(*buf)->next,sizeof(struct text_buffer));
787  *buf = (*buf)->next;
788  (*buf)->top = 1;
789  (*buf)->data[0]=c;
790  }
791 }
792 
793 /* free a linked list of buffers */
794 void
796  struct text_buffer *buf;
797 {
798  struct text_buffer *next;
799  while (buf) {
800  next = buf->next;
801  free(buf);
802  buf=next;
803  }
804 }
805 
806 static long
807 get_record_internal(args,result,funct)
808  ptr_psi_term args[],result,funct;
809 {
810  struct text_buffer rootbuf;
811  struct text_buffer *curbuf = &rootbuf;
812  struct text_buffer *lastbuf = &rootbuf;
813  int lastidx = 0,size;
814  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
815  FILE *fp = srm->fp; /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
816  char *sep = (char*)args[1]->value_3;
817  int c;
818  ptr_psi_term t;
819  char *cursep = sep;
820 
821  FP_PREPARE(srm,FP_INPUT);
822  bzero((char*)&rootbuf,sizeof(rootbuf));
823  if (!sep || !*sep) {
824  /* no separator: just grab as much as you can */
825  while ((c=getc(fp)) != EOF)
826  text_buffer_push(&curbuf,(char)c);
827  goto PackUpAndLeave;
828  }
829 
830  if (sep[1]=='\0') {
831  /* only one char in string */
832  while ((c=getc(fp)) != EOF) {
833  text_buffer_push(&curbuf,(char)c);
834  if (c==*sep) break;
835  }
836  goto PackUpAndLeave;
837  }
838 
839  /* general case: multicharacter separator */
840 
841  WaitForStart:
842  if ((c=getc(fp)) == EOF) goto PackUpAndLeave;
843  text_buffer_push(&curbuf,(char)c);
844  if (c==*sep) {
845  cursep = sep+1;
846  lastbuf=curbuf;
847  lastidx=curbuf->top - 1;
848  goto MatchNext;
849  }
850  else goto WaitForStart;
851 
852  MatchNext:
853  if (!*cursep || (c=getc(fp))==EOF) goto PackUpAndLeave;
854  text_buffer_push(&curbuf,(char)c);
855  if (c!=*cursep) goto TryAgain;
856  cursep++;
857  goto MatchNext;
858 
859  TryAgain:
860  if (!text_buffer_next(lastbuf,lastidx+1,*sep,&lastbuf,&lastidx))
861  goto WaitForStart;
862  if (!(cursep=text_buffer_cmp(lastbuf,lastidx,sep)))
863  goto TryAgain;
864  goto MatchNext;
865 
866  PackUpAndLeave:
867  /* compute how much space we need */
868  for(lastbuf=&rootbuf,size=0;lastbuf!=NULL;lastbuf=lastbuf->next)
869  size += lastbuf->top;
870  t=stack_psi_term(0);
871  t->type=quoted_string;
872  t->value_3=(GENERIC)heap_alloc(size+1);
873  for(lastbuf=&rootbuf,sep=(char*)t->value_3;
874  lastbuf!=NULL;sep+=lastbuf->top,lastbuf=lastbuf->next)
875  bcopy(lastbuf->data,sep,lastbuf->top);
876  ((char*)t->value_3)[size]='\0';
877  text_buffer_free(rootbuf.next);
878  push_goal(unify,t,result,NULL);
879  return TRUE;
880 }
881 
882 static long
884 {
885  psi_arg args[2];
886  SETARG(args,0,"1",sys_stream,REQUIRED);
887  SETARG(args,1,"2",quoted_string,REQUIRED);
888  return call_primitive(get_record_internal,NARGS(args),args,0);
889 }
890 
891 static long
892 get_code_internal(args,result,funct)
893  ptr_psi_term args[],result,funct;
894 {
895  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
896  int c;
897  FP_PREPARE(srm,FP_INPUT);
898  if ((c=getc(srm->fp)) == EOF) return FALSE;
899  else return unify_real_result(result,(REAL)c);
900 }
901 
902 static long
904 {
905  psi_arg args[1];
906  SETARG(args,0,"1",sys_stream,REQUIRED);
907  return call_primitive(get_code_internal,NARGS(args),args,0);
908 }
909 
910 static long
911 ftell_internal(args,result,funct)
912  ptr_psi_term args[],result,funct;
913 {
914  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
915  if (srm->op != FP_NONE || srm->op != FP_INPUT) {
916  fflush(srm->fp);
917  srm->op = FP_NONE;
918  }
919  return unify_real_result(result,(REAL)ftell(srm->fp));
920 /* *(FILE**)BYTEDATA_DATA(args[0])));*/
921 }
922 
923 static long
925 {
926  psi_arg args[1];
927  SETARG(args,0,"1",sys_file_stream,REQUIRED);
928  return call_primitive(ftell_internal,NARGS(args),args,0);
929 }
930 
931 #ifndef SEEK_SET
932 #define SEEK_SET 0
933 #endif
934 #ifndef SEEK_CUR
935 #define SEEK_CUR 1
936 #endif
937 #ifndef SEEK_END
938 #define SEEK_END 2
939 #endif
940 
941 static long
942 fseek_internal(args,result,funct)
943  ptr_psi_term args[],result,funct;
944 {
945  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
946  srm->op = FP_NONE;
947  return
948  (fseek(srm->fp ,
949  (long)*(REAL*)args[1]->value_3,
950  args[2]?(long)*(REAL*)args[2]->value_3:SEEK_SET) < 0)
951  ?FALSE:TRUE;
952 }
953 
954 static long
956 {
957  psi_arg args[3];
958  SETARG(args,0,"1",sys_file_stream,MANDATORY);
959  SETARG(args,1,"2",integer,MANDATORY);
960  SETARG(args,2,"3",integer,OPTIONAL);
961  return call_primitive(fseek_internal,NARGS(args),args,0);
962 }
963 
964 static long
965 stream2sys_stream_internal(args,result,funct)
966  ptr_psi_term args[],result,funct;
967 {
968  push_goal(unify,fileptr2stream((FILE*)args[0]->value_3,sys_stream),
969  result,NULL); // added & DJD
970  return TRUE;
971 }
972 
973 static long
975 {
976  psi_arg args[1];
977  SETARG(args,0,"1",stream,REQUIRED);
978  return call_primitive(stream2sys_stream_internal,NARGS(args),args,0);
979 }
980 
981 static long
982 sys_stream2stream_internal(args,result,funct)
983  ptr_psi_term args[],result,funct;
984 {
985  ptr_psi_term tmp;
986  tmp=stack_psi_term(4);
987  tmp->type=stream;
988  tmp->value_3=(GENERIC)((ptr_stream)BYTEDATA_DATA(args[0]))->fp;
989  push_goal(unify,tmp,result,NULL);
990  return TRUE;
991 }
992 
993 static long
995 {
996  psi_arg args[1];
997  SETARG(args,0,"1",sys_stream,REQUIRED);
998  return call_primitive(sys_stream2stream_internal,NARGS(args),args,0);
999 }
1000 
1001 /* SOCKETS AND NETWORKING *
1002  **************************/
1003 
1004 #include <sys/socket.h>
1005 #include <netinet/in.h>
1006 #include <sys/un.h>
1007 #include <netdb.h>
1008 #include <arpa/inet.h>
1009 #include <ctype.h>
1010 
1011 static long
1012 socket_internal(args,result,funct)
1013  ptr_psi_term args[],result,funct;
1014 {
1015  int addr_family=AF_INET,type=SOCK_STREAM,protocol=0;
1016  char *s;
1017  int fd;
1018 
1019  if (args[0]) {
1020  s=(char*)args[0]->value_3;
1021  if (!strcmp(s,"AF_UNIX")) addr_family=AF_UNIX;
1022  else if (!strcmp(s,"AF_INET")) addr_family=AF_INET;
1023  else {
1024  Errorline("Unknown address family in %P.\n",funct);
1025  return FALSE; }
1026  }
1027 
1028  if (args[1]) {
1029  s=(char*)args[1]->value_3;
1030  if (!strcmp(s,"SOCK_STREAM")) type=SOCK_STREAM;
1031  else if (!strcmp(s,"SOCK_DGRAM" )) type=SOCK_DGRAM;
1032  else if (!strcmp(s,"SOCK_RAW" )) {
1033  Errorline("SOCK_RAW not supported in %P.\n",funct);
1034  return FALSE; }
1035  else {
1036  Errorline("Unknown socket type in %P.\n",funct);
1037  return FALSE; }
1038  }
1039 
1040  if ((fd=socket(addr_family,type,protocol))<0)
1041  return FALSE;
1042 
1043  { FILE*fp = fdopen(fd,"r+");
1044  // ptr_psi_term t;
1045 
1046  if (fp==NULL) {
1047  Errorline("fdopen failed on socket in %P.\n",funct);
1048  return FALSE;
1049  }
1050 
1051 /* t = make_bytedata(sys_socket_stream,sizeof(fp));
1052  *(FILE**)BYTEDATA_DATA(t) = fp;*/
1053  push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
1054  }
1055  return TRUE;
1056 }
1057 
1058 static long
1060 {
1061  psi_arg args[2];
1062  SETARG(args,0,"1",quoted_string,OPTIONAL);
1063  SETARG(args,1,"2",quoted_string,OPTIONAL);
1064  return call_primitive(socket_internal,NARGS(args),args,0);
1065 }
1066 
1067 int
1069  char*s;
1070 {
1071  if (s==NULL) return 0;
1072  while (*s)
1073  if (!isdigit(*s) && *s!='.') return 0;
1074  else s++;
1075  return 1;
1076 }
1077 
1078 static long
1079 bind_or_connect_internal(args,result,funct,info)
1080  ptr_psi_term args[],result,funct;
1081  void*info;
1082 {
1083  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1084  int do_bind = info==NULL;
1085 
1086  if (args[1] || args[2]) {
1087  /* bind or connect in the internet domain */
1088  struct sockaddr_in name_loc;
1089  char* hostname = args[1]?(char*)args[1]->value_3:NULL;
1090  // int port;
1091  if (!args[2]) {
1092  Errorline("Missing port number in %P.\n",funct);
1093  return FALSE;
1094  }
1095 
1096  bzero((char*)&name_loc,sizeof(name_loc));
1097  name_loc.sin_family = AF_INET;
1098  name_loc.sin_port = htons((unsigned short)*(REAL*)args[2]->value_3);
1099 
1100  if (!hostname || *hostname=='\0' || !strcasecmp(hostname,"localhost"))
1101  name_loc.sin_addr.s_addr = INADDR_ANY;
1102  else {
1103  struct hostent * h;
1104  int ipaddr;
1105  if ((ipaddr=is_ipaddr(hostname))) {
1106  int i = inet_addr(hostname);
1107  h = gethostbyaddr((char*)&i,sizeof(i),AF_INET);
1108  } else h = gethostbyname(hostname);
1109  if (h==NULL) {
1110  Errorline("%s failed for %P.\n",
1111  ipaddr?"gethostbyaddr":"gethostbyname",funct);
1112  return FALSE;
1113  }
1114  bcopy(h->h_addr,(char*)&(name_loc.sin_addr.s_addr),h->h_length);
1115  }
1116  if ((do_bind?
1117  bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
1118  connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
1119  Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
1120  return FALSE;
1121  }
1122  }
1123  else if (args[3]) {
1124  /* bind in the unix domain */
1125  struct sockaddr_un name_loc;
1126  char* path = (char*)args[3]->value_3;
1127 
1128  name_loc.sun_family = AF_UNIX;
1129  strcpy(name_loc.sun_path,path);
1130 
1131  if ((do_bind?
1132  bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
1133  connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
1134  Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
1135  return FALSE;
1136  }
1137  }
1138  else {
1139  Errorline("Too few arguments in %P.\n",funct);
1140  return FALSE;
1141  }
1142  return TRUE;
1143 }
1144 
1145 static long
1147 {
1148  psi_arg args[4];
1149  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1150  SETARG(args,1,"host",quoted_string,OPTIONAL);
1151  SETARG(args,2,"port",integer,OPTIONAL);
1152  SETARG(args,3,"path",quoted_string,OPTIONAL);
1154 }
1155 
1156 static long
1158 {
1159  psi_arg args[4];
1160  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1161  SETARG(args,1,"host",quoted_string,OPTIONAL);
1162  SETARG(args,2,"port",integer,OPTIONAL);
1163  SETARG(args,3,"path",quoted_string,OPTIONAL);
1164  return call_primitive(bind_or_connect_internal,NARGS(args),args,(GENERIC)1);
1165 }
1166 
1167 static long
1168 listen_internal(args,result,funct)
1169  ptr_psi_term args[],result,funct;
1170 {
1171  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1172  int n = *(REAL*)args[1]->value_3;
1173 
1174  if (listen(fd,n) < 0) return FALSE;
1175  return TRUE;
1176 }
1177 
1178 static long
1180 {
1181  psi_arg args[2];
1182  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1183  SETARG(args,1,"2",integer,MANDATORY);
1184  return call_primitive(listen_internal,NARGS(args),args,0);
1185 }
1186 
1187 static long
1188 accept_internal(args,result,funct)
1189  ptr_psi_term args[],result,funct;
1190 {
1191  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1192  int s;
1193 
1194  if ((s=accept(fd,NULL,NULL)) < 0) return FALSE;
1195  else {
1196  FILE * fp = fdopen(s,"r+");
1197  // ptr_psi_term t;
1198 
1199  if (fp==NULL) {
1200  Errorline("fdopen failed on socket in %P.\n",funct);
1201  return FALSE;
1202  }
1203 
1204 /* t = make_bytedata(sys_socket_stream,sizeof(fp));
1205  *(FILE**)BYTEDATA_DATA(t) = fp;*/
1206  push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
1207  return TRUE;
1208  }
1209 }
1210 
1211 static long
1213 {
1214  psi_arg args[1];
1215  SETARG(args,0,"1",sys_socket_stream,REQUIRED);
1216  return call_primitive(accept_internal,NARGS(args),args,0);
1217 }
1218 
1219 /* SYSTEM ERRORS *
1220  *****************/
1221 
1222 static long
1223 errno_internal(args,result,funct)
1224  ptr_psi_term args[],result,funct;
1225 {
1226  push_goal(unify,stack_int(errno),result,NULL);
1227  return TRUE;
1228 }
1229 
1230 static long
1232 {
1233  return call_primitive(errno_internal,0,NULL,0);
1234 }
1235 
1236 /* some systems are missing these declarations */
1237 // extern char *sys_errlist[];
1238 // extern int sys_nerr;
1239 
1240 static long
1241 errmsg_internal(args,result,funct)
1242  ptr_psi_term args[],result,funct;
1243 {
1244  long n = args[0]?(long)*(REAL*)args[0]->value_3:errno;
1245  // if (n<0 || n>=sys_nerr) return FALSE;
1246  // else {
1247  push_goal(unify,stack_string(strerror(n)),result,NULL);
1248  return TRUE;
1249  // }
1250 }
1251 
1252 static long
1254 {
1255  psi_arg args[1];
1256  SETARG(args,0, "1" , integer , OPTIONAL );
1257  return call_primitive(errmsg_internal,NARGS(args),args,0);
1258 }
1259 
1260 /* MODULES *
1261  ***********/
1262 
1263 /******** C_IMPORT_SYMBOL
1264  import a public symbol from another module into the current one,
1265  optionally renaming it.
1266  */
1267 
1268 static long
1269 import_symbol_internal(args,result,funct)
1270  ptr_psi_term args[],result,funct;
1271 {
1272  ptr_keyword key;
1273 
1274  if (args[1])
1275  key=args[1]->type->keyword;
1276  else
1278  args[0]->type->keyword->symbol);
1279 
1280  if (key)
1281  if (key->definition->type_def != (def_type)undef) {
1282  Errorline("symbol %s already defined in %P.",key->combined_name,funct);
1283  return FALSE;
1284  }
1285  else key->definition=args[0]->type;
1286  else {
1287  /* adapted from update_symbol in modules.c */
1288  /* Add 'module#symbol' to the symbol table */
1289  key=HEAP_ALLOC(struct wl_keyword);
1290  key->module=current_module;
1291  /* use same name */
1292  key->symbol=args[0]->type->keyword->symbol;
1293  key->combined_name=(char *)
1295  key->public=FALSE;
1296  key->private_feature=FALSE;
1297  key->definition=args[0]->type; /* use given definition */
1298 
1300  }
1301  return TRUE;
1302 }
1303 
1304 static long
1306 {
1307  psi_arg args[2];
1308  SETARG(args,0,"1",top,MANDATORY|UNEVALED);
1309  SETARG(args,1,"as",top,OPTIONAL|NOVALUE|UNEVALED);
1310  return call_primitive(import_symbol_internal,NARGS(args),args,0);
1311 }
1312 
1313 /* PROCESSES *
1314  *************/
1315 
1316 static long
1317 fork_internal(args,result,funct)
1318  ptr_psi_term args[],result,funct;
1319 {
1320  pid_t id = fork();
1321  if (id < 0) return FALSE;
1322  else return unify_real_result(result,(REAL)id);
1323 }
1324 
1325 static long
1327 {
1328  return call_primitive(fork_internal,0,NULL,0);
1329 }
1330 
1331 typedef struct {
1332  char * name_str;
1334 } psi_feature;
1335 
1336 #define SETFEATURE(lst,n,nam,val) ((lst[n].name_str=nam),(lst[n].value_str=val))
1337 
1338 static long
1340  ptr_psi_term t;
1341  ptr_definition sym;
1342  psi_feature lst[];
1343  int n;
1344 {
1345  ptr_psi_term u;
1346  int i;
1347  if (n<0) {
1348  fprintf(stderr,"unify_pterm_result called with n<0: n=%d\n",n);
1349  exit(EXIT_FAILURE);
1350  }
1351  u=stack_psi_term(4);
1352  u->type=sym;
1353  for(i=0;i<n;i++)
1354  (void)stack_insert(FEATCMP,lst[i].name_str,&(u->attr_list),(GENERIC)lst[i].value_str);
1355  push_goal(unify,t,u,NULL);
1356  return TRUE;
1357 }
1358 
1359 char *
1361  long n;
1362 {
1363  if (n==1) return one;
1364  else if (n==2) return two;
1365  else if (n==3) return three;
1366  else {
1367  char buf[100];
1368  (void)snprintf(buf,100,"%ld",n);
1369  return heap_copy_string(buf);
1370  }
1371 }
1372 
1373 #ifndef WIFEXITED
1374 #include <sys/wait.h>
1375 #endif
1376 
1382 
1383 static long
1384 unify_wait_result(result,id,status)
1385  ptr_psi_term result;
1386  pid_t id;
1387  int status;
1388 {
1389  int n=2;
1390  long status2;
1391  ptr_definition sym;
1392  psi_feature lst[2];
1393  SETFEATURE(lst,0,one,stack_int(id));
1394  if (id == -1 || status == -1) {
1395  if (errno==ECHILD) {
1397  n=0;
1398  }
1399  else return FALSE;
1400  }
1401  else if (WIFEXITED(status)) {
1402  SETFEATURE(lst,1,two,stack_int(WEXITSTATUS(status)));
1403  sym = sys_process_exited;
1404  }
1405  else if (WIFSIGNALED(status)) {
1406  SETFEATURE(lst,1,two,stack_int(WTERMSIG(status)));
1407  sym = sys_process_signaled;
1408  }
1409  else if (WIFSTOPPED(status)) {
1410  SETFEATURE(lst,1,two,stack_int(WSTOPSIG(status)));
1411  sym = sys_process_stopped;
1412  }
1413 #ifdef WIFCONTINUED
1414  else if (WIFCONTINUED(status)) {
1415  sym = sys_process_continued;
1416  n=1;
1417  }
1418 #endif
1419  else {
1420  status2 = status;
1421  Errorline("Unexpected wait status: %d",status2);
1422  return FALSE;
1423  }
1424  return unify_pterm_result(result,sym,lst,n);
1425 }
1426 
1427 static long
1428 wait_internal(args,result,funct)
1429  ptr_psi_term args[],result,funct;
1430 {
1431  int status;
1432  pid_t id = wait(&status);
1433  return unify_wait_result(result,id,status);
1434 }
1435 
1436 static long
1438 {
1439  return call_primitive(wait_internal,0,NULL,0);
1440 }
1441 
1442 static long
1443 waitpid_internal(args,result,funct)
1444  ptr_psi_term args[],result,funct;
1445 {
1446  int status;
1447  pid_t id = waitpid((pid_t)(long)*(REAL*)args[0]->value_3,&status,
1448  args[1]?(int)(long)*(REAL*)args[1]->value_3:0);
1449  return unify_wait_result(result,id,status);
1450 }
1451 
1452 static long
1454 {
1455  psi_arg args[2];
1456  SETARG(args,0,"1",integer,REQUIRED);
1457  SETARG(args,1,"2",integer,OPTIONAL);
1458  return call_primitive(waitpid_internal,NARGS(args),args,0);
1459 }
1460 
1461 static long
1462 kill_internal(args,result,funct)
1463  ptr_psi_term args[],result,funct;
1464 {
1465  return (kill((pid_t)*(REAL*)args[0]->value_3,
1466  (int)*(REAL*)args[1]->value_3)==0)?TRUE:FALSE;
1467 }
1468 
1469 static long
1471 {
1472  psi_arg args[2];
1473  SETARG(args,0,"1",integer,MANDATORY);
1474  SETARG(args,1,"2",integer,MANDATORY);
1475  return call_primitive(kill_internal,NARGS(args),args,0);
1476 }
1477 
1478 /* MISCELLANEOUS *
1479  ****************/
1480 
1481 static long
1482 cuserid_internal(args,result,funct)
1483  ptr_psi_term args[],result,funct;
1484 {
1485  // char name[L_cuserid+1];
1486  // if (*cuserid(name) == '\0') return FALSE;
1487  // else {
1488  push_goal(unify,result,stack_string(getlogin()),NULL);
1489  return TRUE;
1490  // }
1491 }
1492 
1493 static long
1495 {
1496  return call_primitive(cuserid_internal,0,NULL,0);
1497 }
1498 
1499 #ifndef MAXHOSTNAMELEN
1500 #include <sys/param.h>
1501 #endif
1502 
1503 static long
1504 gethostname_internal(args,result,funct)
1505  ptr_psi_term args[],result,funct;
1506 {
1507  char name_loc[MAXHOSTNAMELEN+1];
1508  if (gethostname(name_loc,MAXHOSTNAMELEN+1) == 0) {
1509  push_goal(unify,result,stack_string(name_loc),NULL);
1510  return TRUE;
1511  }
1512  else return FALSE;
1513 }
1514 
1515 static long
1517 {
1519 }
1520 
1521 /* LAZY PROJECT
1522  ***************/
1523 
1524 static long
1525 lazy_project_internal(args,result,funct)
1526  ptr_psi_term args[],result,funct;
1527 {
1528  ptr_node n;
1529  char buffer_loc[100];
1530  if (args[1]->type == top) {
1531  residuate(args[0]);
1532  residuate(args[1]);
1533  return TRUE;
1534  }
1535  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1536  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
1537  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1538  strcpy(buffer_loc,(char*)args[1]->value_3);
1539  else
1540  strcpy(buffer_loc,args[1]->type->keyword->symbol);
1541  n=find(FEATCMP,buffer_loc,args[0]->attr_list);
1542  if (n) push_goal(unify,(ptr_psi_term)n->data,result,NULL);
1543  /* this is all bullshit because projection should residuate
1544  on its 2nd arg until it becomes value. In particular, think
1545  of using `int' as a feature when it is clear that `int' may
1546  subsequently be refined to a particular integer. */
1547  else residuate(args[0]);
1548  return TRUE;
1549 }
1550 
1551 static long
1553 {
1554  psi_arg args[2];
1555  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
1556  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
1557  return call_primitive(lazy_project_internal,NARGS(args),args,0);
1558 }
1559 
1560 /* WAIT_ON_FEATURE
1561  ******************/
1562 
1563 static long
1564 wait_on_feature_internal(args,result,funct)
1565  ptr_psi_term args[],result,funct;
1566 {
1567  char buffer_loc[100];
1568  if (args[1]->type == top) {
1569  residuate(args[0]);
1570  residuate(args[1]);
1571  return TRUE;
1572  }
1573  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1574  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
1575  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1576  strcpy(buffer_loc,(char*)args[1]->value_3);
1577  else
1578  strcpy(buffer_loc,args[1]->type->keyword->symbol);
1579  if (find(FEATCMP,buffer_loc,args[0]->attr_list))
1581  /* this is all bullshit because projection should residuate
1582  on its 2nd arg until it becomes value. In particular, think
1583  of using `int' as a feature when it is clear that `int' may
1584  subsequently be refined to a particular integer. */
1585  else residuate(args[0]);
1586  return TRUE;
1587 }
1588 
1589 static long
1591 {
1592  psi_arg args[3];
1593  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
1594  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
1595  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
1596  return call_primitive(wait_on_feature_internal,NARGS(args),args,0);
1597 }
1598 
1599 static long
1601  ptr_psi_term args[],result,funct;
1602 {
1603  char buffer_loc[100];
1604  if (args[1]->type == top) {
1605  residuate(args[0]);
1606  residuate(args[1]);
1607  return TRUE;
1608  }
1609  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1610  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
1611  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1612  strcpy(buffer_loc,(char*)args[1]->value_3);
1613  else
1614  strcpy(buffer_loc,args[1]->type->keyword->symbol);
1615  if (find(FEATCMP,buffer_loc,args[0]->attr_list)) {
1616  unify_bool_result(result,TRUE);
1618  }
1619  /* this is all bullshit because projection should residuate
1620  on its 2nd arg until it becomes value. In particular, think
1621  of using `int' as a feature when it is clear that `int' may
1622  subsequently be refined to a particular integer. */
1623  else residuate(args[0]);
1624  return TRUE;
1625 }
1626 
1627 static long
1629 {
1630  psi_arg args[3];
1631  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
1632  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
1633  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
1634  return call_primitive(my_wait_on_feature_internal,NARGS(args),args,0);
1635 }
1636 
1637 /* CALL_ONCE
1638  ************/
1639 /*
1640  call_once(G) -> T | G,!,T=lf_true;T=lf_false.
1641  */
1642 
1643 static long
1644 call_once_internal(args,result,funct)
1645  ptr_psi_term args[],result,funct;
1646 {
1647  ptr_psi_term value;
1649  resid_aim=NULL;
1650  value = stack_psi_term(4);
1651  value->type = lf_false;
1652  push_choice_point(unify,result,value,NULL);
1653  value = stack_psi_term(4);
1654  value->type = lf_true;
1655  push_goal(unify,result,value,NULL);
1658  return TRUE;
1659 }
1660 
1661 static long
1663 {
1664  psi_arg args[1];
1665  SETARG(args,0,"1",top,MANDATORY|NOVALUE|UNEVALED);
1666  return call_primitive(call_once_internal,NARGS(args),args,0);
1667 }
1668 
1669 static long
1670 apply1_internal(args,result,funct)
1671  ptr_psi_term args[],result,funct;
1672 {
1673  long success=TRUE;
1674  if (args[0]->type==top) residuate(args[0]);
1675  else if (args[0]->type->type_def!=(def_type)function_it) {
1676  Errorline("1st arg not a function in %P.\n",funct);
1677  success=FALSE;
1678  }
1679  else {
1680  // char buffer_loc[1000];
1681  char * feat;
1682  ptr_psi_term fun;
1683  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1684  feat = get_numeric_feature((long)*(REAL*)args[1]->value_3);
1685  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1686  feat = (char *)args[1]->value_3;
1687  else
1688  feat = (char *)heap_copy_string(args[1]->type->keyword->symbol);
1689  clear_copy();
1690  fun=distinct_copy(args[0]);
1691  (void)stack_insert(FEATCMP,(char *)feat,&(fun->attr_list),(GENERIC)args[2]);
1692  push_goal(eval,fun,result,(GENERIC)fun->type->rule);
1693  }
1694  return success;
1695 }
1696 
1697 static long
1699 {
1700  psi_arg args[3];
1701  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
1702  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
1703  SETARG(args,2,"3",top,REQUIRED|NOVALUE);
1704  return call_primitive(apply1_internal,NARGS(args),args,0);
1705 }
1706 
1707 static long
1708 getpid_internal(args,result,funct)
1709  ptr_psi_term args[],result,funct;
1710 {
1711  return unify_real_result(result,(REAL)getpid());
1712 }
1713 
1714 static long
1716 {
1717  return call_primitive(getpid_internal,0,0,0);
1718 }
1719 
1720 /********************************************************************
1721  INITIALIZATION FUNCTIONS
1722  *******************************************************************/
1723 
1724 
1725 void
1727 {
1728 #ifdef LIFE_NDBM
1729  make_ndbm_type_links();
1730 #endif
1736  make_type_link(sys_bytedata ,built_in); /* DENYS: BYTEDATA */
1737 }
1738 
1739 void
1741 {
1742  check_definition(&sys_bytedata); /* DENYS: BYTEDATA */
1748  check_definition(&sys_process_no_children);
1749  check_definition(&sys_process_exited);
1750  check_definition(&sys_process_signaled);
1751  check_definition(&sys_process_stopped);
1752  check_definition(&sys_process_continued);
1753 #ifdef LIFE_NDBM
1754  check_ndbm_definitions();
1755 #endif
1756 }
1757 
1758 
1759 void
1761 {
1762  ptr_module curmod = current_module;
1764 
1765  sys_bytedata =update_symbol(sys_module,"bytedata"); /* DENYS: BYTEDATA */
1766  sys_bitvector =update_symbol(sys_module,"bitvector");
1767  sys_regexp =update_symbol(sys_module,"regexp");
1768  sys_stream =update_symbol(sys_module,"stream");
1769  sys_file_stream =update_symbol(sys_module,"file_stream");
1770  sys_socket_stream =update_symbol(sys_module,"socket_stream");
1771  sys_process_no_children=update_symbol(sys_module,"process_no_children");
1772  sys_process_exited =update_symbol(sys_module,"process_exited");
1773  sys_process_signaled =update_symbol(sys_module,"process_signaled");
1774  sys_process_stopped =update_symbol(sys_module,"process_stopped");
1775  sys_process_continued =update_symbol(sys_module,"process_continued");
1776 
1777  /* DENYS: BYTEDATA */
1778  /* purely for illustration
1779  new_built_in(sys_module,"string_to_bytedata",(def_type)function_it,c_string_to_bytedata);
1780  new_built_in(sys_module,"bytedata_to_string",(def_type)function_it,c_bytedata_to_string);
1781  */
1783  new_built_in(sys_module,"bitvector_and" ,(def_type)function_it ,c_bitvector_and);
1784  new_built_in(sys_module,"bitvector_or" ,(def_type)function_it ,c_bitvector_or);
1785  new_built_in(sys_module,"bitvector_xor" ,(def_type)function_it ,c_bitvector_xor);
1786  new_built_in(sys_module,"bitvector_not" ,(def_type)function_it ,c_bitvector_not);
1787  new_built_in(sys_module,"bitvector_count" ,(def_type)function_it ,c_bitvector_count);
1788  new_built_in(sys_module,"bitvector_get" ,(def_type)function_it ,c_bitvector_get);
1789  new_built_in(sys_module,"bitvector_set" ,(def_type)function_it ,c_bitvector_set);
1790  new_built_in(sys_module,"bitvector_clear" ,(def_type)function_it ,c_bitvector_clear);
1791  new_built_in(sys_module,"regexp_compile" ,(def_type)function_it ,c_regexp_compile);
1792  new_built_in(sys_module,"regexp_execute" ,(def_type)function_it ,c_regexp_execute);
1793  new_built_in(sys_module,"int2stream" ,(def_type)function_it ,c_int2stream);
1794  new_built_in(sys_module,"fopen" ,(def_type)function_it ,c_fopen);
1795  new_built_in(sys_module,"fclose" ,(def_type)function_it ,c_fclose);
1796  new_built_in(sys_module,"get_buffer" ,(def_type)function_it ,c_get_buffer);
1797  new_built_in(sys_module,"get_record" ,(def_type)function_it ,c_get_record);
1798  new_built_in(sys_module,"get_code" ,(def_type)function_it ,c_get_code);
1799  new_built_in(sys_module,"ftell" ,(def_type)function_it ,c_ftell);
1801  new_built_in(sys_module,"socket" ,(def_type)function_it ,c_socket);
1802  new_built_in(sys_module,"bind" ,(def_type)predicate,c_bind);
1803  new_built_in(sys_module,"connect" ,(def_type)predicate,c_connect);
1804  new_built_in(sys_module,"fwrite" ,(def_type)predicate,c_fwrite);
1805  new_built_in(sys_module,"fflush" ,(def_type)predicate,c_fflush);
1806  new_built_in(sys_module,"listen" ,(def_type)predicate,c_listen);
1807  new_built_in(sys_module,"accept" ,(def_type)function_it ,c_accept);
1808  new_built_in(sys_module,"errno" ,(def_type)function_it ,c_errno);
1809  new_built_in(sys_module,"errmsg" ,(def_type)function_it ,c_errmsg);
1810  new_built_in(sys_module,"import_symbol" ,(def_type)predicate,c_import_symbol);
1811  new_built_in(sys_module,"fork" ,(def_type)function_it ,c_fork);
1812  new_built_in(sys_module,"wait" ,(def_type)function_it ,c_wait);
1813  new_built_in(sys_module,"waitpid" ,(def_type)function_it ,c_waitpid);
1814  new_built_in(sys_module,"kill" ,(def_type)predicate,c_kill);
1815  new_built_in(sys_module,"cuserid" ,(def_type)function_it ,c_cuserid);
1816  new_built_in(sys_module,"gethostname" ,(def_type)function_it ,c_gethostname);
1817  new_built_in(sys_module,"lazy_project" ,(def_type)function_it ,c_lazy_project);
1818  new_built_in(sys_module,"wait_on_feature" ,(def_type)predicate,c_wait_on_feature);
1819  new_built_in(sys_module,"my_wait_on_feature" ,(def_type)function_it ,c_my_wait_on_feature);
1820  new_built_in(sys_module,"apply1" ,(def_type)function_it ,c_apply1);
1821  new_built_in(sys_module,"getpid" ,(def_type)function_it ,c_getpid);
1822  new_built_in(sys_module,"stream2sys_stream" ,(def_type)function_it ,c_stream2sys_stream);
1823  new_built_in(sys_module,"sys_stream2stream" ,(def_type)function_it ,c_sys_stream2stream);
1824 #ifdef LIFE_DBM
1826 #endif
1827 #ifdef LIFE_NDBM
1828  insert_ndbm_builtins();
1829 #endif
1831  new_built_in(bi_module ,"call_once" ,(def_type)function_it ,c_call_once);
1832  (void)set_current_module(curmod);
1833 }
#define BV_OR
Definition: sys.c:163
#define prove
Definition: def_const.h:273
static long bitvector_unop(long op)
Definition: sys.c:299
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
char * text_buffer_cmp(struct text_buffer *buf, int idx, char *str)
Definition: sys.c:748
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
void insert_sys_builtins()
Definition: sys.c:1760
#define BV_NOT
Definition: sys.c:243
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
ptr_definition sys_regexp
Definition: def_glob.h:131
static long c_make_bitvector()
Definition: sys.c:155
static long c_bitvector_not()
Definition: sys.c:308
static long c_wait()
Definition: sys.c:1437
#define MANDATORY
Definition: def_const.h:219
void make_sys_type_links()
Definition: sys.c:1726
#define BV_CLEAR
Definition: sys.c:321
static long lazy_project_internal(args, result, funct)
Definition: sys.c:1525
#define FEATCMP
Definition: def_const.h:257
void clear_copy()
clear_copy
Definition: copy.c:53
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
static long wait_internal(args, result, funct)
Definition: sys.c:1428
static long gethostname_internal(args, result, funct)
Definition: sys.c:1504
static long get_code_internal(args, result, funct)
Definition: sys.c:892
char * combined_name
Definition: def_struct.h:92
static long bitvector_bit_internal(args, result, funct, GENERIC op)
Definition: sys.c:361
char data[TEXTBUFSIZE]
Definition: def_struct.h:401
long call_primitive(long(*fun)(), int num, argi, GENERIC info)
Definition: sys.c:12
void regerror(char *s)
Definition: sys.c:404
ptr_module current_module
Definition: def_glob.h:161
static long bitvector_bit_code(unsigned long *bv1, long idx, ptr_psi_term result, int op, ptr_psi_term funct)
Definition: sys.c:324
static long c_accept()
Definition: sys.c:1212
static long my_wait_on_feature_internal(args, result, funct)
Definition: sys.c:1600
#define SETARG(args, i, the_feature, the_type, the_options)
Definition: def_macro.h:163
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_definition stream
Definition: def_glob.h:103
static long c_fwrite()
Definition: sys.c:664
static long int2stream_internal(args, result, funct)
Definition: sys.c:582
void text_buffer_free(struct text_buffer *buf)
Definition: sys.c:795
static long c_call_once()
Definition: sys.c:1662
static long unify_pterm_result(ptr_psi_term t, ptr_definition sym, lst, int n)
Definition: sys.c:1339
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
char * make_module_token(ptr_module module, char *str)
Definition: modules.c:185
static long kill_internal(args, result, funct)
Definition: sys.c:1462
char * two
Definition: def_glob.h:251
#define BV_SET
Definition: sys.c:320
#define undef
Definition: def_const.h:360
static long c_stream2sys_stream()
Definition: sys.c:974
static long c_ftell()
Definition: sys.c:924
static long bitvector_binop_code(unsigned long *bv1, unsigned long *bv2, ptr_psi_term result, GENERIC op)
Definition: sys.c:167
#define general_cut
Definition: def_const.h:282
static long c_regexp_compile()
Definition: sys.c:453
static long c_int2stream()
Definition: sys.c:598
ptr_definition definition
Definition: def_struct.h:96
def_type type_def
Definition: def_struct.h:133
static long c_kill()
Definition: sys.c:1470
ptr_definition sys_file_stream
Definition: def_glob.h:133
ptr_psi_term fileptr2stream(FILE *fp, ptr_definition typ)
Definition: sys.c:571
#define BV_XOR
Definition: sys.c:164
static long c_fseek()
Definition: sys.c:955
#define DEFRULES
Definition: def_const.h:138
static long fwrite_internal(args, result, funct)
Definition: sys.c:650
static long c_get_record()
Definition: sys.c:883
FILE * fp
Definition: sys.c:563
long c_abort()
c_abort
Definition: built_ins.c:2248
static long bitvector_unop_internal(args, result, funct, GENERIC op)
Definition: sys.c:290
ptr_definition sys_stream
Definition: def_glob.h:132
ptr_psi_term value_str
Definition: sys.c:1333
static long fopen_internal(args, result, funct)
Definition: sys.c:607
ptr_hash_table symbol_table
Definition: def_struct.h:79
static long c_getpid()
Definition: sys.c:1715
static long c_get_code()
Definition: sys.c:903
static long c_bitvector_set()
Definition: sys.c:387
static long c_fclose()
Definition: sys.c:642
GENERIC data
Definition: def_struct.h:185
ptr_definition top
Definition: def_glob.h:106
void curry()
curry
Definition: lefun.c:174
#define NULL
Definition: def_const.h:203
static long regexp_compile_internal(args, result, funct)
Definition: sys.c:416
static long waitpid_internal(args, result, funct)
Definition: sys.c:1443
static long errno_internal(args, result, funct)
Definition: sys.c:1223
char * three
Definition: def_glob.h:252
char * symbol
Definition: def_struct.h:91
ptr_goal resid_aim
Definition: def_glob.h:220
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
static long bitvector_bit(long op)
Definition: sys.c:371
#define REAL
Definition: def_const.h:72
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
static long get_buffer_internal(args, result, funct)
Definition: sys.c:692
char * get_numeric_feature(long n)
Definition: sys.c:1360
#define JUSTFAIL
Definition: def_const.h:217
#define eval
Definition: def_const.h:278
#define FP_OUTPUT
Definition: sys.c:560
static long c_apply1()
Definition: sys.c:1698
static long c_bitvector_xor()
Definition: sys.c:238
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
static long c_fflush()
Definition: sys.c:684
static long getpid_internal(args, result, funct)
Definition: sys.c:1708
static long c_fopen()
Definition: sys.c:623
struct a_stream * ptr_stream
static long bitvector_binop(long op)
Definition: sys.c:216
void Errorline(char *format,...)
Definition: error.c:414
static long c_connect()
Definition: sys.c:1157
char * heap_copy_string(char *s)
Definition: trees.c:147
static long bitvector_binop_internal(ptr_psi_term *args, ptr_psi_term result, ptr_psi_term funct, GENERIC op)
Definition: sys.c:206
static long socket_internal(args, result, funct)
Definition: sys.c:1012
static long unify_wait_result(ptr_psi_term result, pid_t id, int status)
Definition: sys.c:1384
#define FP_NONE
Definition: sys.c:558
static long c_listen()
Definition: sys.c:1179
#define SETFEATURE(lst, n, nam, val)
Definition: sys.c:1336
ptr_psi_term stack_pair(ptr_psi_term left, ptr_psi_term right)
stack_pair
Definition: built_ins.c:69
static long c_import_symbol()
Definition: sys.c:1305
static long c_waitpid()
Definition: sys.c:1453
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
#define BV_GET
Definition: sys.c:319
#define deref_ptr(P)
Definition: def_macro.h:95
static long errmsg_internal(args, result, funct)
Definition: sys.c:1241
#define BYTEDATA_DATA(X)
Definition: sys.c:128
static long accept_internal(args, result, funct)
Definition: sys.c:1188
ptr_definition sys_process_signaled
Definition: sys.c:1379
void check_sys_definitions()
Definition: sys.c:1740
#define TEXTBUFSIZE
Definition: def_struct.h:396
ptr_definition type
Definition: def_struct.h:364
#define REQUIRED
Definition: def_const.h:215
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
HASH_INSERT.
Definition: hash_table.c:151
static long fflush_internal(args, result, funct)
Definition: sys.c:673
static long ftell_internal(args, result, funct)
Definition: sys.c:911
ptr_psi_term distinct_copy(ptr_psi_term t)
distinct_copy
Definition: copy.c:393
#define TRUE
Definition: def_const.h:127
ptr_definition sys_bitvector
Definition: def_glob.h:130
static long c_fork()
Definition: sys.c:1326
static long sys_stream2stream_internal(args, result, funct)
Definition: sys.c:982
int is_ipaddr(char *s)
Definition: sys.c:1068
ptr_definition built_in
Definition: def_glob.h:75
void make_type_link(ptr_definition t1, ptr_definition t2)
Definition: types.c:848
static long cuserid_internal(args, result, funct)
Definition: sys.c:1482
ptr_definition integer
Definition: def_glob.h:93
ptr_definition lf_true
Definition: def_glob.h:107
ptr_psi_term stack_int(long n)
stack_int
Definition: built_ins.c:91
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
static long bitvector_unop_code(unsigned long *bv1, ptr_psi_term result, int op)
Definition: sys.c:247
int text_buffer_next(struct text_buffer *buf, int idx, char c, struct text_buffer **rbuf, int *ridx)
Definition: sys.c:724
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_definition sys_process_stopped
Definition: sys.c:1380
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
#define BV_AND
Definition: sys.c:162
ptr_definition sys_process_continued
Definition: sys.c:1381
static long c_bitvector_count()
Definition: sys.c:314
ptr_goal aim
Definition: def_glob.h:49
static long import_symbol_internal(args, result, funct)
Definition: sys.c:1269
char * one
Definition: def_glob.h:250
void insert_dbm_builtins()
static long c_wait_on_feature()
Definition: sys.c:1590
#define FP_INPUT
Definition: sys.c:559
static long c_bind()
Definition: sys.c:1146
#define unify
Definition: def_const.h:274
static long make_bitvector_internal(args, result, funct)
Definition: sys.c:138
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
static long c_errno()
Definition: sys.c:1231
Definition: sys.c:562
static long fclose_internal(args, result, funct)
Definition: sys.c:632
static long c_regexp_execute()
Definition: sys.c:538
ptr_module sys_module
Definition: def_glob.h:162
static long c_cuserid()
Definition: sys.c:1494
ptr_module module
Definition: def_struct.h:90
static long fork_internal(args, result, funct)
Definition: sys.c:1317
void check_definition(ptr_definition *d)
check_definition
Definition: memory.c:662
static long c_bitvector_or()
Definition: sys.c:232
#define FP_PREPARE(s, OP)
Definition: sys.c:567
static long c_socket()
Definition: sys.c:1059
ptr_definition sys_bytedata
Definition: def_glob.h:336
#define NOVALUE
Definition: def_const.h:220
ptr_definition sys_socket_stream
Definition: def_glob.h:134
ptr_definition sys_process_exited
Definition: sys.c:1378
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
int op
Definition: sys.c:564
#define SEEK_SET
Definition: sys.c:932
long unify_real_result(ptr_psi_term t, REAL v)
unify_real_result
Definition: built_ins.c:387
static long wait_on_feature_internal(args, result, funct)
Definition: sys.c:1564
static long c_bitvector_and()
Definition: sys.c:226
static long get_record_internal(args, result, funct)
Definition: sys.c:807
static ptr_psi_term make_bytedata(ptr_definition sort, unsigned long bytes)
Definition: sys.c:113
#define NARGS(args)
Definition: def_macro.h:169
int private_feature
Definition: def_struct.h:95
static long c_lazy_project()
Definition: sys.c:1552
static long c_my_wait_on_feature()
Definition: sys.c:1628
static long c_bitvector_get()
Definition: sys.c:381
static long c_bitvector_clear()
Definition: sys.c:393
char * name_str
Definition: sys.c:1332
ptr_module bi_module
Definition: def_glob.h:155
int public
Definition: def_struct.h:94
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long apply1_internal(args, result, funct)
Definition: sys.c:1670
static long c_sys_stream2stream()
Definition: sys.c:994
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_psi_term stack_string(char *s)
stack_string
Definition: built_ins.c:109
#define OPTIONAL
Definition: def_const.h:214
static long listen_internal(args, result, funct)
Definition: sys.c:1168
static long stream2sys_stream_internal(args, result, funct)
Definition: sys.c:965
struct text_buffer * next
Definition: def_struct.h:399
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
static long bind_or_connect_internal(args, result, funct, void *info)
Definition: sys.c:1079
static long c_gethostname()
Definition: sys.c:1516
#define BV_COUNT
Definition: sys.c:244
ptr_node attr_list
Definition: def_struct.h:171
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
static long c_get_buffer()
Definition: sys.c:710
#define ARGNN
Definition: def_const.h:347
static long call_once_internal(args, result, funct)
Definition: sys.c:1644
ptr_definition sys_process_no_children
Definition: sys.c:1377
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
#define POLYTYPE
Definition: def_const.h:218
void stack_insert_copystr(char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:260
ptr_choice_point choice_stack
Definition: def_glob.h:51
static long c_errmsg()
Definition: sys.c:1253
static long regexp_execute_internal(args, result, funct)
Definition: sys.c:469
static long fseek_internal(args, result, funct)
Definition: sys.c:942
#define UNEVALED
Definition: def_const.h:216
void text_buffer_push(struct text_buffer **buf, char c)
Definition: sys.c:773