File Clean up. Removed files with .o and ~ at end of file names. Moved hanoi...

File Clean up.  Removed files with .o and ~ at end of file names.  Moved hanoi example from bin to examples.

RIGAL/rigsc.446/bin/RIGCOMP.TMP

-hanoi

RIGAL/rigsc.446/bin/hanoi.rig

-
-  -- Hanoi tower problem
-#MAIN
- OPEN S ' ';
- $Count:=4; -- Count of rings in first tower
- S<<' Rings count =' $Count ;
- $STATE:=#INIT($Count); -- Global variable 
-
- #VIDEOSHOW(T); 
-#H( $Count 1 3 );
- 
-##
-#H
- $Num $From $To
- / 
-S<< ' $Num $From $To ='  $Num $From $To ;
-
- IF $Num=1 -> 
-       S << 'FROM' $From 'TO ' $To;
-       #VIDEOMOVE ($From $To);
-       #VIDEOSHOW (T)
-   ELSIF T->
-       $Middle := 6-$From-$To ;
-      #H( $Num-1 $From $Middle );
-      #H( 1      $From $To );
-      #H( $Num-1 $Middle $To )
-FI / ##
-
-#INIT  $Count
-/  $V:=(.
-      <. LEN : COPY($Count), BODY : (.COPY($Count).) .>
-      <. LEN : 0     , BODY : (.0.)      .>
-      <. LEN : 0     , BODY : (.0.)      .> .);
-   LOOP
-    IF $Count=1 -> BREAK FI;
-    $Count:=COPY($Count-1);
-    $V[1].BODY!.:=$Count;
-    $V[2].BODY!.:=0;
-    $V[3].BODY!.:=0;
-  END;
-  RETURN $V;
- / ##
-
-#VIDEOMOVE
-  $From $To
-  / 
-   $S_from := LAST #MAIN $STATE [$From];
-   $S_to   := LAST #MAIN $STATE [$To];
-   $Ring:=COPY( $S_from.BODY[$S_from.LEN]);
-   $S_from.BODY[$S_from.LEN]:=0;
-   $S_from.LEN+:=-1;
-   $S_to.LEN+:=1;
-   $S_to.BODY[$S_to.LEN]:=$Ring;
-  /
-##
-
-#VIDEOSHOW
-
-/ $X:=LAST #MAIN $STATE;
-  $I:=1;
-  LOOP
-   S<<$I '   ';
-   #STR($X[1].BODY[-$I]);
-   S<]'   ';
-   #STR($X[2].BODY[-$I]) ;
-   S<]'   ';
-   #STR($X[3].BODY[-$I]);
-   IF $I>=LAST #MAIN $Count -> BREAK;FI;
-   $I+:=1;
-  END;
-  S<<;
-#CALL_PAS(1 '<<<<<>>>>>>')/##
-
-#STR
-  $N
-/ $E:=LAST #MAIN $Count-$N;
-  #FILL(' ' $E); 
-  #FILL('O' 2*$N);
-  #FILL(' ' $E)/ ##  
-
-#FILL 
- $SYM $CNT
- /LOOP
-   $CNT:=$CNT-1;
-   IF $CNT<0 -> BREAK FI;
-   S<]@$SYM; 
-  END; 
- /## 

RIGAL/rigsc.446/bin/xd-copy.txt

-#!/bin/bash -f
-$rig/anrig -p N.TMP
-$rig/genrigd  S -p N.TMP
- cc   -w  -I{$rig}/../include  -I.  xcrg.c  xcrg_0.c -o hanoi $rig/../lib/riglib.a -lm
-rm -f xcrg_0.c  xcrg_0.o 
-rm -f xcrg.c  xcrg.o xcrga.h xcrg.h
-rm -f *.RC2 *.RC4  RIGCOMP.TMP N.TMP

RIGAL/rigsc.446/doc/80.txt~

-
-   Operations with  real values in Rigal
-  =======================================
-
-NOTE:
-This description presents implementation of
-operations with  real values in Rigal in 
-MS-DOS (Turbo-Pascal based) and UNIX (C - based)
-variants, starting from Rigal V.2.34 and UNIX Rigal V.4.45.
-Read carefully parts regarding UNIX and MS-DOS. 
-
- Old such description was for MS-DOS version 
-only. Unix description exists only starting from version
-4.45.
-
-   Limitations of Turbo Pascal
-   ===========================
-
-MS-DOS Rigal is implemented via Pascal real run time library. The
-following sequence of characters is accepted by Pascal VAL
-procedure as a real number:
-
-  (* space *) [ (+!-) ] (* digits1 *) [ '.' (* digit2 *) ]
-              [ (e!E)   [ (+!-) ] (* digit3 *) ]
-  The context constraints are that:
-   digit1+digit2<37  ( limited number of digits )
-   The absolute value of digits1.digits2E[-]digits3 must be
-   in 2.9e-39 ... 1.7e38
-
-  We assume that UNIX C has no such constraints.
-
-  Input real number from lexical analyzer
-  =======================================
-
-We call real numbers stored in Rigal memory as #FATOMs. Use
-built-in Rigal predicate #FATOM to recognize them. They
-can be read by the lexical analyzer from its input as
-sequences of characters that must match following grammar
-rule
-
-   (+ digits1 +)
-   ( '.' (* digit2 *)  [ (e!E)   [ (+!-) ] (* digit3 *) ]
-   !                     (e!E)   [ (+!-) ] (* digit3 *) )
-
-and it must be acceptable by procedure VAL (see above).
-
-IN MS-DOS:
-=========
-If #FATOM is read then it is stored in 8-byte-length atom, 6
-bytes are occupied by standard representation of REAL type
-in Pascal. In other two bytes number of digits before dot
-and number of digits after the dot are stored. If the input
-number was in exponential form then these bytes contain
-zeros.
-
-IN UNIX:
-=======
-If #FATOM is read then it is stored in 8-byte-length atom,
-assuming that sizeof(double)=8. The information about the 
-number of digits before the dot and number of digits after
-the dot are _NOT_ stored.
-
-
-Since standard 6 (or 8)-byte representation is stored, only 10 (13)
- digits are valid.
-
-Non-matching in MS-DOS scaner 
-=============================
-If the input value matches grammar and does not match "VAL
-rules"  then atom with type #KEYWORD is produced (it is
-used for diagnostic purposes).  Normally #FATOM is produced.
-
-Output of real numbers
-======================
- Statements PRINT, <<, ,<], built-in rules #IMPLODE and
-#EXPLODE output real numbers in "exponential" form,
-like the %E format in UNIX, or simple WRITE() in Pascal.
-
-    Sd.ddddddddddEZdd
-  S is space or '-'
-  d are digits (exactly 10 digits after dot)
-  E is character 'E'
-  Z is '+' or '-'
-
- Real numbers in traditional operators
- =====================================
-  If you use real numbers in traditional arithmetical
-operators and comparisons, all #FATOMs  are accepted the
-same way as NULL. It corresponds to 0 value. If you  compare
-#FATOMs with '=', their internal representation (with 6
-or 8 bytes long code) will be compared. Therefore, there
-is no sense in such operations.
-
-  Ways to create #FATOM
-  =====================
- #CALL_PAS(80 S any_string)
-  returns #FATOM if the string value matches "VAL rule".
-Otherwise NULL is returned.
-
-  #CALL_PAS(80 I integer)
-  returns #FATOM. Integer value can be arbitrary.
-
-
-  Ways to get information from #FATOM
-  ===================================
- ( THIS APPLIES TO MS_DOS VARIANT ONLY !)
- ====================================== 
-  #CALL_PAS(80 D #FATOM) returns pair
-   (. digits_before  digits_after .)
-  for FATOM values that were entered through the
-lexical analyzer. If the number was entered in exponential
-style (with character, 'E'), value (. 0 0 .) is returned.
-If the value was obtained by #CALL_PAS(80..),  NULL is
-returned. There is no other ways to create #FATOM.
-
-  NOTE:
- If you have entered #FATOM to variable $X via lexical
-analyzer, you can output it with the same number of digits
-before and after the point (if it was not exponential
-style) as it was read by lexical analyser:
-
-  $D:=#CALL_PAS(80 D $X);
-  IF $D AND ($D[1]+$D[2]>0) ->
-   $REZ:=#CALL_PAS(80 Z $X ($D[1]+$D[2]+1)*100+$D[2])
-  ELSIF T->
-   $REZ:=#CALL_PAS(80 V $X)
-  FI;
-
-  Conversions (MS-DOS VARIANT ONLY)
-  =================================
-  #CALL_PAS(80 T #FATOM)
-  returns #NUMBER - whole part of real value. If the
-number is not in -2147483648..2147483647 then NULL is
-returned.
-
-  #CALL_PAS(80 Z #FATOM D*100+A)
-  returns formatted string with the value of the real
-number. "A" can be positive or negative.
-
-  If "A" is arbitrary NEGATIVE number then exponential form
-is produced in following form:
-   Sd.dEZdd (e.g. -7.7E01)
-   S is  space or '-' Z is '-' or '+'
-
-  If D>=9 then additional digits are added after the point,
-but not more than 10 digits.
-
-  If "A" is 0 then integer value is produced, possible with
-'-'.
-  If "A" is positive, it specifies number of digits after
-the point. Non-exponential form is produced.
-Zeros are appended after point if necessary. The
-number of digits after the point cannot be larger than 11.
-
-  After all cases discussed above, if "D" is larger than the
-new string, RIGAL adds spaces from the left side of the
-string. The result string length is not less than "D".
-
-  #CALL_PAS(80 R #FATOM p)
-  - returns rounded value of real number. The number is
-rounded such way that digits after p-th position after the
-dot  must be set to zeros. E.g. 23.1415 rounded at 2 nd
-position must be 23.140000.
-   If p is not positive, it is  accepted as 0.  If absolute
-value of real*(10 in p-th degree) is larger than 1e37 then
-NULL is returned.
-
-  #CALL_PAS(80 V #FATOM)
-  - creates string from real number in form
-    [-]d.ddddddddddESdd
-    S is '+' or '-'
-
- Conversions (UNIX VARIANT ONLY)
- =================================
-
- #CALL_PAS(80 F #FATOM  FORMAT_STRING)
-  returns   formatted string with UNIX C the _arbitrary_ format
-  (allowed in UNIX C sprintf function) you specified, 
-  for example   #CALL_PAS(80 F $A  'A=%.9e');
-  Note, however, that this option is _not_ ported to MS-DOS.
-
- #CALL_PAS(80 Z #FATOM D*100+A)
-  returns formatted string with the value of the real
-number. "A" _must_ be positive.
-
-  If "A" is 0 then integer value is produced, possible with
-'-'.
-  If "A" is positive, it specifies number of digits after
-the point. Non-exponential form is produced.
-Zeros are appended after point if necessary. The
-number of digits after the point cannot be larger than 11.
-
-  After all cases discussed above, if "D" is larger than the
-new string, RIGAL adds spaces from the left side of the
-string. The result string length is not less than "D".
-
- #CALL_PAS(80 V #FATOM)
-  returns   formatted string with UNIX C  %E format.
-
- Mathematical operations
- =======================
-
-  #CALL_PAS(80 op #FATOM #FATOM)
-  Operations "op" can be '+','-', '*','/',  '<','>',
-'<=','>=', '<>','='
-  In MS-DOS  if '+' or '-' applied, absolute value of the arguments
-must be less than 6.2e37 otherwise NULL is returned.
-
-   In MS-DOS  if '*' or '-' applied, absolute value of the result must
-be between 1.6e-38..6.2e37 and the second argument of '/' is
-not 0, otherwise NULL is returned.
-  If '<','>','<=','>=','<>','=' are applied, one of the
-arguments is returned to indicate 'true', NULL is returned
-to indicate 'false' Note that it is BAD and DANGEROUS STYLE to check the
-results of real arithmetic using '=' or '<>' operations,
-because the computer never calculates precise results. You
-can compare two real numbers only after some conversion,
-e.g. using #CALL_PAS(80 V ...).
-
- #CALL_PAS(80 Q #FATOM) returns square root if argument is
-not negative, NULL otherwise.
-
-  #CALL_PAS(80 X #FATOM) returns exponential ( e in r-th
-degree) of the argument.
-
-  #CALL_PAS(80 L #FATOM) returns natural logarithm if the
-argument is positive, otherwise NULL.
-
-  Mathematical operations for UNIX only
-  ===================================== 
-#CALL_PAS(80 op #FATOM)
-
- where op = tSIN, tCOS, tTAN, tASIN, tACOS, tATAN.
- 
- call corresponding functions from UNIX libm library.
-
-
-
-   Common note about #CALL_PAS(80..).
-   =================================
-  It has no run time diagnostic.
-  If wrong types of arguments  of wrong number of arguments
-or wrong operation name is given, NULL is returned.
-  If #CALL_PAS(80...) produces a #FATOM, it is 6 (or 8) bytes long
-and it has _no_ information about the digits before and after
-the dot.
-  You can learn more details about #CALL_PAS(80) from
-source files USE80.PAS and SERVICES.PAS in MS-DOS,
-usemod.c, sevice.c in UNIX C.

RIGAL/rigsc.446/include/c1.h~

-/*#define xxx printf("lin=%d file=%s\n",__LINE__,__FILE__);*/
-#define xxx ;
-int g_argc;
-Char ** g_argv;
-
-typedef union v {
-  a sa;   /* s -adres */
-  longint nu;
-  boolean bo;
-  a at;   /* a -adres */
-} v;
-
-
-boolean debugrule;   /* to be used in future */
-Char filebuf[2048];
-
-
-/************ definitions in  c1 ***************/
-extern Void er PP((long n));
-
-/* kod o{ibki */
-extern Void errstr PP((long n, Char *s));
-
-extern Void crlist PP((long *l));
-/* p2c: c1.z, line 471:
- * Note: Turbo Pascal conditional compilation directive was ignored [218] */
-
-/*  sozdatx pustoj spisok  */
-/*$ifdef xx*/
-/*extern Void d PP((long r, long s));*/
-extern Void d PP((long status_r ,char * rulename,long  rulenum,long  param,boolean  success));
-
-extern Void d1 PP((long r));
-
-/*$endif*/
-extern Void addel PP((long sel, boolean not_atomic, long xsel, long ob, long *tr_));
-
-extern long numval PP((long ob));
-
-/* nomer wstr.prawila */
-extern Void bltin PP((v *rr, boolean *success, long arg, long n));
-
-/* a-adres  */
-extern Void mkatom PP((long k, char atype, long *r));
-
-/*************** c2 *****************/
-extern Void concop PP((long *a1, long a2));
-
-extern Void indxop PP((long xx, boolean isobject, long xa, long l, long *rez));
-
-extern Void selop PP((long xn, boolean not_atomic, long xa, long tr_, long *rez));
-
-extern Void setind PP((long xx, boolean isobject, long xa, long l, long rez));
-
-extern Void setsel PP((long xn, boolean not_atomic, long xa, long tr_, long rez));
-
-extern Void addnum PP((long *a1, long a2));
-
-extern Void copyop PP((long ob, long *rez));
-
-
-/* ******************* c3 ******************* */
-
-#define max_digit       10
-
-
-extern Void epilog PV();
-
-extern Void prolog PV();
-
-/* a-adr.imeni fajla*/
-/* s-adr.wyw.obxekta*/
-/* s now.stroki*/
-/* s probelami*/
-extern Void outxt PP((long fname, long arg, boolean nl, boolean blanks));
-
-/* a-adr.imeni fajla*/
-/* wywodimyj atom*/
-/* s now.stroki*/
-/* s probelami*/
-extern Void outatm PP((long fname, Char *arg, boolean nl, boolean blanks));
-
-
-/* a-adres imeni fajla*/
-/* s-adr.*/
-extern Void opn PP((long fname, long fspec));
-
-/* 0-load,1 -save*/
-extern Void loasav PP((v *p, long f, long paz));
-
-extern Void explod PP((long kk, long *rez));
-
-extern Void implod PP((ptr_ *pl, long *rez));
-
-extern Void bltin1 PP((long *rez, boolean *success, ptr_ *pl, long n));
-
-/* a-adr.*/
-extern Void clsfil PP((long fname));
-
-/**************** c4 ******************* */
-/* cequ(=), cnequ(<>) */
-extern boolean eqop PP((long o, long a1, long a2));
-
-extern Void varpat PP((ptr_ *pl, char tip, long *rez, boolean *success));
-
-extern Void atmpat PP((long aconval, ptr_ *pl, long *rez, boolean *success));
-
-extern boolean eqnum PP((long m1, long n));
-
-extern boolean eqatom PP((long m1, long atm));
-
-/* kod operacii */
-extern boolean compare PP((long op, long a1, long a2));
-
-
-

RIGAL/rigsc.446/include/define.h~

-/****** define.h *****/
-/* the declaration of main data structures of
-   s-space for rigal/ unix;
-   (c) rigal v.00-v.2.xx
-*/
-
-#define rigal_version         "4.43"
-
-
-/* descriptor sizes ******************************** */
-
-#define listnodenumb    5   /*  number of nodes for list descriptor  */
-#define mainlistelnum   5
-/* was = 6 before 1.60 */
-/* = (listnodenumb - 2) * 2 -1 number of list elements in the
-    main list descriptor */
-
-#define fragmlistelnum  8
-/*= (listnodenumb - 1) * 2  number of list elements in
-     auxilary list descriptors */
-
-#define treenodenumb    5   /*  number of nodes for tree descriptor */
-
-#define maintreearcnum  3
-/* (treenodenumb - 2) number of list elements in the
-         main tree descriptor */
-
-
-#define fragmtreearcnum  4
-/* (treenodenumb - 1)  in auxilary */
-
-#define null_           0   /* empty  object */
-#define maxvarnumb      127   /* maximal number of variables in one rule */
-#define filenum         5   /* maximal number of opened files */
-
-
-/* following s-addresses are reserved for internal purposes
-   - for the interpretable code. they are x*512 , they are in  0 <= x < 64k */
-/*      0    512   1024   1536   2048   2560   3072 */
-/*   3584   4096   4608   5120   5632   6144   6656 */
-/*   7168   7680   8192   8704   9216   9728  10240 */
-/*  10752  11264  11776  12288  12800  13312  13824 */
-/*  14336  14848  15360  15872  16384  16896  17408 */
-/*  17920  18432  18944  19456  19968  20480  20992 */
-/*  21504  22016  22528  23040  23552  24064  24576 */
-/*  25088  25600  26112  26624  27136  27648  28160 */
-/*  28672  29184  29696  30208  30720  31232  31744 */
-
-/* codes used in the interpreter  */
-
-#define tr              512   /* tree <. .> */
-#define li              1024   /* list (. .) */
-#define al              1536   /* alternatiwa ( ! ) */
-#define fa              2048   /* fakultatiw [ ] */
-#define se              2560   /* star el. ( * * ) */
-#define ps              3072   /* plus (+ +) */
-#define ti              3584   /* tree iteration <* *> */
-#define vpat            6144   /* v -pattern */
-#define spat            6656   /* s -pattern */
-
-/* separatori w s-kodah rigal */
-
-#define tdelim          4096   /* separatorx wetwej derewa */
-#define adelim          4608   /* separatorx wetwej alxternatiwy */
-#define asdelim         5632   /* razd.lew. i praw. ~astej := */
-#define opdelim         28672   /* separatorx / */
-#define clistdelim      14336
-#define ctreedelim      15872
-#define seldelim        30720   /* razd.selektora i obxekta */
-
-/* statements and operators  */
-
-#define cfail           12288
-#define creturn         11776
-#define cass1           6144
-#define cass2           6656
-#define cass3           7168
-#define cass4           7680
-#define cass5           8192
-#define cnull           29184   /* $e:= null w {ablone */
-#define clast           17408
-#define crule           17920
-#define cselect         18432
-#define cindex          18944
-#define cname           19456
-#define cmult           19968
-#define cdiv            20480
-#define cmod            20992
-#define cconc           21504
-#define clconc          22016
-#define ctradd          22528
-#define cadd            23040
-#define cminus          23552
-#define cequ            24064
-#define cnequ           24576
-#define cgt             25088
-#define clt             25600
-#define cge             26112
-#define cle             26624
-#define cin             27136
-#define cand            27648
-#define cor             28160
-#define cnot            16384
-#define cunminus        16896
-#define ccopy           29696
-#define clist1          13312
-#define clist2          13824
-#define ctree1          14848
-#define ctree2          15360
-
-
-/* data types */
-
-
-typedef long longint;
-
-
-typedef unsigned short word;
-   /* must be 2 byte positive integer */
-typedef Char string80[81];
-
-typedef short byte_type;
-
-/* string80=string[80];*/
-
-typedef long a;
-
-typedef long aa;
-   /* adresses of a-space */
-
-typedef Char c2[2];   /* =2.  bytes */
-typedef Char c4[4];
-/* c8 = packed array [1..8] of char;*/
-typedef Char bl80[80];
-typedef Char a80[80];
-typedef Char real_char[sizeof(double)];   /*added 17-feb-92*/
-
-#define dummy           0
-#define listmain        1
-#define listfragm       2
-#define treemain        3
-#define treefragm       4
-#define atom            5
-#define idatom          6
-#define keyword         7
-#define number          8
-#define tatom           9
-#define fatom           10
-#define variable        11
-#define idvariable      12
-#define nvariable       13
-#define fvariable       14
-#define rulename        15
-#define object_d        16
-#define set_coord       17
-#define spec            18
-#define xxx_19          19
-#define complex_desk    20
-#define start_list      21
-#define end_list        22
-#define start_tree      23
-#define end_tree        24
-#define name_obj        25
-#define eof_desk        26
-
-
-/* !! internal representation of these enumerable constants
-     is important !! */
-/* =1.  bytes */
-/*0*/
-/*1*/
-/*2*/
-/*3*/
-/*4*/
-/*5*/
-/*6*/
-/* identifier */
-/*7*/
-/*8*/
-/*9*/
-/* text constant */
-/*10*/
-/* float constant */
-/*11*/
-/*17*/
-/* sets coordinate */
-/*18*/
-/* special delimiter 0,512,1024,..*/
-/* reserved */
-/*20*/
-/*21*/
-/*22*/
-/*23*/
-/*24*/
-/*25*/
-/*26*/
-
-/* these structures are important,
-   if something is shifted, it must be marked in
-   defpage.pas tables */
-/* "dtype" and "flags" must be 2 first bytes */
-/*  "next" must be the last 37-40 bytes */
-/* "xx", "xxx" are reserved fields */
-/* "cord" is unsigned integer, 2 bytes */
-/* "val"  is signed long integer */
-
-/* old version :
-mainlistdescriptor= record             (* =40.  bytes *)
-   dtype : descriptortype;                   (* =1.  bytes *)
-   flags : 0 ..31;                           (* =1.  bytes *)
-   xx :   array [ 1 ..  1  ] of boolean;(* =1.  bytes *)
-   elnum : 0 ..mainlistelnum;                (* =1.  bytes *)
-   totalelnum : longint;                      (* =4.  bytes *)
-   name : aa;                                (* =4.  bytes *)
-   elt : array[ 1 ..mainlistelnum] of a;     (* =6*4=24.  bytes *)
-   next : a; end;                            (* =4.  bytes *)
-*/
-
-typedef struct mainlistdescriptor {
-  /* =40.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  boolean xx[1];   /* =1.  bytes */
-  char elnum;   /* =1.  bytes */
-  longint totalelnum;   /* =4.  bytes */
-  aa name;   /* =4.  bytes */
-  a elt[mainlistelnum];   /* =5*4=20.  bytes */
-  a lastfragm;   /* last descriptor address    =4.  bytes */
-  a next;
-} mainlistdescriptor;   /* =4.  bytes */
-
-typedef struct fragmlistdescriptor {
-  /* =40.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  char elnum;   /* =1.  bytes */
-  boolean xx[1];   /* =1.  bytes */
-  a elt[fragmlistelnum];   /* =8*4=32.  bytes */
-  a next;
-} fragmlistdescriptor;   /* =4.  bytes */
-
-
-typedef struct te {
-  aa arcname;   /* =8=4+4.  bytes */
-  a elt;
-} te;
-
-
-typedef struct maintreedescriptor {
-  /* =40.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  char arcnum;   /* =1.  bytes */
-  boolean xx[1];   /* =1.  bytes */
-  longint totalarcnum;   /* =4.  bytes */
-  aa name;   /* =4.  bytes */
-  te arc[maintreearcnum];   /* =8*3=24.  bytes */
-  a next;
-} maintreedescriptor;   /* =4.  bytes */
-
-typedef struct fragmtreedescriptor {
-  /* =40.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  char arcnum;   /* =1.  bytes */
-  boolean xx[1];   /* =1.  bytes */
-  te arc[fragmtreearcnum];   /* =8*4=32.  bytes */
-  a next;
-} fragmtreedescriptor;   /* =4.  bytes */
-
-
-typedef struct atomdescriptor {
-  /* =8.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  word cord;
-  /* unsigned */
-  /* =2.  bytes */
-  aa name;   /* =4.  bytes */
-} atomdescriptor;
-
-typedef struct numberdescriptor {
-  /* =8.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  word cord;   /* =2.  bytes */
-  longint val;   /* signed */
-} numberdescriptor;   /* =4.  bytes */
-
-typedef struct vardescriptor {
-  /* =8.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  boolean guard;   /* =1.  bytes */
-  char location;   /* =1.  bytes */
-  aa name;
-} vardescriptor;   /* =4.  bytes */
-
-typedef struct ruledescriptor {
-  /* =16.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  word cord;   /* =2.  bytes */
-  aa name;   /* =4.  bytes */
-  a fragmadr;   /* =4.  bytes */
-  a nomintab;   /* =4.  bytes */
-} ruledescriptor;
-
-
-typedef struct specdescriptor {
-  /* =8.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  boolean xx[2];   /* =2.  bytes */
-  longint val;
-} specdescriptor;   /* =4.  bytes */
-
-typedef struct objdescriptor {
-  /* =16.  bytes */
-  char dtype;   /* =1.  bytes */
-  char flags;   /* =1.  bytes */
-  boolean variable_;   /* =1.  bytes */
-  char nel;   /* =1.  bytes */
-
-  a fragmorvar;   /* =4.  bytes */
-  a glavn;   /* =4.  bytes */
-  a rezerv;   /* =4.  bytes */
-} objdescriptor;
-
-typedef a a10_type[10];
-
-typedef union mpd {
-  /* multiply pointers to descriptors */
-  a sa;
-  mainlistdescriptor *smld;
-  fragmlistdescriptor *sfld;
-  maintreedescriptor *smtd;
-  fragmtreedescriptor *sftd;
-  atomdescriptor *sad;
-  numberdescriptor *snd;
-  vardescriptor *svd;
-  ruledescriptor *srd;
-  atomdescriptor *sc8;
-  specdescriptor *sspec;
-  objdescriptor *sobj;
-  Char *sbl80;
-  long *sa10;
-} mpd;   /* =4.  bytes */
-
-#define ptrlist         0
-#define ptrtree         1
-#define packedlist      2
-
-/*------------------------------------------------*/
-
-typedef struct ptr_ {
-  /* refers to the current element of agregate */
-  unsigned ptrtype : 2;
-/* p2c: defsun3.z, line 337: Note:
- * Field width for PTRTYPE assumes enum ptrtype_enum has 3 elements [105] */
-  /* type of agregate */
-  unsigned nel : 4;
-  /* number of element in current fragment of agregate,
-     or in array */
-  /* =0 if no more elements */
-  unsigned plistsize : 3;
-  /* current size of array;
-      used for rule call optimization
-      with <= 4 arguments.
-    used only if ptrtype=packedlist ,
-    undefined otherwise */
-
-  a cel;   /* refers to the current element */
-  union {
-    struct {
-      a arc;   /* arc selector a-address */
-
-      a curfragment;   /* current fragment descriptor */
-
-      /* main fragment */
-      a mainadr;
-    } U1;
-    /* number "4" is fixed in compiler code-generation phase
-       file stmt2.rig rule #g_call */
-    a plistelt[3];
-  } UU;
-} ptr_;
-
-/*======================================*/
-/* this is used for access to os file names */
-typedef Char filename_type[81];
-typedef Char checker_message_type[81];
-typedef Char filespecification[81];
-
-
-
-/* this is used for checker and editor common variables */
-
-typedef struct error_rec_type {
-  checker_message_type message;
-  filename_type filename;
-  word address;
-} error_rec_type;
-
-
-typedef struct _REC_filetab {
-  a name;   /* a-address of rigal file */
-  boolean isopen;   /*  */
-  boolean screen;
-  long strlen;   /* specified max length */
-  long curlen;   /* current length */
-} _REC_filetab;
-
-
-/* character set *********************************** */
-long digit[9], letter[9], symbols[9];
-_REC_filetab filetab[filenum];
-
-FILE *files[filenum];
-
-

RIGAL/rigsc.446/lint/RIGCOMP.TMP

-rig_lint
-l_anal
-l_operat
-l_instr
-l_patt
-l_patt2
-l_patt3
-l_exprs
-l_expr1
-l_closur
-l_check

RIGAL/rigsc.446/lint/xd

-#!/bin/csh -f
-$rig/anrig -p N.TMP
-$rig/genrigd  S -p N.TMP
- cc   -w  -O -I{$rig}/../include  -I.  xcrg.c  xcrg_0.c\
-xcrg_1.c\
-xcrg_2.c\
-xcrg_3.c\
-xcrg_4.c\
-xcrg_5.c\
-xcrg_6.c\
-xcrg_7.c\
-xcrg_8.c\
-xcrg_9.c\
-xcrg_10.c\
--o rig_lint\
-$rig/../lib/riglib.a -lm
-rm -f xcrg_0.c  xcrg_0.o 
-rm -f xcrg_1.c  xcrg_1.o 
-rm -f xcrg_2.c  xcrg_2.o 
-rm -f xcrg_3.c  xcrg_3.o 
-rm -f xcrg_4.c  xcrg_4.o 
-rm -f xcrg_5.c  xcrg_5.o 
-rm -f xcrg_6.c  xcrg_6.o 
-rm -f xcrg_7.c  xcrg_7.o 
-rm -f xcrg_8.c  xcrg_8.o 
-rm -f xcrg_9.c  xcrg_9.o 
-rm -f xcrg_10.c  xcrg_10.o 
-rm -f xcrg.c  xcrg.o xcrga.h xcrg.h
-rm -f *.RC2 *.RC4  RIGCOMP.TMP N.TMP

