home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / huprolog / Source / C / ATOMS next >
Encoding:
Text File  |  1990-06-10  |  34.5 KB  |  918 lines
  1. /***************************************************
  2. ****************************************************
  3. **                                                **
  4. **  HU-Prolog     Portable Interpreter System     **
  5. **                                                **
  6. **  Release 1.62   January  1990                  **
  7. **                                                **
  8. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  9. **                                                **
  10. **  (C) 1989      Humboldt-University             **
  11. **                Department of Mathematics       **
  12. **                GDR 1086 Berlin, P.O.Box 1297   **
  13. **                                                **
  14. ****************************************************
  15. ***************************************************/
  16.  
  17. #include "systems.h"
  18. #include "types.h"
  19. #include "errors.h"
  20. #include "atoms.h"
  21. #include "manager.h"
  22.  
  23. /*
  24. ATOM TABLE
  25. Each atom is associated with operator and clause information which is
  26. stored in an 'atomentry'.  The identifiers for atoms in the input are
  27. mapped to the corresponding entry through a hash table.  Collisions are
  28. handled by chaining together atom entries. 
  29. */
  30.  
  31. IMPORT ATOM BASEATOM,ATOMSTOP,ATOMHTOP;
  32. IMPORT STRING STRINGSTOP; 
  33. IMPORT TERM BASETERM,GLOTOP;
  34. IMPORT void ARGERROR(),ERROR(),ABORT();
  35. IMPORT TERM A0,A1,A2;
  36. IMPORT string strcat();                  /* from CLIB */
  37. IMPORT boolean WARNFLAG;       /* from prolog.c        */
  38. IMPORT boolean aSYSMODE;
  39. IMPORT ATOM heapatom(),stackatom();
  40. IMPORT STRING heapstring(),stackstring();
  41. IMPORT int INTVALUE();
  42. IMPORT void TESTATOM();
  43. IMPORT boolean UNIFY();
  44. IMPORT void wq();
  45. IMPORT void CHECKATOM();
  46.  
  47. /*
  48. EXPORT   ATOM LOOKUP(string,int,boolean);
  49. EXPORT   ATOM LOOKATOM(ATOM,int);
  50. EXPORT   ATOM atom(TERM),copyatom(ATOM),GetAtom(ATOM);
  51. EXPORT   TERM LISTREP(string);
  52. EXPORT   string NEWATOM;
  53. EXPORT  void STARTATOM(),ATOMCHAR();
  54. EXPORT   InitAtoms();
  55. EXPORT  void DOOP();
  56. EXPORT   ATOM LASTATOM;
  57. EXPORT   void InitUAtom();
  58. */
  59.  
  60.  
  61. GLOBAL ATOM LASTATOM=LAST_ATOM;
  62.  
  63. #define HASHSIZE 0x100
  64. GLOBAL ATOM  HASHTAB [HASHSIZE+1];
  65. GLOBAL int HASH_SIZE=HASHSIZE; /* for save.c */
  66.  
  67. #define hashcode(C1,C2)     ((((C1) & 0x7f)<<1)|     \
  68.                 ((((C1)?(C2):0)&0x40)>>6))
  69. #define strhash(S)     hashcode(*S,*(S+1))
  70. LOCAL int idhash(ATOM A)
  71. { register STRING index; index=longstring(A);
  72.   return hashcode(repchar(index),repchar(index+1));
  73. }
  74.  
  75. /* create an new atom */
  76.  
  77. #if !BIT8
  78. #define STRINGSPACE 256 /* Size of string buffer. */
  79. #endif
  80. #if BIT8
  81. #define STRINGSPACE 128 /* Size of string buffer. */
  82. #endif
  83.  
  84. GLOBAL char stab[STRINGSPACE]; /* also used in help.c */
  85.  
  86. string NEWATOM=stab;
  87. LOCAL int NEWINDEX;
  88.  
  89. GLOBAL void STARTATOM (void)
  90. { NEWATOM=stab; NEWINDEX=0; }
  91.  
  92. GLOBAL void ATOMCHAR (register char C)
  93. { if(NEWINDEX>=STRINGSPACE) ERROR(aSTRINGSPACEE);
  94.   stab[NEWINDEX++]=C;
  95. }
  96.  
  97. /* #if !POINTEROFFSET */
  98. LOCAL int idstrcmp(ATOM A, register string S)
  99. { register STRING index;
  100.   index=longstring(A);
  101.   while(*S==repchar(index)) {if(*S++) index++; else return 0;}
  102.   return (repchar(index) - *S);
  103. }
  104. /* #endif
  105. #if POINTEROFFSET
  106. #define idstrcmp(A,s)   strcmp(longstring(A),s)
  107. #endif
  108. */
  109. LOCAL ATOM CONSTATOM;  /* used during initialization only */
  110. LOCAL boolean INIT;
  111.  
  112. LOCAL void initfields(register ATOM A, register int AR)
  113. {
  114.       info(A)=0;
  115.       oprec(A)=0; 
  116.       clause(A)=nil_clause;
  117.       arity(A)=AR;
  118.       nextatom(A)=chainatom(A)=nil_atom;
  119. }
  120.  
  121. /* Enter an atom and return its value. */
  122. GLOBAL ATOM LOOKUP (string str, int ar, boolean heap)
  123. /*  search and create only in heap */
  124. { 
  125.     register ATOM A,OA;
  126.     ATOM NA,CHAINATOM,HASHATOM;
  127.     int cmp,H,nf;
  128.     boolean create;
  129.  
  130. /*****************************************/
  131. /*    heap=true; */
  132. /*****************************************/
  133.     OA=NA=CHAINATOM=nil_atom;
  134.     nf=0;
  135.     H=strhash(str);
  136. #if DEBUG
  137.     if(DEBUGFLAG) 
  138.     { out_1("\nLOOKUP:");out_1(str);out_1("/");out_1(itoa(ar));
  139.       out_1(heap ? " heap " : " stack ");
  140.       out_1("hash:");out_1(itoa(H));out_1(";");out_1(itoa(HASHTAB[H]));
  141.     }
  142. #endif
  143.     if(ar < 0 ) { ar= -ar; create=false;} else create=true;
  144.     if(ar > MAXARITY) ERROR(BADARITYE);
  145.     HASHATOM=HASHTAB[ H ];
  146.     if(HASHATOM) /* search in primary chain */
  147.     {
  148. #if DEBUG
  149.     if(DEBUGFLAG) 
  150.         { out_1("#"); }
  151. #endif
  152.         OA=A=HASHATOM;
  153.         while(non_nil_atom(A) && (cmp=idstrcmp(A,str)) < 0)
  154.         {OA=A;A=nextatom(A);nf++;}
  155.         if(A && cmp==0) NA=A;
  156.         while(non_nil_atom(A) && (cmp=idstrcmp(A,str))==0 && 
  157.       (hide(A) || private(A)))
  158.         {
  159. #if DEBUG
  160.             if(DEBUGFLAG)
  161.             {
  162.                 out_1("{");
  163.                 out_1(itoa(A));
  164.                 if(A)
  165.                 {
  166.                     out_1(";");out_1(itoa(cmp));
  167.                     out_1(";");out_1(itoa(hide(A)));
  168.                     out_1(";");out_1(itoa(private(A)));
  169.                     out_1(";");out_1(itoa(nextatom(A)));
  170.  
  171.                 }
  172.                 out_1("}");
  173.             }
  174. #endif
  175.             OA=A;A=nextatom(A);nf++;
  176.         }
  177.         if(!A) cmp=1;
  178.         if(A && cmp==0) /* search in secondary chain */
  179.         {
  180.         int AA,OAA;
  181. #if DEBUG
  182.             if(DEBUGFLAG) out_1("@");
  183. #endif
  184.             nf++;
  185.             CHAINATOM=NA=OA=A;
  186.         AA=OAA=arity(A);
  187.             while(non_nil_atom(A) && !(ar==AA ||
  188.                          (ar < AA && ar > OAA) ||
  189.                          (ar < AA && OAA > AA)
  190.                         ))
  191.             { OA=A; OAA=AA; A=chainatom(A); AA=arity(A);}
  192.             if( A && ar==AA) goto found;
  193.         }
  194.     }
  195.     if(!heap)  /* search atom in stack */
  196.     {
  197.         for(A=ATOMSTOP;A<MAXATOMS;inc_atom(A))
  198.             if(idstrcmp(A,str)==0)
  199.             { NA=A; if(ar==arity(A))goto found; }
  200.     }
  201.     if(create) /* create atom */
  202.     {
  203.         if(INIT) A=CONSTATOM;
  204.         else if(heap) A=heapatom();
  205.         else { STRINGSTOP=(STRING)nextatom(ATOMSTOP); A=stackatom(); }
  206.         if( NA ) longstring(A)=longstring(NA);
  207.         else if(heap) longstring(A)=heapstring(str);
  208.         else longstring(A)=stackstring(str); 
  209.         initfields(A,ar);
  210.         setfirst(A);
  211.         if(heap) 
  212.         {
  213.             if(HASHATOM==nil_atom || nf==0 )
  214.             {
  215.                 nextatom(A)=HASHTAB[H];
  216.                 HASHTAB[H]=A;goto found;
  217.             }
  218.             if(cmp !=0)  
  219.             {
  220.                 nextatom(A)=nextatom(OA);
  221.                 nextatom(OA)=A;
  222.             }
  223.             else
  224.             {
  225.                 setnotfirst(A);
  226.                 chainatom(A)=chainatom(OA);
  227.                 nextatom(A)=CHAINATOM;
  228.                 chainatom(OA)=A;
  229.                 
  230.             }
  231.         }
  232.         else
  233.             nextatom(A)= (card)STRINGSTOP;
  234.     }
  235.     else A=nil_atom;
  236.   found:
  237.     STARTATOM();
  238. #if DEBUG
  239.     if(DEBUGFLAG){ out_1(itoa(A));out_1("\n");}
  240. #endif
  241.     return A;
  242. }
  243.  
  244. LOCAL char tempstring[STRINGSPACE];
  245.  
  246. #if !POINTEROFFSET
  247. GLOBAL string tempcopy(ATOM A)
  248. { register int si; 
  249.   register STRING i;
  250.   register char CH; 
  251.   i=longstring(A); 
  252.   for(CH=repchar(i),si=0;tempstring[si++]=CH;CH=repchar(++i))
  253.      if(si>=STRINGSPACE) ERROR(ATOMSPACEE);
  254.   return tempstring;
  255. }
  256. #endif
  257.  
  258. GLOBAL ATOM modify(ATOM A)
  259. { register int si; 
  260.   register STRING i;
  261.   register char CH; 
  262.   i=longstring(A); 
  263.   for(CH=repchar(i),si=0;tempstring[si++]=CH;CH=repchar(++i))
  264.      if(si+1>=STRINGSPACE) ERROR(ATOMSPACEE);
  265.   si--; tempstring[si++]='_'; tempstring[si++]=0;
  266.   return LOOKUP(tempstring,arity(A),true);
  267. }
  268.  
  269. GLOBAL ATOM LOOKATOM(register ATOM A, register int ar)
  270. {
  271.     register ATOM OA;
  272.     ATOM AA;
  273.     boolean create;
  274.     boolean heap=false;
  275.     if(ar < 0 ) { ar= -ar; create=false;} else create=true;
  276.     if(ar > MAXARITY) ERROR(BADARITYE);
  277.     AA=A;
  278. #if DEBUG
  279.     if(DEBUGFLAG)
  280.     {
  281.         out_1("\nLOOKATOM:("),out_1(tempcopy(A)),
  282.         out_1(","),out_1(itoa(A)),out_1(","),out_1(itoa(ar));
  283.         out_1(")");
  284.     }
  285. #endif
  286.     if(A <=ATOMHTOP) /* A is an heapatom */
  287.     {
  288.         if(arity(A)==ar) return A;
  289.         if(private(A) || hide(A)) heap=true;
  290. #if DEBUG
  291.         if(DEBUGFLAG) { out_1(heap ? "<heap>" : "<stack>"); }
  292. #endif
  293.         if(!first(A)) A=nextatom(A);
  294.         OA=A;
  295.         while(non_nil_atom(A) && !(ar==arity(A) ||
  296.                      (ar < arity(A) && ar > arity(OA)) ||
  297.                      (ar < arity(A) && arity(OA) > arity(A))
  298.                     ))
  299.         { OA=A;A=chainatom(A);
  300.         }
  301.         if(A && arity(A)==ar) 
  302.         {
  303. #if DEBUG
  304.         if(DEBUGFLAG) { out_1("<found:");out_1(itoa(A));out_1(">"); }
  305. #endif
  306.             return A;
  307.         }
  308.         if(heap)
  309.             if(create)
  310.             {
  311.                 A=heapatom();
  312.                 longstring(A)=longstring(OA);
  313.                 initfields(A,ar);
  314.                 chainatom(A)=chainatom(OA);
  315.                 chainatom(OA)=A;
  316.                 nextatom(A)=  (first(OA) ? OA : nextatom(OA));
  317.                 if(private(OA))setprivate(A);
  318.                 if(hide(OA))sethide(A);
  319. #if DEBUG
  320.         if(DEBUGFLAG) { out_1("<create:");out_1(itoa(A));out_1(">"); }
  321. #endif
  322.                 return A;
  323.             }
  324.             else return nil_atom;
  325.     }
  326. #if DEBUG
  327.         if(DEBUGFLAG) { out_1("<call LOOKUP>"); }
  328. #endif
  329.     return LOOKUP(tempcopy(AA),(create ? ar : -ar),heap);
  330. }
  331.  
  332. GLOBAL ATOM atom(register TERM X)
  333. { 
  334.   if(name(X)!=DIVIDE_2) ARGERROR();
  335.   return LOOKATOM(name(arg1(X)),INTVALUE(arg2(X)));
  336. }
  337.  
  338. GLOBAL ATOM copyatom(register ATOM A)
  339. /* copy an Atom A to the heap */
  340. {
  341.     register ATOM NA;
  342.     register TERM T;
  343.     if(A <=  ATOMHTOP) return(A); /* do nothing */
  344.     NA=LOOKUP(tempcopy(A),(int)arity(A),true);
  345.     for(T=BASETERM;T<=GLOTOP;inc_term(T))
  346.       {  if(name(T)==A) name(T)=NA; }
  347.     setrc(NA); /* for reconsult */
  348.     return NA;
  349. }
  350.  
  351.  
  352. LOCAL void PRIVATE(register ATOM A)
  353. {
  354.     A=copyatom(A);
  355.     if(!first(A)) A=nextatom(A);
  356.     while(non_nil_atom(A)) { setprivate(A); A=chainatom(A); }
  357.     return;
  358. }
  359.     
  360. LOCAL void HIDE(register ATOM A)
  361. {
  362.     register string str;
  363.     register int cmp;
  364.     ATOM AA=nil_atom;
  365.     A=copyatom(A);
  366.     str=tempcopy(A);
  367.     if(!first(A)) A=nextatom(A);
  368.     while(non_nil_atom(A)) { sethide(A); A=chainatom(A); }
  369.     A=HASHTAB[strhash(str)];
  370.     while(non_nil_atom(A) && (cmp=idstrcmp(A,str)) <=0 )
  371.     {
  372.         if(cmp==0 && !hide(A) && private(A)) AA=A;
  373.         A=nextatom(A);
  374.     }
  375.     while(non_nil_atom(AA)) { setnotprivate(AA); AA=chainatom(AA); }
  376. }
  377.  
  378. GLOBAL void DOPRIVATE(void)
  379. { while(name(A0)==CONS_2)
  380.     { PRIVATE(name(arg1(A0))); A0=arg2(A0); }
  381.   if(name(A0) !=NIL_0) PRIVATE(name(A0));
  382. }
  383.  
  384. GLOBAL void DOHIDE(void)
  385. { 
  386.   while(name(A0)==CONS_2)
  387.     { HIDE(name(arg1(A0))); A0=arg2(A0); }
  388.   if(name(A0) !=NIL_0) HIDE(name(A0));
  389. }
  390.  
  391. /* A Prolog list of the characters of s: cf. 'atom'. */
  392. GLOBAL TERM LISTREP (register string S)
  393. { register TERM  X;
  394.   register int  N, LENGTH;
  395.   LENGTH=0;
  396.   while(S[LENGTH]) LENGTH++;
  397.   if(LENGTH==0) return mkatom(NIL_0);
  398.   X=mk2sons(INTT,(TERM)S[N=LENGTH-1],NIL_0,nil_term);
  399.   while(--N >=0)
  400.       X=mk2sons(INTT,(TERM)S[N],CONS_2,X);
  401.   return mkfunc(CONS_2,X);
  402. }
  403.  
  404. #define nextchain(A) (first(A) ?  nextatom(A) : nextatom(nextatom(A)))
  405. GLOBAL ATOM GetAtom(register ATOM A)
  406. {
  407.     register int count;
  408.   start:;
  409.     if(A==nil_atom) count=0;
  410.     else if(chainatom(A)) {A=chainatom(A); goto found;}
  411.     else if(nextchain(A)) 
  412.         {A=  nextchain(A);goto found;}
  413.     else count=idhash(A)+1;
  414.     while(count < HASHSIZE && HASHTAB[count]==nil_atom) count++;
  415.     if(count < HASHSIZE) A=HASHTAB[count]; 
  416.     else A=nil_atom;
  417.   found:;
  418.     if(non_nil_atom(A) && ( private(A) || hide(A))) 
  419.       goto start;
  420.     return A;
  421. }
  422.  
  423.  
  424. /************ I N I T I A L I S A T I O N ***************/
  425.  
  426. #define sysflag 0x4000
  427.  
  428. LOCAL struct { ATOM macro;
  429.   string str;
  430.   char predtype;
  431.   char optype;
  432.   PREC_TYPE  prec;
  433.        } 
  434.        
  435. InitT[] 
  436. ={
  437. #if LONGARITH
  438.     { LONGT       , "<<LONG>>"  , NORMP   , NONO , LONGSIZE       },
  439. #endif
  440. #if REALARITH 
  441.     { REALT       , "<<REAL>>"  , NORMP   , NONO , REALSIZE       },
  442. #endif
  443.     { READ_1      , "read"      , EVALP   , NONO , 1    |sysflag  },
  444.     { READ_2      , "read"      , EVALP   , NONO , 2    |sysflag  },
  445.     { WRITE_1     , "write"     , EVALP   , NONO , 1    |sysflag  },
  446.     { WRITEQ_1    , "writeq"    , EVALP   , NONO , 1    |sysflag  },
  447.     { DISPLAY_1   , "display"   , EVALP   , NONO , 1    |sysflag  },
  448.     { GET0_1      , "get0"      , EVALP   , NONO , 1    |sysflag  },
  449.     { UNGET_0     , "unget"     , EVALP   , NONO , 0    |sysflag  },
  450.     { GET_1       , "get"       , EVALP   , NONO , 1    |sysflag  },
  451.     { SKIP_1      , "skip"      , EVALP   , NONO , 1    |sysflag  },
  452.     { ASK_1       , "ask"       , EVALP   , NONO , 1    |sysflag  },
  453.     { PUT_1       , "put"       , EVALP   , NONO , 1    |sysflag  },
  454.     { CLS_0       , "cls"       , EVALP   , NONO , 0    |sysflag  },
  455.     { GOTOXY_2    , "gotoxy"    , EVALP   , NONO , 2    |sysflag  },
  456.     { EOLN_0      , "eoln"      , EVALP   , NONO , 0    |sysflag  },
  457.     { EOF_0       , "eof"       , EVALP   , NONO , 0    |sysflag  },
  458.     { NL_0        , "nl"        , EVALP   , NONO , 0    |sysflag  },
  459.     { TAB_1       , "tab"       , EVALP   , NONO , 1    |sysflag  },
  460.     { FILEE_0     , "fileerrors", EVALP   , NONO , 0    |sysflag  },
  461.     { FILEE_1     , "fileerrors", EVALP   , NONO , 1    |sysflag  },
  462.     { NFILEE_0    , "nofileerrors",EVALP  , NONO , 0    |sysflag  },
  463.     { SEE_1       , "see"       , EVALP   , NONO , 1    |sysflag  },
  464.     { SEEING_1    , "seeing"    , EVALP   , NONO , 1    |sysflag  },
  465.     { SEEN_0      , "seen"      , EVALP   , NONO , 0    |sysflag  },
  466.     { TELL_1      , "tell"      , EVALP   , NONO , 1    |sysflag  },
  467.     { TELLING_1   , "telling"   , EVALP   , NONO , 1    |sysflag  },
  468.     { TOLD_0      , "told"      , EVALP   , NONO , 0    |sysflag  },
  469.     { OPEN_1      , "open"      , EVALP   , NONO , 1    |sysflag  },
  470.     { CLOSE_1     , "close"     , EVALP   , NONO , 1    |sysflag  },
  471.     { SEEK_2       , "seek"      , EVALP   , NONO , 2    |sysflag  },
  472.  
  473.     { TTYGET_1     , "ttyget"    , EVALP   , NONO , 1    |sysflag  },
  474.     { TTYPUT_1     , "ttyput"    , EVALP   , NONO , 1    |sysflag  },
  475.     { TTYGET0_1    , "ttyget0"   , EVALP   , NONO , 1    |sysflag  },
  476.     { TTYREAD_1    , "ttyread"   , EVALP   , NONO , 1    |sysflag  },
  477.     { TTYWRITE_1  , "ttywrite"   , EVALP   , NONO , 1    |sysflag  },
  478.     { TTYSKIP_1    , "ttyskip"   , EVALP   , NONO , 1    |sysflag  },
  479.     { TTYCLS_0     , "ttycls"    , EVALP   , NONO , 0    |sysflag  },
  480.     { TTYGOTOXY_2 , "ttygotoxy"  , EVALP   , NONO , 2    |sysflag  },
  481.     { TTYTAB_1     , "ttytab"    , EVALP   , NONO , 1    |sysflag  },
  482.     { TTYASK_1     , "ttyask"    , EVALP   , NONO , 1    |sysflag  },
  483.     { TTYNL_0      , "ttynl"     , EVALP   , NONO , 0    |sysflag  },
  484.  
  485.     { FNAME_2     , "$file"      , NORMP  , NONO , 2     |sysflag  },
  486.     { FASSIGN_2   , "assign"     , EVALP  , NONO , 2     |sysflag  },
  487.     { aWINDOW_0   , "window"     , EVALP  , NONO , 0     |sysflag  },
  488.     { WGET0_1     , "wget0"      , EVALP  , NONO , 1     |sysflag  },
  489.  
  490. #if WINDOWS
  491.     { BLINK_0     , "blink"      , NORMP  , NONO , 0               },
  492.     { REVERSE_0   , "reverse"    , NORMP  , NONO , 0               },
  493.     { BOLD_0      , "bold"       , NORMP  , NONO , 0               },
  494.     { UNDER_0     , "underline"  , NORMP  , NONO , 0               },
  495.     { WINDOW_6    , "window"     , NORMP  , NONO , 6               },
  496. #endif
  497.  
  498.  
  499.     { TRACE_0     , "trace"     , EVALP   , NONO , 0    |sysflag  },
  500.     { TRACE_1     , "trace"     , EVALP   , NONO , 1    |sysflag  },
  501.     { NOTRACE_0   , "notrace"   , EVALP   , NONO , 0    |sysflag  },
  502.     { ECHO_1      , "echo"      , EVALP   , NONO , 1    |sysflag  },
  503.     { WARN_1      , "warn"      , EVALP   , NONO , 1    |sysflag  },
  504.     { DEBUG_1     , "$debug"    , EVALP   , NONO , 1    |sysflag  },
  505.     { OCHECK_1    , "ocheck"    , EVALP   , NONO , 1    |sysflag  },
  506.     { SPY_1       , "spy"       , EVALP   , NONO , 1    |sysflag  },
  507.     { NOSPY_1     , "nospy"     , EVALP   , NONO , 1    |sysflag  },
  508.     { SYSMODE_1   , "sysmode"   , EVALP   , NONO , 1    |sysflag  },
  509.     { aINTERRUPT_1, "interrupt" , EVALP   , NONO , 1    |sysflag  },
  510.     { REDUCE_1    , "reducing"  , EVALP   , NONO , 1    |sysflag  },
  511.  
  512.     { ATOM_1      , "atom"      , ISATOMP , NONO , 1    |sysflag  },
  513.     { CURATOM_1   , "current_atom",BTEVALP, NONO , 1    |sysflag  },
  514.     { CUROP_3     , "current_op", BTEVALP , NONO , 3    |sysflag  },
  515.     { CURPRED_1   , "current_predicate",BTEVALP,NONO,1    |sysflag  },
  516.     { INTEGER_1   , "integer"   , ISINTEGERP,NONO, 1    |sysflag  },
  517.     { NUMBER_1    , "number"    , EVALP   , NONO , 1    |sysflag  },
  518.     { ATOMIC_1    , "atomic"    , EVALP   , NONO , 1    |sysflag  },
  519.     { LIST_1      , "list"      , EVALP   , NONO , 1    |sysflag  },
  520.     { MEMBER_2    , "member"    , BTEVALP , NONO , 2    |sysflag  },
  521.     { IS_MEMBER_2 , "is_member" , ISMEMBP , NONO , 2    |sysflag  },
  522.     { NO_MEMBER_2 , "no_member" , NOMEMBP , NONO , 2    |sysflag  },
  523.     { APP_3       , "sysappend" , EVALP   , NONO , 3    |sysflag  },
  524.     { COMPOUND_1  , "compound"  , EVALP   , NONO , 1    |sysflag  },
  525.     { STRING_1    , "string"    , EVALP   , NONO , 1    |sysflag  },
  526.     { VAR_1       , "var"       , ISVARP  , NONO , 1    |sysflag  },
  527.     { NONVAR_1    , "nonvar"    , EVALP   , NONO , 1    |sysflag  },
  528.     { INVAR_1     , "invar"     , EVALP   , NONO , 1    |sysflag  },
  529.     { GROUND_1    , "ground"    , EVALP   , NONO , 1    |sysflag  },
  530.     { FUNCTOR_3   , "functor"   , EVALP   , NONO , 3    |sysflag  },
  531.     { ARG_3       , "arg"       , EVALP   , NONO , 3    |sysflag  },
  532.     { NAME_2      , "name"      , EVALP   , NONO , 2    |sysflag  },
  533.     { UNIV_2      , "=.."       , EVALP   , XFXO , 700  |sysflag  },
  534.  
  535.     { DBREF_1     , "_db_ref"   , NORMP   , NONO , 1              },
  536.     { ASSERT_1    , "assert"    , EVALP   , NONO , 1    |sysflag  },
  537.     { ASSERTA_1   , "asserta"   , EVALP   , NONO , 1    |sysflag  },
  538.     { ASSERTZ_1   , "assertz"   , EVALP   , NONO , 1    |sysflag  },
  539.     { DBASS_2     , "assert"    , EVALP   , NONO , 2    |sysflag  },
  540.     { DBASSA_2    , "asserta"   , EVALP   , NONO , 2    |sysflag  },
  541.     { DBASSZ_2    , "assertz"   , EVALP   , NONO , 2    |sysflag  },
  542.     { DBASS_3     , "assert"    , EVALP   , NONO , 3    |sysflag  },
  543.     { RETRACT_1   , "retract"   , BTEVALP , NONO , 1    |sysflag  },
  544.     { DBRET_2     , "retract"   , BTEVALP , NONO , 2    |sysflag  },
  545.     { RETALL_1    , "retractall", EVALP   , NONO , 1    |sysflag  },
  546.     { ABOL_1       , "abolish"   , EVALP   , NONO , 1    |sysflag  },
  547.     { ABOL_2      , "abolish"   , EVALP   , NONO , 2    |sysflag  },
  548.     { CLAUSE_2    , "clause"    , BTEVALP , NONO , 2    |sysflag  },
  549.     { CLAUSE_3    , "clause"    , BTEVALP , NONO , 3    |sysflag  },
  550.     { CONSULT_1   , "consult"   , EVALP   , NONO , 1    |sysflag  },
  551.     { RECONSULT_1 , "reconsult" , EVALP   , NONO , 1    |sysflag  },
  552.     { LISTALL_0  ,  "listing"   , EVALP   , NONO , 0    |sysflag  },
  553.     { LISTING_1   , "listing"   , EVALP   , NONO , 1    |sysflag  },
  554.  
  555.     { CUT_0       , "!"         , CUTP    , NONO , 0    |sysflag  },
  556.     { FAIL_0      , "fail"      , FAILP   , NONO , 0    |sysflag  },
  557.     { TRUE_0      , "true"      , NORMP   , NONO , 0    |sysflag  },
  558.     { REPEAT_0    , "repeat"    , NORMP   , NONO , 0    |sysflag  },
  559.     { END_0       , "end_of_file", EVALP   , NONO , 0    |sysflag  },
  560.     { HALT_0      , "halt"      , EVALP   , NONO , 0    |sysflag  },
  561.     { EXIT_1      , "exit"      , EVALP   , NONO , 1    |sysflag  },
  562.     { ABORT_0     , "abort"     , EVALP   , NONO , 0    |sysflag  },
  563.     { RESTART_0   , "restart"   , EVALP   , NONO , 0    |sysflag  },
  564.     { CALL_1      , "call"      , NORMP   , NONO , 1    |sysflag  },
  565.     { MAIN_0      , "$main"     , NORMP   , NONO , 0              },
  566.     { SAVE_1      , "save"      , EVALP   , NONO , 1    |sysflag  },
  567.  
  568.     { IS_2        , "is"        , EVALP   , XFXO , 700  |sysflag  },
  569. #if ASSIGN
  570.     { ASSIGN_2    , ":="        , NORMP   , XFYO , 700  |sysflag  },
  571. #endif
  572.     { LT_2        , "<"         , NORMP   , XFXO , 700  |sysflag  },
  573.     { LE_2        , "=<"        , NORMP   , XFXO , 700  |sysflag  },
  574.     { GT_2        , ">"         , NORMP   , XFXO , 700  |sysflag  },
  575.     { GE_2        , ">="        , NORMP   , XFXO , 700  |sysflag  },
  576.  
  577.     { EQ_2        , "=:="       , NORMP   , XFXO , 700  |sysflag  },
  578.     { NE_2        , "=\\="      , NORMP   , XFXO , 700  |sysflag  },
  579.  
  580.     { PLUS_2      , "+"         , NORMP   , YFXO , 500            },
  581.     { MINUS_2     , "-"         , NORMP   , YFXO , 500            },
  582.     { TIMES_2     , "*"         , NORMP   , YFXO , 400            },
  583.     { DIVIDE_2    , "/"         , NORMP   , YFXO , 400            },
  584.     { MOD_2       , "mod"       , NORMP   , YFXO , 400            },
  585.     { MINUS_1     , "-"         , NORMP   , FYO  , 300            },
  586.  
  587.     { NIL_0       , "[]"        , NORMP   , NONO , 0    |sysflag  },
  588.     { CONS_2      , "."         , NORMP   , XFYO , 300  |sysflag  },
  589.     { CURLY_0     , "{}"        , NORMP   , NONO , 0    |sysflag  },
  590.     { CURLY_1     , "{}"        , NORMP   , NONO , 1    |sysflag  },
  591.     { ARROW_2     , ":-"        , EVALP   , XFXO , 1200 |sysflag  },
  592.     { ARROW_1     , ":-"        , NORMP   , FXO  , 1200 |sysflag  },
  593.     { QUESTION_1  , "?-"        , NORMP   , FXO  , 1200 |sysflag  },
  594.     { SEMI_2      , ";"         , NORMP   , XFYO , 1100 |sysflag  },
  595.     { IMPL_2      , "->"        , NORMP   , XFYO , 1050 |sysflag  },
  596.     { COMMA_2     , ","         , NORMP   , XFYO , 1000 |sysflag  },
  597.     { NOT_1       , "not"       , NORMP   , FYO  , 800  |sysflag  },
  598.     { NOT1_1      , "\\+"       , NORMP   , FYO  , 800  |sysflag  },
  599.     { ISEQ_2      , "="         , NORMP   , XFXO , 700  |sysflag  },
  600.     { ISNEQ_2     , "\\="       , NORMP   , XFXO , 700  |sysflag  },
  601.     { EQUAL_2     , "=="        , EVALP   , XFXO , 700  |sysflag  },
  602.     { NOEQUAL_2   , "\\=="      , EVALP   , XFXO , 700  |sysflag  },
  603.     { TOP_0       , "toplevel"  , NORMP   , NONO , 0              },
  604.     { INIT_0      , "initialize", NORMP   , NONO , 0              },
  605.     { PROMPT_0    , "prompt"    , NORMP   , NONO , 0              },
  606.     { INTERRUPT_0 , "interrupt" , NORMP   , NONO , 0              },
  607.     { ERROR_2     , "error"     , NORMP   , NONO , 2              },
  608.     { UNKNOWN_1   , "unknown"   , NORMP   , NONO , 1              }, 
  609.  
  610.     { STDIN_0     , "stdin"     , NORMP   , NONO , 0              },
  611.     { STDOUT_0    , "stdout"    , NORMP   , NONO , 0              },
  612.     { STDERR_0    , "stderr"    , NORMP   , NONO , 0              },
  613.     { STDTRACE_0  , "stdtrace"  , NORMP   , NONO , 0              },
  614. #if HELP
  615.     { STDHELP_0   , "stdhelp"   , NORMP   , NONO , 0              },
  616. #endif
  617.     { ON_0        , "on"        , NORMP   , NONO , 0              },
  618.     { OFF_0       , "off"       , NORMP   , NONO , 0              },
  619.     { ALL_0       , "all"       , NORMP   , NONO , 0              },
  620.     { USER_0      , "user"      , NORMP   , NONO , 0              },
  621.     { NULL_0      , "null"      , NORMP   , NONO , 0              },
  622.     { FX_0        , "fx"        , NORMP   , NONO , 0              },
  623.     { FY_0        , "fy"        , NORMP   , NONO , 0              },
  624.     { XF_0        , "xf"        , NORMP   , NONO , 0              },
  625.     { YF_0        , "yf"        , NORMP   , NONO , 0              },
  626.     { XFX_0       , "xfx"       , NORMP   , NONO , 0              },
  627.     { XFY_0       , "xfy"       , NORMP   , NONO , 0              },
  628.     { YFX_0       , "yfx"       , NORMP   , NONO , 0              },
  629.     { CALL_0      , "call"      , NORMP   , NONO , 0              },
  630.     { PROVED_0    , "proved"    , NORMP   , NONO , 0              },
  631.     { REDO_0      , "redo"      , NORMP   , NONO , 0              },
  632.     { FAILED_0    , "failed"    , NORMP   , NONO , 0              },
  633.  
  634.     { STATS_0     , "stats"     , EVALP   , NONO , 0    |sysflag  },
  635.     { OP_3        , "op"        , EVALP   , NONO , 3    |sysflag  },
  636.     { DICT_1      , "dict"      , EVALP   , NONO , 1    |sysflag  },
  637.     { SDICT_1     , "sdict"     , EVALP   , NONO , 1    |sysflag  },
  638.     { SYS_1       , "sys"       , EVALP   , NONO , 1    |sysflag  },
  639.     { SORT_2      , "sort"      , EVALP   , NONO , 2    |sysflag  },
  640.     { SORT0_2     , "sort0"     , EVALP   , NONO , 2    |sysflag  },
  641.  
  642.     { EVALUATE_2  , "$evaluate"  , ARITHP  , NONO , 2    |sysflag  },
  643.     { DASSIGN_2    , "$dass"     , EVALP   , NONO , 2    |sysflag  },
  644.     { REDUCE_2     , "$reduce"    , EVALP   , NONO , 2    |sysflag  },
  645.     { ACOMP_1     , "$acomp"     , EVALP   , NONO , 1    |sysflag  },
  646.  
  647.     { MAXINT_0    , "maxint"    , NORMP   , NONO , 0               },
  648.     { MININT_0    , "minint"    , NORMP   , NONO , 0               },
  649.     { MAXAR_0     , "maxarity"  , NORMP   , NONO , 0           },
  650.     { MAXDEP_0    , "maxdepth"  , NORMP   , NONO , 0           },
  651. #if REALARITH
  652.     { E_0          , "e"         , NORMP   , NONO , 0              },
  653.     { PI_0         , "pi"        , NORMP   , NONO , 0              }, 
  654.     { REAL_1       , "real"      , EVALP   , NONO , 1              },
  655.     { EXP_1        , "exp"       , NORMP   , NONO , 1              },
  656.     { LN_1         , "ln"        , NORMP   , NONO , 1              },
  657.     { LOG10_1      , "log10"     , NORMP   , NONO , 1              },
  658.     { SQRT_1       , "sqrt"      , NORMP   , NONO , 1              },
  659.     { SIN_1        , "sin"       , NORMP   , NONO , 1              },
  660.     { COS_1        , "cos"       , NORMP   , NONO , 1              },
  661.     { TAN_1        , "tan"       , NORMP   , NONO , 1              },
  662.     { ASIN_1       , "asin"      , NORMP   , NONO , 1              },
  663.     { ACOS_1       , "acos"      , NORMP   , NONO , 1              },
  664.     { ATAN_1       , "atan"      , NORMP   , NONO , 1              },
  665.     { FLOOR_1      , "floor"     , NORMP   , NONO , 1              },
  666.     { CEIL_1       , "ceil"      , NORMP   , NONO , 1              },
  667.     { POWER_2      , "**"        , NORMP   , XFYO , 350            },
  668.     { ENTIER_1    , "entier"    , NORMP   , NONO , 1              },
  669. #endif
  670.     { LSHIFT_2    , "<<"        , NORMP   , XFYO , 600            },
  671.     { RSHIFT_2    , ">>"        , NORMP   , XFYO , 600            },
  672.     { BITAND_2    , "&"         , NORMP   , XFYO , 650            },
  673.     { BITOR_2     , "\\"        , NORMP   , XFYO , 650            },
  674.     { AND_2        , "&&"        , NORMP   , XFYO , 650            },
  675.     { OR_2         , "\\\\"      , NORMP   , XFYO , 650            },
  676.     { NEG_1        , "/"         , NORMP   , FYO  , 300            },
  677.     { BITNEG_1    , "~"          , NORMP   , FYO , 300              },
  678.     { IDIV_2       , "//"        , NORMP   , YFXO , 400            },
  679.     { ALT_2        , "@<"        , EVALP   , XFXO , 700  |sysflag  },
  680.     { ALE_2        , "@=<"       , EVALP   , XFXO , 700  |sysflag  },
  681.     { AGT_2        , "@>"        , EVALP   , XFXO , 700  |sysflag  },
  682.     { AGE_2        , "@>="       , EVALP   , XFXO , 700  |sysflag  },
  683.     { AEQ_2        , "@="        , EVALP   , XFXO , 700  |sysflag  },
  684.     { ANE_2        , "@\\="      , EVALP   , XFXO , 700  |sysflag  },
  685.     { EVAL_1       , "eval"      , NORMP   , NONO , 1              },
  686.     { QUOTE_1      , "`"         , NORMP   , FYO  , 650            },
  687.     { NL_2        , "\n"        , NORMP   , XFYO , 999            },
  688.     { VERSION_0   , "version"   , EVALP   , NONO , 0   |sysflag   },
  689.     { PRIVATE_1   , "private"   , EVALP   , NONO , 1   |sysflag   },
  690.     { HIDE_1      , "hide"      , EVALP   , NONO , 1   |sysflag   },
  691.     { ENSURE_3    , "ensure"    , EVALP   , NONO , 3   | sysflag  },
  692.     { ANCESTORS_1 , "ancestors" , EVALP   , NONO , 1   | sysflag  },
  693.     { GOTO_1      , "$goto"     , GOTOP   , NONO , 1   | sysflag   },
  694.  
  695.     { OPSYS_1     , "operating_system",EVALP,NONO, 1    |sysflag  },
  696.     { TIMER_1     , "timer"     , EVALP   , NONO , 1    |sysflag  },
  697.     { ARGC_1      , "argc"      , EVALP   , NONO , 1    |sysflag  },
  698.     { ARGV_2      , "argv"      , EVALP   , NONO , 2    |sysflag  },
  699.  
  700. #if !CPM
  701.     { TIME_3      , "time"      , EVALP   , NONO , 3    |sysflag  },
  702.     { DATE_3      , "date"      , EVALP   , NONO , 3    |sysflag  },
  703.     { WEEKDAY_1   , "weekday"   , EVALP   , NONO , 1    |sysflag  },
  704.     { GETENV_2    , "getenv"    , EVALP   , NONO , 2   | sysflag  },
  705. #if !RISCOS
  706.     { PUTENV_2    , "putenv"    , EVALP   , NONO , 2    |sysflag  },
  707. #endif
  708.     { SYSTEM_1    , "system"    , EVALP   , NONO , 1    |sysflag  },
  709. #endif
  710.  
  711. #if HELP
  712.     { HELP_0      , "help"      , EVALP   , NONO , 0   | sysflag  },
  713.     { HELP_1      , "help"      , EVALP   , NONO , 1   | sysflag  },
  714. #endif
  715.  
  716. #if DBASE3
  717.     { OPENDBF_2   , "opendbf"   , EVALP   , NONO , 2   | sysflag  },
  718.     { CREATEDBF_2 , "createdbf" , EVALP   , NONO , 2   | sysflag  },
  719.     { CLOSEDBF_1  , "closedbf"  , EVALP   , NONO , 1   | sysflag  },
  720.     { READDBF_3   , "readdbf"   , BTEVALP , NONO , 3   | sysflag  },
  721.     { WRITEDBF_3  , "writedbf"  , EVALP   , NONO , 3   | sysflag  },
  722.     { SEEKDBF_2   , "seekdbf"   , EVALP   , NONO , 2   | sysflag  },
  723.     { ERASEDBF_2  , "erasedbf"  , EVALP   , NONO , 2   | sysflag  },
  724. #endif
  725.  
  726. #if SYMBOLARITH
  727.     { COLON_2     , ":"         , NORMP   , XFYO , 600     },
  728.     { INL_1       , "inl"       , NORMP   , NONO , 1       },
  729.     { INR_1       , "inr"       , NORMP   , NONO , 1       },
  730.     { SPREAD_2    , "spread"    , NORMP   , NONO , 2       },
  731.     { DECIDE_3    , "decide"    , NORMP   , NONO , 3       },
  732.     { IND_4       , "ind"       , NORMP   , NONO , 4       },
  733.     { INT_EQ_4    , "int_eq"    , NORMP   , NONO , 4       },
  734.     { LISTIND_3   , "list_ind"  , NORMP   , NONO , 3       },
  735.     { LAMBDA_1    , "lambda"    , NORMP   , NONO , 1       },
  736.     { SUBST_3     , "subst"     , NORMP   , NONO , 3       },
  737.     { SUBST_4     , "subst"     , EVALP   , NONO , 4       },
  738.     { RECIND_3    , "rec_ind"   , NORMP   , NONO , 3       },
  739.     { TILDE_0     , "~"         , NORMP   , NONO , 0       },
  740.     { OF_2        , "of"        , NORMP   , YFXO , 250     },
  741.     { SUCC_1      , "s"         , NORMP   , NONO , 1       },
  742.     { PRED_1      , "p"         , NORMP   , NONO , 1       },
  743.     { PIND_3      , "p_ind"     , NORMP   , NONO , 3       },
  744. #endif
  745.  
  746. #if HACKY
  747.     { iCHOICEP_1 , "$$choicep"  , EVALP   , NONO , 1 |sysflag},
  748.     { iHEAPT_1   , "$$heapt"    , EVALP   , NONO , 1 |sysflag},
  749.     { iSTACKT_1  , "$$stackt"   , EVALP   , NONO , 1 |sysflag},
  750.     { iAHEAPT_1  , "$$aheapt"   , EVALP   , NONO , 1 |sysflag},
  751.     { iASTACKT_1 , "$$astackt"  , EVALP   , NONO , 1 |sysflag},
  752.     { iENV_1     , "$$env"      , EVALP   , NONO , 1 |sysflag},
  753.     { iTRAIL_1   , "$$trail"    , EVALP   , NONO , 1 |sysflag},
  754.     { iNROFCALLS_2,"$$nrofcalls", EVALP   , NONO , 2 |sysflag},
  755. #endif
  756.  
  757. #if CPM
  758.     { BDOS_3      , "bdos"      , EVALP   , NONO , 3 |sysflag},
  759.     { PEEK_3      , "peek"      , EVALP   , NONO , 3 |sysflag},
  760.     { POKE_2      , "poke"      , EVALP   , NONO , 2 |sysflag},
  761. #endif
  762.  
  763.     { 0           , "\0"        , 0       , 0    , 0       }
  764.  };
  765.  
  766.  
  767. GLOBAL void InitAtoms(void)
  768. { register int I;
  769.   int Arity,Oprec,Predtype,Optype;
  770.   string Name;
  771.   ATOM A; 
  772.   for(I=0;I<HASHSIZE;I++) HASHTAB[I]=nil_atom; /* ??? */
  773.   INIT=true;
  774.   nextatom(MAXATOMS)=MAXSTRINGS;
  775.   for(I=0;InitT[I].macro;I++)
  776.     { CONSTATOM=InitT[I].macro;
  777.       Name=InitT[I].str; 
  778.       Optype=InitT[I].optype;
  779.       Predtype=InitT[I].predtype;
  780.       Oprec=InitT[I].prec & ~sysflag;
  781.       switch(Optype)
  782.  { case XFXO: case XFYO : case YFXO : Arity=2; break;
  783.           case NONO : Arity=Oprec; Oprec=0; break;
  784.           default: Arity=1; break;
  785.         }
  786.       A=LOOKUP(Name,Arity,true);
  787.       oprec(A)=Oprec; 
  788.       if(InitT[I].prec & sysflag) setsystem(A);
  789.       setoclass(A,Optype); setclass(A,Predtype);
  790.     }
  791.   INIT=false;
  792.   nextatom(ATOMSTOP)=(card)STRINGSTOP;
  793.   setclass(UNBOUNDT,VARP); setsystem(UNBOUNDT);
  794.   setclass(VART,VARP); setsystem(VART);
  795.   setclass(SKELT,VARP); setsystem(SKELT);
  796.   setclass(INTT,VARP); setsystem(INTT);
  797. }
  798.  
  799. #if USER
  800. GLOBAL void InitUAtom(int Phase, int Macro, string Name, int Predtype, 
  801.                       int Optype, int Oprec, int System)
  802. { int Arity;
  803.   ATOM A; 
  804.   /* InitUAtom(0,...) is called at the very beginning
  805.      from  InitUser(0)  and sets  LASTATOM and ATOMHTOP ;
  806.      InitUAtom(1,...) is called from InitUser(1) after
  807.      InitAtoms()  and InitDatabase() 
  808.   */
  809.   if(Phase==0) 
  810.      { inc_atom(LASTATOM); inc_atom(ATOMHTOP); return; }
  811.   INIT=true;
  812.   CONSTATOM=Macro;
  813.   STARTATOM();
  814.   switch(Optype)
  815.        { case XFXO: case XFYO : case YFXO : Arity=2; break;
  816.           case NONO : Arity=Oprec; Oprec=0; break;
  817.           default: Arity=1; break;
  818.         }
  819.   A=LOOKUP(Name,Arity,true);
  820.   oprec(A)=Oprec; 
  821.   if(System) setsystem(A); 
  822.   setoclass(A,Optype); setclass(A,Predtype);
  823.   INIT=false;
  824. }
  825. #endif
  826.  
  827.  
  828. GLOBAL boolean DONAME (void)
  829. { 
  830.   switch(name(A0))
  831.   {
  832.         case INTT:  return UNI(A1,LISTREP(itoa(ival(A0))));
  833. #if LONGARITH
  834.         case LONGT: return UNI(A1,LISTREP(ltoa(longval(A0))));
  835. #endif
  836. #if REALARITH
  837.         case REALT: return UNI(A1,LISTREP(ftoa(realval(A0))));
  838. #endif
  839.         case UNBOUNDT: 
  840.             {
  841.                 register TERM  X;
  842.                 register int C;
  843.                 STARTATOM();
  844.                 X=A1;
  845.                 while(name(X)==CONS_2)
  846.                 { 
  847.                     C=INTVALUE(arg1(X));
  848.                     if(C <=0 || C > 255) ARGERROR();
  849.                     ATOMCHAR(C);
  850.                     X=arg2(X);
  851.                 }
  852.                 TESTATOM(NIL_0,X);
  853.                 ATOMCHAR(0);
  854.                 return UNI(A0,mkatom(LOOKUP(NEWATOM,0,false)));
  855.             }  
  856.         default: CHECKATOM(A0);
  857.                  return UNI(A1,LISTREP(tempcopy(name(A0))));
  858.     }
  859. }
  860.  
  861. GLOBAL void DOOP (void)
  862. { 
  863.     PREC_TYPE P;
  864.     ARITY_TYPE ARITY;
  865.     ATOM  A;
  866.     int F,F1,F2; /* OpType */
  867.     TERM T;
  868.   
  869.     if( (P=INTVALUE(A0)) < 0 || P > MAXPREC) ARGERROR();
  870.     if(name(A2)!=CONS_2) CHECKATOM(A2);
  871.     switch(A=name(A1))
  872.     { 
  873.         case FX_0:   F=FXO ; ARITY=1; break;
  874.         case FY_0:   F=FYO;  ARITY=1; break; 
  875.         case XF_0:   F=XFO;  ARITY=1; break;
  876.         case YF_0:   F=YFO;  ARITY=1; break;
  877.         case XFX_0:  F=XFXO; ARITY=2; break;
  878.         case XFY_0:  F=XFYO; ARITY=2; break; 
  879.         case YFX_0:  F=YFXO; ARITY=2; break; 
  880.         default:     ARGERROR();
  881.     }
  882.     if(P==0) F=NONO;
  883.     do
  884.     {
  885.         if(name(A2)==CONS_2)
  886.         {
  887.             T=arg1(A2); A2=arg2(A2);
  888.             if(name(A2)==NIL_0) A2=nil_term;
  889.         }
  890.         else 
  891.         {
  892.             T=A2; A2=nil_term;
  893.         }
  894.         CHECKATOM(T);
  895.         F1=oclass(LOOKATOM(name(T),-1));
  896.         F2=oclass(LOOKATOM(name(T),-2));
  897.         /* A must be copy to heap, because some infos are global */
  898.         A=copyatom( LOOKATOM(name(T),ARITY) );
  899.         if(system(A) && !aSYSMODE) ERROR(SYSPROCE);
  900.         if(WARNFLAG && P)
  901.         {
  902.           if(oclass(A) !=NONO)
  903.           { ws("WARNING: redeclaration of operator ");
  904.             wq(A);ws("/"); wi(ARITY);ws("\n");
  905.           }
  906.           if( /* infix-postfix-conflict */ 
  907.              ((F==XFXO || F==XFYO || F==YFXO)&&(F1==FXO || F1==FYO)) ||
  908.              ((F==XFO || F==YFO)&&(F2==XFXO || F2==XFYO || F2==YFXO)))
  909.           { ws("WARNING: possibly conflicting infix/postfix ");
  910.             ws("declaration for "); wq(A); ws("\n");
  911.           }
  912.         }
  913.         setoclass(A,(int)F); oprec(A)=P;
  914.     } while(A2 !=nil_term);
  915. }
  916.  
  917.  
  918.