Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
bi_sys.c
Go to the documentation of this file.
1 
5 /* Copyright 1992 Digital Equipment Corporation
6  All Rights Reserved
7 */
8 #include "defs.h"
9 
10 #define copyPsiTerm(a,b) (ptr_psi_term )memcpy(a,b,sizeof(psi_term))
11 
12 /******** C_TRACE
13  With no arguments: Toggle the trace flag & print a message saying whether
14  tracing is on or off.
15  With argument 1: If it is top, return the trace flag and disable tracing.
16  If it is true or false, set the trace flag to that value. Otherwise, give
17  an error.
18  With argument 2: If it is top, return the stepflag and disable stepping.
19  If it is true or false, set the stepflag to that value. Otherwise, give
20  an error.
21 */
22 
30 long c_trace()
31 {
32  long success=TRUE;
33  ptr_psi_term t,arg1,arg2;
34 
35  t=aim->aaaa_1;
37  get_two_args(t->attr_list,&arg1,&arg2);
38  if (arg1) {
39  deref_ptr(arg1);
40  if (is_top(arg1)) {
42  trace=FALSE;
43  }
44  else if (arg1->type==lf_true)
45  trace=TRUE;
46  else if (arg1->type==lf_false)
47  trace=FALSE;
48  else {
49  Errorline("bad first argument in %P.\n",t);
50  /* report_error(t,"bad first argument"); */
51  success=FALSE;
52  }
53  }
54  if (arg2) {
55  deref_ptr(arg2);
56  if (is_top(arg2)) {
59  }
60  else if (arg2->type==lf_true)
61  stepflag=TRUE;
62  else if (arg2->type==lf_false)
64  else {
65  Errorline("bad second argument in %P.\n",t);
66  /* report_error(t,"bad second argument"); */
67  success=FALSE;
68  }
69  }
70  if (!arg1 && !arg2)
71  toggle_trace();
72  return success;
73 }
74 
81 long c_tprove()
82 {
83  ptr_psi_term t;
84 
85  t=aim->aaaa_1;
88  return TRUE;
89 }
90 
98 static long c_step()
99 {
100  ptr_psi_term t;
101 
102  t=aim->aaaa_1;
104  toggle_step();
105  return TRUE;
106 }
107 
115 static long c_verbose()
116 {
117  ptr_psi_term t;
118 
119  t=aim->aaaa_1;
121  verbose = !verbose;
122  printf("*** Verbose mode is turned ");
123  printf(verbose?"on.\n":"off.\n");
124  return TRUE;
125 }
126 
136 static long c_warning()
137 {
138  ptr_psi_term t;
139 
140  t=aim->aaaa_1;
143 
144  /* RM: Sep 24 1993 */
145  infoline("*** Warning messages are%s printed\n",warningflag?"":" not");
146 
147  return TRUE;
148 }
149 
157 static long c_maxint()
158 {
159  ptr_psi_term t,result;
160  REAL val;
161  long num,success;
162 
163  t=aim->aaaa_1;
165  result=aim->bbbb_1;
166  deref_ptr(result);
167  success=get_real_value(result,&val,&num);
168  if (success) {
169  if (num)
170  success=(val==(REAL)WL_MAXINT);
171  else
172  success=unify_real_result(result,(REAL)WL_MAXINT);
173  }
174  return success;
175 }
176 
177 
178 
179 /* 21.1 */
186 long c_quiet()
187 {
188  ptr_psi_term t,result,ans;
189  long success=TRUE;
190 
191  t=aim->aaaa_1;
193  result=aim->bbbb_1;
194  deref_ptr(result);
195  ans=stack_psi_term(4);
196  ans->type = NOTQUIET ? lf_false : lf_true;
197  push_goal(unify,result,ans,NULL);
198  return success;
199 }
200 
207 static long c_cputime()
208 {
209  ptr_psi_term result, t;
210  REAL thetime,val;
211  long num,success;
212 
213  t=aim->aaaa_1;
215  result=aim->bbbb_1;
216  deref_ptr(result);
217  success=get_real_value(result,&val,&num);
218  if (success) {
219  (void)times(&life_end);
220  thetime=(life_end.tms_utime-life_start.tms_utime)/60.0;
221  if (num)
222  success=(val==thetime);
223  else
224  success=unify_real_result(result,thetime);
225  }
226  return success;
227 }
228 
236 static long c_realtime()
237 {
238  ptr_psi_term result, t;
239  REAL thetime,val;
240  long num,success;
241  struct timeval tp;
242  struct timezone tzp;
243 
244  t=aim->aaaa_1;
246  result=aim->bbbb_1;
247  deref_ptr(result);
248  success=get_real_value(result,&val,&num);
249  if (success) {
250  gettimeofday(&tp, &tzp);
251  thetime=(REAL)tp.tv_sec + ((REAL)tp.tv_usec/1000000.0);
252  /* thetime=times(&life_end)/60.0; */
253  if (num)
254  success=(val==thetime);
255  else
256  success=unify_real_result(result,thetime);
257  }
258  return success;
259 }
260 
269 static long c_localtime()
270 {
271  ptr_psi_term result, t, psitime;
272  long success=TRUE;
273  struct timeval tp;
274  struct timezone tzp;
275  struct tm *thetime;
276 
277  t=aim->aaaa_1;
279  result=aim->bbbb_1;
280  deref_ptr(result);
281 
282  gettimeofday(&tp, &tzp);
283  thetime=localtime((time_t *) &(tp.tv_sec));
284 
285  psitime=stack_psi_term(4);
286  psitime->type=timesym;
287  stack_add_int_attr(psitime, year_attr, thetime->tm_year+1900);
288  stack_add_int_attr(psitime, month_attr, thetime->tm_mon+1);
289  stack_add_int_attr(psitime, day_attr, thetime->tm_mday);
290  stack_add_int_attr(psitime, hour_attr, thetime->tm_hour);
291  stack_add_int_attr(psitime, minute_attr, thetime->tm_min);
292  stack_add_int_attr(psitime, second_attr, thetime->tm_sec);
293  stack_add_int_attr(psitime, weekday_attr, thetime->tm_wday);
294 
295  push_goal(unify,result,psitime,NULL);
296 
297  return success;
298 }
299 
306 static long c_statistics()
307 {
308  ptr_psi_term t;
309  long success=TRUE;
310  long t1,t2,t3;
311 
312  t=aim->aaaa_1;
314 
315  t1 = sizeof(mem_base)*(stack_pointer-mem_base);
316  t2 = sizeof(mem_base)*(mem_limit-heap_pointer);
317  t3 = sizeof(mem_base)*(mem_limit-mem_base);
318 
319  printf("\n");
320  /* printf("************** SYSTEM< INFORMATION **************\n"); */
321  printf("Stack size : %8ld bytes (%5ldK) (%ld%%)\n",t1,t1/1024,100*t1/t3);
322  printf("Heap size : %8ld bytes (%5ldK) (%ld%%)\n",t2,t2/1024,100*t2/t3);
323  printf("Total memory: %8ld bytes (%5ldK)\n",t3,t3/1024);
324 
325 #ifdef X11
326  printf("X predicates are installed.\n");
327 #else
328  printf("X predicates are not installed.\n");
329 #endif
330 
331  /* printf("\n"); */
332  /* printf("************************************************\n"); */
333  return success;
334 }
335 
336 
343 static long c_garbage()
344 {
345  ptr_psi_term t;
346 
347  t=aim->aaaa_1;
349  garbage();
350  return TRUE;
351 }
352 
353 
360 static long c_getenv()
361 {
362  long success=FALSE;
363  ptr_psi_term arg1,arg2,funct,result,t;
364  long smaller;
365  char * s;
366 
367  funct = aim->aaaa_1;
368  result=aim->bbbb_1;
369  deref_ptr(funct);
370  deref_ptr(result);
371 
372  get_two_args(funct->attr_list, &arg1, &arg2);
373  if(arg1) {
374  deref_ptr(arg1);
375  if(matches(arg1->type,quoted_string,&smaller) && arg1->value_3) {
376  s=getenv((char *)arg1->value_3);
377  if(s) {
378  success=TRUE;
379  t=stack_psi_term(4);
380  t->type=quoted_string;
382  push_goal(unify,result,t,NULL);
383  }
384  }
385  else
386  Errorline("bad argument in %P\n",funct);
387  }
388  else
389  Errorline("argument missing in %P\n",funct);
390 
391  return success;
392 }
393 
400 static long c_system()
401 {
402  long success=TRUE;
403  ptr_psi_term arg1,arg2,funct,result;
404  REAL value;
405  long smaller;
406 
407  funct=aim->aaaa_1;
408  deref_ptr(funct);
409  result=aim->bbbb_1;
410  get_two_args(funct->attr_list,&arg1,&arg2);
411  if(arg1) {
412  deref(arg1);
413  deref_args(funct,set_1);
414  if((success=matches(arg1->type,quoted_string,&smaller)))
415  if(arg1->value_3) {
416  value=(REAL)system((char *)arg1->value_3);
417  if(value==127) {
418  success=FALSE;
419  Errorline("could not execute shell in %P.\n",funct);
420  /* report_error(funct,"couldn't execute shell"); */
421  }
422  else
423  success=unify_real_result(result,value);
424  }
425  else {
426  /* residuate(arg1); */ /* RM: Feb 10 1993 */
427  success=FALSE;
428  Errorline("bad argument in %P.\n",funct);
429  }
430  else {
431  success=FALSE;
432  Errorline("bad argument in %P.\n",funct);
433  /* report_error(funct,"bad argument"); */
434  }
435  }
436  else
437  curry();
438 
439  return success;
440 }
441 
449 static long c_encode()
450 {
451  ptr_psi_term t;
452 
453  t=aim->aaaa_1;
455  encode_types();
456  return TRUE;
457 }
458 
460 
469 {
470  unitListElement = x;
471 }
472 
480 {
481  return makePsiTerm((void *)unitListElement);
482 }
483 
491 {
493  return NULL;
494 }
495 
504 {
505  return makePsiTerm((void *)p->value_1);
506 }
507 
516 {
517  return (GENERIC )(p->next);
518 }
519 
528 {
529  ptr_psi_term q;
530 
532  mark_quote(q);
533  return q;
534 }
535 
546 {
547  ptr_psi_term psi;
548 
549  psi = stack_psi_term(4);
550  copyPsiTerm(psi, p->goal->aaaa_1);
551  psi->status = 4;
552  return psi;
553 }
554 
562 {
563  return (GENERIC )(p->next);
564 }
565 
573 {
574  ptr_psi_term p;
575 
576  p = stack_psi_term(4);
577  p->type = x;
578  return p;
579 }
580 
589 ptr_psi_term makePsiList(GENERIC head, ptr_psi_term (*valueFunc)(), GENERIC (*nextFunc)())
590 {
591  ptr_psi_term result;
592 
593 
594  /* RM: Dec 14 1992: Added the new list representation */
595  result=stack_nil();
596 
597  while (head) {
598  result=stack_cons((*valueFunc)(head),result);
599  head=(*nextFunc)(head);
600  }
601  return result;
602 }
603 
604 
605 
611 static long c_residList()
612 {
613  ptr_psi_term func;
614  ptr_psi_term result,arg1, other;
615 
616  func = aim->aaaa_1;
617  deref_ptr(func);
618 
619  get_one_arg(func->attr_list, &arg1);
620  if (!arg1)
621  {
622  curry();
623  return TRUE;
624  }
625 
626  result = aim->bbbb_1;
627  deref(result);
628  deref_ptr(arg1);
629  deref_args(func, set_1);
630 
631  other = makePsiList((void *)arg1->resid,
633  residListNext);
634  resid_aim = NULL;
635  push_goal(unify,result,other,NULL);
636  return TRUE;
637 }
638 
645 {
646  ptr_goal old = goal_stack;
647  ptr_goal g;
648 
650  g = goal_stack;
651  g->next=NULL;
652  goal_stack = old;
653  return g;
654 }
655 
656 
662 static long c_residuate()
663 {
664  ptr_psi_term pred;
665  ptr_psi_term arg1, arg2;
666  ptr_goal g;
667 
668  pred = aim->aaaa_1;
669  deref_ptr(pred);
670 
671  get_two_args(pred->attr_list, &arg1, &arg2);
672  if ((!arg1)||(!arg2)) {
673  Errorline("%P requires two arguments.\n",pred);
674  return FALSE;
675  }
676 
677  deref_ptr(arg1);
678  deref_ptr(arg2);
679  deref_args(pred, set_1_2);
680 
681  g = makeGoal(arg2);
682  (void)residuateGoalOnVar(g, arg1, NULL);
683 
684  return TRUE;
685 }
686 
696 static long c_mresiduate()
697 
698 {
699  long success=TRUE;
700  ptr_psi_term pred;
701  ptr_psi_term arg1, arg2, tmp, var;
702  ptr_goal g;
703 
704  pred = aim->aaaa_1;
705  deref_ptr(pred);
706 
707  get_two_args(pred->attr_list, &arg1, &arg2);
708  if ((!arg1)||(!arg2)) {
709  Errorline("%P requires two arguments.\n",pred);
710  return FALSE;
711  }
712 
713  deref_ptr(arg1);
714  deref_ptr(arg2);
715  deref_args(pred, set_1_2);
716 
717  g = makeGoal(arg2);
718 
719  /* Then residuate on all the list variables: */
720  tmp=arg1;
721  while(tmp && tmp->type==alist) { /* RM: Dec 14 1992 */
722  get_two_args(tmp->attr_list,&var,&tmp);
723  if(var) {
724  deref_ptr(var);
725  (void)residuateGoalOnVar(g,var,NULL);
726  }
727  if(tmp)
728  deref_ptr(tmp);
729  }
730 
731  if(!tmp || tmp->type!=nil) {
732  Errorline("%P should be a nil-terminated list in mresiduate.\n",arg1);
733  success=FALSE;
734  }
735 
736  return success;
737 }
738 
745 {
747  new_built_in(bi_module,"step",(def_type)predicate,c_step);
748  new_built_in(bi_module,"verbose",(def_type)predicate,c_verbose);
749  new_built_in(bi_module,"warning",(def_type)predicate,c_warning);
751  new_built_in(bi_module,"cpu_time",(def_type)function_it,c_cputime);
752  new_built_in(bi_module,"quiet",(def_type)function_it,c_quiet); /* 21.1 */
753  new_built_in(bi_module,"real_time",(def_type)function_it,c_realtime);
754  new_built_in(bi_module,"local_time",(def_type)function_it,c_localtime);
755  new_built_in(bi_module,"statistics",(def_type)predicate,c_statistics);
756  new_built_in(bi_module,"gc",(def_type)predicate,c_garbage);
757  new_built_in(bi_module,"system",(def_type)function_it,c_system);
758  new_built_in(bi_module,"getenv",(def_type)function_it,c_getenv);
759  new_built_in(bi_module,"encode",(def_type)predicate,c_encode);
760  new_built_in(bi_module,"rlist",(def_type)function_it,c_residList);
761  new_built_in(bi_module,"residuate",(def_type)predicate,c_residuate);
762  new_built_in(bi_module,"mresiduate",(def_type)predicate,c_mresiduate);
763  new_built_in(bi_module,"tprove",(def_type)predicate,c_tprove);
764 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:572
#define prove
Definition: def_const.h:273
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
ptr_psi_term aaaa_1
Definition: def_struct.h:224
static long c_mresiduate()
c_mresiduate
Definition: bi_sys.c:696
ptr_residuation resid
Definition: def_struct.h:173
GENERIC unitListNext()
set unitListElement to NULL & return NULL
Definition: bi_sys.c:490
static long c_garbage()
force garbage collection
Definition: bi_sys.c:343
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
ptr_definition timesym
Definition: def_glob.h:108
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
#define is_top(T)
Definition: def_macro.h:108
void garbage()
garbage
Definition: memory.c:1529
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
static long c_step()
toggle trace single step
Definition: bi_sys.c:98
ptr_goal goal_stack
Definition: def_glob.h:50
GENERIC mem_limit
Definition: def_glob.h:13
#define NOTQUIET
Definition: def_macro.h:10
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_goal goal
Definition: def_struct.h:156
static long c_realtime()
real time since 00:00:00 GMT, January 1, 1970
Definition: bi_sys.c:236
ptr_residuation next
Definition: def_struct.h:157
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long verbose
Definition: def_glob.h:273
#define copyPsiTerm(a, b)
Definition: bi_sys.c:10
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
matches
Definition: types.c:1666
#define set_empty
Definition: def_const.h:193
#define DEFRULES
Definition: def_const.h:138
long residuateGoalOnVar(ptr_goal g, ptr_psi_term var, ptr_psi_term othervar)
residuateGoalOnVar
Definition: lefun.c:192
void toggle_step()
Definition: error.c:650
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
struct tms life_start life_end
Definition: def_glob.h:17
void curry()
curry
Definition: lefun.c:174
#define NULL
Definition: def_const.h:203
long warningflag
Definition: def_glob.h:270
ptr_psi_term quotedStackCopy(psi_term p)
make psi term from unitListElement
Definition: bi_sys.c:527
ptr_goal resid_aim
Definition: def_glob.h:220
#define REAL
Definition: def_const.h:72
void insert_system_builtins()
insert_system_builtins
Definition: bi_sys.c:744
long trace
Definition: def_glob.h:272
ptr_psi_term unitListValue()
make psi term from unitListElement
Definition: bi_sys.c:479
static long c_verbose()
toggle verbose flag
Definition: bi_sys.c:115
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
stack_add_int_attr
Definition: token.c:94
void set_trace_to_prove()
Definition: error.c:639
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition alist
Definition: def_glob.h:94
void infoline(char *format,...)
Definition: error.c:245
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
static long c_residuate()
c_residuate
Definition: bi_sys.c:662
#define TRUE
Definition: def_const.h:127
static long c_getenv()
get value environment variable
Definition: bi_sys.c:360
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC mem_base
Definition: def_glob.h:11
long c_trace()
trace
Definition: bi_sys.c:30
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
void toggle_trace()
Definition: error.c:644
GENERIC value_3
Definition: def_struct.h:170
ptr_definition lf_false
Definition: def_glob.h:89
long stepflag
Definition: def_glob.h:150
ptr_psi_term intListValue(ptr_int_list p)
make psi term from ptr_int_list [->value_1]
Definition: bi_sys.c:503
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
ptr_goal aim
Definition: def_glob.h:49
char * weekday_attr
Definition: def_glob.h:259
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_goal makeGoal(ptr_psi_term p)
makeGoal
Definition: bi_sys.c:644
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:675
static long c_warning()
toggle warning flag
Definition: bi_sys.c:136
#define unify
Definition: def_const.h:274
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
void encode_types()
encode_types
Definition: types.c:1091
GENERIC residListNext(ptr_residuation p)
Definition: bi_sys.c:561
static long c_system()
pass string to system to execute
Definition: bi_sys.c:400
#define deref_args(P, S)
Definition: def_macro.h:145
#define WL_MAXINT
Definition: def_const.h:76
static long c_cputime()
cpu time used
Definition: bi_sys.c:207
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
char * minute_attr
Definition: def_glob.h:257
static long c_residList()
c_residList()
Definition: bi_sys.c:611
long unify_real_result(ptr_psi_term t, REAL v)
unify_real_result
Definition: built_ins.c:387
GENERIC intListNext(ptr_int_list p)
return p->next
Definition: bi_sys.c:515
ptr_psi_term makePsiList(GENERIC head, ptr_psi_term(*valueFunc)(), GENERIC(*nextFunc)())
makePsiList
Definition: bi_sys.c:589
static long c_encode()
encode type
Definition: bi_sys.c:449
ptr_definition nil
Definition: def_glob.h:97
char * year_attr
Definition: def_glob.h:253
GENERIC stack_pointer
Definition: def_glob.h:14
static long c_localtime()
localtime
Definition: bi_sys.c:269
char * second_attr
Definition: def_glob.h:258
char * day_attr
Definition: def_glob.h:255
ptr_module bi_module
Definition: def_glob.h:155
ptr_definition type
Definition: def_struct.h:165
static GENERIC unitListElement
Definition: bi_sys.c:459
char * hour_attr
Definition: def_glob.h:256
GENERIC value_1
Definition: def_struct.h:54
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_psi_term residListGoalQuote(ptr_residuation p)
Definition: bi_sys.c:545
static long c_maxint()
return greatest exact integer
Definition: bi_sys.c:157
static long c_statistics()
wild_life stats
Definition: bi_sys.c:306
long c_tprove()
UNSURE.
Definition: bi_sys.c:81
long c_quiet()
Definition: bi_sys.c:186
ptr_node attr_list
Definition: def_struct.h:171
void setUnitList(GENERIC x)
set static unitListElement
Definition: bi_sys.c:468
char * month_attr
Definition: def_glob.h:254
ptr_goal next
Definition: def_struct.h:227
ptr_int_list next
Definition: def_struct.h:55