RIGAL/rigsc.446/src/Makefile~

-
-#
-# MAKEFILE for Rigal in C, version 4.45.1
-#
-
-# C compiler to use (Compiler path can be changed by the user)
-CCFLAGS = -g
-PCA =  cc $(CCFLAGS)  -c -D xsun=1 -I../include/
-# Specify -DLE for Little-endian architectures (Big-endian is default)!
-# Specify -Dbbs for BBS-version of scaner (LaTeX version is default)!
-
-LIBS = -lm
-# This is for sin, cos, sqrt etc.
-
-#  Other things are usually not changed by the user
-.INIT:  check$(rig) 
-
-# -------------------------------------------------
-#  MACRO DEFINITIONS
-# -----------------------------------------------
-# Object files for "rc"
-RCF_SRC = defsun3.o ley_.o nef2.o ou2.o  sevice.o
-# They are in src/ subdirectory
-
-# Object files for "ic"
-ICF_SRC = cim.o defsun3.o erm.o ic.o ley_.o scan.o scanmif.o usemod.o nef2.o ou2.o sevice.o
-
-
-# Object files for "rc -c" (library) 
-CCF_SRC = defsun3.o ley_.o scan.o scanmif.o usemod.o c1.o c2.o c3.o c4.o nef2.o ou2.o sevice.o
-
-
-DISTLIB =  defsun3.c ley_.c scan.c scanmif.c usemod.c c1.c c2.c c3.c c4.c nef2.c ou2.c sevice.c
-
-# All include files
-INCLIB_SRC = ../include/c1.h ../include/define.h  \
- ../include/defpage.h ../include/ley.h \
- ../include/scan.h ../include/cim.h \
- ../include/def180.h   ../include/nef2.h\
- ../include/usemod.h   ../include/globrig.h
-
-#--------------------------------------------------------
-# TARGET DEFINITIONS
-#---------------------------------------------------------
-
-# Normally builds all necessary after unpack and performs test.
-normal:   bins ../lib/riglib.a ../bin/anrig ../bin/genrigd ../bin/rig_lint test clean
-
-bins:     bin ../bin/rc ../bin/ic ../bin/v
-bin:
-	-mkdir ../bin
-../bin/rc:$(RCF_SRC) rc_.o
-	cc $(CCFLAGS)  -o ../bin/rc rc_.o $(RCF_SRC) 
-
-../bin/ic:$(ICF_SRC)
-	cc  $(CCFLAGS) -o ../bin/ic    $(ICF_SRC) $(LIBS)
-
-
-../bin/v:$(RCF_SRC) v.o 
-	cc  $(CCFLAGS) -o ../bin/v  v.o  $(RCF_SRC) $(LIBS)
-
-../lib/riglib.a:$(CCF_SRC) 
-	@echo '*Starting creating library'
-	-mkdir ../lib
-	-rm -f ../lib/riglib.a
-	ar rv ../lib/riglib.a $(CCF_SRC)
-	-ranlib ../lib/riglib.a
-	@echo '*Library created'
-
-../bin/anrig:$(INCLIB_SRC) ../lib/riglib.a 
-	cc  $(CCFLAGS) -w \
-	 -Ianrig/ -I../include/\
-	 anrig/xcrg.c  anrig/xcrg_0.c\
-	 anrig/xcrg_1.c\
-	 anrig/xcrg_2.c\
-	 anrig/xcrg_3.c\
-	 anrig/xcrg_4.c\
-	 anrig/xcrg_5.c\
-	 anrig/xcrg_6.c\
-	 anrig/xcrg_7.c\
-	 anrig/xcrg_8.c\
-	 anrig/xcrg_9.c\
-	 -o ../bin/anrig ../lib/riglib.a $(LIBS)
-	-rm -f anrig/*.o
-
-../bin/genrigd:$(INCLIB_SRC) ../lib/riglib.a
-	cc  $(CCFLAGS) -w \
-	 -Igenrig/ -I../include/\
-	 genrig/xcrg.c\
-	 genrig/xcrg_1.c\
-	 genrig/xcrg_2.c\
-	 genrig/xcrg_3.c\
-	 genrig/xcrg_4.c\
-	 genrig/xcrg_5.c\
-	 genrig/xcrg_6.c\
-	 genrig/xcrg_7.c\
-	 genrig/xcrg_8.c\
-	 genrig/xcrg_9.c\
-	 genrig/xcrg_10.c\
-	 -o ../bin/genrigd ../lib/riglib.a $(LIBS)
-	-rm -f genrig/*.o
-
-../bin/rig_lint: ../lint/rig_lint.rig ../bin/rc ../lib/riglib.a ../bin/anrig ../bin/genrigd
-	(cd ../lint;../bin/rc rig_lint -c -P '-O';cd ..)
-	-mv ../lint/rig_lint ../bin/  	
-
-test: ../test/rigcrf.rig  ../bin/rc ../lib/riglib.a ../bin/anrig ../bin/genrigd
-	(cd ../test;\
-	 $(rig)/rc rigcrf;\
-	 $(rig)/ic rigcrf rigcrf;\
-	 $(rig)/rc  rigcrf -c;\
-	 rigcrf rigcrf)
-
-##------------------ Hidden possibilities
-z:       anrigz genrigz
-anrigz:
-	(cd anrig;\
-	 ../../bin/rc anrig;\
-	 ../../bin/anrig;\
-         ../../bin/genrigd S -p N.TMP;\
-	 /bin/rm *.RC2 *.RC4 *.TMP)
-
-genrigz:
-	(cd genrig;\
-	 ../../bin/rc genrigd;\
-	 ../../bin/anrig;\
-         ../../bin/genrigd S -p N.TMP;\
-	 /bin/rm *.RC2 *.RC4 *.TMP)
-##---------------------------------------
-VERSION = 445.2
-tar:	clean
-	-rm -f ../rigsc.$(VERSION).tar.Z
-	(cd ..;tar -cvf rigsc.$(VERSION).tar include src examples lint doc test)
-	compress ../rigsc.$(VERSION).tar
-	cp ../rigsc.$(VERSION).tar.Z /info/ftp/pub/labs/pelab/rigal/
-##--------------------------------------
-clean:
-	mv ../test/rigcrf.rig .
-	-rm -f *.o */*.o  *.RC2 */*.RC2  *.RC4 */*.RC4    */*.rsc  ../lint/*.o ../lint/*.RC2 ../lint/*.RC4  \
-	 ../examples/hanoi ../*/*.rsc ../*/*.out ../*/*/*.out ../test/*
-	mv rigcrf.rig ../test/
-##--------------------------------------
-.c.o:   $(INCLIB_SRC)
-	$(PCA) $< -o $@
-check:
-	@echo '********************************************************'
-	@echo '*' User ERROR: you have not set \"rig\" environment variable to $(PWD)/../bin
-	@echo '********************************************************'
-	____FATAL___ERROR___
-check$(rig):
-	@echo VARIABLE rig have been set to $(rig)
-	@echo ---------------------------------------
-##----------------------------------------
-# Prepare distribution 
-mkdist$(RFILE)$(RDIR):
-	@echo '*** to prepare for distribution write make mkdist RFILE=fff RDIR=/u/vaden/xyz/xyz/'
-mkdist: 
-	(cd $(RDIR);\
-	$(rig)/rc $(RFILE);\
-	$(rig)/anrig;\
-	$(rig)/genrigd S -p N.TMP;\
-	/bin/rm *.RC2 *.RC4 *.TMP)
-	cp ../include/*  $(RDIR)
-	cp $(DISTLIB) $(RDIR)
-	(cd $(RDIR);\
-	echo 'cc -O  -w  -D xsun=1 ' $(DISTLIB) ' xc*.c -o ' $(RFILE) $(LIBS)   > cmd)
-mkdist2:
-	(cd 	$(RDIR);\
-	cc -O -w -D xsun=1  $(DISTLIB)  xc*.c -o $(RFILE) $(LIBS)  ;/bin/rm *.o)

RIGAL/rigsc.446/src/c1.c~

-#include "globrig.h"
-#include "define.h"
-#include "defpage.h"
-#include "nef2.h"
-#include "c1.h"
-
-/* Local variables for bltin: */
-struct LOC_bltin {
-  long l;
-  bl80 mm;
-} ;
-
-Local long alen(k, LINK)
-long k;
-struct LOC_bltin *LINK;
-{
-  a t;
-
-
-  t = k;
-  pointa(t, LINK->mm, &LINK->l);   /*ibm*/
-  return LINK->l;
-}  /* alen */
-
-
-
-
-
-Void bltin(rr, success, arg, n)
-v *rr;
-boolean *success;
-long arg, n;
-{
-  /* nomer wstr.prawila */
-  /*===========================*/
-  /* wyzow wstroennogo prawila */
-  /*===========================*/
-  struct LOC_bltin V;
-  /* wyhod */
-
-  char rulenum;
-  a k, s, rez;
-  mpd x, y;
-  long t;
-  longint li_;
-  string80 s80;   /* for parameter */
-  atomdescriptor *WITH;
-  numberdescriptor *WITH1;
-
-
-
-  rr->nu = 0;
-  rulenum = n;
-  k = arg;
-  if ((k & 511) != 0 || k >= 65536L || k < 0)
-    pointr(k, &x.sa);
-  *success = true;
-  rez = arg;
-  switch (rulenum) {
-
-  case 3:   /* #atom */
-    if (k == null_)
-      goto _L99;
-    *success = (((1L << ((long)x.sad->dtype)) &
-		 ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) != 0);
-    break;
-
-  case 4:   /* #number */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == number);
-    break;
-
-  case 5:   /* #ident */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == idatom);
-    break;
-
-  case 6:   /* #list */
-    if (k == null_)
-      goto _L99;
-    *success = (x.sad->dtype == listmain);
-    break;
-
-  case 7:   /* #tree */
-    if (k == null_)
-      goto _L99;
-    *success = (x.sad->dtype == treemain);
-    break;
-
-  case 8:   /* #tatom */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == tatom);
-    break;
-
-  case 9:   /* #fatom */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == fatom);
-    break;
-
-  case 10:   /* #_keyword */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == keyword);
-    break;
-
-  case 11:   /* #_specdesc */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == spec);
-    break;
-
-  case 15:   /* #len */
-    if (k == null_)
-      rr->nu = 0;
-    else {
-      switch (x.sad->dtype) {
-
-      case atom:
-      case idatom:
-      case keyword:
-      case tatom:
-      case fatom:
-	rr->nu = alen(x.sad->name, &V);
-	break;
-
-      case number:
-	/* pods~itatx ~islo zna~.cifr */
-	li_ = x.snd->val;
-	t = 0;
-	while (li_ != 0) {
-	  li_ /= 10;
-	  t++;
-	}
-	if (t == 0)
-	  t = 1;
-	if (x.snd->val < 0)
-	  t++;
-	rr->nu = t;
-	break;
-	/* number */
-
-      case listmain:
-	rr->nu = x.smld->totalelnum;
-	break;
-
-      case treemain:
-	rr->nu = x.smtd->totalarcnum;
-	break;
-
-
-      default:
-	rr->nu = 0;
-	break;
-      }/* case */
-    }
-    break;
-    /* #len */
-
-  case 14:   /* #_rulename */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (x.sad->dtype == rulename);
-    break;
-
-  case 12:   /* #_varname */
-    if (k == null_)
-      *success = false;
-    else
-      *success = (((1L << ((long)x.sad->dtype)) &
-	    ((1L << ((long)fvariable + 1)) - (1L << ((long)variable)))) != 0);
-    break;
-
-  case 16:
-  case 17:   /* #_ruletoatom, #_varntoatm */
-    if (k == null_)
-      *success = false;
-    else {
-      if (x.srd->dtype == rulename && rulenum == 16 ||
-	  (((1L << ((long)x.svd->dtype)) &
-	    ((1L << ((long)fvariable + 1)) - (1L << ((long)variable)))) != 0 &&
-	   rulenum == 17)) {
-	gets1(&s, &y.sa);
-	WITH = y.sad;
-	WITH->dtype = idatom;
-	if (rulenum == 16)
-	  WITH->name = x.srd->name;
-	else
-	  WITH->name = x.svd->name;
-	rez = s;
-      } else
-	*success = false;
-    }
-    break;
-
-  case 19:   /* #debug */
-    debugrule = true;
-    break;
-
-  case 21:   /* _content2 */
-    if ((k & 511) == 0 && k < 65536L && k >= 0)
-      *success = false;
-    else {
-      s = x.snd->val;
-      gets1(&k, &x.sa);
-      WITH1 = x.snd;
-      WITH1->dtype = number;
-      WITH1->val = s;
-      rez = k;
-    }
-    break;
-    /* _content2 */
-
-  case 22:   /* #chr */
-    if ((k & 511) == 0 && k < 65536L && k >= 0) {
-      rez = null_;
-      *success = false;
-    } else if (x.snd->dtype != number || x.snd->val > 255 || x.snd->val < 0) {
-      rez = null_;
-      *success = false;
-    } else {
-      t = x.snd->val;
-      V.mm[0] = (Char)t;
-      V.l = 1;
-      putatm(V.mm, V.l, &s);
-      gets1(&k, &x.sa);
-      WITH = x.sad;
-      if (is_rig_letter((int)t))
-	WITH->dtype = idatom;
-      else
-	WITH->dtype = atom;
-      WITH->name = s;
-      rez = k;
-    }
-    break;
-    /* chr */
-
-  case 23:   /* parm */
-    rez = null_;
-    V.l = 1;
-    while (V.l < g_argc) {
-      strcpy(s80,g_argv[(int)V.l]);
-      brt(s80);
-      if (!strcmp(s80, "-p"))
-	V.l++;
-      else
-	lconc(&rez, str_to_atom(s80));
-      V.l++;
-    }
-
-    break;
-
-
-
-
-  case 24:   /* #_totatom */
-    if (k == null_)
-      *success = false;
-    else {
-      gets1(&s, &y.sa);
-      WITH = y.sad;
-      WITH->dtype = tatom;
-      WITH->name = x.sad->name;
-      WITH->flags = 0;
-      rez = s;
-    }
-    break;
-
-  case 25:   /* #ord */
-    if ((k & 511) == 0 && k < 65536L && k >= 0) {
-      *success = false;
-      goto _L99;
-    }
-    if (((1L << ((long)x.sad->dtype)) &
-	 (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) |
-	  (1L << ((long)tatom)))) != 0) {
-      k = x.sad->name;
-      pointa(k, V.mm, &V.l);
-      rr->nu = V.mm[0];
-    } else
-      *success = false;
-    break;
-    /* ord */
-
-
-  }/* case */
-_L99:
-  if (!*success)
-    rez = null_;
-  if (n != 15 && n != 25)
-    rr->sa = rez;
-}
-
-
-
-Void mkatom(k, atype, r)
-long k;
-char atype;
-long *r;
-{
-  /* a-adres  */
-  mpd x;
-  atomdescriptor *WITH;
-
-  if (k == 0) {
-    *r = null_;
-    return;
-  }
-  gets1(r, &x.sa);
-  WITH = x.sad;
-  WITH->dtype = atype;
-  WITH->name = k;
-}  /* mkatom */
-
-
-Void crlist(l)
-long *l;
-{
-  /*  sozdatx pustoj spisok  */
-  long n;
-  mpd x;
-  mainlistdescriptor *WITH;
-
-
-  gets5(l, &x.sa);
-  WITH = x.smld;
-  WITH->dtype = listmain;
-  WITH->elnum = 0;
-  WITH->totalelnum = 0;
-  WITH->name = null_;
-  WITH->next = null_;
-  for (n = 0; n < mainlistelnum; n++)
-    WITH->elt[n] = null_;
-}  /* crlist */
-
-
-
-Static Void errstrmes(n, m)
-long n;
-Char *m;
-{
-  Char STR2[130];
-
-  switch (n) {
-
-  case 1:
-    sprintf(m, "Interpreter stack size overflow (stack size = %s);",
-	    strcpy(STR2, m));
-    break;
-
-  case 2:
-    strcpy(m, "Assignment left side is not list or tree");
-    break;
-
-  case 3:
-    strcpy(m, "List index is not number");
-    break;
-
-  case 4:
-    strcpy(m, "Using [..] not for list");
-    break;
-
-  case 5:
-    strcpy(m, "Index value exceeds list bounds");
-    break;
-
-  case 6:
-    strcpy(m, "Not list or tree after \"::\"");
-    break;
-
-  case 7:
-    strcpy(m, "Not atomic name before \"::\"");
-    break;
-
-  case 8:
-    strcpy(m, "NULL in left side of assignment");
-    break;
-
-  case 9:
-    strcpy(m, "Not numerical value in left side of \"+:=\" statement");
-    break;
-
-  case 10:
-    strcpy(m, "Not numerical value in right side of \"+:=\" statement");
-    break;
-
-  case 11:
-    strcpy(m, "File specification is not atom");
-    break;
-
-  case 12:
-    strcpy(m, "Too long file specification");
-    break;
-
-  case 13:
-    strcpy(m, "Too much open text files");
-    break;
-
-  case 14:
-    strcpy(m, "File not open for output");
-    break;
-
-  case 15:
-    strcpy(m, "Wrong file name in SAVE statement ");
-    break;
-
-  case 16:
-    strcpy(m, "File was not closed before new opening");
-    break;
-
-  case 17:
-    strcpy(m, "Atom length exceeds file record length");
-    break;
-
-  case 18:
-    strcpy(m, "Not exist file in LOAD statement ");
-    break;
-
-  case 19:
-    strcpy(m, "Wrong file name in OPEN statement ");
-    break;
-
-  case 21:
-    strcpy(m, "Selector after \".\" is not identifier ");
-    break;
-
-  case 22:
-    strcpy(m, "Selector in tree constructor is not identifier ");
-    break;
-
-  case 23:
-    strcpy(m, "Not tree before \".\" operation ");
-    break;
-
-  case 24:
-    strcpy(m, "Not tree or list as base of FORALL-IN statement ");
-    break;
-
-  case 25:
-    strcpy(m, "Atom length more than 80 bytes in #IMPLODE ");
-    break;
-
-  case 26:
-    strcpy(m, "\"BRANCHES\" option cannot be used for lists ");
-    break;
-
-  default:
-    strcpy(m, "Unknown error");
-    break;
-  }
-}
-
-
-Void er(n)
-long n;
-{
-  /* kod oshibki */
-  string80 m;
-
-  errstrmes(n, m);
-  if (out_open)
-    fprintf(out, "*** ERROR %12ld %s\n", n, m);
-  else
-    printf("*** ERROR %12ld %s\n", n, m);
-
-}  /* err */
-
-
-Void errstr(n, s)
-long n;
-Char *s;
-{
-  string80 m;
-
-  errstrmes(n, m);
-  if (out_open)
-    fprintf(out, "*** ERROR %12ld %s%s\n", n, m, s);
-  else
-    printf("*** ERROR %12ld %s%s\n", n, m, s);
-}  /* err */
-
-
-/* used for statistics only */
-Void d1(r)
-long r;
-{
-  /* called from runtime library, s=1, r=1000..1030 */
-}
-
-
-Void d(r, s)
-long r, s;
-{
-  /* called from r1..r999 r=1..999, s=1..4 */
-  if (s == 1)
-    printf(".b.%12ld\n", r);
-  if (s == 2)
-    printf(".c.%12ld\n", r);
-  if (s == 3)
-    printf(".r.%12ld\n", r);
-  if (s == 4)
-    printf(".e.%12ld\n", r);
-  /*    if s=1 then inc(dmas[r]);
-        if s=10 then for i:=1 to 200 do dmas[i]:=0;
-        if s=11 then begin
-         assign(ff,'sta.lst');
-         rewrite(ff);
-         for i:=0 to 49 do begin
-          for j:=1 to 4 do write(ff,i*4+j:3,' ',dmas[i*4+j]:4,' !');
-          writeln(ff); end;
-        close (ff);
-        end;
-    */
-
-
-}
-
-
-
-
-Void addel(sel, not_atomic, xsel, ob, tr_)
-long sel;
-boolean not_atomic;
-long xsel, ob, *tr_;
-{
-  /*===============================*/
-  /* dobawitx k derewu |lement     */
-  /*  tr := tr ++ <. sel : ob .>   */
-  /*===============================*/
-  /* wyhod s tr:=l */
-  /* wyhod bez tr:=l */
-
-  a l;   /* s-adres glawnogo derewa */
-  mpd x;   /* dostup k glawnomu deskr.derewa */
-
-
-
-
-  if (not_atomic) {
-    if (xsel == null_) {
-      er(21L);
-      goto _L2;
-    }
-    pointr(xsel, &x.sa);
-    if (x.sad->dtype != idatom) {
-      er(22L);
-      goto _L2;
-    }
-    sel = x.sad->name;
-  }
-  addel3(tr_, sel, ob);
-_L2: ;
-}
-
-
-long numval(ob)
-long ob;
-{
-  /*=============*/
-  /* ob -> ~islo */
-  /*=============*/
-  mpd x;
-
-
-  if (ob == null_)
-    return 0;
-  else {
-    pointr(ob, &x.sa);
-    if (x.snd->dtype != number)
-      return 0;
-    else
-      return (x.snd->val);   /* sign proc deleted */
-  }
-
-
-}
-
-
-/* numval*/
-
-
-
-/* End. */

