Skip to content
Snippets Groups Projects
Commit e27bd695 authored by Mike Collins's avatar Mike Collins
Browse files

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.
parent f6292103
No related branches found
No related tags found
No related merge requests found
Showing
with 0 additions and 1971 deletions
hanoi
-- 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;
/##
#!/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
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.
File moved
File moved
/*#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));
/****** 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];
rig_lint
l_anal
l_operat
l_instr
l_patt
l_patt2
l_patt3
l_exprs
l_expr1
l_closur
l_check
#!/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
#
# 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)
#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. */
File deleted
File deleted
File deleted
#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. */
File deleted
File deleted
File deleted
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment