Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
sys.c
Go to the documentation of this file.
1 
9 /* Copyright by Denys Duchier, Dec 1994
10  Simon Fraser University
11 */
12 
13 #include "defs.h"
14 
24 long call_primitive(long (*fun)(),int num,psi_arg argi[],GENERIC info)
25 {
26  ptr_psi_term funct,arg,result,argo[ARGNN]; /* no more than 10 arguments */
27  ptr_node n;
28  int allargs=1,allvalues=1,i;
29  funct=aim->aaaa_1;
30  deref_ptr(funct);
31  result=aim->bbbb_1;
32  for (i=0;i<num;i++) {
33  n=find(FEATCMP,argi[i].feature,funct->attr_list);
34  /* argument present */
35  if (n) {
36  arg = (ptr_psi_term) n->data;
37  /* in case we don't want to evaluate the argument
38  just follow the chain of corefs and don't do
39  any of the other checks: they'll have do be done
40  by fun; just go on to the next arg */
41  if (argi[i].options&UNEVALED) {
42  deref_ptr(arg);
43  argo[i]=arg;
44  continue; }
45  /* this arg should be evaled */
46  deref(arg);
47  argo[i]=arg;
48  /* arg of admissible type */
49  if (argi[i].options&POLYTYPE) {
50  ptr_definition *type = (ptr_definition *)argi[i].type;
51  while (*type != NULL)
52  if (overlap_type(arg->type,*type))
53  goto admissible;
54  else type++;
55  }
56  else {
57  if (overlap_type(arg->type,argi[i].type))
58  goto admissible;
59  }
60  /* not admissible */
61  if (argi[i].options&JUSTFAIL) return FALSE;
62  Errorline("Illegal argument in %P.\n",funct);
63  return (c_abort());
64  /* admissible */
65  admissible:
66  /* has value */
67  if (arg->value_3) {
68  ptr_definition *type = (ptr_definition *)argi[i].type;
69  /* paranoid check: really correct type */
70  if (argi[i].options&POLYTYPE) {
71  while (*type != NULL)
72  if (sub_type(arg->type,*type))
73  goto correct;
74  else type++;
75  }
76  else {
77  if (sub_type(arg->type,(ptr_definition)type)) goto correct;
78  }
79  /* type incorrect */
80  if (argi[i].options&JUSTFAIL) return FALSE;
81  Errorline("Illegal argument in %P.\n",funct);
82  return (c_abort());
83  /* correct */
84  correct:;
85  }
86  /* missing value - do we need it */
87  else if (!(argi[i].options&NOVALUE)) allvalues=0;
88  }
89  /* argument missing */
90  else {
91  argo[i]=NULL;
92  if (argi[i].options&MANDATORY) {
93  Errorline("Missing argument '%s' in %P.\n",argi[i].feature,funct);
94  return (c_abort());
95  }
96  else if (argi[i].options&REQUIRED) allargs=0;
97  }
98  }
99  if (allargs)
100  if (allvalues) {
101  return fun(argo,result,funct,info);
102  }
103  else {
104  for (i=0;i<num;i++) {
105  /* if arg present and should be evaled but has no value */
106  if (argo[i] && !(argi[i].options&UNEVALED) && !argo[i]->value_3)
107  residuate(argo[i]);
108  }
109  }
110  else curry();
111  return TRUE;
112 }
113 
114 /* DENYS: BYTEDATA */
115 
126 static ptr_psi_term make_bytedata(ptr_definition sort,unsigned long bytes)
127 {
128  ptr_psi_term temp_result;
129  char *b = (char *) heap_alloc(bytes+sizeof(bytes));
130  *((long *) b) = bytes;
131  bzero(b+sizeof(bytes),bytes);
132  temp_result=stack_psi_term(0);
133  temp_result->type=sort;
134  temp_result->value_3=(GENERIC)b;
135  return temp_result;
136 }
137 
138 #define BYTEDATA_SIZE(X) (*(unsigned long *)(X->value_3))
139 #define BYTEDATA_DATA(X) ((char*)((char*)X->value_3 + sizeof(unsigned long)))
140 
141 /* BIT VECTORS *
142  ***************/
143 
155 {
156  long bits = *(REAL *)args[0]->value_3;
157  if (bits < 0) {
158  Errorline("negative argument in %P.\n",funct);
159  return FALSE; }
160  else {
161  unsigned long bytes = bits / sizeof(char);
162  ptr_psi_term temp_result;
163  if ((bits % sizeof(char)) != 0) bytes++;
164  temp_result = make_bytedata(sys_bitvector,bytes);
165  push_goal(unify,temp_result,result,NULL);
166  return TRUE; }
167 }
168 
174 static long c_make_bitvector()
175 {
176  psi_arg args[1];
177  SETARG(args,0, "1" , integer , REQUIRED );
178  return call_primitive(make_bitvector_internal,NARGS(args),args,0);
179 }
180 
181 #define BV_AND 0
182 #define BV_OR 1
183 #define BV_XOR 2
184 
194 static long bitvector_binop_code(unsigned long *bv1,unsigned long *bv2,ptr_psi_term result,GENERIC op)
195 {
196  unsigned long size1 = *bv1;
197  unsigned long size2 = *bv2;
198  unsigned long size3 = (size1>size2)?size1:size2;
199  ptr_psi_term temp_result = make_bytedata(sys_bitvector,size3);
200  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
201  unsigned char *s2 = ((unsigned char*)bv2)+sizeof(size2);
202  unsigned char *s3 = ((unsigned char *) temp_result->value_3) + sizeof(size3);
203  unsigned long i;
204  switch ((long)op) { // added cast DJD 2.16
205  case BV_AND:
206  for(i=0;i<size3;i++) s3[i] = s1[i] & s2[i];
207  if (size1<size2) for(;i<size2;i++) s3[i] = 0;
208  else for(;i<size1;i++) s3[i] = 0;
209  break;
210  case BV_OR:
211  for(i=0;i<size3;i++) s3[i] = s1[i] | s2[i];
212  if (size1<size2) for(;i<size2;i++) s3[i] = s2[i];
213  else for(;i<size1;i++) s3[i] = s1[i];
214  break;
215  case BV_XOR:
216  for(i=0;i<size3;i++) s3[i] = s1[i] ^ s2[i];
217  if (size1<size2) for(;i<size2;i++) s3[i] = (unsigned char) 0 ^ s2[i];
218  else for(;i<size1;i++) s3[i] = s1[i] ^ (unsigned char) 0;
219  break;
220  default: return (c_abort());
221  }
222  push_goal(unify,temp_result,result,NULL);
223  return TRUE;
224 }
225 
236 {
237  return bitvector_binop_code((unsigned long *)args[0]->value_3,
238  (unsigned long *)args[1]->value_3,
239  result,(GENERIC)op);
240 }
241 
248 static long bitvector_binop(long op)
249 {
250  psi_arg args[2];
251  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
252  SETARG(args,1, "2" , sys_bitvector , REQUIRED );
253  return call_primitive(bitvector_binop_internal,NARGS(args),args,(GENERIC)op);
254 }
255 
261 static long c_bitvector_and()
262 {
263  return bitvector_binop(BV_AND);
264 }
265 
271 static long c_bitvector_or()
272 {
273  return bitvector_binop(BV_OR);
274 }
275 
281 static long c_bitvector_xor()
282 {
283  return bitvector_binop(BV_XOR);
284 }
285 
286 #define BV_NOT 0
287 #define BV_COUNT 1
288 
297 static long bitvector_unop_code(unsigned long *bv1,ptr_psi_term result,int op)
298 {
299  unsigned long size1 = *bv1;
300  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
301  unsigned long i;
302  ptr_psi_term temp_result;
303  unsigned char *s3;
304  switch (op) {
305  case BV_NOT:
306  temp_result = make_bytedata(sys_bitvector,size1);
307  s3 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
308  for(i=0;i<size1;i++) s3[i] = ~(s1[i]);
309  break;
310  case BV_COUNT:
311  {
312  int cnt = 0;
313  register unsigned char c;
314  for(i=0;i<size1;i++) {
315  c=s1[i];
316  if (c & 1<<0) cnt++;
317  if (c & 1<<1) cnt++;
318  if (c & 1<<2) cnt++;
319  if (c & 1<<3) cnt++;
320  if (c & 1<<4) cnt++;
321  if (c & 1<<5) cnt++;
322  if (c & 1<<6) cnt++;
323  if (c & 1<<7) cnt++; }
324  return unify_real_result(result,(REAL) cnt);
325  }
326  break;
327  default: return (c_abort());
328  }
329  push_goal(unify,temp_result,result,NULL);
330  return TRUE;
331 }
332 
343 static long bitvector_unop_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct,int op)
344 {
345  return bitvector_unop_code((unsigned long *)args[0]->value_3,result, op);
346 }
347 
354 static long bitvector_unop(GENERIC op)
355 {
356  psi_arg args[1];
357  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
358  return call_primitive(bitvector_unop_internal,NARGS(args),args,op);
359 }
360 
366 static long c_bitvector_not()
367 {
368  return bitvector_unop((GENERIC)BV_NOT); // cast added 12/10/2016 DJD 2.29
369 }
370 
376 static long c_bitvector_count()
377 {
378  return bitvector_unop((GENERIC)BV_COUNT); // cast added 12/10/2016 DJD 2.29
379 }
380 
381 #define BV_GET 0
382 #define BV_SET 1
383 #define BV_CLEAR 2
384 
395 static long bitvector_bit_code(unsigned long *bv1,long idx,ptr_psi_term result,int op,ptr_psi_term funct)
396 {
397  unsigned long size1 = *bv1;
398  unsigned char *s1 = ((unsigned char*)bv1)+sizeof(size1);
399  unsigned long i = idx / sizeof(char);
400  int j = idx % sizeof(char);
401  ptr_psi_term temp_result;
402  unsigned char *s2;
403  if (idx<0 || idx>=size1) {
404  Errorline("Index out of bound in %P.\n",funct);
405  return FALSE; }
406  switch (op) {
407  case BV_GET:
408  return unify_real_result(result,(REAL)((s1[i] & (1<<j))?1:0));
409  break;
410  case BV_SET:
411  temp_result = make_bytedata(sys_bitvector,size1);
412  s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
413  bcopy(s1,s2,size1);
414  s2[i] |= 1<<j;
415  break;
416  case BV_CLEAR:
417  temp_result = make_bytedata(sys_bitvector,size1);
418  s2 = ((unsigned char *) temp_result->value_3) + sizeof(size1);
419  bcopy(s1,s2,size1);
420  s2[i] &= ~ (1<<j);
421  break;
422  }
423  push_goal(unify,temp_result,result,NULL);
424  return TRUE;
425 }
426 
436 static long bitvector_bit_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct,int op)
437 {
438  return bitvector_bit_code((unsigned long *)args[0]->value_3,
439  (long)*((REAL*)args[1]->value_3),
440  result,op,funct);
441 }
442 
449 static long bitvector_bit(long op)
450 {
451  psi_arg args[2];
452  SETARG(args,0, "1" , sys_bitvector , REQUIRED );
453  SETARG(args,1, "2" , integer , REQUIRED );
454  return call_primitive(bitvector_bit_internal,NARGS(args),args,(GENERIC)op);
455 }
456 
462 static long c_bitvector_get()
463 {
464  return bitvector_bit(BV_GET);
465 }
466 
472 static long c_bitvector_set()
473 {
474  return bitvector_bit(BV_SET);
475 }
476 
482 static long c_bitvector_clear()
483 {
484  return bitvector_bit(BV_CLEAR);
485 }
486 
487 /* REGULAR EXPRESSIONS *
488  ***********************/
489 
490 #include "regexp/regexp.h"
491 
498 void regerror(char *s)
499 {
500  fprintf(stderr,"Regexp Error: %s\n",s);
501 }
502 
515 {
516  ptr_psi_term temp_result;
517  regexp * re = regcomp((char *)args[0]->value_3);
518  long bytes;
519  if (re == NULL) {
520  Errorline("compilation of regular expression failed in %P.\n",funct);
521  return (c_abort()); }
522  /* compute the size of the regexp stuff. this is essentially the size
523  of the regexp structure + the size of the program (bytecode) including
524  the final END opcode (i.e. 0), hence the + 1, minus the bytes that we
525  have counted twice, i.e. those between the start of the program and
526  the computed end of the regexp structure (i.e. in case a regexp
527  struct is larger, maybe to respect alignment constraints, than it has
528  to be, and also to count the 1 byte of program included in the decl
529  of struct regexp */
530  bytes = last_regsize();
531  temp_result = make_bytedata(sys_regexp,bytes);
532  /* now let's copy the regexp stuff into the bytedata block. The regmust
533  field must be treated specially because it is a pointer into program:
534  we cannot simply change it to reflect the location where the program
535  will be copied to because that may well change over time: the gc may
536  relocate the bytedata block. Instead, we convert regmust into an
537  offset and each time we need to pass it to regexec or regsub we must
538  first convert it back into a pointer then back into an offset when we
539  are done. Note that, if regmust is NULL we must leave it that way */
540  if (re->regmust != NULL)
541  re->regmust = (char *) ((unsigned long) (re->regmust - (char *)re));
542  bcopy((char*)re,((char*)temp_result->value_3)+sizeof(unsigned long),bytes);
543  free(re); /* free the regexp: no longer needed */
544  /* return result */
545  push_goal(unify,temp_result,result,NULL);
546  return TRUE;
547 }
548 
554 static long c_regexp_compile()
555 {
556  psi_arg args[1];
557  SETARG(args,0, "1" , quoted_string , REQUIRED );
558  return call_primitive(regexp_compile_internal,NARGS(args),args,0);
559 }
560 
577 {
578  regexp * re = (regexp*)(((char *)args[0]->value_3)+sizeof(unsigned long));
579  char * must = re->regmust;
580  long offset = 0;
581  // long success = TRUE;
582  /* check that args[3] aka "offset" is valid if present */
583  if (args[3]) {
584  offset = *(REAL*)args[3]->value_3;
585  if (offset < 0 || offset > strlen((char*)args[1]->value_3)) {
586  Errorline("Illegal offset in %P.\n",funct);
587  return (c_abort()); }
588  }
589  /* convert regmust from offset into a pointer if not NULL */
590  if (must != NULL)
591  re->regmust = (char*)re+(unsigned long)must;
592  /* perform operation */
593  if (regexec(re,((char *)args[1]->value_3) + offset) == 0) {
594  if (must != NULL) re->regmust = must; /* back into an offset */
595  return FALSE;
596  }
597  else {
598  /* construct result of match */
599  char **sp = re->startp;
600  char **ep = re->endp;
601  int i;
602  char buffer_loc[5]; /* in case NSUBEXP ever gets increased */
603  ptr_node n3;
604  if (must != NULL) re->regmust = must; /* back into an offset */
605  if (args[2]) {
606  /* only instantiate the numeric features present in args[2]
607  then return true */
608  for (i=0;i<NSUBEXP;i++,sp++,ep++) {
609  if (*sp==NULL) break;
610  (void)snprintf(buffer_loc,5,"%d",i);
611  n3=find(FEATCMP,buffer_loc,args[2]->attr_list);
612  if (n3) {
613  ptr_psi_term psi = (ptr_psi_term) n3->data;
614  /* need to add 1 to these offsets because somehow life strings
615  are 1-based rather than 0-based. Who is the moron who made
616  that decision? This isn't Pascal! */
617  ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
618  stack_int(*ep - (char *)args[1]->value_3 + 1));
619  push_goal(unify,psi,bounds,NULL);
620  }
621  }
622  /* return true */
623  unify_bool_result(result,TRUE);
624  }
625  else {
626  /* create a term to represent all the groups and return it */
627  ptr_psi_term psi = stack_psi_term(4);
628  psi->type = top;
629  for (i=0;i<NSUBEXP;i++,sp++,ep++) {
630  if (*sp==NULL) break;
631  (void)snprintf(buffer_loc,5,"%d",i);
632  { ptr_psi_term bounds = stack_pair(stack_int(*sp - (char *)args[1]->value_3 + 1),
633  stack_int(*ep - (char *)args[1]->value_3 + 1));
634  stack_insert_copystr(buffer_loc,&(psi->attr_list),(GENERIC)bounds); }
635  }
636  /* return the new term */
637  push_goal(unify,psi,result,NULL);
638  }
639  return TRUE;
640  }
641 }
642 
648 static long c_regexp_execute()
649 {
650  psi_arg args[4];
651  SETARG(args,0, "1" , sys_regexp , REQUIRED );
652  SETARG(args,1, "2" , quoted_string , REQUIRED );
653  SETARG(args,2, "3" , top , OPTIONAL|NOVALUE );
654  SETARG(args,3, "offset" , integer , OPTIONAL );
655  return call_primitive(regexp_execute_internal,NARGS(args),args,0);
656 }
657 
658 /* FILE STREAMS *
659  ****************/
660 
661 /* when a fp is opened for updating an input operation
662  should not follow an output operation without an intervening
663  flush or file positioning operation; and the other way around
664  too. I am going to keep track of what operations have been
665  applied so that flush will be automatically invoked when
666  necessary */
667 
668 #define FP_NONE 0
669 #define FP_INPUT 1
670 #define FP_OUTPUT 2
671 
672 typedef struct a_stream {
673  FILE *fp;
674  int op;
675 } *ptr_stream;
676 
677 #define FP_PREPARE(s,OP) \
678  if (s->op != OP && s->op != FP_NONE) fflush(s->fp); \
679  s->op = OP;
680 
689 {
690  ptr_psi_term result = make_bytedata(typ,sizeof(struct a_stream));
691  ((ptr_stream)BYTEDATA_DATA(result))->fp = fp;
692  ((ptr_stream)BYTEDATA_DATA(result))->op = FP_NONE;
693  return result;
694 }
695 
705 {
706  FILE *fp = fdopen((int)*(REAL*)args[0]->value_3,
707  (char*)args[1]->value_3);
708  if (fp==NULL) return FALSE;
709  else {
710  push_goal(unify,fileptr2stream(fp,sys_stream),result,NULL); // added & DJD
711 /* ptr_psi_term temp_result = make_bytedata(sys_stream,sizeof(fp));
712  *(FILE**)BYTEDATA_DATA(temp_result) = fp;
713  push_goal(unify,temp_result,result,NULL); */
714  return TRUE;
715  }
716 }
717 
723 static long c_int2stream()
724 {
725  psi_arg args[2];
726  SETARG(args,0,"1",integer,REQUIRED);
727  SETARG(args,1,"2",quoted_string,REQUIRED);
728  return call_primitive(int2stream_internal,NARGS(args),args,0);
729 }
730 
739 static long fopen_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
740 {
741  FILE *fp = fopen((char*)args[0]->value_3,
742  (char*)args[1]->value_3);
743  if (fp==NULL) return FALSE;
744  else {
745 /* ptr_psi_term temp_result = make_bytedata(sys_file_stream,sizeof(fp));
746  *(FILE**)BYTEDATA_DATA(temp_result) = fp;
747 */
748  push_goal(unify,fileptr2stream(fp,sys_file_stream),result,NULL); // added & DJD
749  return TRUE;
750  }
751 }
752 
758 static long c_fopen()
759 {
760  psi_arg args[2];
761  SETARG(args,0, "1" , quoted_string , REQUIRED );
762  SETARG(args,1, "2" , quoted_string , REQUIRED );
763  return call_primitive(fopen_internal,NARGS(args),args,0);
764 }
765 
774 static long fclose_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
775 {
776  if (fclose(((ptr_stream)BYTEDATA_DATA(args[0]))->fp) != 0)
777  return FALSE;
778  else
779  return TRUE;
780 }
781 
787 static long c_fclose()
788 {
789  psi_arg args[1];
790  SETARG(args,0, "1" , sys_stream , REQUIRED );
791  return call_primitive(fclose_internal,NARGS(args),args,0);
792 }
793 
802 static long fwrite_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
803 {
804  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
805  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
806  char* txt = (char*)args[1]->value_3;
807  FP_PREPARE(srm,FP_OUTPUT);
808  if (txt && *txt!='\0' &&
809  fwrite((void*)txt,sizeof(char),strlen(txt),srm->fp)<=0)
810  return FALSE;
811  return TRUE;
812 }
813 
819 static long c_fwrite()
820 {
821  psi_arg args[2];
822  SETARG(args,0,"1",sys_stream,MANDATORY);
823  SETARG(args,1,"2",quoted_string,MANDATORY);
824  return call_primitive(fwrite_internal,NARGS(args),args,0);
825 }
826 
835 static long fflush_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
836 {
837  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
838  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
839  srm->op = FP_NONE;
840  if (fflush(srm->fp)!=0) return FALSE;
841  return TRUE;
842 }
843 
849 static long c_fflush()
850 {
851  psi_arg args[1];
852  SETARG(args,0,"1",sys_stream,MANDATORY);
853  return call_primitive(fflush_internal,NARGS(args),args,0);
854 }
855 
865 {
866  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
867  /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
868  long size = *(REAL*)args[1]->value_3;
870  t->type = quoted_string;
871  t->value_3=(GENERIC)heap_alloc(size+1);
872  bzero((char*)t->value_3,size+1);
873  FP_PREPARE(srm,FP_INPUT);
874  if (fread((void*)t->value_3,sizeof(char),size,srm->fp) <= 0)
875  return FALSE;
876  push_goal(unify,t,result,NULL);
877  return TRUE;
878 }
879 
885 static long c_get_buffer()
886 {
887  psi_arg args[2];
888  SETARG(args,0,"1",sys_stream,REQUIRED);
889  SETARG(args,1,"2",integer,REQUIRED);
890  return call_primitive(get_buffer_internal,NARGS(args),args,0);
891 }
892 
893 
907 int text_buffer_next(struct text_buffer *buf,int idx,char c,struct text_buffer **rbuf,int *ridx)
908 {
909  while (buf) {
910  while (idx<buf->top)
911  if (buf->data[idx] == c) {
912  *rbuf=buf;
913  *ridx=idx;
914  return 1;
915  }
916  else idx++;
917  buf=buf->next;
918  idx=0;
919  }
920  return 0;
921 }
922 
934 char *text_buffer_cmp(struct text_buffer *buf,int idx,char *str)
935 {
936  while (buf) {
937  while (idx<buf->top)
938  if (!*str || buf->data[idx] != *str)
939  return 0;
940  else { idx++; str++; }
941  if (!*str && !buf->next) return str;
942  else {
943  buf=buf->next;
944  idx=0;
945  }
946  }
947  return 0;
948 }
949 
961 void text_buffer_push(struct text_buffer **buf,char c)
962 {
963  if ((*buf)->top < TEXTBUFSIZE)
964  (*buf)->data[(*buf)->top++] = c;
965  else {
966  (*buf)->next = (struct text_buffer *)
967  malloc(sizeof(struct text_buffer));
968  if (!(*buf)->next) {
969  fprintf(stderr,"Fatal error: malloc failed in text_buffer_push\n");
970  exit(EXIT_FAILURE);
971  }
972  bzero((char*)(*buf)->next,sizeof(struct text_buffer));
973  *buf = (*buf)->next;
974  (*buf)->top = 1;
975  (*buf)->data[0]=c;
976  }
977 }
978 
986 void text_buffer_free(struct text_buffer *buf)
987 {
988  struct text_buffer *next;
989  while (buf) {
990  next = buf->next;
991  free(buf);
992  buf=next;
993  }
994 }
995 
1005 {
1006  struct text_buffer rootbuf;
1007  struct text_buffer *curbuf = &rootbuf;
1008  struct text_buffer *lastbuf = &rootbuf;
1009  int lastidx = 0,size;
1010  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
1011  FILE *fp = srm->fp; /*FILE* fp = *(FILE**)BYTEDATA_DATA(args[0]);*/
1012  char *sep = (char*)args[1]->value_3;
1013  int c;
1014  ptr_psi_term t;
1015  char *cursep = sep;
1016 
1017  FP_PREPARE(srm,FP_INPUT);
1018  bzero((char*)&rootbuf,sizeof(rootbuf));
1019  if (!sep || !*sep) {
1020  /* no separator: just grab as much as you can */
1021  while ((c=getc(fp)) != EOF)
1022  text_buffer_push(&curbuf,(char)c);
1023  goto PackUpAndLeave;
1024  }
1025 
1026  if (sep[1]=='\0') {
1027  /* only one char in string */
1028  while ((c=getc(fp)) != EOF) {
1029  text_buffer_push(&curbuf,(char)c);
1030  if (c==*sep) break;
1031  }
1032  goto PackUpAndLeave;
1033  }
1034 
1035  /* general case: multicharacter separator */
1036 
1037  WaitForStart:
1038  if ((c=getc(fp)) == EOF) goto PackUpAndLeave;
1039  text_buffer_push(&curbuf,(char)c);
1040  if (c==*sep) {
1041  cursep = sep+1;
1042  lastbuf=curbuf;
1043  lastidx=curbuf->top - 1;
1044  goto MatchNext;
1045  }
1046  else goto WaitForStart;
1047 
1048  MatchNext:
1049  if (!*cursep || (c=getc(fp))==EOF) goto PackUpAndLeave;
1050  text_buffer_push(&curbuf,(char)c);
1051  if (c!=*cursep) goto TryAgain;
1052  cursep++;
1053  goto MatchNext;
1054 
1055  TryAgain:
1056  if (!text_buffer_next(lastbuf,lastidx+1,*sep,&lastbuf,&lastidx))
1057  goto WaitForStart;
1058  if (!(cursep=text_buffer_cmp(lastbuf,lastidx,sep)))
1059  goto TryAgain;
1060  goto MatchNext;
1061 
1062  PackUpAndLeave:
1063  /* compute how much space we need */
1064  for(lastbuf=&rootbuf,size=0;lastbuf!=NULL;lastbuf=lastbuf->next)
1065  size += lastbuf->top;
1066  t=stack_psi_term(0);
1067  t->type=quoted_string;
1068  t->value_3=(GENERIC)heap_alloc(size+1);
1069  for(lastbuf=&rootbuf,sep=(char*)t->value_3;
1070  lastbuf!=NULL;sep+=lastbuf->top,lastbuf=lastbuf->next)
1071  bcopy(lastbuf->data,sep,lastbuf->top);
1072  ((char*)t->value_3)[size]='\0';
1073  text_buffer_free(rootbuf.next);
1074  push_goal(unify,t,result,NULL);
1075  return TRUE;
1076 }
1077 
1083 static long c_get_record()
1084 {
1085  psi_arg args[2];
1086  SETARG(args,0,"1",sys_stream,REQUIRED);
1087  SETARG(args,1,"2",quoted_string,REQUIRED);
1088  return call_primitive(get_record_internal,NARGS(args),args,0);
1089 }
1090 
1100 {
1101  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
1102  int c;
1103  FP_PREPARE(srm,FP_INPUT);
1104  if ((c=getc(srm->fp)) == EOF) return FALSE;
1105  else return unify_real_result(result,(REAL)c);
1106 }
1107 
1113 static long c_get_code()
1114 {
1115  psi_arg args[1];
1116  SETARG(args,0,"1",sys_stream,REQUIRED);
1117  return call_primitive(get_code_internal,NARGS(args),args,0);
1118 }
1119 
1128 static long ftell_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1129 {
1130  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
1131  if (srm->op != FP_NONE || srm->op != FP_INPUT) {
1132  fflush(srm->fp);
1133  srm->op = FP_NONE;
1134  }
1135  return unify_real_result(result,(REAL)ftell(srm->fp));
1136 /* *(FILE**)BYTEDATA_DATA(args[0])));*/
1137 }
1138 
1144 static long c_ftell()
1145 {
1146  psi_arg args[1];
1147  SETARG(args,0,"1",sys_file_stream,REQUIRED);
1148  return call_primitive(ftell_internal,NARGS(args),args,0);
1149 }
1150 
1151 #ifndef SEEK_SET
1152 #define SEEK_SET 0
1153 #endif
1154 #ifndef SEEK_CUR
1155 #define SEEK_CUR 1
1156 #endif
1157 #ifndef SEEK_END
1158 #define SEEK_END 2
1159 #endif
1160 
1169 static long fseek_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1170 {
1171  ptr_stream srm = (ptr_stream)BYTEDATA_DATA(args[0]);
1172  srm->op = FP_NONE;
1173  return
1174  (fseek(srm->fp ,
1175  (long)*(REAL*)args[1]->value_3,
1176  args[2]?(long)*(REAL*)args[2]->value_3:SEEK_SET) < 0)
1177  ?FALSE:TRUE;
1178 }
1179 
1185 static long c_fseek()
1186 {
1187  psi_arg args[3];
1188  SETARG(args,0,"1",sys_file_stream,MANDATORY);
1189  SETARG(args,1,"2",integer,MANDATORY);
1190  SETARG(args,2,"3",integer,OPTIONAL);
1191  return call_primitive(fseek_internal,NARGS(args),args,0);
1192 }
1193 
1203 {
1204  push_goal(unify,fileptr2stream((FILE*)args[0]->value_3,sys_stream),
1205  result,NULL); // added & DJD
1206  return TRUE;
1207 }
1208 
1214 static long c_stream2sys_stream()
1215 {
1216  psi_arg args[1];
1217  SETARG(args,0,"1",stream,REQUIRED);
1218  return call_primitive(stream2sys_stream_internal,NARGS(args),args,0);
1219 }
1220 
1230 {
1231  ptr_psi_term tmp;
1232  tmp=stack_psi_term(4);
1233  tmp->type=stream;
1234  tmp->value_3=(GENERIC)((ptr_stream)BYTEDATA_DATA(args[0]))->fp;
1235  push_goal(unify,tmp,result,NULL);
1236  return TRUE;
1237 }
1238 
1244 static long c_sys_stream2stream()
1245 {
1246  psi_arg args[1];
1247  SETARG(args,0,"1",sys_stream,REQUIRED);
1248  return call_primitive(sys_stream2stream_internal,NARGS(args),args,0);
1249 }
1250 
1251 /* SOCKETS AND NETWORKING *
1252  **************************/
1253 
1254 #include <sys/socket.h>
1255 #include <netinet/in.h>
1256 #include <sys/un.h>
1257 #include <netdb.h>
1258 #include <arpa/inet.h>
1259 #include <ctype.h>
1260 
1269 static long socket_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1270 {
1271  int addr_family=AF_INET,type=SOCK_STREAM,protocol=0;
1272  char *s;
1273  int fd;
1274 
1275  if (args[0]) {
1276  s=(char*)args[0]->value_3;
1277  if (!strcmp(s,"AF_UNIX")) addr_family=AF_UNIX;
1278  else if (!strcmp(s,"AF_INET")) addr_family=AF_INET;
1279  else {
1280  Errorline("Unknown address family in %P.\n",funct);
1281  return FALSE; }
1282  }
1283 
1284  if (args[1]) {
1285  s=(char*)args[1]->value_3;
1286  if (!strcmp(s,"SOCK_STREAM")) type=SOCK_STREAM;
1287  else if (!strcmp(s,"SOCK_DGRAM" )) type=SOCK_DGRAM;
1288  else if (!strcmp(s,"SOCK_RAW" )) {
1289  Errorline("SOCK_RAW not supported in %P.\n",funct);
1290  return FALSE; }
1291  else {
1292  Errorline("Unknown socket type in %P.\n",funct);
1293  return FALSE; }
1294  }
1295 
1296  if ((fd=socket(addr_family,type,protocol))<0)
1297  return FALSE;
1298 
1299  { FILE*fp = fdopen(fd,"r+");
1300  // ptr_psi_term t;
1301 
1302  if (fp==NULL) {
1303  Errorline("fdopen failed on socket in %P.\n",funct);
1304  return FALSE;
1305  }
1306 
1307 /* t = make_bytedata(sys_socket_stream,sizeof(fp));
1308  *(FILE**)BYTEDATA_DATA(t) = fp;*/
1309  push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
1310  }
1311  return TRUE;
1312 }
1313 
1319 static long c_socket()
1320 {
1321  psi_arg args[2];
1322  SETARG(args,0,"1",quoted_string,OPTIONAL);
1323  SETARG(args,1,"2",quoted_string,OPTIONAL);
1324  return call_primitive(socket_internal,NARGS(args),args,0);
1325 }
1326 
1333 int is_ipaddr(char *s)
1334 {
1335  if (s==NULL) return 0;
1336  while (*s)
1337  if (!isdigit(*s) && *s!='.') return 0;
1338  else s++;
1339  return 1;
1340 }
1341 
1351 static long bind_or_connect_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct,void *info)
1352 {
1353  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1354  int do_bind = info==NULL;
1355 
1356  if (args[1] || args[2]) {
1357  /* bind or connect in the internet domain */
1358  struct sockaddr_in name_loc;
1359  char* hostname = args[1]?(char*)args[1]->value_3:NULL;
1360  if (!args[2]) {
1361  Errorline("Missing port number in %P.\n",funct);
1362  return FALSE;
1363  }
1364 
1365  bzero((char*)&name_loc,sizeof(name_loc));
1366  name_loc.sin_family = AF_INET;
1367  name_loc.sin_port = htons((unsigned short)*(REAL*)args[2]->value_3);
1368 
1369  if (!hostname || *hostname=='\0' || !strcasecmp(hostname,"localhost"))
1370  name_loc.sin_addr.s_addr = INADDR_ANY;
1371  else {
1372  struct hostent * h;
1373  int ipaddr;
1374  if ((ipaddr=is_ipaddr(hostname))) {
1375  int i = inet_addr(hostname);
1376  h = gethostbyaddr((char*)&i,sizeof(i),AF_INET);
1377  } else h = gethostbyname(hostname);
1378  if (h==NULL) {
1379  Errorline("%s failed for %P.\n",
1380  ipaddr?"gethostbyaddr":"gethostbyname",funct);
1381  return FALSE;
1382  }
1383  bcopy(h->h_addr,(char*)&(name_loc.sin_addr.s_addr),h->h_length);
1384  }
1385  if ((do_bind?
1386  bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
1387  connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
1388  Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
1389  return FALSE;
1390  }
1391  }
1392  else if (args[3]) {
1393  /* bind in the unix domain */
1394  struct sockaddr_un name_loc;
1395  char* path = (char*)args[3]->value_3;
1396 
1397  name_loc.sun_family = AF_UNIX;
1398  strcpy(name_loc.sun_path,path);
1399 
1400  if ((do_bind?
1401  bind(fd,(struct sockaddr *)&name_loc,sizeof(name_loc)):
1402  connect(fd,(struct sockaddr *)&name_loc,sizeof(name_loc))) < 0) {
1403  Errorline("%s failed in %P.\n",do_bind?"bind":"connect",funct);
1404  return FALSE;
1405  }
1406  }
1407  else {
1408  Errorline("Too few arguments in %P.\n",funct);
1409  return FALSE;
1410  }
1411  return TRUE;
1412 }
1413 
1419 static long c_bind()
1420 {
1421  psi_arg args[4];
1422  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1423  SETARG(args,1,"host",quoted_string,OPTIONAL);
1424  SETARG(args,2,"port",integer,OPTIONAL);
1425  SETARG(args,3,"path",quoted_string,OPTIONAL);
1427 }
1428 
1434 static long c_connect()
1435 {
1436  psi_arg args[4];
1437  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1438  SETARG(args,1,"host",quoted_string,OPTIONAL);
1439  SETARG(args,2,"port",integer,OPTIONAL);
1440  SETARG(args,3,"path",quoted_string,OPTIONAL);
1441  return call_primitive(bind_or_connect_internal,NARGS(args),args,(GENERIC)1);
1442 }
1443 
1444 static long
1445 listen_internal(args,result,funct)
1446  ptr_psi_term args[],result,funct;
1447 {
1448  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1449  int n = *(REAL*)args[1]->value_3;
1450 
1451  if (listen(fd,n) < 0) return FALSE;
1452  return TRUE;
1453 }
1454 
1460 static long c_listen()
1461 {
1462  psi_arg args[2];
1463  SETARG(args,0,"1",sys_socket_stream,MANDATORY);
1464  SETARG(args,1,"2",integer,MANDATORY);
1465  return call_primitive(listen_internal,NARGS(args),args,0);
1466 }
1467 
1476 static long accept_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1477 {
1478  int fd = fileno(((ptr_stream)BYTEDATA_DATA(args[0]))->fp);
1479  int s;
1480 
1481  if ((s=accept(fd,NULL,NULL)) < 0) return FALSE;
1482  else {
1483  FILE * fp = fdopen(s,"r+");
1484  // ptr_psi_term t;
1485 
1486  if (fp==NULL) {
1487  Errorline("fdopen failed on socket in %P.\n",funct);
1488  return FALSE;
1489  }
1490 
1491 /* t = make_bytedata(sys_socket_stream,sizeof(fp));
1492  *(FILE**)BYTEDATA_DATA(t) = fp;*/
1493  push_goal(unify,fileptr2stream(fp,sys_socket_stream),result,NULL); // added & DJD
1494  return TRUE;
1495  }
1496 }
1497 
1503 static long c_accept()
1504 {
1505  psi_arg args[1];
1506  SETARG(args,0,"1",sys_socket_stream,REQUIRED);
1507  return call_primitive(accept_internal,NARGS(args),args,0);
1508 }
1509 
1510 /* SYSTEM ERRORS *
1511  *****************/
1512 
1521 static long errno_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1522 {
1523  push_goal(unify,stack_int(errno),result,NULL);
1524  return TRUE;
1525 }
1526 
1532 static long c_errno()
1533 {
1534  return call_primitive(errno_internal,0,NULL,0);
1535 }
1536 
1537 /* some systems are missing these declarations */
1538 // extern char *sys_errlist[];
1539 // extern int sys_nerr;
1540 
1549 static long errmsg_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1550 {
1551  long n = args[0]?(long)*(REAL*)args[0]->value_3:errno;
1552  // if (n<0 || n>=sys_nerr) return FALSE;
1553  // else {
1554  push_goal(unify,stack_string(strerror(n)),result,NULL);
1555  return TRUE;
1556  // }
1557 }
1558 
1564 static long c_errmsg()
1565 {
1566  psi_arg args[1];
1567  SETARG(args,0, "1" , integer , OPTIONAL );
1568  return call_primitive(errmsg_internal,NARGS(args),args,0);
1569 }
1570 
1571 /* MODULES *
1572  ***********/
1573 
1583 {
1584  ptr_keyword key;
1585 
1586  if (args[1])
1587  key=args[1]->type->keyword;
1588  else
1590  args[0]->type->keyword->symbol);
1591 
1592  if (key)
1593  if (key->definition->type_def != (def_type)undef) {
1594  Errorline("symbol %s already defined in %P.",key->combined_name,funct);
1595  return FALSE;
1596  }
1597  else key->definition=args[0]->type;
1598  else {
1599  /* adapted from update_symbol in modules.c */
1600  /* Add 'module#symbol' to the symbol table */
1601  key=HEAP_ALLOC(struct wl_keyword);
1602  key->module=current_module;
1603  /* use same name */
1604  key->symbol=args[0]->type->keyword->symbol;
1605  key->combined_name=(char *)
1607  key->public=FALSE;
1608  key->private_feature=FALSE;
1609  key->definition=args[0]->type; /* use given definition */
1610 
1612  }
1613  return TRUE;
1614 }
1615 
1624 static long c_import_symbol()
1625 {
1626  psi_arg args[2];
1627  SETARG(args,0,"1",top,MANDATORY|UNEVALED);
1628  SETARG(args,1,"as",top,OPTIONAL|NOVALUE|UNEVALED);
1629  return call_primitive(import_symbol_internal,NARGS(args),args,0);
1630 }
1631 
1632 /* PROCESSES *
1633  *************/
1634 
1643 static long fork_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1644 {
1645  pid_t id = fork();
1646  if (id < 0) return FALSE;
1647  else return unify_real_result(result,(REAL)id);
1648 }
1649 
1655 static long c_fork()
1656 {
1657  return call_primitive(fork_internal,0,NULL,0);
1658 }
1659 
1660 typedef struct {
1661  char * name_str;
1663 } psi_feature;
1664 
1665 #define SETFEATURE(lst,n,nam,val) ((lst[n].name_str=nam),(lst[n].value_str=val))
1666 
1677 {
1678  ptr_psi_term u;
1679  int i;
1680  if (n<0) {
1681  fprintf(stderr,"unify_pterm_result called with n<0: n=%d\n",n);
1682  exit(EXIT_FAILURE);
1683  }
1684  u=stack_psi_term(4);
1685  u->type=sym;
1686  for(i=0;i<n;i++)
1687  (void)stack_insert(FEATCMP,lst[i].name_str,&(u->attr_list),(GENERIC)lst[i].value_str);
1688  push_goal(unify,t,u,NULL);
1689  return TRUE;
1690 }
1691 
1698 char *get_numeric_feature(long n)
1699 {
1700  if (n==1) return one;
1701  else if (n==2) return two;
1702  else if (n==3) return three;
1703  else {
1704  char buf[100];
1705  (void)snprintf(buf,100,"%ld",n);
1706  return heap_copy_string(buf);
1707  }
1708 }
1709 
1710 #ifndef WIFEXITED
1711 #include <sys/wait.h>
1712 #endif
1713 
1719 
1728 static long unify_wait_result(ptr_psi_term result,pid_t id,int status)
1729 {
1730  int n=2;
1731  long status2;
1732  ptr_definition sym;
1733  psi_feature lst[2];
1734  SETFEATURE(lst,0,one,stack_int(id));
1735  if (id == -1 || status == -1) {
1736  if (errno==ECHILD) {
1738  n=0;
1739  }
1740  else return FALSE;
1741  }
1742  else if (WIFEXITED(status)) {
1743  SETFEATURE(lst,1,two,stack_int(WEXITSTATUS(status)));
1744  sym = sys_process_exited;
1745  }
1746  else if (WIFSIGNALED(status)) {
1747  SETFEATURE(lst,1,two,stack_int(WTERMSIG(status)));
1748  sym = sys_process_signaled;
1749  }
1750  else if (WIFSTOPPED(status)) {
1751  SETFEATURE(lst,1,two,stack_int(WSTOPSIG(status)));
1752  sym = sys_process_stopped;
1753  }
1754 #ifdef WIFCONTINUED
1755  else if (WIFCONTINUED(status)) {
1756  sym = sys_process_continued;
1757  n=1;
1758  }
1759 #endif
1760  else {
1761  status2 = status;
1762  Errorline("Unexpected wait status: %d",status2);
1763  return FALSE;
1764  }
1765  return unify_pterm_result(result,sym,lst,n);
1766 }
1767 
1776 static long wait_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1777 {
1778  int status;
1779  pid_t id = wait(&status);
1780  return unify_wait_result(result,id,status);
1781 }
1782 
1788 static long c_wait()
1789 {
1790  return call_primitive(wait_internal,0,NULL,0);
1791 }
1792 
1801 static long waitpid_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1802 {
1803  int status;
1804  pid_t id = waitpid((pid_t)(long)*(REAL*)args[0]->value_3,&status,
1805  args[1]?(int)(long)*(REAL*)args[1]->value_3:0);
1806  return unify_wait_result(result,id,status);
1807 }
1808 
1814 static long c_waitpid()
1815 {
1816  psi_arg args[2];
1817  SETARG(args,0,"1",integer,REQUIRED);
1818  SETARG(args,1,"2",integer,OPTIONAL);
1819  return call_primitive(waitpid_internal,NARGS(args),args,0);
1820 }
1821 
1830 static long kill_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1831 {
1832  return (kill((pid_t)*(REAL*)args[0]->value_3,
1833  (int)*(REAL*)args[1]->value_3)==0)?TRUE:FALSE;
1834 }
1835 
1841 static long c_kill()
1842 {
1843  psi_arg args[2];
1844  SETARG(args,0,"1",integer,MANDATORY);
1845  SETARG(args,1,"2",integer,MANDATORY);
1846  return call_primitive(kill_internal,NARGS(args),args,0);
1847 }
1848 
1849 /* MISCELLANEOUS *
1850  ****************/
1851 
1860 static long cuserid_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
1861 {
1862  // char name[L_cuserid+1];
1863  // if (*cuserid(name) == '\0') return FALSE;
1864  // else {
1865  push_goal(unify,result,stack_string(getlogin()),NULL);
1866  return TRUE;
1867  // }
1868 }
1869 
1875 static long c_cuserid()
1876 {
1877  return call_primitive(cuserid_internal,0,NULL,0);
1878 }
1879 
1880 #ifndef MAXHOSTNAMELEN
1881 #include <sys/param.h>
1882 #endif
1883 
1893 {
1894  char name_loc[MAXHOSTNAMELEN+1];
1895  if (gethostname(name_loc,MAXHOSTNAMELEN+1) == 0) {
1896  push_goal(unify,result,stack_string(name_loc),NULL);
1897  return TRUE;
1898  }
1899  else return FALSE;
1900 }
1901 
1907 static long c_gethostname()
1908 {
1910 }
1911 
1912 /* LAZY PROJECT
1913  ***************/
1914 
1924 {
1925  ptr_node n;
1926  char buffer_loc[100];
1927  if (args[1]->type == top) {
1928  residuate(args[0]);
1929  residuate(args[1]);
1930  return TRUE;
1931  }
1932  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1933  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
1934  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1935  strcpy(buffer_loc,(char*)args[1]->value_3);
1936  else
1937  strcpy(buffer_loc,args[1]->type->keyword->symbol);
1938  n=find(FEATCMP,buffer_loc,args[0]->attr_list);
1939  if (n) push_goal(unify,(ptr_psi_term)n->data,result,NULL);
1940  /* this is all bullshit because projection should residuate
1941  on its 2nd arg until it becomes value. In particular, think
1942  of using `int' as a feature when it is clear that `int' may
1943  subsequently be refined to a particular integer. */
1944  else residuate(args[0]);
1945  return TRUE;
1946 }
1947 
1953 static long c_lazy_project()
1954 {
1955  psi_arg args[2];
1956  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
1957  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
1958  return call_primitive(lazy_project_internal,NARGS(args),args,0);
1959 }
1960 
1961 /* WAIT_ON_FEATURE
1962  ******************/
1963 
1973 {
1974  char buffer_loc[100];
1975  if (args[1]->type == top) {
1976  residuate(args[0]);
1977  residuate(args[1]);
1978  return TRUE;
1979  }
1980  if (sub_type(args[1]->type,integer) && args[1]->value_3)
1981  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
1982  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
1983  strcpy(buffer_loc,(char*)args[1]->value_3);
1984  else
1985  strcpy(buffer_loc,args[1]->type->keyword->symbol);
1986  if (find(FEATCMP,buffer_loc,args[0]->attr_list))
1988  /* this is all bullshit because projection should residuate
1989  on its 2nd arg until it becomes value. In particular, think
1990  of using `int' as a feature when it is clear that `int' may
1991  subsequently be refined to a particular integer. */
1992  else residuate(args[0]);
1993  return TRUE;
1994 }
1995 
2001 static long c_wait_on_feature()
2002 {
2003  psi_arg args[3];
2004  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
2005  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
2006  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
2007  return call_primitive(wait_on_feature_internal,NARGS(args),args,0);
2008 }
2009 
2019 {
2020  char buffer_loc[100];
2021  if (args[1]->type == top) {
2022  residuate(args[0]);
2023  residuate(args[1]);
2024  return TRUE;
2025  }
2026  if (sub_type(args[1]->type,integer) && args[1]->value_3)
2027  snprintf(buffer_loc,100,"%ld",(long)*(REAL*)args[1]->value_3);
2028  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
2029  strcpy(buffer_loc,(char*)args[1]->value_3);
2030  else
2031  strcpy(buffer_loc,args[1]->type->keyword->symbol);
2032  if (find(FEATCMP,buffer_loc,args[0]->attr_list)) {
2033  unify_bool_result(result,TRUE);
2035  }
2036  /* this is all bullshit because projection should residuate
2037  on its 2nd arg until it becomes value. In particular, think
2038  of using `int' as a feature when it is clear that `int' may
2039  subsequently be refined to a particular integer. */
2040  else residuate(args[0]);
2041  return TRUE;
2042 }
2043 
2050 {
2051  psi_arg args[3];
2052  SETARG(args,0,"1",top,MANDATORY|NOVALUE);
2053  SETARG(args,1,"2",top,MANDATORY|NOVALUE);
2054  SETARG(args,2,"3",top,MANDATORY|NOVALUE|UNEVALED);
2055  return call_primitive(my_wait_on_feature_internal,NARGS(args),args,0);
2056 }
2057 
2070 {
2071  ptr_psi_term value;
2073  resid_aim=NULL;
2074  value = stack_psi_term(4);
2075  value->type = lf_false;
2076  push_choice_point(unify,result,value,NULL);
2077  value = stack_psi_term(4);
2078  value->type = lf_true;
2079  push_goal(unify,result,value,NULL);
2082  return TRUE;
2083 }
2084 
2090 static long c_call_once()
2091 {
2092  psi_arg args[1];
2093  SETARG(args,0,"1",top,MANDATORY|NOVALUE|UNEVALED);
2094  return call_primitive(call_once_internal,NARGS(args),args,0);
2095 }
2096 
2105 static long apply1_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
2106 {
2107  long success=TRUE;
2108  if (args[0]->type==top) residuate(args[0]);
2109  else if (args[0]->type->type_def!=(def_type)function_it) {
2110  Errorline("1st arg not a function in %P.\n",funct);
2111  success=FALSE;
2112  }
2113  else {
2114  // char buffer_loc[1000];
2115  char * feat;
2116  ptr_psi_term fun;
2117  if (sub_type(args[1]->type,integer) && args[1]->value_3)
2118  feat = get_numeric_feature((long)*(REAL*)args[1]->value_3);
2119  else if (sub_type(args[1]->type,quoted_string) && args[1]->value_3)
2120  feat = (char *)args[1]->value_3;
2121  else
2122  feat = (char *)heap_copy_string(args[1]->type->keyword->symbol);
2123  clear_copy();
2124  fun=distinct_copy(args[0]);
2125  (void)stack_insert(FEATCMP,(char *)feat,&(fun->attr_list),(GENERIC)args[2]);
2126  push_goal(eval,fun,result,(GENERIC)fun->type->rule);
2127  }
2128  return success;
2129 }
2130 
2136 static long c_apply1()
2137 {
2138  psi_arg args[3];
2139  SETARG(args,0,"1",top,REQUIRED|NOVALUE);
2140  SETARG(args,1,"2",top,REQUIRED|NOVALUE);
2141  SETARG(args,2,"3",top,REQUIRED|NOVALUE);
2142  return call_primitive(apply1_internal,NARGS(args),args,0);
2143 }
2144 
2153 static long getpid_internal(ptr_psi_term args[],ptr_psi_term result,ptr_psi_term funct)
2154 {
2155  return unify_real_result(result,(REAL)getpid());
2156 }
2157 
2163 static long c_getpid()
2164 {
2165  return call_primitive(getpid_internal,0,0,0);
2166 }
2167 
2175 {
2176 #ifdef LIFE_NDBM
2177  make_ndbm_type_links();
2178 #endif
2184  make_type_link(sys_bytedata ,built_in); /* DENYS: BYTEDATA */
2185 }
2186 
2193 {
2194  check_definition(&sys_bytedata); /* DENYS: BYTEDATA */
2200  check_definition(&sys_process_no_children);
2201  check_definition(&sys_process_exited);
2202  check_definition(&sys_process_signaled);
2203  check_definition(&sys_process_stopped);
2204  check_definition(&sys_process_continued);
2205 #ifdef LIFE_NDBM
2206  check_ndbm_definitions();
2207 #endif
2208 }
2209 
2216 {
2217  ptr_module curmod = current_module;
2219 
2220  sys_bytedata =update_symbol(sys_module,"bytedata"); /* DENYS: BYTEDATA */
2221  sys_bitvector =update_symbol(sys_module,"bitvector");
2222  sys_regexp =update_symbol(sys_module,"regexp");
2223  sys_stream =update_symbol(sys_module,"stream");
2224  sys_file_stream =update_symbol(sys_module,"file_stream");
2225  sys_socket_stream =update_symbol(sys_module,"socket_stream");
2226  sys_process_no_children=update_symbol(sys_module,"process_no_children");
2227  sys_process_exited =update_symbol(sys_module,"process_exited");
2228  sys_process_signaled =update_symbol(sys_module,"process_signaled");
2229  sys_process_stopped =update_symbol(sys_module,"process_stopped");
2230  sys_process_continued =update_symbol(sys_module,"process_continued");
2231 
2232  /* DENYS: BYTEDATA */
2233  /* purely for illustration
2234  new_built_in(sys_module,"string_to_bytedata",(def_type)function_it,c_string_to_bytedata);
2235  new_built_in(sys_module,"bytedata_to_string",(def_type)function_it,c_bytedata_to_string);
2236  */
2238  new_built_in(sys_module,"bitvector_and" ,(def_type)function_it ,c_bitvector_and);
2239  new_built_in(sys_module,"bitvector_or" ,(def_type)function_it ,c_bitvector_or);
2240  new_built_in(sys_module,"bitvector_xor" ,(def_type)function_it ,c_bitvector_xor);
2241  new_built_in(sys_module,"bitvector_not" ,(def_type)function_it ,c_bitvector_not);
2242  new_built_in(sys_module,"bitvector_count" ,(def_type)function_it ,c_bitvector_count);
2243  new_built_in(sys_module,"bitvector_get" ,(def_type)function_it ,c_bitvector_get);
2244  new_built_in(sys_module,"bitvector_set" ,(def_type)function_it ,c_bitvector_set);
2245  new_built_in(sys_module,"bitvector_clear" ,(def_type)function_it ,c_bitvector_clear);
2246  new_built_in(sys_module,"regexp_compile" ,(def_type)function_it ,c_regexp_compile);
2247  new_built_in(sys_module,"regexp_execute" ,(def_type)function_it ,c_regexp_execute);
2248  new_built_in(sys_module,"int2stream" ,(def_type)function_it ,c_int2stream);
2249  new_built_in(sys_module,"fopen" ,(def_type)function_it ,c_fopen);
2250  new_built_in(sys_module,"fclose" ,(def_type)function_it ,c_fclose);
2251  new_built_in(sys_module,"get_buffer" ,(def_type)function_it ,c_get_buffer);
2252  new_built_in(sys_module,"get_record" ,(def_type)function_it ,c_get_record);
2253  new_built_in(sys_module,"get_code" ,(def_type)function_it ,c_get_code);
2254  new_built_in(sys_module,"ftell" ,(def_type)function_it ,c_ftell);
2256  new_built_in(sys_module,"socket" ,(def_type)function_it ,c_socket);
2257  new_built_in(sys_module,"bind" ,(def_type)predicate,c_bind);
2258  new_built_in(sys_module,"connect" ,(def_type)predicate,c_connect);
2259  new_built_in(sys_module,"fwrite" ,(def_type)predicate,c_fwrite);
2260  new_built_in(sys_module,"fflush" ,(def_type)predicate,c_fflush);
2261  new_built_in(sys_module,"listen" ,(def_type)predicate,c_listen);
2262  new_built_in(sys_module,"accept" ,(def_type)function_it ,c_accept);
2263  new_built_in(sys_module,"errno" ,(def_type)function_it ,c_errno);
2264  new_built_in(sys_module,"errmsg" ,(def_type)function_it ,c_errmsg);
2265  new_built_in(sys_module,"import_symbol" ,(def_type)predicate,c_import_symbol);
2266  new_built_in(sys_module,"fork" ,(def_type)function_it ,c_fork);
2267  new_built_in(sys_module,"wait" ,(def_type)function_it ,c_wait);
2268  new_built_in(sys_module,"waitpid" ,(def_type)function_it ,c_waitpid);
2269  new_built_in(sys_module,"kill" ,(def_type)predicate,c_kill);
2270  new_built_in(sys_module,"cuserid" ,(def_type)function_it ,c_cuserid);
2271  new_built_in(sys_module,"gethostname" ,(def_type)function_it ,c_gethostname);
2272  new_built_in(sys_module,"lazy_project" ,(def_type)function_it ,c_lazy_project);
2273  new_built_in(sys_module,"wait_on_feature" ,(def_type)predicate,c_wait_on_feature);
2274  new_built_in(sys_module,"my_wait_on_feature" ,(def_type)function_it ,c_my_wait_on_feature);
2275  new_built_in(sys_module,"apply1" ,(def_type)function_it ,c_apply1);
2276  new_built_in(sys_module,"getpid" ,(def_type)function_it ,c_getpid);
2277  new_built_in(sys_module,"stream2sys_stream" ,(def_type)function_it ,c_stream2sys_stream);
2278  new_built_in(sys_module,"sys_stream2stream" ,(def_type)function_it ,c_sys_stream2stream);
2279 #ifdef LIFE_DBM
2281 #endif
2282 #ifdef LIFE_NDBM
2283  insert_ndbm_builtins();
2284 #endif
2286  new_built_in(bi_module ,"call_once" ,(def_type)function_it ,c_call_once);
2287  (void)set_current_module(curmod);
2288 }
#define BV_OR
Definition: sys.c:182
#define prove
Definition: def_const.h:279
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5375
char * text_buffer_cmp(struct text_buffer *buf, int idx, char *str)
text_buffer_cmp
Definition: sys.c:934
ptr_psi_term aaaa_1
Definition: def_struct.h:229
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
void insert_sys_builtins()
insert_sys_builtins
Definition: sys.c:2215
#define BV_NOT
Definition: sys.c:286
#define predicate
Definition: def_const.h:367
#define function_it
Definition: def_const.h:368
ptr_definition sys_regexp
Definition: def_glob.h:136
static long errmsg_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
errmsg_internal
Definition: sys.c:1549
static long c_make_bitvector()
c_make_bitvector
Definition: sys.c:174
static long c_bitvector_not()
c_bitvector_not
Definition: sys.c:366
static long c_wait()
c_wait
Definition: sys.c:1788
#define MANDATORY
Definition: def_const.h:225
void make_sys_type_links()
make_sys_type_links
Definition: sys.c:2174
#define BV_CLEAR
Definition: sys.c:383
#define FEATCMP
Definition: def_const.h:263
void clear_copy()
clear_copy
Definition: copy.c:53
static long fflush_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
fflush_internal
Definition: sys.c:835
static long accept_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
accept_internal
Definition: sys.c:1476
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
long call_primitive(long(*fun)(), int num, psi_arg argi[], GENERIC info)
call_primitive
Definition: sys.c:24
char * combined_name
Definition: def_struct.h:97
char data[TEXTBUFSIZE]
Definition: def_struct.h:406
void regerror(char *s)
regerror
Definition: sys.c:498
ptr_module current_module
Definition: def_glob.h:166
static long fwrite_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
fwrite_internal
Definition: sys.c:802
static long bitvector_bit_code(unsigned long *bv1, long idx, ptr_psi_term result, int op, ptr_psi_term funct)
bitvector_bit_code
Definition: sys.c:395
static long c_accept()
c_accept
Definition: sys.c:1503
#define SETARG(args, i, the_feature, the_type, the_options)
Definition: def_macro.h:168
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
static long regexp_execute_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
regexp_execute_internal
Definition: sys.c:576
ptr_definition stream
Definition: def_glob.h:108
static long c_fwrite()
c_fwrite
Definition: sys.c:819
static long bitvector_unop(GENERIC op)
bitvector_unop
Definition: sys.c:354
void text_buffer_free(struct text_buffer *buf)
text_buffer_free
Definition: sys.c:986
static long c_call_once()
c_call_once
Definition: sys.c:2090
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:344
char * two
Definition: def_glob.h:256
#define BV_SET
Definition: sys.c:382
#define undef
Definition: def_const.h:366
static long c_stream2sys_stream()
c_stream2sys_stream
Definition: sys.c:1214
static long c_ftell()
c_ftell
Definition: sys.c:1144
static long bitvector_binop_code(unsigned long *bv1, unsigned long *bv2, ptr_psi_term result, GENERIC op)
bitvector_binop_code
Definition: sys.c:194
static long getpid_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
getpid_internal
Definition: sys.c:2153
#define general_cut
Definition: def_const.h:288
static long c_regexp_compile()
c_regexp_compile
Definition: sys.c:554
static long c_int2stream()
c_int2stream
Definition: sys.c:723
ptr_definition definition
Definition: def_struct.h:101
static long fork_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
Definition: sys.c:1643
def_type type_def
Definition: def_struct.h:138
static long c_kill()
c_kill
Definition: sys.c:1841
includes
ptr_definition sys_file_stream
Definition: def_glob.h:138
ptr_psi_term fileptr2stream(FILE *fp, ptr_definition typ)
fileptr2stream
Definition: sys.c:688
#define BV_XOR
Definition: sys.c:183
static long c_fseek()
c_fseek
Definition: sys.c:1185
#define DEFRULES
Definition: def_const.h:144
static long c_get_record()
c_get_record
Definition: sys.c:1083
FILE * fp
Definition: sys.c:673
long c_abort()
c_abort
Definition: built_ins.c:2247
static long fclose_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
fclose_internal
Definition: sys.c:774
ptr_definition sys_stream
Definition: def_glob.h:137
ptr_psi_term value_str
Definition: sys.c:1662
ptr_hash_table symbol_table
Definition: def_struct.h:84
static long int2stream_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
int2stream_internal
Definition: sys.c:704
static long c_getpid()
c_getpid
Definition: sys.c:2163
static long import_symbol_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
import_symbol_internal
Definition: sys.c:1582
static long c_get_code()
c_get_code
Definition: sys.c:1113
ptr_keyword keyword
Definition: def_struct.h:129
static long bind_or_connect_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, void *info)
bind_or_connect_internal
Definition: sys.c:1351
static long c_bitvector_set()
c_bitvector_set
Definition: sys.c:472
struct wl_psi_term * ptr_psi_term
quotedStackCopy
Definition: def_struct.h:39
static long c_fclose()
c_fclose
Definition: sys.c:787
GENERIC data
Definition: def_struct.h:190
ptr_definition top
Definition: def_glob.h:111
void curry()
curry
Definition: lefun.c:174
#define NULL
Definition: def_const.h:209
char * three
Definition: def_glob.h:257
char * symbol
Definition: def_struct.h:96
ptr_goal resid_aim
Definition: def_glob.h:225
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
static long bitvector_bit(long op)
bitvector_bit
Definition: sys.c:449
#define REAL
Definition: def_const.h:78
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
static long call_once_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
call_once_internal
Definition: sys.c:2069
static long waitpid_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
waitpid_internal
Definition: sys.c:1801
#define JUSTFAIL
Definition: def_const.h:223
#define eval
Definition: def_const.h:284
#define FP_OUTPUT
Definition: sys.c:670
static long c_apply1()
c_apply1()
Definition: sys.c:2136
static long c_bitvector_xor()
c_bitvector_xor
Definition: sys.c:281
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
static long c_fflush()
c_fflush
Definition: sys.c:849
static long make_bitvector_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
make_bitvector_internal
Definition: sys.c:154
static long c_fopen()
c_fopen
Definition: sys.c:758
struct a_stream * ptr_stream
static long bitvector_binop(long op)
bitvector_binop
Definition: sys.c:248
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
static long c_connect()
c_connect
Definition: sys.c:1434
static long get_record_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
get_record_internal
Definition: sys.c:1004
static long bitvector_binop_internal(ptr_psi_term *args, ptr_psi_term result, ptr_psi_term funct, GENERIC op)
bitvector_binop_internal
Definition: sys.c:235
static long unify_wait_result(ptr_psi_term result, pid_t id, int status)
unify_wait_result
Definition: sys.c:1728
static long socket_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
socket_internal
Definition: sys.c:1269
#define FP_NONE
Definition: sys.c:668
static long c_listen()
c_listen
Definition: sys.c:1460
#define SETFEATURE(lst, n, nam, val)
Definition: sys.c:1665
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()
c_import_symbol
Definition: sys.c:1624
static long c_waitpid()
c_waitpid
Definition: sys.c:1814
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
#define BV_GET
Definition: sys.c:381
#define deref_ptr(P)
Definition: def_macro.h:100
static long unify_pterm_result(ptr_psi_term t, ptr_definition sym, psi_feature lst[], int n)
unify_pterm_result
Definition: sys.c:1676
#define BYTEDATA_DATA(X)
Definition: sys.c:139
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
static long stream2sys_stream_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
stream2sys_stream_internal
Definition: sys.c:1202
ptr_definition sys_process_signaled
Definition: sys.c:1716
void check_sys_definitions()
check_sys_definitions
Definition: sys.c:2192
#define TEXTBUFSIZE
Definition: def_struct.h:401
ptr_definition type
Definition: def_struct.h:369
#define REQUIRED
Definition: def_const.h:221
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
HASH_INSERT.
Definition: hash_table.c:151
ptr_psi_term distinct_copy(ptr_psi_term t)
distinct_copy
Definition: copy.c:393
#define TRUE
Definition: def_const.h:133
ptr_definition sys_bitvector
Definition: def_glob.h:135
static long c_fork()
c_fork
Definition: sys.c:1655
static long bitvector_bit_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, int op)
bitvector_bit_internal
Definition: sys.c:436
static long kill_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
kill_internal
Definition: sys.c:1830
int is_ipaddr(char *s)
is_ipaddr
Definition: sys.c:1333
ptr_definition built_in
Definition: def_glob.h:80
void make_type_link(ptr_definition t1, ptr_definition t2)
make_type_link
Definition: types.c:901
ptr_definition integer
Definition: def_glob.h:98
static long fseek_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
fseek_internal
Definition: sys.c:1169
ptr_definition lf_true
Definition: def_glob.h:112
ptr_psi_term stack_int(long n)
stack_int
Definition: built_ins.c:91
ptr_pair_list rule
Definition: def_struct.h:131
#define FALSE
Definition: def_const.h:134
#define deref(P)
Definition: def_macro.h:147
static long sys_stream2stream_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
sys_stream2stream_internal
Definition: sys.c:1229
static long bitvector_unop_code(unsigned long *bv1, ptr_psi_term result, int op)
bitvector_unop_code
Definition: sys.c:297
int text_buffer_next(struct text_buffer *buf, int idx, char c, struct text_buffer **rbuf, int *ridx)
text_buffer_next
Definition: sys.c:907
ptr_definition quoted_string
Definition: def_glob.h:106
static long get_code_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
get_code_internal
Definition: sys.c:1099
ptr_definition sys_process_stopped
Definition: sys.c:1717
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
ptr_definition lf_false
Definition: def_glob.h:94
GENERIC value_3
Definition: def_struct.h:175
#define BV_AND
Definition: sys.c:181
ptr_definition sys_process_continued
Definition: sys.c:1718
static long c_bitvector_count()
c_bitvector_count
Definition: sys.c:376
ptr_goal aim
Definition: def_glob.h:54
static long get_buffer_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
get_buffer_internal
Definition: sys.c:864
char * one
Definition: def_glob.h:255
void insert_dbm_builtins()
static long c_wait_on_feature()
c_wait_on_feature
Definition: sys.c:2001
#define FP_INPUT
Definition: sys.c:669
static long c_bind()
c_bind
Definition: sys.c:1419
#define unify
Definition: def_const.h:280
static long regexp_compile_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
regexp_compile_internal
Definition: sys.c:514
static long ftell_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
ftell_internal
Definition: sys.c:1128
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
static long c_errno()
c_errno
Definition: sys.c:1532
Definition: sys.c:672
static long bitvector_unop_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct, int op)
bitvector_unop_internal
Definition: sys.c:343
static long fopen_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
fopen_internal
Definition: sys.c:739
char * get_numeric_feature(long n)
get_numeric_feature
Definition: sys.c:1698
static long c_regexp_execute()
c_regexp_execute
Definition: sys.c:648
ptr_module sys_module
Definition: def_glob.h:167
static long c_cuserid()
c_cuserid
Definition: sys.c:1875
ptr_module module
Definition: def_struct.h:95
void check_definition(ptr_definition *d)
check_definition
Definition: memory.c:662
static long c_bitvector_or()
c_bitvector_or
Definition: sys.c:271
#define FP_PREPARE(s, OP)
Definition: sys.c:677
static long c_socket()
c_socket
Definition: sys.c:1319
ptr_definition sys_bytedata
Definition: def_glob.h:341
#define NOVALUE
Definition: def_const.h:226
ptr_definition sys_socket_stream
Definition: def_glob.h:139
ptr_definition sys_process_exited
Definition: sys.c:1715
char * make_module_token(ptr_module module, char *str)
make_module_token
Definition: modules.c:191
int op
Definition: sys.c:674
static long wait_on_feature_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
wait_on_feature_internal
Definition: sys.c:1972
#define SEEK_SET
Definition: sys.c:1152
long unify_real_result(ptr_psi_term t, REAL v)
unify_real_result
Definition: built_ins.c:386
static long c_bitvector_and()
c_bitvector_and
Definition: sys.c:261
static ptr_psi_term make_bytedata(ptr_definition sort, unsigned long bytes)
make_bytedata(
Definition: sys.c:126
#define NARGS(args)
Definition: def_macro.h:174
int private_feature
Definition: def_struct.h:100
static long c_lazy_project()
c_lazy_project
Definition: sys.c:1953
static long c_my_wait_on_feature()
c_my_wait_on_feature
Definition: sys.c:2049
static long c_bitvector_get()
c_bitvector_get
Definition: sys.c:462
static long c_bitvector_clear()
c_bitvector_clear
Definition: sys.c:482
char * name_str
Definition: sys.c:1661
ptr_module bi_module
Definition: def_glob.h:160
int public
Definition: def_struct.h:99
static long wait_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
wait_internal
Definition: sys.c:1776
ptr_definition type
Definition: def_struct.h:170
ptr_psi_term bbbb_1
Definition: def_struct.h:230
static long c_sys_stream2stream()
c_sys_stream2stream
Definition: sys.c:1244
static long apply1_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
apply1_internal
Definition: sys.c:2105
unsigned long * GENERIC
Definition: def_struct.h:22
ptr_psi_term stack_string(char *s)
stack_string
Definition: built_ins.c:109
#define OPTIONAL
Definition: def_const.h:220
static long listen_internal(args, result, funct)
Definition: sys.c:1445
struct text_buffer * next
Definition: def_struct.h:404
#define HEAP_ALLOC(A)
Definition: def_macro.h:20
static long errno_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
errno_internal
Definition: sys.c:1521
static long c_gethostname()
c_gethostname
Definition: sys.c:1907
#define BV_COUNT
Definition: sys.c:287
ptr_node attr_list
Definition: def_struct.h:176
static long my_wait_on_feature_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
my_wait_on_feature_internal
Definition: sys.c:2018
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
static long c_get_buffer()
c_get_buffer
Definition: sys.c:885
#define ARGNN
Definition: def_const.h:353
static long cuserid_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
cuserid_internal
Definition: sys.c:1860
ptr_definition sys_process_no_children
Definition: sys.c:1714
static long gethostname_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
gethostname_internal
Definition: sys.c:1892
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
#define POLYTYPE
Definition: def_const.h:224
void stack_insert_copystr(char *keystr, ptr_node *tree, GENERIC info)
stack_insert_copystr
Definition: trees.c:301
ptr_choice_point choice_stack
Definition: def_glob.h:56
static long c_errmsg()
c_errmsg
Definition: sys.c:1564
static long lazy_project_internal(ptr_psi_term args[], ptr_psi_term result, ptr_psi_term funct)
lazy_project_internal
Definition: sys.c:1923
#define UNEVALED
Definition: def_const.h:222
void text_buffer_push(struct text_buffer **buf, char c)
text_buffer_push
Definition: sys.c:961