RIGAL/rigsc.446/src/c4.c~

-#include "globrig.h"
-#include "define.h"
-#include "defpage.h"
-#include "nef2.h"
-#include "c1.h"
-
-boolean eqatom(m1, atm)
-long m1, atm;
-{
-  mpd x;
-  atomdescriptor *WITH;
-
-  if (m1 == null_)
-    return false;
-  else {
-    pointr(m1, &x.sa);
-    WITH = x.sad;
-    return (((1L << ((long)WITH->dtype)) & (((1L << ((long)keyword + 1)) -
-		 (1L << ((long)atom))) | (1L << ((long)fatom)))) != 0 &&
-	    WITH->name == atm);
-  }
-}
-
-
-Void varpat(pl, tip, rez, success)
-ptr_ *pl;
-char tip;
-long *rez;
-boolean *success;
-{
-  mpd x;
-  atomdescriptor *WITH;
-
-
-  *rez = pl->cel;
-  if (pl->nel == 0 || *rez == null_)
-    *success = false;
-  else {
-    pointr(*rez, &x.sa);
-    WITH = x.sad;
-    *success = (WITH->dtype == tip);
-  }
-  if (*success) {
-    if (pl->ptrtype != ptrtree)
-      next(pl);
-  } else
-    *rez = null_;
-}  /* varpat */
-
-
-Void atmpat(aconval, pl, rez, success)
-long aconval;
-ptr_ *pl;
-long *rez;
-boolean *success;
-{
-  mpd x;
-  atomdescriptor *WITH;
-
-
-  *rez = pl->cel;
-  if (pl->nel == 0 || *rez == null_)
-    *success = false;
-  else {
-    pointr(*rez, &x.sa);
-    WITH = x.sad;
-    *success = ((WITH->dtype == atom || WITH->dtype == idatom ||
-		 WITH->dtype == keyword ||
-		 WITH->dtype == fatom) && WITH->name == aconval);
-    /* tatom removed from this set 25-july 1989 */
-  }
-  if (*success) {
-    if (pl->ptrtype != ptrtree)
-      next(pl);
-  } else
-    *rez = null_;
-}  /* atmpat */
-
-
-
-boolean eqnum(m1, n)
-long m1, n;
-{
-  mpd x;
-  numberdescriptor *WITH;
-
-
-  if (m1 == null_)
-    return false;
-  else {
-    pointr(m1, &x.sa);
-    WITH = x.snd;
-    return (WITH->dtype == number && WITH->val == n);
-  }
-}  /* eqnum */
-
-
-
-boolean eqop(o, a1, a2)
-long o, a1, a2;
-{
-  /* cequ(=), cnequ(<>) */
-  /*====================================*/
-  /*   rawenstwo/ nerawenstwo obxektow  */
-  /* whod: a1             a2            */
-  /* wyhod:  true / false w rez1        */
-  /*====================================*/
-  /*wyhod */
-
-  mpd x, y;
-  boolean rez;
-  ptr_ px, py;
-
-
-
-  rez = true;
-  if (a2 == null_) {
-    if (a1 == null_)
-      goto _L1;
-    else {
-      pointr(a1, &x.sa);
-      rez = (((1L << ((long)x.smld->dtype)) &
-	      ((1L << ((long)listmain)) | (1L << ((long)treemain)))) != 0 &&
-	     x.smld->totalelnum == 0);
-      goto _L1;
-    }
-  }  /* a2 =null */
-  pointr(a2, &x.sa);
-  if (a1 == null_) {
-    rez = (((1L << ((long)x.smld->dtype)) &
-	    ((1L << ((long)listmain)) | (1L << ((long)treemain)))) != 0 &&
-	   x.smld->totalelnum == 0);
-    goto _L1;
-  }
-  pointr(a1, &y.sa);
-  /* oba ne null */
-  switch (x.smld->dtype) {
-
-  case variable:
-  case idvariable:
-  case nvariable:
-  case fvariable:
-  case spec:
-  case rulename:   /* coord removed */
-    rez = (memcmp(x.sc8, y.sc8, sizeof(atomdescriptor)) == 0);
-    break;
-
-  case number:
-    rez = (y.snd->dtype == number && x.snd->val == y.snd->val);
-    break;
-
-
-  case atom:
-  case idatom:
-  case keyword:
-  case tatom:
-  case fatom:
-    rez = (((1L << ((long)y.sad->dtype)) &
-	    (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) |
-	     (1L << ((long)tatom)) | (1L << ((long)fatom)))) != 0 &&
-	   x.sad->name == y.sad->name);
-    break;
-
-  case listmain:
-    rez = (x.smld->totalelnum == y.smld->totalelnum &&
-	   y.smld->dtype == listmain);
-    if (rez) {
-      first(a1, &px);
-      first(a2, &py);
-      while (rez && px.nel != 0) {
-	rez = eqop(o, px.cel, py.cel);
-	next(&px);
-	next(&py);
-      }  /* while */
-    }
-    break;
-
-  case treemain:
-    rez = (x.smtd->totalarcnum == y.smtd->totalarcnum &&
-	   y.smtd->dtype == treemain);
-    if (rez) {
-      first(a1, &px);
-      while (rez && px.nel != 0) {
-	first(a2, &py);
-	while (py.nel != 0 && px.UU.U1.arc != py.UU.U1.arc)
-	  next(&py);
-	if (py.nel == 0)
-	  rez = false;
-	else
-	  rez = eqop(o, px.cel, py.cel);
-	next(&px);
-      }  /* while */
-    }
-    break;
-  }/* case */
-_L1:
-  return rez;
-
-  /* a2 <>null */
-}  /* eqop */
-
-
-/* c4.pas */
-
-boolean compare(op, a1, a2)
-long op, a1, a2;
-{
-  /* kod operacii */
-  /*=======================*/
-  /* operacii              */
-  /*      > < >= <=        */
-  /* whod:                 */
-  /*         a1   a2       */
-  /* wyhod:                */
-  /*           a1 op a2    */
-  /*=======================*/
-  boolean Result;
-  /* wyhod */
-
-  mpd x;
-  longint n[2];   /* changed 17-nov-90 */
-  aa a_adr[2];
-  char dts[2];
-
-
-  Result = false;
-
-  if (a1 == null_) {
-    n[0] = 0;
-    dts[0] = dummy;
-  } else {
-    pointr(a1, &x.sa);
-    n[0] = x.snd->val;
-    dts[0] = x.snd->dtype;
-    a_adr[0] = x.sad->name;
-  }
-
-  if (a2 == null_) {
-    n[1] = 0;
-    dts[1] = dummy;
-  } else {
-    pointr(a2, &x.sa);
-    n[1] = x.snd->val;
-    dts[1] = x.snd->dtype;
-    a_adr[1] = x.sad->name;
-  }
-
-  if ((dts[0] == dummy || dts[0] == number) &&
-      (dts[1] == dummy || dts[1] == number)) {
-    Result = (op == 3 && n[0] > n[1] || op == 1 && n[0] < n[1] ||
-	      op == 4 && n[0] >= n[1] || op == 2 && n[0] <= n[1]);
-
-  } else {
-    if (((1L << ((long)dts[0])) & ((1L << ((long)atom)) | (1L << ((long)idatom)) |
-	   (1L << ((long)keyword)) | (1L << ((long)tatom)))) != 0) {
-      if (((1L << ((long)dts[1])) &
-	   ((1L << ((long)atom)) | (1L << ((long)idatom)) |
-	    (1L << ((long)keyword)) | (1L << ((long)tatom)))) != 0) {
-	Result = compatom(op, a_adr[0], a_adr[1]);
-
-      } else {
-	if (dts[1] == dummy)
-	  Result = (op > 2);
-      }
-
-    } else {
-      if (dts[0] == dummy &&
-	  ((1L << ((long)dts[1])) & ((1L << ((long)atom)) | (1L << ((long)idatom)) |
-	     (1L << ((long)keyword)) | (1L << ((long)tatom)))) != 0)
-	Result = (op < 3);
-    }
-  }
-
-
-
-
-_L33:
-  return Result;
-
-
-}  /* compare */
-
-
-
-
-
-/* End. */