diff --git a/RIGAL/rigsc.446/doc/langdesc.html b/RIGAL/rigsc.446/doc/langdesc.html index df78350a867c71c4bc11a26a30290989339f32f3..31a80cf58260d3757c71254c9e10372e052c5d71 100644 --- a/RIGAL/rigsc.446/doc/langdesc.html +++ b/RIGAL/rigsc.446/doc/langdesc.html @@ -1458,7 +1458,7 @@ Notes in Computer Science, Vol.180, Springer-Verlag, Berlin, 1984. <p> [9] R.Vilhelm. Presentation of the compiler generation system MUG2: Examples, global flow analysis and optimization// Le point -sur la compilation, INRIA, 1978, à.307-336. +sur la compilation, INRIA, 1978, �.307-336. <p> [10] Basic REFAL and its implementation on computers.// CNIPIASS, Moscow, 1977, (in Russian). <p> [11] P.Lucas. Formal definition of programming languages and diff --git a/RIGAL/rigsc.446/doc/langdesc.txt b/RIGAL/rigsc.446/doc/langdesc.txt index f2327c3ebdfc322933a3b8bb28f49a213f55651e..79fd82af7eb4f2d256fa9cc86a0f6edea3f62963 100644 --- a/RIGAL/rigsc.446/doc/langdesc.txt +++ b/RIGAL/rigsc.446/doc/langdesc.txt @@ -1405,7 +1405,7 @@ Notes in Computer Science, Vol.180, Springer-Verlag, Berlin, 1984. [9] R.Vilhelm. Presentation of the compiler generation system MUG2: Examples, global flow analysis and optimization// Le point -sur la compilation, INRIA, 1978, à.307-336. +sur la compilation, INRIA, 1978, �.307-336. [10] Basic REFAL and its implementation on computers.// CNIPIASS, Moscow, 1977, (in Russian). [11] P.Lucas. Formal definition of programming languages and diff --git a/RIGAL/rigsc.446/include/c1.h b/RIGAL/rigsc.446/include/c1.h index 86c9ed2ee7823afe03c241bed4d2807db61258db..05c7670410c6f516498b8e7b6f227e07d827872c 100644 --- a/RIGAL/rigsc.446/include/c1.h +++ b/RIGAL/rigsc.446/include/c1.h @@ -1,65 +1,62 @@ -#ifndef _MONTEREYPHOENIXC1_ -#define _MONTEREYPHOENIXC1_ - /*#define xxx printf("lin=%d file=%s\n",__LINE__,__FILE__);*/ #define xxx ; int g_argc; -Char ** g_argv; +char ** g_argv; typedef union v { a sa; /* s -adres */ longint nu; - boolean bo; + bool bo; a at; /* a -adres */ } v; -boolean debugrule; /* to be used in future */ -Char filebuf[2048]; +bool debugrule; /* to be used in future */ +char filebuf[2048]; /************ definitions in c1 ***************/ -extern Void er PP((long n)); +extern void er PP((long n)); /* kod o{ibki */ -extern Void errstr PP((long n, Char *s)); +extern void errstr PP((long n, char *s)); -extern Void crlist PP((long *l)); +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 d PP((long r, long s));*/ +extern void d PP((long status_r ,char * rulename,long rulenum,long param,bool success)); -extern Void d1 PP((long r)); +extern void d1 PP((long r)); /*$endif*/ -extern Void addel PP((long sel, boolean not_atomic, long xsel, long ob, long *tr_)); +extern void addel PP((long sel, bool 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)); +extern void bltin PP((v *rr, bool *success, long arg, long n)); /* a-adres */ -extern Void mkatom PP((long k, char atype, long *r)); +extern void mkatom PP((long k, char atype, long *r)); /*************** c2 *****************/ -extern Void concop PP((long *a1, long a2)); +extern void concop PP((long *a1, long a2)); -extern Void indxop PP((long xx, boolean isobject, long xa, long l, long *rez)); +extern void indxop PP((long xx, bool isobject, long xa, long l, long *rez)); -extern Void selop PP((long xn, boolean not_atomic, long xa, long tr_, long *rez)); +extern void selop PP((long xn, bool not_atomic, long xa, long tr_, long *rez)); -extern Void setind PP((long xx, boolean isobject, long xa, long l, long rez)); +extern void setind PP((long xx, bool isobject, long xa, long l, long rez)); -extern Void setsel PP((long xn, boolean not_atomic, long xa, long tr_, long rez)); +extern void setsel PP((long xn, bool not_atomic, long xa, long tr_, long rez)); -extern Void addnum PP((long *a1, long a2)); +extern void addnum PP((long *a1, long a2)); -extern Void copyop PP((long ob, long *rez)); +extern void copyop PP((long ob, long *rez)); /* ******************* c3 ******************* */ @@ -67,56 +64,54 @@ extern Void copyop PP((long ob, long *rez)); #define max_digit 10 -extern Void epilog PV(); +extern void epilog PV(); -extern Void prolog 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)); +extern void outxt PP((long fname, long arg, bool nl, bool blanks)); /* a-adr.imeni fajla*/ /* wywodimyj atom*/ /* s now.stroki*/ /* s probelami*/ -extern Void outatm PP((long fname, Char *arg, boolean nl, boolean blanks)); +extern void outatm PP((long fname, char *arg, bool nl, bool blanks)); /* a-adres imeni fajla*/ /* s-adr.*/ -extern Void opn PP((long fname, long fspec)); +extern void opn PP((long fname, long fspec)); /* 0-load,1 -save*/ -extern Void loasav PP((v *p, long f, long paz)); +extern void loasav PP((v *p, long f, long paz)); -extern Void explod PP((long kk, long *rez)); +extern void explod PP((long kk, long *rez)); -extern Void implod PP((ptr_ *pl, long *rez)); +extern void implod PP((ptr_ *pl, long *rez)); -extern Void bltin1 PP((long *rez, boolean *success, ptr_ *pl, long n)); +extern void bltin1 PP((long *rez, bool *success, ptr_ *pl, long n)); /* a-adr.*/ -extern Void clsfil PP((long fname)); +extern void clsfil PP((long fname)); /**************** c4 ******************* */ /* cequ(=), cnequ(<>) */ -extern boolean eqop PP((long o, long a1, long a2)); +extern bool eqop PP((long o, long a1, long a2)); -extern Void varpat PP((ptr_ *pl, char tip, long *rez, boolean *success)); +extern void varpat PP((ptr_ *pl, char tip, long *rez, bool *success)); -extern Void atmpat PP((long aconval, ptr_ *pl, long *rez, boolean *success)); +extern void atmpat PP((long aconval, ptr_ *pl, long *rez, bool *success)); -extern boolean eqnum PP((long m1, long n)); +extern bool eqnum PP((long m1, long n)); -extern boolean eqatom PP((long m1, long atm)); +extern bool eqatom PP((long m1, long atm)); /* kod operacii */ -extern boolean compare PP((long op, long a1, long a2)); - -extern Void indxcon PP((xx, isobject, xa, l1, l2)); +extern bool compare PP((long op, long a1, long a2)); -extern Void indxaddtre PP((xx, isobject, xa, l1, l2)); -#endif +extern void indxcon PP((xx, isobject, xa, l1, l2)); +extern void indxaddtre PP((xx, isobject, xa, l1, l2)); diff --git a/RIGAL/rigsc.446/include/cim.h b/RIGAL/rigsc.446/include/cim.h index 5e8bb0c7f3da1307467c82f5df76ba9e054fbf3d..621ca09dab56923b5c792d8e7d30376d755f8a64 100644 --- a/RIGAL/rigsc.446/include/cim.h +++ b/RIGAL/rigsc.446/include/cim.h @@ -1,6 +1,4 @@ -#ifndef _MONTEREYPHOENIXCIM_ -#define _MONTEREYPHOENIXCIM_ -/* from glovar */ + /* from glovar */ #define varnum 2000 /* dlina steka lokalxnyh peremennyh, was 500 */ @@ -18,13 +16,13 @@ long sbase; /* tek. dlina vs */ a teklexem; /* tek.zna~enie $$ */ /* ustanawl.w spatt i vpatt */ -boolean break_; /* true -prerwatx ohwatyw. iteratiwnu` */ +bool break_; /* true -prerwatx ohwatyw. iteratiwnu` */ /* konstrukci` */ -boolean continue_; /* false -w prawile wypolnilsq */ +bool continue_; /* false -w prawile wypolnilsq */ /* return ili fail */ -boolean fail; /* byl operator fail(=true) */ +bool fail; /* byl operator fail(=true) */ a atomt; /* s-adres atoma t, sozd. w prolog */ -boolean debugrule; /* true-wkl`~ena trassirowka */ +bool debugrule; /* true-wkl`~ena trassirowka */ a atomrules, atomnorules; /* adresa atomow rules,norules -sozd.w prolog */ /* ispolxz. w debug */ @@ -34,94 +32,94 @@ long run_param_cnt; /* kod o{ibki */ -extern Void err PP((long n)); +extern void err PP((long n)); -extern Void getval PP((long *m)); +extern void getval PP((long *m)); /* kod o{ibki */ -extern Void errstr PP((long n, Char *s)); +extern void errstr PP((long n, char *s)); /* usepasu */ /*interpreter access*/ /* number of option */ /* pointer to argument list */ -extern Void usepas PP((long n, ptr_ *pl, long *rez)); +extern void usepas PP((long n, ptr_ *pl, long *rez)); /* result */ /* from psu */ -extern Void push PV(); +extern void push PV(); -extern Void pratom PP((long aa_)); +extern void pratom PP((long aa_)); /* adres nom.wstr.prawila */ -extern Void prblt PP((long nn)); +extern void prblt PP((long nn)); /* adres w sr-prostr. (<>0) deskr.atoma */ /* ili peremennoj w {ablone */ /* adres w st-prostr. (<>0) glawnogo */ /* fragmenta deskr.spiska */ -extern boolean compnames PP((long p, long ld)); +extern bool compnames PP((long p, long ld)); -extern Void srchrule PP((long rd, ptr_ *pp)); +extern void srchrule PP((long rd, ptr_ *pp)); -extern Void srchrule1 PP((long rd, ptr_ *pp)); +extern void srchrule1 PP((long rd, ptr_ *pp)); -extern Void lastop PV(); +extern void lastop PV(); /* from aru */ /* kod op. */ -extern Void arithm PP((long op)); +extern void arithm PP((long op)); -extern Void unmins PV(); +extern void unmins PV(); -extern Void selctr PV(); +extern void selctr PV(); /* cequ(=), cnequ(<>) */ -extern Void eqop PP((long o)); +extern void eqop PP((long o)); /* cequ(=), cnequ(<>) */ -extern Void eqop1 PP((long o, long a1, long a2, boolean *rez1)); +extern void eqop1 PP((long o, long a1, long a2, bool *rez1)); -extern Void copyop PV(); +extern void copyop PV(); -extern Void indxop PV(); +extern void indxop PV(); -extern Void add PP((long *d, long *r)); +extern void add PP((long *d, long *r)); /* from beiu */ -extern Void concop PP((long *a1, long a2)); +extern void concop PP((long *a1, long a2)); -extern Void nameop PV(); +extern void nameop PV(); -extern Void explode PP((long kk, long *rez)); +extern void explode PP((long kk, long *rez)); /* 1-j argument */ /* nomer wstr.prawila */ -extern Void bltin PP((long *rez, boolean *success, ptr_ *pl, long n)); +extern void bltin PP((long *rez, bool *success, ptr_ *pl, long n)); /* 1-j argument */ -extern Void implode PP((ptr_ *pl, long *rez)); +extern void implode PP((ptr_ *pl, long *rez)); /* from ci */ -extern Void rule PP((long *rez, boolean *success, ptr_ *pl, ptr_ *pp)); +extern void rule PP((long *rez, bool *success, ptr_ *pl, ptr_ *pp)); -extern Void expression PP((ptr_ *c, long *rez)); +extern void expression PP((ptr_ *c, long *rez)); -extern Void pattern PP((long *rez, boolean *success, ptr_ *pl, ptr_ *p)); +extern void pattern PP((long *rez, bool *success, ptr_ *pl, ptr_ *p)); -extern Void statement PP((long p, boolean *succ, long *rez)); +extern void statement PP((long p, bool *succ, long *rez)); -extern Void contre PP((ptr_ *c)); +extern void contre PP((ptr_ *c)); -extern Void objexpr PP((ptr_ *c, long *nvar, boolean *t)); +extern void objexpr PP((ptr_ *c, long *nvar, bool *t)); /* tip operatora (specadres)*/ /* ssylka na deskriptor spiska operatora */ -extern Void assgn PP((long ot, long p)); +extern void assgn PP((long ot, long p)); /* s-adres spiska operatora w sr-prostranstwe*/ @@ -129,45 +127,45 @@ extern Void assgn PP((long ot, long p)); neuspeha iz fail */ /* dlq wozwrata rezulxtata iz return */ -extern Void cond PP((long p, boolean *succ, long *rez)); +extern void cond PP((long p, bool *succ, long *rez)); /* s-adres spiska operatora */ /* dlq wozwrata neuspeha iz fail */ /* dlq wozwrata rez.iz return */ -extern Void loop PP((long p, boolean *succ, long *rez)); +extern void loop PP((long p, bool *succ, long *rez)); -extern Void inout PP((long p, long ot)); +extern void inout PP((long p, long ot)); /* ukaz.na 1-` leksemu */ /* prodwigaetsq wpered */ /* adres |l-ta {ablona (alxternatiwa) */ -extern Void alter PP((long *rez, boolean *success, ptr_ *pl, long p)); +extern void alter PP((long *rez, bool *success, ptr_ *pl, long p)); /* ukaz.tek.leksemu */ /* s-adres |l-ta {ablona */ /* (+...+) -true, (*...* )- false */ -extern Void starlist PP((long *rez, boolean *success, ptr_ *pl, long p, - boolean pluslist)); +extern void starlist PP((long *rez, bool *success, ptr_ *pl, long p, + bool pluslist)); /* ukaz.na 1-` leksemu, */ /* prodwigaetsq wpered */ /* s-adres |l-ta {ablona */ -extern Void facult PP((long *rez, boolean *success, ptr_ *pl, long p)); +extern void facult PP((long *rez, bool *success, ptr_ *pl, long p)); /* ukazatelx na deskriptor derewa leksem */ /* |l-t {ablona */ -extern Void tree PP((long *parmrez, boolean *parmsuccess, ptr_ *parmpl, - long p, boolean star)); +extern void tree PP((long *parmrez, bool *parmsuccess, ptr_ *parmpl, + long p, bool star)); /* ukazatelx na deskriptor spiska (leksema) */ /* ukazatelx na |l-t {ablona */ -extern Void list PP((long *rez, boolean *success, ptr_ *pl, long p)); +extern void list PP((long *rez, bool *success, ptr_ *pl, long p)); /* spat or vpat */ -extern Void spatt PP((long *rez, boolean *success, ptr_ *pl, long p, long y)); +extern void spatt PP((long *rez, bool *success, ptr_ *pl, long p, long y)); /*===================*/ /* s-, ili v- {ablon */ @@ -175,17 +173,16 @@ extern Void spatt PP((long *rez, boolean *success, ptr_ *pl, long p, long y)); /* tek.leksema */ /* ukazatelx na spisok wetwi (prostogo prawila)*/ -extern Void simple PP((long *rez, boolean *success, ptr_ *pl, long p)); +extern void simple PP((long *rez, bool *success, ptr_ *pl, long p)); /* na~alo konstruktora, a'13312. */ /* c prodw.wpered, rez. (. .) w */ /* steke v[ ] */ -extern Void conlst PP((ptr_ *c)); +extern void conlst PP((ptr_ *c)); -extern Void int11 PP((boolean debug, long code)); +extern void int11 PP((bool debug, long code)); -extern Void prolog PP((ptr_ *y, boolean debug, long code)); +extern void prolog PP((ptr_ *y, bool debug, long code)); -extern Void epilog PV(); -#endif +extern void epilog PV(); diff --git a/RIGAL/rigsc.446/include/def180.h b/RIGAL/rigsc.446/include/def180.h index cb3c559cd82188697b43e6515fca4a2d1187163b..8f5e25d912fb667075485abd9cd9f7c4b2f509b9 100644 --- a/RIGAL/rigsc.446/include/def180.h +++ b/RIGAL/rigsc.446/include/def180.h @@ -1,88 +1,85 @@ -#ifndef _MONTEREYPHOENIXDEF180_ -#define _MONTEREYPHOENIXDEF180_ typedef union allpacked { bl80 bl; - Char p1; - Char p2[2]; - Char p3[3]; - Char p4[4]; - Char p5[5]; - Char p6[6]; - Char p7[7]; - Char p8[8]; - Char p9[9]; - Char p10[10]; - Char p11[11]; - Char p12[12]; - Char p13[13]; - Char p14[14]; - Char p15[15]; - Char p16[16]; - Char p17[17]; - Char p18[18]; - Char p19[19]; - Char p20[20]; - Char p21[21]; - Char p22[22]; - Char p23[23]; - Char p24[24]; - Char p25[25]; - Char p26[26]; - Char p27[27]; - Char p28[28]; - Char p29[29]; - Char p30[30]; - Char p31[31]; - Char p32[32]; - Char p33[33]; - Char p34[34]; - Char p35[35]; - Char p36[36]; - Char p37[37]; - Char p38[38]; - Char p39[39]; - Char p40[40]; - Char p41[41]; - Char p42[42]; - Char p43[43]; - Char p44[44]; - Char p45[45]; - Char p46[46]; - Char p47[47]; - Char p48[48]; - Char p49[49]; - Char p50[50]; - Char p51[51]; - Char p52[52]; - Char p53[53]; - Char p54[54]; - Char p55[55]; - Char p56[56]; - Char p57[57]; - Char p58[58]; - Char p59[59]; - Char p60[60]; - Char p61[61]; - Char p62[62]; - Char p63[63]; - Char p64[64]; - Char p65[65]; - Char p66[66]; - Char p67[67]; - Char p68[68]; - Char p69[69]; - Char p70[70]; - Char p71[71]; - Char p72[72]; - Char p73[73]; - Char p74[74]; - Char p75[75]; - Char p76[76]; - Char p77[77]; - Char p78[78]; - Char p79[79]; - Char p80[80]; + char p1; + char p2[2]; + char p3[3]; + char p4[4]; + char p5[5]; + char p6[6]; + char p7[7]; + char p8[8]; + char p9[9]; + char p10[10]; + char p11[11]; + char p12[12]; + char p13[13]; + char p14[14]; + char p15[15]; + char p16[16]; + char p17[17]; + char p18[18]; + char p19[19]; + char p20[20]; + char p21[21]; + char p22[22]; + char p23[23]; + char p24[24]; + char p25[25]; + char p26[26]; + char p27[27]; + char p28[28]; + char p29[29]; + char p30[30]; + char p31[31]; + char p32[32]; + char p33[33]; + char p34[34]; + char p35[35]; + char p36[36]; + char p37[37]; + char p38[38]; + char p39[39]; + char p40[40]; + char p41[41]; + char p42[42]; + char p43[43]; + char p44[44]; + char p45[45]; + char p46[46]; + char p47[47]; + char p48[48]; + char p49[49]; + char p50[50]; + char p51[51]; + char p52[52]; + char p53[53]; + char p54[54]; + char p55[55]; + char p56[56]; + char p57[57]; + char p58[58]; + char p59[59]; + char p60[60]; + char p61[61]; + char p62[62]; + char p63[63]; + char p64[64]; + char p65[65]; + char p66[66]; + char p67[67]; + char p68[68]; + char p69[69]; + char p70[70]; + char p71[71]; + char p72[72]; + char p73[73]; + char p74[74]; + char p75[75]; + char p76[76]; + char p77[77]; + char p78[78]; + char p79[79]; + char p80[80]; } allpacked; -#endif diff --git a/RIGAL/rigsc.446/include/define.h b/RIGAL/rigsc.446/include/define.h index 177bc6389f0908122a7c10f89b935e9426e1ad4d..49a1e7d5f33928d24c9168f9e58441c7f43dcafa 100644 --- a/RIGAL/rigsc.446/include/define.h +++ b/RIGAL/rigsc.446/include/define.h @@ -1,6 +1,3 @@ -#ifndef _MONTEREYPHOENIXDEFINE_ -#define _MONTEREYPHOENIXDEFINE_ - /****** define.h *****/ /* the declaration of main data structures of s-space for rigal/ unix; @@ -120,7 +117,7 @@ typedef long longint; typedef unsigned short word; /* must be 2 byte positive integer */ -typedef Char string80[81]; +typedef char string80[81]; typedef short byte_type; @@ -131,12 +128,12 @@ typedef long a; typedef long aa; /* adresses of a-space */ -typedef Char c2[2]; /* =2. bytes */ -typedef Char c4[4]; +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*/ +typedef char bl80[80]; +typedef char a80[80]; +typedef char real_char[sizeof(double)]; /*added 17-feb-92*/ #define dummy 0 #define listmain 1 @@ -211,7 +208,7 @@ typedef Char real_char[sizeof(double)]; /*added 17-feb-92*/ mainlistdescriptor= record (* =40. bytes *) dtype : descriptortype; (* =1. bytes *) flags : 0 ..31; (* =1. bytes *) - xx : array [ 1 .. 1 ] of boolean;(* =1. bytes *) + xx : array [ 1 .. 1 ] of bool;(* =1. bytes *) elnum : 0 ..mainlistelnum; (* =1. bytes *) totalelnum : longint; (* =4. bytes *) name : aa; (* =4. bytes *) @@ -219,11 +216,12 @@ mainlistdescriptor= record (* =40. bytes *) next : a; end; (* =4. bytes *) */ -typedef struct mainlistdescriptor { +typedef struct mainlistdescriptor +{ /* =40. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ - boolean xx[1]; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ char elnum; /* =1. bytes */ longint totalelnum; /* =4. bytes */ aa name; /* =4. bytes */ @@ -232,47 +230,52 @@ typedef struct mainlistdescriptor { a next; } mainlistdescriptor; /* =4. bytes */ -typedef struct fragmlistdescriptor { +typedef struct fragmlistdescriptor +{ /* =40. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ char elnum; /* =1. bytes */ - boolean xx[1]; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ a elt[fragmlistelnum]; /* =8*4=32. bytes */ a next; } fragmlistdescriptor; /* =4. bytes */ -typedef struct te { +typedef struct te +{ aa arcname; /* =8=4+4. bytes */ a elt; } te; -typedef struct maintreedescriptor { +typedef struct maintreedescriptor +{ /* =40. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ char arcnum; /* =1. bytes */ - boolean xx[1]; /* =1. bytes */ + bool 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 { +typedef struct fragmtreedescriptor +{ /* =40. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ char arcnum; /* =1. bytes */ - boolean xx[1]; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ te arc[fragmtreearcnum]; /* =8*4=32. bytes */ a next; } fragmtreedescriptor; /* =4. bytes */ -typedef struct atomdescriptor { +typedef struct atomdescriptor +{ /* =8. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ @@ -282,7 +285,8 @@ typedef struct atomdescriptor { aa name; /* =4. bytes */ } atomdescriptor; -typedef struct numberdescriptor { +typedef struct numberdescriptor +{ /* =8. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ @@ -290,16 +294,18 @@ typedef struct numberdescriptor { longint val; /* signed */ } numberdescriptor; /* =4. bytes */ -typedef struct vardescriptor { +typedef struct vardescriptor +{ /* =8. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ - boolean guard; /* =1. bytes */ + bool guard; /* =1. bytes */ char location; /* =1. bytes */ aa name; } vardescriptor; /* =4. bytes */ -typedef struct ruledescriptor { +typedef struct ruledescriptor +{ /* =16. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ @@ -310,19 +316,21 @@ typedef struct ruledescriptor { } ruledescriptor; -typedef struct specdescriptor { +typedef struct specdescriptor +{ /* =8. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ - boolean xx[2]; /* =2. bytes */ + bool xx[2]; /* =2. bytes */ longint val; } specdescriptor; /* =4. bytes */ -typedef struct objdescriptor { +typedef struct objdescriptor +{ /* =16. bytes */ char dtype; /* =1. bytes */ char flags; /* =1. bytes */ - boolean variable_; /* =1. bytes */ + bool variable_; /* =1. bytes */ char nel; /* =1. bytes */ a fragmorvar; /* =4. bytes */ @@ -332,22 +340,23 @@ typedef struct objdescriptor { typedef a a10_type[10]; -typedef union mpd { +typedef union mpd +{ /* multiply pointers to descriptors */ a sa; - mainlistdescriptor *smld; + mainlistdescriptor *smld; fragmlistdescriptor *sfld; - maintreedescriptor *smtd; + maintreedescriptor *smtd; fragmtreedescriptor *sftd; - atomdescriptor *sad; - numberdescriptor *snd; - vardescriptor *svd; - ruledescriptor *srd; - atomdescriptor *sc8; - specdescriptor *sspec; - objdescriptor *sobj; - Char *sbl80; - long *sa10; + atomdescriptor *sad; + numberdescriptor *snd; + vardescriptor *svd; + ruledescriptor *srd; + atomdescriptor *sc8; + specdescriptor *sspec; + objdescriptor *sobj; + char *sbl80; + long *sa10; } mpd; /* =4. bytes */ #define ptrlist 0 @@ -391,9 +400,9 @@ typedef struct 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]; +typedef char filename_type[81]; +typedef char checker_message_type[81]; +typedef char filespecification[81]; @@ -408,8 +417,8 @@ typedef struct error_rec_type { typedef struct _REC_filetab { a name; /* a-address of rigal file */ - boolean isopen; /* */ - boolean screen; + bool isopen; /* */ + bool screen; long strlen; /* specified max length */ long curlen; /* current length */ } _REC_filetab; @@ -421,5 +430,4 @@ _REC_filetab filetab[filenum]; FILE *files[filenum]; -#endif diff --git a/RIGAL/rigsc.446/include/defpage.h b/RIGAL/rigsc.446/include/defpage.h index 44a22b7e309262e7a6adf051df4a384eb66c2cc0..db08aa22e8bb2a70cd0d33662f8d1ca3f851c238 100644 --- a/RIGAL/rigsc.446/include/defpage.h +++ b/RIGAL/rigsc.446/include/defpage.h @@ -1,65 +1,63 @@ -#ifndef _MONTEREYPHOENIXDEFPAGE_ -#define _MONTEREYPHOENIXDEFPAGE_ /******* defpage.h *********/ -extern Void opena PV(); +extern void opena PV(); /********* putatm input ad : address of first char na : length of charstring output e : a_pointer for this atom **/ -extern Void putatm PP((Char *ad, long na, long *e)); +extern void putatm PP((char *ad, long na, long *e)); /********* pointa input e : a_pointer output ad: charstring na: length of charstring **/ -extern Void pointa PP((long e, Char *ad, long *na)); +extern void pointa PP((long e, char *ad, long *na)); -extern Void savea PV(); +extern void savea PV(); -extern Void closea PV(); +extern void closea PV(); extern void opens (); /********* loads input f : file specifikation string output e : s_pointer of loud object **/ -extern Void loads PP((Char *f, long *e)); +extern void loads PP((char *f, long *e)); /********* saves input f : file specification string e : s_pointer of object to be saved output none ***********************/ -extern Void saves PP((Char *f, long *e)); +extern void saves PP((char *f, long *e)); -extern Void savesn PP((Char *f, long *e)); +extern void savesn PP((char *f, long *e)); -extern Void reopen PP((long *f, long *e)); +extern void reopen PP((long *f, long *e)); /********* reopen e : old s_pointer f : new s_pointer */ /********* getsn input none output e1 : s_pointer of new memory e2 : address of new memory **/ -extern Void gets1 PP((long *e1, long *e2)); +extern void gets1 PP((long *e1, long *e2)); -extern Void gets2 PP((long *e1, long *e2)); +extern void gets2 PP((long *e1, long *e2)); -extern Void gets5 PP((long *e1, long *e2)); +extern void gets5 PP((long *e1, long *e2)); /********* pointx input e1 : s_pointer of object output e2 : address of object **/ -extern Void points PP((long e1, long *e2)); +extern void assert_and_assign_real_pointer PP((long e1, long *e2)); -extern Void pointr PP((long e1, long *e2)); +extern void assert_and_assign_real_pointer PP((long e1, long *e2)); /********* closes input none output none **/ -extern Void closes PV(); +extern void closes PV(); /********* voly input none output k : number of disc reads l : number of disc writes m : number of pages on ddisc **/ -extern Void vola PP((long *dr, long *dw, long *dp)); +extern void vola PP((long *dr, long *dw, long *dp)); -extern Void vols PP((long *dr, long *dw, long *dp)); +extern void vols PP((long *dr, long *dw, long *dp)); #define max_printconst 15 @@ -67,45 +65,46 @@ extern Void vols PP((long *dr, long *dw, long *dp)); FILE *out; /* file used as print file */ -boolean out_screen; /* works pscr, not pout */ -boolean out_open; /* this file is open for output */ +bool out_screen; /* works pscr, not pout */ +bool out_open; /* this file is open for output */ long max_printlevel; /* maximum level of nested prints */ -Char vdname; /* drive name used as ram disk , "winm-" only */ +char vdname; /* drive name used as ram disk , "winm-" only */ -extern boolean existfile PP((Char *fname)); +extern bool existfile PP((char *fname)); -extern boolean rightfile PP((Char *fname)); +extern bool rightfile PP((char *fname)); -extern Char *aa_str PP((Char *Result, long a1)); +extern char *aa_str PP((char *Result, long a1)); extern long long_to_atom PP((long a_long)); -extern long str_to_atom PP((Char *ssr)); -extern long str_to_textatom PP((Char *ssr)); +extern long str_to_atom PP((char *ssr)); +extern long str_to_textatom PP((char *ssr)); -extern Void val PP((Char *m, long *intval, long *rez)); +extern void val PP((char *m, long *intval, long *rez)); -extern Void init_dinform PV(); +extern void init_dinform PV(); /*procedure argv(i:integer;var rez:string80); extern; function argc:integer; extern;*/ -extern Char *long_to_str PP((Char *Result, long int_)); +extern char *long_to_str PP((char *Result, long int_)); -extern Char *real_to_string PP((Char *Result, double ar)); +extern char *real_to_string PP((char *Result, double ar)); -extern Void val2 PP((Char *st, double *r, long *code)); +extern void val2 PP((char *st, double *r, long *code)); -extern Char *real_to_string_f PP((Char *Result, double ar, long dignum, +extern char *real_to_string_f PP((char *Result, double ar, long dignum, long afterpoint)); -extern Void brt PP((Char *p1)); - -extern boolean is_rig_letter PP((int)); -extern boolean is_rig_symbol PP((int)); +extern void keep_string_up_to_first_space PP((char *p1)); +extern void set_string( char *, char * ); +extern void set_name_extension( char *, char *, char * ); +extern void keep_string_up_to_first_space( char *); +extern bool is_rig_letter PP((int)); +extern bool is_rig_symbol PP((int)); extern char* _OutMem PP((void)); -extern Void _EscIO PP((int)); +extern void _EscIO PP((int)); -#endif diff --git a/RIGAL/rigsc.446/include/defsun3.h b/RIGAL/rigsc.446/include/defsun3.h new file mode 100644 index 0000000000000000000000000000000000000000..dddd7b869f8ee12925f2ad26a4c6a24e75cd2c37 --- /dev/null +++ b/RIGAL/rigsc.446/include/defsun3.h @@ -0,0 +1,250 @@ + +#ifdef MIPSEL +// For DEC variant, ULTRIX computers, + Little endian variant of MIPS architecture: + changed ... +#define dos 1 +#endif + +#ifdef i386 +// INTEL architecture: +// changed ... +#define dos 1 +#endif + +#ifdef LE +// All other little-endian architectures +#define dos 1 +#endif + + // #define dos 1 + // defines order of bytes + // set to yes if lower byte is first in the word; + // set to no if lower byte is last in the word + +// memory manager error messages +#define m_cur_rewrite "1001 - Current disk rewrite error" +#define m_vir_rewrite "1002 - Virtual disk rewrite error" +#define m_cur_read "1003 - Current disk read error" +#define m_vir_read "1004 - Virtual disk read error" +#define m_cur_write "1005 - Current disk write error" +#define m_vir_write "1006 - Virtual disk write error" +#define m_over "1007 - Structured object memory overflow" +#define m_aover "1008 - Atomic memory overflow" +#define m_load "1009 - Disk error during LOAD" +#define m_reset "1010 - Disk reset error during LOAD" +#define m_save "1011 - Disk error during SAVE" +#define m_rewrite "1012 - Disk rewrite error during SAVE" +#define m_uns "1013 - Unsufficient core memory" +#define m_wrong "1014 - Internal error - wrong Spointer" +#define m_NULL_ptr "1015 - Internal error - NULL pointer" +#define m_STACK_ptr "1016 - Internal error - STACK pointer" +#define m_invalid_ptr "1017 - Internal error - INVALID pointer" + +#define lblksize 128 +#define cblksize 512 +#define asize 32767 // increased size of a_page, not limited +//2048; +#define ssize 16384 // must be 2^^shiftpage +//11; +#define shiftpage 14 + +#define andoffs (ssize - 1) + +#define msize 12 +#define fssize (ssize + lblksize) +#define spazime 255 // tiek lietots izteiksme chr(...). +#define apazime 254 // ja ir problemas,var lietot 127 126 +#define one 256 +#define setflag 1 +#define clearflag 126 + +#define minpage 0 + +#define maxpage 32767 // maxpage + // set to maximum value = 32767 + // Size of S-Space is maxpage*ssize*4 bytes =32 K * 16K * 4=2048 MB + + +typedef unsigned char pagenumber; + + +typedef char x512[512]; + +typedef struct a_block +{ + word infgar; + uint8_t inform[asize]; +} a_block; + + +typedef a_block a_buf[32]; + +#define PAGE(n) () +typedef struct s_buf +{ + uint32_t inform[fssize]; + struct s_buf *nextbuf; // not used + pagenumber pagenr; // not used + bool modif; // not used here + word infgar; // not used +} s_buf; + +// Order of bytes is important +#ifdef dos +typedef struct +{ + char pazime; + char page; // used for number of A-page 0..31 + word offset; +} pazofpa; +typedef struct +{ + word offsetpart, segmentpart; +} segoff; + +typedef struct +{ + word page, offset; +} newstru; + +#else +typedef struct +{ + word offset; + char page; // used for number of A-page 0..31 + char pazime; +} pazofpa; + +typedef struct +{ + word segmentpart, offsetpart; +} segoff; +typedef struct +{ + word offset, page; +} newstru; +#endif + +// need 4 (get,set)-pairs +// feature +// offset (always the same as uint16_t +// page ( uint8_t) +// page ( uint16_t) +// print content from a_bufp +// original code check for 0 in the uint32 pointa. +// I will check for null or invalid address then +// check for immediate +typedef uint32_t *pointer_to_content_in_an_s_buf; +typedef union sa_pointer +{ + pointer_to_content_in_an_s_buf ptr_to_information; + uint32_t pointa; + char immed[4]; + pazofpa struct_; + segoff wstruct; + longint exnumb; + newstru newstruct; +} sa_pointer; + +/* type descriptortype = + (dummy , listmain , listfragm , treemain , treefragm , + atomm , idatom , keyword , number , tatom , + fatom , variable , idvariable , nvariable , fvariable , + rulename, objekts , coord , spec ); +*/ + +typedef union object_type +{ + struct + { + char dtype; + char flags; + } U1; + sa_pointer pointarray[10]; + longint longintarray[10]; +} object_type; + + +typedef union absadr +{ + uint32_t *adrese; + object_type *objpoint; + longint *lintpoint; +} absadr; + + +typedef struct bl80rec +{ + bl80 c; +} bl80rec; + +typedef union charmas +{ + char *cptr1; + bl80rec *cptrec80; + char *cptr80; +} charmas; + + +typedef struct _REC_dinformtype +{ + word length, apointbit, spointbit; +} _REC_dinformtype; + +typedef _REC_dinformtype dinformtype[27]; + +// static variables for putatm: +struct LOC_putatm +{ + uint32_t na; + charmas cptr; + sa_pointer atbilde; + uint32_t intpage; +}; + +// static variables for saves: +struct LOC_saves +{ + FILE *outfile; + longint kp; + sa_pointer bulta2; + absadr p2, p3; + union + { + longint long_[256]; + char chr[1024]; + struct + { + x512 b1, b2; + } U3; + } buffer; +}; + +// static variables for reopen: +struct LOC_reopen +{ + longint kp; + sa_pointer bulta2; + absadr p2, p3; +}; + +// static variables for savesn: +struct LOC_savesn +{ + FILE *outfile; + longint kp; + sa_pointer bulta2; + absadr p2, p3; + union + { + longint long_[256]; + char chr[1024]; + struct + { + x512 b1, b2; + } U3; + } buffer; +}; + + diff --git a/RIGAL/rigsc.446/include/globrig.h b/RIGAL/rigsc.446/include/globrig.h index 296778c4b10af5b82e34532e8963d6172c47a27e..ea98602aff3f242875157d2a8e9e335a4fb881c5 100644 --- a/RIGAL/rigsc.446/include/globrig.h +++ b/RIGAL/rigsc.446/include/globrig.h @@ -1,26 +1,19 @@ -#ifndef _MONTEREYPHOENIXGLOBRIG_ -#define _MONTEREYPHOENIXGLOBRIG_ - #include<stdio.h> #include<stdlib.h> #include<string.h> #include<stdbool.h> -#include <ctype.h> - +#include<ctype.h> +#include<assert.h> +#include<stdint.h> +#include<unistd.h> + /******** GLOBRIG.H ******/ -#define Char char -#define boolean char -#define Void void #define PP(x) () #define PV() () -#define true 1 -#define false 0 -#define Static static -#define Local static #define FileNotFound 1 - + char* __M__; -#define Malloc(n) ((__M__ = malloc(n)) ? __M__ : (char*)_OutMem()) -#endif +#define Calloc(n) ((__M__ = calloc(1, n)) ? __M__ : (char*)_OutMem()) + diff --git a/RIGAL/rigsc.446/include/ley.h b/RIGAL/rigsc.446/include/ley.h index 353140d136f5e8dd56d66347d87f77d2b5b76f89..891d3ce7a067b9a6feaa25e453f38b561d00c3f8 100644 --- a/RIGAL/rigsc.446/include/ley.h +++ b/RIGAL/rigsc.446/include/ley.h @@ -1,9 +1,5 @@ -#ifndef _MONTEREYPHOENIXLEY_ -#define _MONTEREYPHOENIXLEY_ - /******************** ley.h ************************** */ -extern Void ley PP((Char *first_file, long *lesrez, boolean not_include, +extern void ley PP((char *first_file, long *lesrez, bool not_include, error_rec_type *error_rec)); -#endif diff --git a/RIGAL/rigsc.446/include/nef2.h b/RIGAL/rigsc.446/include/nef2.h index 1326ee428f2e7b0ea978e80725239d9c1ac2be44..bcc685377579b43fdfe2e5026931d8e7d441b44c 100644 --- a/RIGAL/rigsc.446/include/nef2.h +++ b/RIGAL/rigsc.446/include/nef2.h @@ -1,55 +1,52 @@ -#ifndef _MONTEREYPHOENIXNEF2_ -#define _MONTEREYPHOENIXNEF2_ - /***************** nef2.h ***************/ -extern Void next PP((ptr_ *p)); +extern void next PP((ptr_ *p)); -extern boolean eqatoms PP((long p1, long p2)); +extern bool eqatoms PP((long p1, long p2)); -extern Void first PP((long p, ptr_ *pp)); +extern void first PP((long p, ptr_ *pp)); -extern Void lconc PP((long *a1, long a2)); +extern void lconc PP((long *a1, long a2)); /* add an element*/ -extern Void crlst PP((long *l)); +extern void crlst PP((long *l)); /* s-adr. added element */ /* s- adr. new fragment */ -extern Void crlistfr PP((long el, long *f)); +extern void crlistfr PP((long el, long *f)); -extern Void crtree PP((long *t)); +extern void crtree PP((long *t)); /* make empty tree */ /* s-address of new tree fragment */ -extern Void crtreefr PP((long sel, long ob, long *frag)); +extern void crtreefr PP((long sel, long ob, long *frag)); /* where to change */ /* change to adr */ -extern Void changeel PP((ptr_ *pp, long adr)); +extern void changeel PP((ptr_ *pp, long adr)); /* input - s-address */ /* output:long integer value */ -extern boolean plnum PP((long sval, long *intval)); +extern bool plnum PP((long sval, long *intval)); /* input - any number */ -extern Void mknumb PP((long n, long *r)); +extern void mknumb PP((long n, long *r)); /* output - new descriptor (number) */ /* s-address of main tree descr*/ /* selector, a-address */ /* object*/ -extern Void addel3 PP((long *tr_, long sel, long ob)); +extern void addel3 PP((long *tr_, long sel, long ob)); /* 1-st tree */ /* 2-nd tree */ -extern Void addtre PP((long *m, long t2)); +extern void addtre PP((long *m, long t2)); -extern boolean compatom PP((long op, long adr1, long adr2)); +extern bool compatom PP((long op, long adr1, long adr2)); extern double take_fatom PP((long a1)); -extern Void pout PP((long root)); +extern void pout PP((long root)); + +extern void pscr PP((long root)); -extern Void pscr PP((long root)); -#endif diff --git a/RIGAL/rigsc.446/include/rc_.h b/RIGAL/rigsc.446/include/rc_.h new file mode 100644 index 0000000000000000000000000000000000000000..82211c204fe8ac9f90c630a44fa7ec66f7cd71bf --- /dev/null +++ b/RIGAL/rigsc.446/include/rc_.h @@ -0,0 +1,113 @@ +#define filemax 3 /* ~islo wlovenij dlq include */ +#define bufmaxlen 10 /* dlina malogo bufera , kak minimum - 8 */ +#define rulemaxnum 400 /* ~islo prawil w programme */ +#define two_char_sym_max 50 /* maks. ~islo dwuhbajtowyh simwolow */ + + +#define let_sign 1 +#define d_colon 2 +#define more_eq 3 +#define less_more 4 +#define lpar_point 5 +#define rpar_point 6 +#define less_eq 7 +#define minus_more 8 +#define lpar_star 9 +#define rpar_star 10 +#define lpar_plus 11 +#define rpar_plus 12 +#define d_cross 13 +#define d_semic 14 +#define d_excl 15 +#define d_plus 16 +#define excl_point 17 +#define less_point 18 +#define more_point 19 +#define less_star 20 +#define more_star 21 +#define lpar_colon 22 /* ---- */ +#define d_less 22 +#define rpar_colon 23 /* ---- */ +#define d_more 23 +#define if_key 24 +#define fi_key 25 +#define in_key 26 /* ---- */ +#define do_key 27 +#define od_key 28 +#define or_key 29 +#define plus 30 +#define excl_sign 31 +#define lpar 32 +#define rpar 33 +#define minus 34 +#define eq_sign 35 +#define star 36 +#define point 37 +#define more_sign 38 +#define less_sign 39 +#define lbrac 40 +#define rbrac 41 + +#define and_key 42 +#define mod_key 43 +#define div_key 44 +#define not_key 45 +#define save_key 46 +#define load_key 47 +#define fail_key 48 +#define copy_key 49 +#define elsif_key 50 +#define onfail_key 51 +#define print_key 52 +#define report_key 52 /* ---- */ +#define forall_key 53 +#define open_key 54 +#define outtext_key 54 /* ---- */ +#define slash 55 +#define semic 56 +#define return_key 57 +#define last_key 58 +#define null_key 59 +#define colon_sign 60 +#define comma_sign 61 +#define close_key 62 +#define break_key 63 +#define end_key 64 +#define loop_key 65 +#define d_sun 66 /* ------ */ +#define less_rbrac 67 /* ------ */ +#define s_apost 68 /* ------ */ +#define v_apost 69 /* ------ */ +#define reserv5_key 70 /* ------ */ +#define selectors_key 71 +#define branches_key 72 + +#define maxkey 72 + +#define tempo "_CH_RIG.TMP" + +typedef uint8_t key_type_as_int; + /* nomer kl`~ewogo slowa, ograni~en dlq case */ + +typedef union bufrectype { + char lexbuf[bufmaxlen]; + char b1; + char b2[2]; + char b3[3]; + char b4[4]; + char b5[5]; + char b6[6]; + char b7[7]; + char b8[8]; + char b9[9]; + char b10[10]; +} bufrectype; + + +extern void push (ptr_ *, long ); + + + +//----------------above line are confirmed ----------- + + diff --git a/RIGAL/rigsc.446/include/scan.h b/RIGAL/rigsc.446/include/scan.h index d275e0935b786df9e3a36c0e9b59f1ed3a416cca..352efda48e302d48969bd446ebe2e7b8f31b9aa5 100644 --- a/RIGAL/rigsc.446/include/scan.h +++ b/RIGAL/rigsc.446/include/scan.h @@ -1,27 +1,23 @@ -#ifndef _MONTEREYPHOENIXSCAN_ -#define _MONTEREYPHOENIXSCAN_ - - -extern Void initialize_scan_variables PV(); +extern void initialize_scan_variables PV(); /*******************************************/ /*1=from file,2=list of strings,3=absulute address*/ /* result; set to null if input is absent */ /* error number list; set to null if no error*/ /* list of atoms */ -extern Void scaner PP((long mode_parm, Char *filename, Char *options_str, +extern void scaner PP((long mode_parm, char *filename, char *options_str, long *rez, long *erlist_parm, long strlist, long segm, long ofs)); -extern Void initialize_scan_variables_mif PV(); +extern void initialize_scan_variables_mif PV(); /*******************************************/ /*1=from file,2=list of strings,3=absulute address*/ /* result; set to null if input is absent */ /* error number list; set to null if no error*/ /* list of atoms */ -extern Void scaner_mif PP((long mode_parm, Char *filename, Char *options_str, +extern void scaner_mif PP((long mode_parm, char *filename, char *options_str, long *rez, long *erlist_parm, long strlist, long segm, long ofs)); -#endif + diff --git a/RIGAL/rigsc.446/include/usemod.h b/RIGAL/rigsc.446/include/usemod.h index 428f623cc8aaa68c3d93a5affa52010756399b77..d1da76cc89987e199c8a025e9a7d6c090d66abeb 100644 --- a/RIGAL/rigsc.446/include/usemod.h +++ b/RIGAL/rigsc.446/include/usemod.h @@ -1,304 +1,301 @@ -#ifndef _MONTEREYPHOENIXUSEMOD_ -#define _MONTEREYPHOENIXUSEMOD_ +extern void use_1 PP((long p1, long p2, long p3, long *rez)); -extern Void use_1 PP((long p1, long p2, long p3, long *rez)); +extern void use_2 PP((long p1, long p2, long p3, long *rez)); -extern Void use_2 PP((long p1, long p2, long p3, long *rez)); +extern void use_3 PP((long p1, long p2, long p3, long *rez)); -extern Void use_3 PP((long p1, long p2, long p3, long *rez)); +extern void use_4 PP((long p1, long p2, long p3, long *rez)); -extern Void use_4 PP((long p1, long p2, long p3, long *rez)); +extern void use_5 PP((long p1, long p2, long p3, long *rez)); -extern Void use_5 PP((long p1, long p2, long p3, long *rez)); +extern void use_6 PP((long p1, long p2, long p3, long *rez)); -extern Void use_6 PP((long p1, long p2, long p3, long *rez)); +extern void use_7 PP((long p1, long p2, long p3, long *rez)); -extern Void use_7 PP((long p1, long p2, long p3, long *rez)); +extern void use_8 PP((long p1, long p2, long p3, long *rez)); -extern Void use_8 PP((long p1, long p2, long p3, long *rez)); +extern void use_9 PP((long p1, long p2, long p3, long *rez)); -extern Void use_9 PP((long p1, long p2, long p3, long *rez)); +extern void use_10 PP((long p1, long p2, long p3, long *rez)); -extern Void use_10 PP((long p1, long p2, long p3, long *rez)); +extern void use_11 PP((long p1, long p2, long p3, long *rez)); -extern Void use_11 PP((long p1, long p2, long p3, long *rez)); +extern void use_12 PP((long p1, long p2, long p3, long *rez)); -extern Void use_12 PP((long p1, long p2, long p3, long *rez)); +extern void use_13 PP((long p1, long p2, long p3, long *rez)); -extern Void use_13 PP((long p1, long p2, long p3, long *rez)); +extern void use_14 PP((long p1, long p2, long p3, long *rez)); -extern Void use_14 PP((long p1, long p2, long p3, long *rez)); +extern void use_15 PP((long p1, long p2, long p3, long *rez)); -extern Void use_15 PP((long p1, long p2, long p3, long *rez)); +extern void use_16 PP((long p1, long p2, long p3, long *rez)); -extern Void use_16 PP((long p1, long p2, long p3, long *rez)); +extern void use_17 PP((long p1, long p2, long p3, long *rez)); -extern Void use_17 PP((long p1, long p2, long p3, long *rez)); +extern void use_18 PP((long p1, long p2, long p3, long *rez)); -extern Void use_18 PP((long p1, long p2, long p3, long *rez)); +extern void use_19 PP((long p1, long p2, long p3, long *rez)); -extern Void use_19 PP((long p1, long p2, long p3, long *rez)); +extern void use_20 PP((long p1, long p2, long p3, long *rez)); -extern Void use_20 PP((long p1, long p2, long p3, long *rez)); +extern void use_21 PP((long p1, long p2, long p3, long *rez)); -extern Void use_21 PP((long p1, long p2, long p3, long *rez)); +extern void use_22 PP((long p1, long p2, long p3, long *rez)); -extern Void use_22 PP((long p1, long p2, long p3, long *rez)); +extern void use_23 PP((long p1, long p2, long p3, long *rez)); -extern Void use_23 PP((long p1, long p2, long p3, long *rez)); +extern void use_24 PP((long p1, long p2, long p3, long *rez)); -extern Void use_24 PP((long p1, long p2, long p3, long *rez)); +extern void use_25 PP((long p1, long p2, long p3, long *rez)); -extern Void use_25 PP((long p1, long p2, long p3, long *rez)); +extern void use_26 PP((long p1, long p2, long p3, long *rez)); -extern Void use_26 PP((long p1, long p2, long p3, long *rez)); +extern void use_27 PP((long p1, long p2, long p3, long *rez)); -extern Void use_27 PP((long p1, long p2, long p3, long *rez)); +extern void use_28 PP((long p1, long p2, long p3, long *rez)); -extern Void use_28 PP((long p1, long p2, long p3, long *rez)); +extern void use_29 PP((long p1, long p2, long p3, long *rez)); -extern Void use_29 PP((long p1, long p2, long p3, long *rez)); +extern void use_30 PP((long p1, long p2, long p3, long *rez)); -extern Void use_30 PP((long p1, long p2, long p3, long *rez)); +extern void use_31 PP((long p1, long p2, long p3, long *rez)); -extern Void use_31 PP((long p1, long p2, long p3, long *rez)); +extern void use_32 PP((long p1, long p2, long p3, long *rez)); -extern Void use_32 PP((long p1, long p2, long p3, long *rez)); +extern void use_33 PP((long p1, long p2, long p3, long *rez)); -extern Void use_33 PP((long p1, long p2, long p3, long *rez)); +extern void use_34 PP((long p1, long p2, long p3, long *rez)); -extern Void use_34 PP((long p1, long p2, long p3, long *rez)); +extern void use_35 PP((long p1, long p2, long p3, long *rez)); -extern Void use_35 PP((long p1, long p2, long p3, long *rez)); +extern void use_36 PP((long p1, long p2, long p3, long *rez)); -extern Void use_36 PP((long p1, long p2, long p3, long *rez)); +extern void use_37 PP((long p1, long p2, long p3, long *rez)); -extern Void use_37 PP((long p1, long p2, long p3, long *rez)); +extern void use_38 PP((long p1, long p2, long p3, long *rez)); -extern Void use_38 PP((long p1, long p2, long p3, long *rez)); +extern void use_39 PP((long p1, long p2, long p3, long *rez)); -extern Void use_39 PP((long p1, long p2, long p3, long *rez)); +extern void use_40 PP((long p1, long p2, long p3, long *rez)); -extern Void use_40 PP((long p1, long p2, long p3, long *rez)); +extern void use_41 PP((long p1, long p2, long p3, long *rez)); -extern Void use_41 PP((long p1, long p2, long p3, long *rez)); +extern void use_42 PP((long p1, long p2, long p3, long *rez)); -extern Void use_42 PP((long p1, long p2, long p3, long *rez)); +extern void use_43 PP((long p1, long p2, long p3, long *rez)); -extern Void use_43 PP((long p1, long p2, long p3, long *rez)); +extern void use_44 PP((long p1, long p2, long p3, long *rez)); -extern Void use_44 PP((long p1, long p2, long p3, long *rez)); +extern void use_45 PP((long p1, long p2, long p3, long *rez)); -extern Void use_45 PP((long p1, long p2, long p3, long *rez)); +extern void use_46 PP((long p1, long p2, long p3, long *rez)); -extern Void use_46 PP((long p1, long p2, long p3, long *rez)); +extern void use_47 PP((long p1, long p2, long p3, long *rez)); -extern Void use_47 PP((long p1, long p2, long p3, long *rez)); +extern void use_48 PP((long p1, long p2, long p3, long *rez)); -extern Void use_48 PP((long p1, long p2, long p3, long *rez)); +extern void use_49 PP((long p1, long p2, long p3, long *rez)); -extern Void use_49 PP((long p1, long p2, long p3, long *rez)); +extern void use_50 PP((long p1, long p2, long p3, long *rez)); -extern Void use_50 PP((long p1, long p2, long p3, long *rez)); +extern void use_51 PP((long p1, long p2, long p3, long *rez)); -extern Void use_51 PP((long p1, long p2, long p3, long *rez)); +extern void use_52 PP((long p1, long p2, long p3, long *rez)); -extern Void use_52 PP((long p1, long p2, long p3, long *rez)); +extern void use_53 PP((long p1, long p2, long p3, long *rez)); -extern Void use_53 PP((long p1, long p2, long p3, long *rez)); +extern void use_54 PP((long p1, long p2, long p3, long *rez)); -extern Void use_54 PP((long p1, long p2, long p3, long *rez)); +extern void use_55 PP((long p1, long p2, long p3, long *rez)); -extern Void use_55 PP((long p1, long p2, long p3, long *rez)); +extern void use_56 PP((long p1, long p2, long p3, long *rez)); -extern Void use_56 PP((long p1, long p2, long p3, long *rez)); +extern void use_57 PP((long p1, long p2, long p3, long *rez)); -extern Void use_57 PP((long p1, long p2, long p3, long *rez)); +extern void use_58 PP((long p1, long p2, long p3, long *rez)); -extern Void use_58 PP((long p1, long p2, long p3, long *rez)); +extern void use_59 PP((long p1, long p2, long p3, long *rez)); -extern Void use_59 PP((long p1, long p2, long p3, long *rez)); +extern void use_60 PP((long p1, long p2, long p3, long *rez)); -extern Void use_60 PP((long p1, long p2, long p3, long *rez)); +extern void use_61 PP((long p1, long p2, long p3, long *rez)); -extern Void use_61 PP((long p1, long p2, long p3, long *rez)); +extern void use_62 PP((long p1, long p2, long p3, long *rez)); -extern Void use_62 PP((long p1, long p2, long p3, long *rez)); +extern void use_63 PP((long p1, long p2, long p3, long *rez)); -extern Void use_63 PP((long p1, long p2, long p3, long *rez)); +extern void use_64 PP((long p1, long p2, long p3, long *rez)); -extern Void use_64 PP((long p1, long p2, long p3, long *rez)); +extern void use_65 PP((long p1, long p2, long p3, long *rez)); -extern Void use_65 PP((long p1, long p2, long p3, long *rez)); +extern void use_66 PP((long p1, long p2, long p3, long *rez)); -extern Void use_66 PP((long p1, long p2, long p3, long *rez)); +extern void use_67 PP((long p1, long p2, long p3, long *rez)); -extern Void use_67 PP((long p1, long p2, long p3, long *rez)); +extern void use_68 PP((long p1, long p2, long p3, long *rez)); -extern Void use_68 PP((long p1, long p2, long p3, long *rez)); +extern void use_69 PP((long p1, long p2, long p3, long *rez)); -extern Void use_69 PP((long p1, long p2, long p3, long *rez)); +extern void use_70 PP((long p1, long p2, long p3, long *rez)); -extern Void use_70 PP((long p1, long p2, long p3, long *rez)); +extern void use_71 PP((long p1, long p2, long p3, long *rez)); -extern Void use_71 PP((long p1, long p2, long p3, long *rez)); +extern void use_72 PP((long p1, long p2, long p3, long *rez)); -extern Void use_72 PP((long p1, long p2, long p3, long *rez)); +extern void use_73 PP((long p1, long p2, long p3, long *rez)); -extern Void use_73 PP((long p1, long p2, long p3, long *rez)); +extern void use_74 PP((long p1, long p2, long p3, long *rez)); -extern Void use_74 PP((long p1, long p2, long p3, long *rez)); +extern void use_75 PP((long p1, long p2, long p3, long *rez)); -extern Void use_75 PP((long p1, long p2, long p3, long *rez)); +extern void use_76 PP((long p1, long p2, long p3, long *rez)); -extern Void use_76 PP((long p1, long p2, long p3, long *rez)); +extern void use_77 PP((long p1, long p2, long p3, long *rez)); -extern Void use_77 PP((long p1, long p2, long p3, long *rez)); +extern void use_78 PP((long p1, long p2, long p3, long *rez)); -extern Void use_78 PP((long p1, long p2, long p3, long *rez)); +extern void use_79 PP((long p1, long p2, long p3, long *rez)); -extern Void use_79 PP((long p1, long p2, long p3, long *rez)); +extern void use_80 PP((long p1, long p2, long p3, long *rez)); -extern Void use_80 PP((long p1, long p2, long p3, long *rez)); +extern void use_81 PP((long p1, long p2, long p3, long *rez)); -extern Void use_81 PP((long p1, long p2, long p3, long *rez)); +extern void use_82 PP((long p1, long p2, long p3, long *rez)); -extern Void use_82 PP((long p1, long p2, long p3, long *rez)); +extern void use_83 PP((long p1, long p2, long p3, long *rez)); -extern Void use_83 PP((long p1, long p2, long p3, long *rez)); +extern void use_84 PP((long p1, long p2, long p3, long *rez)); -extern Void use_84 PP((long p1, long p2, long p3, long *rez)); +extern void use_85 PP((long p1, long p2, long p3, long *rez)); -extern Void use_85 PP((long p1, long p2, long p3, long *rez)); +extern void use_86 PP((long p1, long p2, long p3, long *rez)); -extern Void use_86 PP((long p1, long p2, long p3, long *rez)); +extern void use_87 PP((long p1, long p2, long p3, long *rez)); -extern Void use_87 PP((long p1, long p2, long p3, long *rez)); +extern void use_88 PP((long p1, long p2, long p3, long *rez)); -extern Void use_88 PP((long p1, long p2, long p3, long *rez)); +extern void use_89 PP((long p1, long p2, long p3, long *rez)); -extern Void use_89 PP((long p1, long p2, long p3, long *rez)); +extern void use_90 PP((long p1, long p2, long p3, long *rez)); -extern Void use_90 PP((long p1, long p2, long p3, long *rez)); +extern void use_91 PP((long p1, long p2, long p3, long *rez)); -extern Void use_91 PP((long p1, long p2, long p3, long *rez)); +extern void use_92 PP((long p1, long p2, long p3, long *rez)); -extern Void use_92 PP((long p1, long p2, long p3, long *rez)); +extern void use_93 PP((long p1, long p2, long p3, long *rez)); -extern Void use_93 PP((long p1, long p2, long p3, long *rez)); +extern void use_94 PP((long p1, long p2, long p3, long *rez)); -extern Void use_94 PP((long p1, long p2, long p3, long *rez)); +extern void use_95 PP((long p1, long p2, long p3, long *rez)); -extern Void use_95 PP((long p1, long p2, long p3, long *rez)); +extern void use_96 PP((long p1, long p2, long p3, long *rez)); -extern Void use_96 PP((long p1, long p2, long p3, long *rez)); +extern void use_97 PP((long p1, long p2, long p3, long *rez)); -extern Void use_97 PP((long p1, long p2, long p3, long *rez)); +extern void use_98 PP((long p1, long p2, long p3, long *rez)); -extern Void use_98 PP((long p1, long p2, long p3, long *rez)); +extern void use_99 PP((long p1, long p2, long p3, long *rez)); -extern Void use_99 PP((long p1, long p2, long p3, long *rez)); +extern void use_100 PP((long p1, long p2, long p3, long *rez)); -extern Void use_100 PP((long p1, long p2, long p3, long *rez)); +extern void use_101 PP((long p1, long p2, long p3, long *rez)); -extern Void use_101 PP((long p1, long p2, long p3, long *rez)); +extern void use_102 PP((long p1, long p2, long p3, long *rez)); -extern Void use_102 PP((long p1, long p2, long p3, long *rez)); +extern void use_103 PP((long p1, long p2, long p3, long *rez)); -extern Void use_103 PP((long p1, long p2, long p3, long *rez)); +extern void use_104 PP((long p1, long p2, long p3, long *rez)); -extern Void use_104 PP((long p1, long p2, long p3, long *rez)); +extern void use_105 PP((long p1, long p2, long p3, long *rez)); -extern Void use_105 PP((long p1, long p2, long p3, long *rez)); +extern void use_106 PP((long p1, long p2, long p3, long *rez)); -extern Void use_106 PP((long p1, long p2, long p3, long *rez)); +extern void use_107 PP((long p1, long p2, long p3, long *rez)); -extern Void use_107 PP((long p1, long p2, long p3, long *rez)); +extern void use_108 PP((long p1, long p2, long p3, long *rez)); -extern Void use_108 PP((long p1, long p2, long p3, long *rez)); +extern void use_109 PP((long p1, long p2, long p3, long *rez)); -extern Void use_109 PP((long p1, long p2, long p3, long *rez)); +extern void use_110 PP((long p1, long p2, long p3, long *rez)); -extern Void use_110 PP((long p1, long p2, long p3, long *rez)); +extern void use_111 PP((long p1, long p2, long p3, long *rez)); -extern Void use_111 PP((long p1, long p2, long p3, long *rez)); +extern void use_112 PP((long p1, long p2, long p3, long *rez)); -extern Void use_112 PP((long p1, long p2, long p3, long *rez)); +extern void use_113 PP((long p1, long p2, long p3, long *rez)); -extern Void use_113 PP((long p1, long p2, long p3, long *rez)); +extern void use_114 PP((long p1, long p2, long p3, long *rez)); -extern Void use_114 PP((long p1, long p2, long p3, long *rez)); +extern void use_115 PP((long p1, long p2, long p3, long *rez)); -extern Void use_115 PP((long p1, long p2, long p3, long *rez)); +extern void use_116 PP((long p1, long p2, long p3, long *rez)); -extern Void use_116 PP((long p1, long p2, long p3, long *rez)); +extern void use_117 PP((long p1, long p2, long p3, long *rez)); -extern Void use_117 PP((long p1, long p2, long p3, long *rez)); +extern void use_118 PP((long p1, long p2, long p3, long *rez)); -extern Void use_118 PP((long p1, long p2, long p3, long *rez)); +extern void use_119 PP((long p1, long p2, long p3, long *rez)); -extern Void use_119 PP((long p1, long p2, long p3, long *rez)); +extern void use_120 PP((long p1, long p2, long p3, long *rez)); -extern Void use_120 PP((long p1, long p2, long p3, long *rez)); +extern void use_121 PP((long p1, long p2, long p3, long *rez)); -extern Void use_121 PP((long p1, long p2, long p3, long *rez)); +extern void use_122 PP((long p1, long p2, long p3, long *rez)); -extern Void use_122 PP((long p1, long p2, long p3, long *rez)); +extern void use_123 PP((long p1, long p2, long p3, long *rez)); -extern Void use_123 PP((long p1, long p2, long p3, long *rez)); +extern void use_124 PP((long p1, long p2, long p3, long *rez)); -extern Void use_124 PP((long p1, long p2, long p3, long *rez)); +extern void use_125 PP((long p1, long p2, long p3, long *rez)); -extern Void use_125 PP((long p1, long p2, long p3, long *rez)); +extern void use_126 PP((long p1, long p2, long p3, long *rez)); -extern Void use_126 PP((long p1, long p2, long p3, long *rez)); +extern void use_127 PP((long p1, long p2, long p3, long *rez)); -extern Void use_127 PP((long p1, long p2, long p3, long *rez)); +extern void use_128 PP((long p1, long p2, long p3, long *rez)); -extern Void use_128 PP((long p1, long p2, long p3, long *rez)); +extern void use_129 PP((long p1, long p2, long p3, long *rez)); -extern Void use_129 PP((long p1, long p2, long p3, long *rez)); +extern void use_130 PP((long p1, long p2, long p3, long *rez)); -extern Void use_130 PP((long p1, long p2, long p3, long *rez)); +extern void use_131 PP((long p1, long p2, long p3, long *rez)); -extern Void use_131 PP((long p1, long p2, long p3, long *rez)); +extern void use_132 PP((long p1, long p2, long p3, long *rez)); -extern Void use_132 PP((long p1, long p2, long p3, long *rez)); +extern void use_133 PP((long p1, long p2, long p3, long *rez)); -extern Void use_133 PP((long p1, long p2, long p3, long *rez)); +extern void use_134 PP((long p1, long p2, long p3, long *rez)); -extern Void use_134 PP((long p1, long p2, long p3, long *rez)); +extern void use_135 PP((long p1, long p2, long p3, long *rez)); -extern Void use_135 PP((long p1, long p2, long p3, long *rez)); +extern void use_136 PP((long p1, long p2, long p3, long *rez)); -extern Void use_136 PP((long p1, long p2, long p3, long *rez)); +extern void use_137 PP((long p1, long p2, long p3, long *rez)); -extern Void use_137 PP((long p1, long p2, long p3, long *rez)); +extern void use_138 PP((long p1, long p2, long p3, long *rez)); -extern Void use_138 PP((long p1, long p2, long p3, long *rez)); +extern void use_139 PP((long p1, long p2, long p3, long *rez)); -extern Void use_139 PP((long p1, long p2, long p3, long *rez)); +extern void use_140 PP((long p1, long p2, long p3, long *rez)); -extern Void use_140 PP((long p1, long p2, long p3, long *rez)); +extern void use_141 PP((long p1, long p2, long p3, long *rez)); -extern Void use_141 PP((long p1, long p2, long p3, long *rez)); +extern void use_142 PP((long p1, long p2, long p3, long *rez)); -extern Void use_142 PP((long p1, long p2, long p3, long *rez)); +extern void use_143 PP((long p1, long p2, long p3, long *rez)); -extern Void use_143 PP((long p1, long p2, long p3, long *rez)); +extern void use_144 PP((long p1, long p2, long p3, long *rez)); -extern Void use_144 PP((long p1, long p2, long p3, long *rez)); +extern void use_145 PP((long p1, long p2, long p3, long *rez)); -extern Void use_145 PP((long p1, long p2, long p3, long *rez)); +extern void use_146 PP((long p1, long p2, long p3, long *rez)); -extern Void use_146 PP((long p1, long p2, long p3, long *rez)); +extern void use_147 PP((long p1, long p2, long p3, long *rez)); -extern Void use_147 PP((long p1, long p2, long p3, long *rez)); +extern void use_148 PP((long p1, long p2, long p3, long *rez)); -extern Void use_148 PP((long p1, long p2, long p3, long *rez)); +extern void use_149 PP((long p1, long p2, long p3, long *rez)); -extern Void use_149 PP((long p1, long p2, long p3, long *rez)); +extern void use_150 PP((long p1, long p2, long p3, long *rez)); -extern Void use_150 PP((long p1, long p2, long p3, long *rez)); -#endif diff --git a/RIGAL/rigsc.446/src/Makefile b/RIGAL/rigsc.446/src/Makefile index 70d3813a0684edcffc359f921434290114fe2b09..74c9a99965901ad2c5024b6c358a4d44d59ecfbc 100644 --- a/RIGAL/rigsc.446/src/Makefile +++ b/RIGAL/rigsc.446/src/Makefile @@ -4,10 +4,15 @@ # # C compiler to use (Compiler path can be changed by the user) +#COMPILER = clang +COMPILER = gcc + #CCFLAGS = -g -DLE -m32 -I/usr/include -I../include -CCFLAGS = -m32 -I/usr/include -I../include +CCFLAGS = -m32 -Wall -Wextra -Wdouble-promotion -Wnonnull -Wnull-dereference -Winit-self -Wimplicit-fallthrough=4 -Wunused-function -Wunused-label -Wunused -Wuninitialized -Wstringop-overflow -Walloca -I/usr/include -I../include +#CCFLAGS = -m32 -Wall -Wextra -Wdouble-promotion -Wnonnull -Wnull-dereference -Winit-self -Wimplicit-fallthrough=4 -Wunused-function -Wunused-label -Wunused -Wuninitialized -Wstringop-overflow -Walloca -I/usr/include -I../include +#CCFLAGS = -fPIC -I/usr/include -I../include #PCA = cc $(CCFLAGS) -D STATIC_CCFLAGS='"$(CCFLAGS)"' -c xsun=1 -I../include/ -I/usr/include -PCA = cc $(CCFLAGS) -D STATIC_CCFLAGS='"$(CCFLAGS)"' -c +PCA = $(COMPILER) $(CCFLAGS) -D STATIC_CCFLAGS='"$(CCFLAGS)"' -c # math lib for sin, cos, sqrt etc. LIBS = -lm @@ -44,7 +49,7 @@ normal: bins ../lib/riglib.a ../bin/anrig ../bin/genrigd ../bin/rig_lint test bins: bin ../bin/rc ../bin/ic ../bin/v bin: - -mkdir -p ../bin + -mkdir ../bin #rigal_scratch:# # rm -rf ../rigal_scratch @@ -63,7 +68,7 @@ bin: ../lib/riglib.a:$(CCF_SRC) @echo '*Starting creating library' - -mkdir -p ../lib + -mkdir ../lib -rm -f ../lib/riglib.a ar rv ../lib/riglib.a $(CCF_SRC) -ranlib ../lib/riglib.a diff --git a/RIGAL/rigsc.446/src/anrig/xcrg.c b/RIGAL/rigsc.446/src/anrig/xcrg.c index 2c2f44319d9af3fd18e45ad8dea5c06a3d7f3235..033635e39099f13f0f1a887290605dd60a054e5d 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg.c @@ -18,7 +18,7 @@ #include "def180.h" #include "xcrg.h" #include "xcrga.h" -a rez1;boolean success1;long k;mpd x; +a rez1;bool success1;long k;mpd x; v loc1;/* $glavn*/ v loc2;/* $FL*/ v loc3;/* $FN*/ @@ -35,10 +35,10 @@ v wrk5; v wrk6; v wrk7; ptr_ pl1; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; main(argc, argv) -int argc;Char *argv[]; +int argc;char *argv[]; { out = NULL; g_argc=argc; g_argv=argv; prolog(argc,argv); acon(); acop(); diff --git a/RIGAL/rigsc.446/src/anrig/xcrg.h b/RIGAL/rigsc.446/src/anrig/xcrg.h index 0b91740b550848c9a7b770535bd03709b2ff3dbd..fc93a323199ccf0df7e5d2de59fadb96c0bb5405 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg.h +++ b/RIGAL/rigsc.446/src/anrig/xcrg.h @@ -1,5 +1,3 @@ -#ifndef _MONTEREYPHOENIXANRIGXCRG_ -#define _MONTEREYPHOENIXANRIGXCRG_ v cnst[69]; a acnst[143]; @@ -21,49 +19,48 @@ v glob24_1; v glob24_2; v glob26_1; v glob3_1; -extern Void r2 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r3 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r4 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r5 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r6 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r7 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r8 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r9 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r10 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r11 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r12 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r13 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r14 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r15 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r16 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r17 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r18 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r19 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r20 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r21 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r22 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r23 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r24 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r25 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r26 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r27 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r28 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r29 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r30 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r31 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r32 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r33 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r34 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r35 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r36 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r37 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r38 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r39 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r40 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r41 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r42 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r43 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r44 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r45 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r46 PP((long *rez, boolean *success, ptr_ *pl)); -#endif +extern void r2 PP((long *rez, bool *success, ptr_ *pl)); +extern void r3 PP((long *rez, bool *success, ptr_ *pl)); +extern void r4 PP((long *rez, bool *success, ptr_ *pl)); +extern void r5 PP((long *rez, bool *success, ptr_ *pl)); +extern void r6 PP((long *rez, bool *success, ptr_ *pl)); +extern void r7 PP((long *rez, bool *success, ptr_ *pl)); +extern void r8 PP((long *rez, bool *success, ptr_ *pl)); +extern void r9 PP((long *rez, bool *success, ptr_ *pl)); +extern void r10 PP((long *rez, bool *success, ptr_ *pl)); +extern void r11 PP((long *rez, bool *success, ptr_ *pl)); +extern void r12 PP((long *rez, bool *success, ptr_ *pl)); +extern void r13 PP((long *rez, bool *success, ptr_ *pl)); +extern void r14 PP((long *rez, bool *success, ptr_ *pl)); +extern void r15 PP((long *rez, bool *success, ptr_ *pl)); +extern void r16 PP((long *rez, bool *success, ptr_ *pl)); +extern void r17 PP((long *rez, bool *success, ptr_ *pl)); +extern void r18 PP((long *rez, bool *success, ptr_ *pl)); +extern void r19 PP((long *rez, bool *success, ptr_ *pl)); +extern void r20 PP((long *rez, bool *success, ptr_ *pl)); +extern void r21 PP((long *rez, bool *success, ptr_ *pl)); +extern void r22 PP((long *rez, bool *success, ptr_ *pl)); +extern void r23 PP((long *rez, bool *success, ptr_ *pl)); +extern void r24 PP((long *rez, bool *success, ptr_ *pl)); +extern void r25 PP((long *rez, bool *success, ptr_ *pl)); +extern void r26 PP((long *rez, bool *success, ptr_ *pl)); +extern void r27 PP((long *rez, bool *success, ptr_ *pl)); +extern void r28 PP((long *rez, bool *success, ptr_ *pl)); +extern void r29 PP((long *rez, bool *success, ptr_ *pl)); +extern void r30 PP((long *rez, bool *success, ptr_ *pl)); +extern void r31 PP((long *rez, bool *success, ptr_ *pl)); +extern void r32 PP((long *rez, bool *success, ptr_ *pl)); +extern void r33 PP((long *rez, bool *success, ptr_ *pl)); +extern void r34 PP((long *rez, bool *success, ptr_ *pl)); +extern void r35 PP((long *rez, bool *success, ptr_ *pl)); +extern void r36 PP((long *rez, bool *success, ptr_ *pl)); +extern void r37 PP((long *rez, bool *success, ptr_ *pl)); +extern void r38 PP((long *rez, bool *success, ptr_ *pl)); +extern void r39 PP((long *rez, bool *success, ptr_ *pl)); +extern void r40 PP((long *rez, bool *success, ptr_ *pl)); +extern void r41 PP((long *rez, bool *success, ptr_ *pl)); +extern void r42 PP((long *rez, bool *success, ptr_ *pl)); +extern void r43 PP((long *rez, bool *success, ptr_ *pl)); +extern void r44 PP((long *rez, bool *success, ptr_ *pl)); +extern void r45 PP((long *rez, bool *success, ptr_ *pl)); +extern void r46 PP((long *rez, bool *success, ptr_ *pl)); diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_1.c b/RIGAL/rigsc.446/src/anrig/xcrg_1.c index a6ed5dcfda325c139bcea1d1e0b7b733c711185b..9ea28e5c611b1a817d011c465cd842a7d0460ad0 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_1.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_1.c @@ -11,9 +11,9 @@ /* R3 glawnoe_prawilo */ /*===============================================*/ /* GENERATED TEXT OF RULE #programma */ - Void r2(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r2(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v oldglob2_1; v oldglob2_2; @@ -59,7 +59,7 @@ glob2_8.sa=NULL; pl2=pl1; rez1=pl1.cel; if ((pl1.nel==0) || (rez1==NULL)) goto _L108; -else { pointr(rez1,&x.sa); +else { assert_and_assign_real_pointer (rez1,&x.sa); if (!((x.sad->dtype==atom)|| (x.sad->dtype==idatom)||(x.sad->dtype==keyword) ||(x.sad->dtype==fatom)) ) goto _L108; else x.sa=x.sad->name ;}; @@ -71,7 +71,7 @@ next(&pl1); /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; {pl4.ptrtype=ptrlist; pl4.nel=1; @@ -109,7 +109,7 @@ next(&pl1); /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; {pl4.ptrtype=ptrlist; pl4.nel=1; @@ -160,9 +160,9 @@ glob2_8=oldglob2_8; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #glawnoe_prawilo */ - Void r3(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r3(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc2;/* $E*/ v wrk1; v wrk2; @@ -173,8 +173,8 @@ v oldglob3_1; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"glawnoe_prawilo", 3 ,pl->cel,0); #endif @@ -284,7 +284,7 @@ addel( acnst[ 19 ],false,NULL, glob2_7 .sa ,& wrk1 .sa ); addel( acnst[ 20 ],false,NULL, glob2_6 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= glob3_1 .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_2.c b/RIGAL/rigsc.446/src/anrig/xcrg_2.c index 87a29f2f22420f6c17882ae10fec62775fe02642..b2162c44d47d38ae36107b20bf2569a012ed517e 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_2.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_2.c @@ -13,9 +13,9 @@ /* R7 ASS_SYMBOL */ /*===============================================*/ /* GENERATED TEXT OF RULE #|l_t_posled_ssablonow */ - Void r4(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r4(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $WORK_PL*/ v loc2;/* $E*/ @@ -30,7 +30,7 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; +bool flag1; #ifdef XX d(1,"|l_t_posled_ssablonow", 4 ,pl->cel,0); #endif @@ -151,7 +151,7 @@ addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk2 .sa ); addel( acnst[ 28 ],false,NULL, loc4 .sa ,& wrk2 .sa ); addel( acnst[ 29 ],false,NULL, loc3 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[23] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ @@ -284,7 +284,7 @@ addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk2 .sa ); addel( acnst[ 28 ],false,NULL, loc4 .sa ,& wrk2 .sa ); addel( acnst[ 29 ],false,NULL, loc3 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[24] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L116:; /* metka wyhoda po neuspehu wetwi */ @@ -340,7 +340,7 @@ addel( acnst[ 27 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); addel( acnst[ 26 ],false,NULL, loc1 .sa ,& wrk2 .sa ); addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[25] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L117:; /* metka wyhoda po neuspehu wetwi */ @@ -422,7 +422,7 @@ addel( acnst[ 37 ],false,NULL, loc6 .sa ,& wrk1 .sa ); addel( acnst[ 26 ],false,NULL, loc1 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[26] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L120:; /* metka wyhoda po neuspehu wetwi */ @@ -450,9 +450,9 @@ goto _L99; _L121:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ALTERNATIVE_SYMBOL */ - Void r5(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r5(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; v wrk2; ptr_ pl1; @@ -484,9 +484,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ssablon */ - Void r6(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r6(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $V*/ v loc2;/* $ASS_SYMBOL*/ v loc3;/* $P*/ @@ -497,7 +497,7 @@ v wrk4; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"ssablon", 6 ,pl->cel,0); #endif @@ -554,12 +554,12 @@ wrk3 .sa =NULL; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc1 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; addel( acnst[ 40 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); addel( acnst[ 42 ],false,NULL, loc3 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc2 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L102; @@ -580,15 +580,15 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ASS_SYMBOL */ - Void r7(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r7(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v wrk1; v wrk2; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"ASS_SYMBOL", 7 ,pl->cel,0); #endif diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_3.c b/RIGAL/rigsc.446/src/anrig/xcrg_3.c index 1c60b84cdebc8bf56ac13eeabdba95fd303726f3..ab24d9ee09f2a110670957284cb75fe2e99cc478 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_3.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_3.c @@ -11,9 +11,9 @@ /* R9 ssablon_spiska */ /*===============================================*/ /* GENERATED TEXT OF RULE #prostoj_ssablon */ - Void r8(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r8(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $mesto*/ v loc3;/* $S*/ @@ -28,8 +28,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"prostoj_ssablon", 8 ,pl->cel,0); #endif @@ -82,7 +82,7 @@ if( !success1 ) goto _L105; wrk1 .sa =NULL; lconc(& wrk1 .sa , cnst[1] .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[29] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ @@ -126,7 +126,7 @@ wrk1 .sa =NULL; addel( acnst[ 46 ],false,NULL, loc1 .sa ,& wrk1 .sa ); addel( acnst[ 47 ],false,NULL, loc2 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[30] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L107:; /* metka wyhoda po neuspehu wetwi */ @@ -151,7 +151,7 @@ r38(&wrk1.sa,&flag1,&pl3);/* #TAB*/ ;xxx; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc1 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ @@ -181,7 +181,7 @@ if( loc3 .sa!=NULL) wrk1 .sa =NULL; lconc(& wrk1 .sa , loc3 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[31] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L109; @@ -195,7 +195,7 @@ if( wrk5 .bo) wrk1 .sa =NULL; lconc(& wrk1 .sa , cnst[1] .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= loc1 .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L109; @@ -209,7 +209,7 @@ r46(&wrk1.sa,&flag1,&pl3);/* #CROSS*/ ;xxx; wrk1 .sa =NULL; lconc(& wrk1 .sa , loc1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[32] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; ;} @@ -270,7 +270,7 @@ if( !success1 ) goto _L111; wrk1 .sa =NULL; lconc(& wrk1 .sa , loc1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[34] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L111:; /* metka wyhoda po neuspehu wetwi */ @@ -329,7 +329,7 @@ if( !success1 ) goto _L112; wrk1 .sa =NULL; lconc(& wrk1 .sa , loc1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[36] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L112:; /* metka wyhoda po neuspehu wetwi */ @@ -424,7 +424,7 @@ addel( acnst[ 37 ],false,NULL, loc5 .sa ,& wrk1 .sa ); addel( acnst[ 26 ],false,NULL, loc4 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc1 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[26] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L117:; /* metka wyhoda po neuspehu wetwi */ @@ -438,9 +438,9 @@ goto _L99; _L117:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ssablon_spiska */ - Void r9(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r9(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $WORK_PL*/ v loc3;/* $R*/ @@ -448,7 +448,7 @@ v wrk1; v wrk2; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"ssablon_spiska", 9 ,pl->cel,0); #endif @@ -512,7 +512,7 @@ addel( acnst[ 41 ],false,NULL, loc1 .sa ,& wrk1 .sa ); addel( acnst[ 26 ],false,NULL, loc2 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc3 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[37] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_4.c b/RIGAL/rigsc.446/src/anrig/xcrg_4.c index 7087ab0ffebd6e63a5db94ac734ea5f41af15fb8..69c7ec2c3412223668e6ea6ad98531b4ecfd6944 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_4.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_4.c @@ -14,9 +14,9 @@ /* R14 BUILTIN */ /*===============================================*/ /* GENERATED TEXT OF RULE #ssablon_derewa */ - Void r10(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r10(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $WORK_PL*/ v loc3;/* $B*/ @@ -27,7 +27,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"ssablon_derewa", 10 ,pl->cel,0); #endif @@ -101,7 +101,7 @@ addel( acnst[ 41 ],false,NULL, loc1 .sa ,& wrk1 .sa ); addel( acnst[ 26 ],false,NULL, loc2 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc3 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[38] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ @@ -175,7 +175,7 @@ r37(&wrk1.sa,&flag1,&pl2);/* #ADD_USEVAR*/ ;xxx; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc4 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; lconc(& loc5 .sa, wrk2 .sa ) ;xxx; @@ -236,7 +236,7 @@ addel( acnst[ 27 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); addel( acnst[ 21 ],false,NULL, loc3 .sa ,& wrk2 .sa ); addel( acnst[ 57 ],false,NULL, loc5 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[38] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L109:; /* metka wyhoda po neuspehu wetwi */ @@ -250,16 +250,16 @@ goto _L99; _L109:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #NAME_PAT */ - Void r11(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r11(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"NAME_PAT", 11 ,pl->cel,0); #endif @@ -301,7 +301,7 @@ if( wrk1 .sa!=NULL) wrk1 .sa =NULL; lconc(& wrk1 .sa , loc1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[39] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L101; @@ -316,7 +316,7 @@ pl2.plistsize= 2; r41(&wrk1.sa,&flag1,&pl2);/* #GETCNST*/ ; lconc(& wrk2 .sa , wrk1 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[40] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; ;} @@ -358,7 +358,7 @@ r37(&wrk1.sa,&flag1,&pl2);/* #ADD_USEVAR*/ ;xxx; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc1 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ @@ -400,9 +400,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #|l_t_ss_derewa */ - Void r12(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r12(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $N*/ v loc2;/* $A*/ v loc3;/* $I*/ @@ -412,7 +412,7 @@ v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"|l_t_ss_derewa", 12 ,pl->cel,0); #endif @@ -512,7 +512,7 @@ if( loc1 .sa!=NULL) { /* RETURN-op. */ /* operaciq :: */ wrk1 .sa=NULL; -if( loc2 .sa!=NULL ) { points( loc2 .sa,&x.sa); +if( loc2 .sa!=NULL ) { assert_and_assign_real_pointer ( loc2 .sa,&x.sa); if( (x.smld->dtype==treemain)||(x.smtd->dtype==listmain)) { x.smtd->name= cnst[41] .sa ; wrk1 = loc2 ;} ;}; rez1 = wrk1 .sa ;goto _L98 ;xxx; @@ -534,9 +534,9 @@ goto _L99; _L106:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #COMMA */ - Void r13(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r13(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; v wrk2; ptr_ pl1; @@ -568,9 +568,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #BUILTIN */ - Void r14(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r14(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; ptr_ pl1; ptr_ pl2; @@ -609,7 +609,7 @@ ptr_ pl2; pl2=pl1; rez1=pl1.cel; if ((pl1.nel==0) || (rez1==NULL)) goto _L123; -else { pointr(rez1,&x.sa); +else { assert_and_assign_real_pointer (rez1,&x.sa); if (!((x.sad->dtype==atom)|| (x.sad->dtype==idatom)||(x.sad->dtype==keyword) ||(x.sad->dtype==fatom)) ) goto _L123; else x.sa=x.sad->name ;}; diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_5.c b/RIGAL/rigsc.446/src/anrig/xcrg_5.c index 4e905b5e4d28d38e2bbd571345c342ef1c421982..b2ccb2afb67c24c19619f6a2c1ac195a01b4630d 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_5.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_5.c @@ -16,9 +16,9 @@ /* R21 EXPR2 */ /*===============================================*/ /* GENERATED TEXT OF RULE #wyravenie */ - Void r15(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r15(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $A2*/ v wrk1; @@ -29,8 +29,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"wyravenie", 15 ,pl->cel,0); #endif @@ -80,7 +80,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[42] .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; @@ -101,9 +101,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR7 */ - Void r16(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r16(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $A2*/ v wrk1; @@ -114,8 +114,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR7", 16 ,pl->cel,0); #endif @@ -165,7 +165,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[45] .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; @@ -186,9 +186,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR6 */ - Void r17(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r17(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $OP*/ v loc3;/* $A2*/ @@ -208,8 +208,8 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR6", 17 ,pl->cel,0); #endif @@ -337,7 +337,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl4);implod(&pl4,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc2 .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; @@ -358,9 +358,9 @@ goto _L99; _L112:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR5 */ - Void r18(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r18(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $OP*/ v loc3;/* $A2*/ @@ -383,8 +383,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR5", 18 ,pl->cel,0); #endif @@ -469,7 +469,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc2 .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; @@ -490,9 +490,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR4 */ - Void r19(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r19(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $OP*/ v loc3;/* $A2*/ @@ -508,8 +508,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR4", 19 ,pl->cel,0); #endif @@ -569,7 +569,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc2 .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; @@ -590,9 +590,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR3 */ - Void r20(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r20(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OP*/ v loc2;/* $A1*/ v loc3;/* $tip*/ @@ -607,8 +607,8 @@ v wrk8; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR3", 20 ,pl->cel,0); #endif @@ -674,7 +674,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl2);implod(&pl2,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc1 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ @@ -702,9 +702,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR2 */ - Void r21(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r21(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A1*/ v loc2;/* $OP*/ v loc3;/* $A2*/ @@ -718,8 +718,8 @@ ptr_ pl3; ptr_ pl4; ptr_ pl5; ptr_ pl6; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR2", 21 ,pl->cel,0); #endif @@ -884,7 +884,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl4);implod(&pl4,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc2 .sa ; wrk4 = wrk3 ;}; loc1 .sa= wrk4 .sa ;xxx; pl2=pl1; diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_6.c b/RIGAL/rigsc.446/src/anrig/xcrg_6.c index 51aa12b4f10a8c00ce5eb10880383d0445619a1d..c8580bc6abd6aa530e40ef4d893fcede614d6cc2 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_6.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_6.c @@ -11,9 +11,9 @@ /* R23 operator3 */ /*===============================================*/ /* GENERATED TEXT OF RULE #operator2 */ - Void r22(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r22(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OP*/ v loc2;/* $E*/ v loc3;/* $NPL*/ @@ -30,7 +30,7 @@ v wrk7; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"operator2", 22 ,pl->cel,0); #endif @@ -78,7 +78,7 @@ _L101:;xxx; wrk1 .sa =NULL; lconc(& wrk1 .sa , loc2 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= loc1 .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ @@ -243,19 +243,19 @@ addel( acnst[ 108 ],false,NULL, loc3 .sa ,& wrk6 .sa ); wrk2 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc4 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk3 = wrk2 ;}; addel( acnst[ 40 ],false,NULL, wrk3 .sa ,& wrk6 .sa ); wrk4 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc5 .sa ,& wrk4 .sa ); /* operaciq :: */ wrk5 .sa=NULL; -if( wrk4 .sa!=NULL ) { points( wrk4 .sa,&x.sa); +if( wrk4 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk4 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk5 = wrk4 ;}; addel( acnst[ 109 ],false,NULL, wrk5 .sa ,& wrk6 .sa ); addel( acnst[ 105 ],false,NULL, loc2 .sa ,& wrk6 .sa ); addel( acnst[ 21 ],false,NULL, loc6 .sa ,& wrk6 .sa ); /* operaciq :: */ wrk7 .sa=NULL; -if( wrk6 .sa!=NULL ) { points( wrk6 .sa,&x.sa); +if( wrk6 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk6 .sa,&x.sa); x.smtd->name= cnst[49] .sa ; wrk7 = wrk6 ;}; rez1 = wrk7 .sa ;goto _L98 ;xxx; goto _L99; _L109:; /* metka wyhoda po neuspehu wetwi */ @@ -314,7 +314,7 @@ r44(&wrk1.sa,&flag1,&pl2);/* #NEW_LABEL*/ ; addel( acnst[ 27 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); addel( acnst[ 21 ],false,NULL, loc6 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[50] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L113:; /* metka wyhoda po neuspehu wetwi */ @@ -343,7 +343,7 @@ loc1 .sa=rez1; wrk1 .sa =NULL; lconc(& wrk1 .sa , cnst[1] .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= loc1 .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L114:; /* metka wyhoda po neuspehu wetwi */ @@ -357,9 +357,9 @@ goto _L99; _L114:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #operator3 */ - Void r23(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r23(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $ID*/ v loc2;/* $R*/ v loc3;/* $BLTIN*/ @@ -379,8 +379,8 @@ v wrk4; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"operator3", 23 ,pl->cel,0); #endif @@ -503,7 +503,7 @@ addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); addel( acnst[ 86 ],false,NULL, loc5 .sa ,& wrk3 .sa ); addel( acnst[ 33 ],false,NULL, loc6 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc3 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ @@ -630,7 +630,7 @@ addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); addel( acnst[ 33 ],false,NULL, loc6 .sa ,& wrk3 .sa ); addel( acnst[ 114 ],false,NULL, loc4 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc7 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L110:; /* metka wyhoda po neuspehu wetwi */ @@ -670,7 +670,7 @@ addel( acnst[ 115 ],false,NULL, loc11 .sa ,& wrk1 .sa ); addel( acnst[ 116 ],false,NULL, loc12 .sa ,& wrk1 .sa ); addel( acnst[ 117 ],false,NULL, loc10 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[54] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L111:; /* metka wyhoda po neuspehu wetwi */ diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_7.c b/RIGAL/rigsc.446/src/anrig/xcrg_7.c index ef5d8785eea4835ec4635b2194398ed5ea0ea8b3..da6c82688c45701e8eea81a735d73484d6d3968b 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_7.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_7.c @@ -18,9 +18,9 @@ /* R32 ONE_ATOM */ /*===============================================*/ /* GENERATED TEXT OF RULE #prawilo */ - Void r24(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r24(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc2;/* $E*/ v wrk1; v wrk2; @@ -28,7 +28,7 @@ v oldglob24_1; v oldglob24_2; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"prawilo", 24 ,pl->cel,0); #endif @@ -125,7 +125,7 @@ addel( acnst[ 118 ],false,NULL, glob24_1 .sa ,& wrk1 .sa ); addel( acnst[ 18 ],false,NULL, glob2_3 .sa ,& wrk1 .sa ); addel( acnst[ 21 ],false,NULL, loc2 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= glob24_2 .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ @@ -170,9 +170,9 @@ glob24_2=oldglob24_2; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #END_OF_BRANCH */ - Void r25(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r25(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; v wrk2; ptr_ pl1; @@ -204,9 +204,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #prostoe_prawilo */ - Void r26(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r26(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $ONFAIL*/ v wrk1; @@ -215,7 +215,7 @@ v oldglob26_1; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"prostoe_prawilo", 26 ,pl->cel,0); #endif @@ -291,9 +291,9 @@ glob26_1=oldglob26_1; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #PLO */ - Void r27(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r27(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ ptr_ pl1; ptr_ pl2; @@ -349,9 +349,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #dejstwiq */ - Void r28(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r28(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; @@ -361,8 +361,8 @@ v wrk5; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"dejstwiq", 28 ,pl->cel,0); #endif @@ -439,9 +439,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #SEMICOLON */ - Void r29(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r29(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; v wrk2; ptr_ pl1; @@ -473,9 +473,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #operator */ - Void r30(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r30(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $X*/ v wrk1; ptr_ pl1; @@ -533,9 +533,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #operator1 */ - Void r31(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r31(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $LABEL*/ v loc2;/* $COND*/ v loc3;/* $OPS*/ @@ -556,7 +556,7 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; +bool flag1; #ifdef XX d(1,"operator1", 31 ,pl->cel,0); #endif @@ -708,7 +708,7 @@ wrk1 .sa =NULL; addel( acnst[ 27 ],false,NULL, loc1 .sa ,& wrk1 .sa ); addel( acnst[ 104 ],false,NULL, loc4 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[55] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ @@ -772,12 +772,12 @@ wrk3 .sa =NULL; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc6 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; addel( acnst[ 40 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); addel( acnst[ 131 ],false,NULL, loc7 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc5 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L110:; /* metka wyhoda po neuspehu wetwi */ @@ -823,7 +823,7 @@ r41(&wrk1.sa,&flag1,&pl2);/* #GETCNST*/ ; addel( acnst[ 41 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); addel( acnst[ 131 ],false,NULL, loc7 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[56] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L111:; /* metka wyhoda po neuspehu wetwi */ @@ -940,7 +940,7 @@ addel( acnst[ 41 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); addel( acnst[ 86 ],false,NULL, loc5 .sa ,& wrk2 .sa ); addel( acnst[ 136 ],false,NULL, loc9 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[58] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L121:; /* metka wyhoda po neuspehu wetwi */ @@ -973,7 +973,7 @@ pl2.plistsize= 2; r41(&wrk1.sa,&flag1,&pl2);/* #GETCNST*/ ; lconc(& wrk2 .sa , wrk1 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[59] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L122:; /* metka wyhoda po neuspehu wetwi */ @@ -987,9 +987,9 @@ goto _L99; _L122:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ONE_ATOM */ - Void r32(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r32(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; @@ -998,7 +998,7 @@ v wrk4; v wrk5; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"ONE_ATOM", 32 ,pl->cel,0); #endif diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_8.c b/RIGAL/rigsc.446/src/anrig/xcrg_8.c index df84581673c0847e05b028bd88b328d301bacba1..f6c94fb30dbadfc4348f54c28946c7d816bd8755 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_8.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_8.c @@ -14,9 +14,9 @@ /* R37 ADD_USEVAR */ /*===============================================*/ /* GENERATED TEXT OF RULE #EXPR1 */ - Void r33(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r33(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E1*/ v loc2;/* $E*/ v loc3;/* $ID*/ @@ -35,8 +35,8 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"EXPR1", 33 ,pl->cel,0); #endif @@ -100,7 +100,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl2);implod(&pl2,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[60] .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ @@ -207,7 +207,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[61] .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ @@ -256,7 +256,7 @@ wrk1 .sa =NULL; addel( acnst[ 139 ],false,NULL, loc3 .sa ,& wrk1 .sa ); addel( acnst[ 40 ],false,NULL, loc2 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[62] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L109:; /* metka wyhoda po neuspehu wetwi */ @@ -322,7 +322,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[63] .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; ;} @@ -448,7 +448,7 @@ addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); addel( acnst[ 86 ],false,NULL, loc6 .sa ,& wrk3 .sa ); addel( acnst[ 33 ],false,NULL, loc7 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc5 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L116:; /* metka wyhoda po neuspehu wetwi */ @@ -575,7 +575,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= loc8 .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L121:; /* metka wyhoda po neuspehu wetwi */ @@ -605,7 +605,7 @@ lconc(& wrk2 .sa , wrk1 .sa ); first(wrk2.sa,&pl3);implod(&pl3,&wrk2.sa); addel( acnst[ 47 ],false,NULL, wrk2 .sa ,& wrk3 .sa ); /* operaciq :: */ wrk4 .sa=NULL; -if( wrk3 .sa!=NULL ) { points( wrk3 .sa,&x.sa); +if( wrk3 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk3 .sa,&x.sa); x.smtd->name= cnst[64] .sa ; wrk4 = wrk3 ;}; rez1 = wrk4 .sa ;goto _L98 ;xxx; goto _L99; _L122:; /* metka wyhoda po neuspehu wetwi */ @@ -646,7 +646,7 @@ _L123:;xxx; wrk1 .sa =NULL; addel( acnst[ 41 ],false,NULL, loc3 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[27] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L124:; /* metka wyhoda po neuspehu wetwi */ @@ -669,7 +669,7 @@ if( !success1 ) goto _L125; wrk1 .sa =NULL; addel( acnst[ 47 ],false,NULL, cnst[29] .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[29] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L125:; /* metka wyhoda po neuspehu wetwi */ @@ -727,7 +727,7 @@ addel( acnst[ 46 ],false,NULL, loc2 .sa ,& wrk1 .sa ); addel( acnst[ 47 ],false,NULL, loc10 .sa ,& wrk1 .sa ); addel( acnst[ 86 ],false,NULL, loc6 .sa ,& wrk1 .sa ); /* operaciq :: */ wrk2 .sa=NULL; -if( wrk1 .sa!=NULL ) { points( wrk1 .sa,&x.sa); +if( wrk1 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk1 .sa,&x.sa); x.smtd->name= cnst[67] .sa ; wrk2 = wrk1 ;}; rez1 = wrk2 .sa ;goto _L98 ;xxx; goto _L99; _L127:; /* metka wyhoda po neuspehu wetwi */ @@ -775,16 +775,16 @@ goto _L99; _L128:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #atom_selektor */ - Void r34(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r34(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v wrk1; v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"atom_selektor", 34 ,pl->cel,0); #endif @@ -809,7 +809,7 @@ pl2.plistsize= 2; r41(&wrk1.sa,&flag1,&pl2);/* #GETCNST*/ ; addel( acnst[ 11 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[67] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ @@ -823,9 +823,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #sozdatx_mesto2 */ - Void r35(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r35(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; @@ -833,8 +833,8 @@ v wrk3; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; #ifdef XX d(1,"sozdatx_mesto2", 35 ,pl->cel,0); #endif @@ -877,9 +877,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ne~islowoj_atom */ - Void r36(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r36(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; @@ -888,7 +888,7 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; +bool flag1; #ifdef XX d(1,"ne~islowoj_atom", 36 ,pl->cel,0); #endif @@ -939,7 +939,7 @@ pl3=pl1; pl4=pl1; rez1=pl1.cel; if ((pl1.nel==0) || (rez1==NULL)) goto _L112; -else { pointr(rez1,&x.sa); +else { assert_and_assign_real_pointer (rez1,&x.sa); if (!((x.sad->dtype==atom)|| (x.sad->dtype==idatom)||(x.sad->dtype==keyword) ||(x.sad->dtype==fatom)) ) goto _L112; else x.sa=x.sad->name ;}; @@ -1045,7 +1045,7 @@ pl2.plistsize= 2; r41(&wrk1.sa,&flag1,&pl2);/* #GETCNST*/ ; addel( acnst[ 11 ],false,NULL, wrk1 .sa ,& wrk2 .sa ); /* operaciq :: */ wrk3 .sa=NULL; -if( wrk2 .sa!=NULL ) { points( wrk2 .sa,&x.sa); +if( wrk2 .sa!=NULL ) { assert_and_assign_real_pointer ( wrk2 .sa,&x.sa); x.smtd->name= cnst[67] .sa ; wrk3 = wrk2 ;}; rez1 = wrk3 .sa ;goto _L98 ;xxx; goto _L99; _L119:; /* metka wyhoda po neuspehu wetwi */ @@ -1059,9 +1059,9 @@ goto _L99; _L119:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ADD_USEVAR */ - Void r37(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r37(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $V*/ v wrk1; ptr_ pl1; diff --git a/RIGAL/rigsc.446/src/anrig/xcrg_9.c b/RIGAL/rigsc.446/src/anrig/xcrg_9.c index 4a7918bcb6ae724aeed59852f726a5700b1ab2bc..412ec0ac8030ff0d85178cb62be7565e340b3b02 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrg_9.c +++ b/RIGAL/rigsc.446/src/anrig/xcrg_9.c @@ -18,9 +18,9 @@ /* R46 CROSS */ /*===============================================*/ /* GENERATED TEXT OF RULE #TAB */ - Void r38(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r38(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $imq_prawila*/ v loc2;/* $T*/ v loc3;/* $imq_peremennoj*/ @@ -30,7 +30,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"TAB", 38 ,pl->cel,0); #endif @@ -105,9 +105,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #LASTTAB */ - Void r39(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r39(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $imq_prawila*/ v loc2;/* $imq_peremennoj*/ v loc3;/* $T*/ @@ -117,7 +117,7 @@ v wrk2; v wrk3; v wrk4; ptr_ pl1; -boolean flag1; +bool flag1; #ifdef XX d(1,"LASTTAB", 39 ,pl->cel,0); #endif @@ -184,9 +184,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GETWRK */ - Void r40(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r40(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; ptr_ pl1; #ifdef XX @@ -223,9 +223,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GETCNST */ - Void r41(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r41(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $C*/ v loc2;/* $N*/ v loc3;/* $L*/ @@ -260,7 +260,7 @@ loc3 .sa=NULL; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L103;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -316,9 +316,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GET_WORK_PL */ - Void r42(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r42(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; ptr_ pl1; #ifdef XX @@ -355,9 +355,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GET_FLAG */ - Void r43(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r43(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; ptr_ pl1; #ifdef XX @@ -394,9 +394,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #NEW_LABEL */ - Void r44(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r44(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; ptr_ pl1; #ifdef XX @@ -424,9 +424,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #RULENUM */ - Void r45(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r45(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $N*/ v loc2;/* $E*/ v loc3;/* $imq*/ @@ -459,7 +459,7 @@ if( !success1 ) goto _L102; /*FORALL-op.*/ if( loc2.sa==NULL ) goto _L101; -pointr ( loc2 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L101;}; first(loc2.sa,&pl2); @@ -491,9 +491,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #CROSS */ - Void r46(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r46(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $R*/ v loc2;/* $C*/ v loc3;/* $T*/ diff --git a/RIGAL/rigsc.446/src/anrig/xcrga.h b/RIGAL/rigsc.446/src/anrig/xcrga.h index 46595c3694938f2fe2bbe6d07f4943c2f9547f7f..706f687476fdc56f2441b3ce050125b96995c49d 100644 --- a/RIGAL/rigsc.446/src/anrig/xcrga.h +++ b/RIGAL/rigsc.446/src/anrig/xcrga.h @@ -1,14 +1,12 @@ -#ifndef _MONTEREYPHOENIXANRIGXCRGA_ -#define _MONTEREYPHOENIXANRIGXCRGA_ -/* Local variables for acon: */ +/* static variables for acon: */ struct LOC_acon {a k;allpacked r;} ; -Local Void uc(l, cn, dt, LINK) +static void uc(l, cn, dt, LINK) long l, cn; char dt; struct LOC_acon *LINK; { putatm(LINK->r.bl, l, &LINK->k); mkatom(LINK->k, dt, &cnst[cn ].sa);} -Static Void acon() +static void acon() { struct LOC_acon V; mpd x; mainlistdescriptor *WITH; V.r.p1='T'; @@ -152,13 +150,13 @@ uc (8L,67L,idatom,&V); WITH->totalelnum = 1; WITH->name = null_; WITH->next = null_;} -/* Local variables for acop: */ +/* static variables for acop: */ struct LOC_acop { allpacked r;} ; -Local Void uc_(l, cn, dt, LINK) +static void uc_(l, cn, dt, LINK) long l, cn; char dt; struct LOC_acop *LINK; {putatm(LINK->r.bl, l, &acnst[cn ]);} -Static Void acop() +static void acop() {struct LOC_acop V; V.r.p1='T'; uc_(1L,1L,idatom,&V); @@ -445,4 +443,3 @@ uc_(2L,141L,atom,&V); memcpy(V.r.p6,"mesto2",6L); uc_(6L,142L,idatom,&V); } -#endif diff --git a/RIGAL/rigsc.446/src/c1.c b/RIGAL/rigsc.446/src/c1.c index a07853d4b0ad81724b5a54c68243469f1b203f8e..3481382f77e0a31e8150674ed101b6aeb6c868a4 100644 --- a/RIGAL/rigsc.446/src/c1.c +++ b/RIGAL/rigsc.446/src/c1.c @@ -4,32 +4,35 @@ #include "nef2.h" #include "c1.h" -/* Local variables for bltin: */ -struct LOC_bltin { +/* static variables for bltin: */ +struct LOC_bltin +{ long l; bl80 mm; -} ; +}; -Local long alen(k, LINK) -long k; -struct LOC_bltin *LINK; +static long +alen (k, LINK) + long k; + struct LOC_bltin *LINK; { a t; t = k; - pointa(t, LINK->mm, &LINK->l); /*ibm*/ + get_data_from_pointa (t, LINK->mm, &LINK->l); /*ibm */ return LINK->l; -} /* alen */ +} /* alen */ -Void bltin(rr, success, arg, n) -v *rr; -boolean *success; -long arg, n; +void +bltin (rr, success, arg, n) + v *rr; + bool *success; + long arg, n; { /* nomer wstr.prawila */ /*===========================*/ @@ -43,7 +46,7 @@ long arg, n; mpd x, y; long t; longint li_; - string80 s80; /* for parameter */ + string80 s80; /* for parameter */ atomdescriptor *WITH; numberdescriptor *WITH1; @@ -53,253 +56,267 @@ long arg, n; rulenum = n; k = arg; if ((k & 511) != 0 || k >= 65536L || k < 0) - pointr(k, &x.sa); + assert_and_assign_real_pointer (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 */ + 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 listmain: - rr->nu = x.smld->totalelnum; - 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 treemain: - rr->nu = x.smtd->totalarcnum; - 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; - default: + case 15: /* #len */ + if (k == null_) 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 + 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; - } - 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 */ + else + *success = (x.sad->dtype == rulename); + break; - 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; + case 12: /* #_varname */ + if (k == null_) + *success = false; else - WITH->dtype = atom; - WITH->name = s; - rez = k; - } - break; - /* chr */ + *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 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++; + case 19: /* #debug */ + debugrule = true; + break; + + case 21: /* _content2 */ + if ((k & 511) == 0 && k < 65536L && k >= 0) + *success = false; else - lconc(&rez, str_to_atom(s80)); - V.l++; - } + { + 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 */ - break; + case 23: /* parm */ + rez = null_; + V.l = 1; + while (V.l < g_argc) + { + strcpy (s80, g_argv[(int) V.l]); + keep_string_up_to_first_space (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 */ + 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; + get_data_from_pointa (k, V.mm, &V.l); + rr->nu = V.mm[0]; + } + else + *success = false; + break; + /* ord */ + + + } /* case */ _L99: if (!*success) rez = null_; @@ -309,28 +326,31 @@ _L99: -Void mkatom(k, atype, r) -long k; -char atype; -long *r; +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); + if (k == 0) + { + *r = null_; + return; + } + gets1 (r, &x.sa); WITH = x.sad; WITH->dtype = atype; WITH->name = k; -} /* mkatom */ +} /* mkatom */ -Void crlist(l) -long *l; +void +crlist (l) + long *l; { /* sozdatx pustoj spisok */ long n; @@ -338,7 +358,7 @@ long *l; mainlistdescriptor *WITH; - gets5(l, &x.sa); + gets5 (l, &x.sa); WITH = x.smld; WITH->dtype = listmain; WITH->elnum = 0; @@ -347,205 +367,208 @@ long *l; WITH->next = null_; for (n = 0; n < mainlistelnum; n++) WITH->elt[n] = null_; -} /* crlist */ +} /* crlist */ -Static Void errstrmes(n, m) -long n; -Char *m; +static void +errstrmes (n, m) + long n; + char *m; { - Char STR2[130]; + char STR2[130]; - switch (n) { + switch (n) + { - case 1: - sprintf(m, "Interpreter stack size overflow (stack size = %s);", - strcpy(STR2, m)); - break; + 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 2: + strcpy (m, "Assignment left side is not list or tree"); + break; - case 3: - strcpy(m, "List index is not number"); - break; + case 3: + strcpy (m, "List index is not number"); + break; - case 4: - strcpy(m, "Using [..] not for list"); - break; + case 4: + strcpy (m, "Using [..] not for list"); + break; - case 5: - strcpy(m, "Index value exceeds list bounds"); - break; + case 5: + strcpy (m, "Index value exceeds list bounds"); + break; - case 6: - strcpy(m, "Not list or tree after \"::\""); - break; + case 6: + strcpy (m, "Not list or tree after \"::\""); + break; - case 7: - strcpy(m, "Not atomic name before \"::\""); - break; + case 7: + strcpy (m, "Not atomic name before \"::\""); + break; - case 8: - strcpy(m, "NULL in left side of assignment"); - 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 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 10: + strcpy (m, "Not numerical value in right side of \"+:=\" statement"); + break; - case 11: - strcpy(m, "File specification is not atom"); - break; + case 11: + strcpy (m, "File specification is not atom"); + break; - case 12: - strcpy(m, "Too long file specification"); - break; + case 12: + strcpy (m, "Too long file specification"); + break; - case 13: - strcpy(m, "Too much open text files"); - break; + case 13: + strcpy (m, "Too much open text files"); + break; - case 14: - strcpy(m, "File not open for output"); - break; + case 14: + strcpy (m, "File not open for output"); + break; - case 15: - strcpy(m, "Wrong file name in SAVE statement "); - 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 16: + strcpy (m, "File was not closed before new opening"); + break; - case 17: - strcpy(m, "Atom length exceeds file record length"); - break; + case 17: + strcpy (m, "Atom length exceeds file record length"); + break; - case 18: - strcpy(m, "Not exist file in LOAD statement "); - break; + case 18: + strcpy (m, "Not exist file in LOAD statement "); + break; - case 19: - strcpy(m, "Wrong file name in OPEN statement "); - break; + case 19: + strcpy (m, "Wrong file name in OPEN statement "); + break; - case 21: - strcpy(m, "Selector after \".\" is not identifier "); - break; + case 21: + strcpy (m, "Selector after \".\" is not identifier "); + break; - case 22: - strcpy(m, "Selector in tree constructor 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 23: + strcpy (m, "Not tree before \".\" operation "); + break; - case 24: - strcpy(m, "Not tree or list as base of FORALL-IN statement "); - 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 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; - } + case 26: + strcpy (m, "\"BRANCHES\" option cannot be used for lists "); + break; + + default: + strcpy (m, "Unknown error"); + break; + } } -Void er(n) -long n; +void +er (n) + long n; { /* kod oshibki */ string80 m; - errstrmes(n, m); + errstrmes (n, m); if (out_open) - fprintf(out, "*** ERROR %12ld %s\n", n, m); + fprintf (out, "*** ERROR %12ld %s\n", n, m); else - printf("*** ERROR %12ld %s\n", n, m); + printf ("*** ERROR %12ld %s\n", n, m); -} /* err */ +} /* err */ -Void errstr(n, s) -long n; -Char *s; +void +errstr (n, s) + long n; + char *s; { string80 m; - errstrmes(n, m); + errstrmes (n, m); if (out_open) - fprintf(out, "*** ERROR %12ld %s%s\n", n, m, s); + fprintf (out, "*** ERROR %12ld %s%s\n", n, m, s); else - printf("*** ERROR %12ld %s%s\n", n, m, s); -} /* err */ + printf ("*** ERROR %12ld %s%s\n", n, m, s); +} /* err */ /* used for statistics only */ -Void d1(r) -long r; +void +d1 (r) + long r; { /* called from runtime library, s=1, r=1000..1030 */ } -Void - d -( -status_r - , - rule_name -, rulenum, param, success) -long status_r , rulenum, param; -char * rule_name; -boolean success; +void d (status_r, rule_name, rulenum, param, success) + long status_r, rulenum, param; + char *rule_name; + bool success; { /* called from r1..r999 r=1..999, s=1..4 */ - if (status_r == 1) { /* Enters rule */ - printf("=>>>CALLS RULE #%s\n",rule_name); - printf(" 1-ST ARGUMENT($):"); - pscr(param); - printf("\n"); -} - if (status_r == 2) { - printf("<<<=EXITS FROM RULE #%s:",rule_name); - if (success) printf(" SUCCESS\n"); - else printf(" UNSUCCESS\n"); - printf("RESULT:"); - pscr(param); - printf("\n"); - } + if (status_r == 1) + { /* Enters rule */ + printf ("=>>>CALLS RULE #%s\n", rule_name); + printf (" 1-ST ARGUMENT($):"); + pscr (param); + printf ("\n"); + } + if (status_r == 2) + { + printf ("<<<=EXITS FROM RULE #%s:", rule_name); + if (success) + printf (" SUCCESS\n"); + else + printf (" UNSUCCESS\n"); + printf ("RESULT:"); + pscr (param); + printf ("\n"); + } /* 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; - */ + 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; + */ } @@ -553,10 +576,11 @@ boolean success; -Void addel(sel, not_atomic, xsel, ob, tr_) -long sel; -boolean not_atomic; -long xsel, ob, *tr_; +void +addel (sel, not_atomic, xsel, ob, tr_) + long sel; + bool not_atomic; + long xsel, ob, *tr_; { /*===============================*/ /* dobawitx k derewu |lement */ @@ -565,30 +589,35 @@ long xsel, ob, *tr_; /* wyhod s tr:=l */ /* wyhod bez tr:=l */ - mpd x; /* dostup k glawnomu deskr.derewa */ + 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; + if (not_atomic) + { + if (xsel == null_) + { + er (21L); + goto _L2; + } + assert_and_assign_real_pointer (xsel, &x.sa); + if (x.sad->dtype != idatom) + { + er (22L); + goto _L2; + } + sel = x.sad->name; } - sel = x.sad->name; - } - addel3(tr_, sel, ob); -_L2: ; + addel3 (tr_, sel, ob); +_L2:; } -long numval(ob) -long ob; +long +numval (ob) + long ob; { /*=============*/ /* ob -> ~islo */ @@ -598,13 +627,14 @@ long ob; 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 */ - } + else + { + assert_and_assign_real_pointer (ob, &x.sa); + if (x.snd->dtype != number) + return 0; + else + return (x.snd->val); /* sign proc deleted */ + } } diff --git a/RIGAL/rigsc.446/src/c2.c b/RIGAL/rigsc.446/src/c2.c index ce971c7a3c6898ac99b08ae2d3dfbb0d4ce3f718..ddce57dbbf56d705875beb6b575f455e3ae5b541 100644 --- a/RIGAL/rigsc.446/src/c2.c +++ b/RIGAL/rigsc.446/src/c2.c @@ -5,8 +5,9 @@ #include "c1.h" -Void addnum(a1, a2) -long *a1, a2; +void +addnum (a1, a2) + long *a1, a2; { /*===========*/ /* a1 +:= a2 */ @@ -15,27 +16,32 @@ long *a1, a2; numberdescriptor *WITH; - if (*a1 == null_) { - mknumb(a2, a1); - return; - } - points(*a1, &x.sa); - /* changed from pointr 25-jul-1989 + if (*a1 == null_) + { + mknumb (a2, a1); + return; + } + assert_and_assign_real_pointer (*a1, &x.sa); + /* changed from assert_and_assign_real_pointer 25-jul-1989 due to change in vax 10-feb-1989 */ - if (x.snd->dtype != number) { - er(9L); - *a1 = null_; - } else { - WITH = x.snd; - WITH->val += a2; /* deleted sign */ - } -} /* addnum*/ - - -Void setsel(xn, not_atomic, xa, tr_, rez) -long xn; -boolean not_atomic; -long xa, tr_, rez; + if (x.snd->dtype != number) + { + er (9L); + *a1 = null_; + } + else + { + WITH = x.snd; + WITH->val += a2; /* deleted sign */ + } +} /* addnum */ + + +void +setsel (xn, not_atomic, xa, tr_, rez) + long xn; + bool not_atomic; + long xa, tr_, rez; { /*==============================================*/ /* whod: tr x */ @@ -44,7 +50,7 @@ long xa, tr_, rez; /* wyhod */ mpd x; - a n; /* imq selektora */ + a n; /* imq selektora */ a t; long i, j; maintreedescriptor *WITH; @@ -53,30 +59,35 @@ long xa, tr_, rez; - if (not_atomic) { - if (xa == null_) { - er(21L); - goto _L1; - } - pointr(xa, &x.sa); - if (x.sad->dtype != idatom) { - er(22L); - goto _L1; + if (not_atomic) + { + if (xa == null_) + { + er (21L); + goto _L1; + } + assert_and_assign_real_pointer (xa, &x.sa); + if (x.sad->dtype != idatom) + { + er (22L); + goto _L1; + } + n = x.sad->name; } - n = x.sad->name; - } else + else n = xn; if (tr_ == null_) goto _L1; /* rezulxtat =null */ /* opredelitx tip tr */ - pointr(tr_, &x.sa); - if (x.smtd->dtype != treemain) { /* sna~ala w glawnom derewe */ - /* oibka */ - er(23L); - goto _L1; - } + assert_and_assign_real_pointer (tr_, &x.sa); + if (x.smtd->dtype != treemain) + { /* sna~ala w glawnom derewe */ + /* oibka */ + er (23L); + goto _L1; + } /*=====================================*/ /* x ukazywaet na glawn.deskr. derewa */ @@ -84,57 +95,65 @@ long xa, tr_, rez; /*=====================================*/ /* poisk selektora n w derewe x */ - WITH = x.smtd; /* with */ + WITH = x.smtd; /* with */ FORLIM = WITH->arcnum; - for (i = 1; i <= FORLIM; i++) { - if (WITH->arc[i - 1].arcname == n) { /* na{li */ - points(tr_, &x.sa); - WITH->arc[i - 1].elt = rez; - if (rez == null_) { - FORLIM1 = WITH->arcnum; - for (j = i; j < FORLIM1; j++) - WITH->arc[j - 1] = WITH->arc[j]; - WITH->arcnum--; - WITH->totalarcnum--; - } - goto _L1; + for (i = 1; i <= FORLIM; i++) + { + if (WITH->arc[i - 1].arcname == n) + { /* na{li */ + assert_and_assign_real_pointer (tr_, &x.sa); + WITH->arc[i - 1].elt = rez; + if (rez == null_) + { + FORLIM1 = WITH->arcnum; + for (j = i; j < FORLIM1; j++) + WITH->arc[j - 1] = WITH->arc[j]; + WITH->arcnum--; + WITH->totalarcnum--; + } + goto _L1; + } } - } t = WITH->next; /* prodolvaem poisk w fragmentah */ - while (t != null_) { - pointr(t, &x.sa); - WITH1 = x.sftd; - FORLIM = WITH1->arcnum; - for (i = 1; i <= FORLIM; i++) { - if (WITH1->arc[i - 1].arcname == n) { /* na{li */ - points(t, &x.sa); - WITH1->arc[i - 1].elt = rez; - if (rez == null_) { - FORLIM1 = WITH1->arcnum; - for (j = i; j < FORLIM1; j++) - WITH1->arc[j - 1] = WITH1->arc[j]; - WITH1->arcnum--; - points(tr_, &x.sa); - WITH = x.smtd; - WITH->totalarcnum--; + while (t != null_) + { + assert_and_assign_real_pointer (t, &x.sa); + WITH1 = x.sftd; + FORLIM = WITH1->arcnum; + for (i = 1; i <= FORLIM; i++) + { + if (WITH1->arc[i - 1].arcname == n) + { /* na{li */ + assert_and_assign_real_pointer (t, &x.sa); + WITH1->arc[i - 1].elt = rez; + if (rez == null_) + { + FORLIM1 = WITH1->arcnum; + for (j = i; j < FORLIM1; j++) + WITH1->arc[j - 1] = WITH1->arc[j]; + WITH1->arcnum--; + assert_and_assign_real_pointer (tr_, &x.sa); + WITH = x.smtd; + WITH->totalarcnum--; + } + goto _L1; + } } - goto _L1; - } - } - t = WITH1->next; /* with */ - } /* while */ + t = WITH1->next; /* with */ + } /* while */ /* ne nali ! */ - er(8L); -_L1: ; -} /* setsel */ + er (8L); +_L1:; +} /* setsel */ -Void setind(xx, isobject, xa, l, rez) -long xx; -boolean isobject; -long xa, l, rez; +void +setind (xx, isobject, xa, l, rez) + long xx; + bool isobject; + long xa, l, rez; { /*==============================================*/ /* whod: l xx */ @@ -151,23 +170,27 @@ long xa, l, rez; - if (isobject) { - n = numval(xa); - if (n == 0) { - er(3L); - goto _L1; + if (isobject) + { + n = numval (xa); + if (n == 0) + { + er (3L); + goto _L1; + } } - } else + else n = xx; /* w n -zna~enie indeksa */ - if (l == null_) /* rezulxtat= null */ + if (l == null_) /* rezulxtat= null */ goto _L1; /* opredelitx tip l */ - pointr(l, &y.sa); - if (y.smld->dtype != listmain) { - er(4L); - goto _L1; - } + assert_and_assign_real_pointer (l, &y.sa); + if (y.smld->dtype != listmain) + { + er (4L); + goto _L1; + } /*============================================*/ /* y ukazywaet na deskriptor glawnogo spiska */ /*============================================*/ @@ -175,37 +198,43 @@ long xa, l, rez; k = y.smld->totalelnum; if (n < 0) n += k + 1; - if (n < 1 || n > k) { - er(5L); - /* indeks wne spiska */ - goto _L1; - } + if (n < 1 || n > k) + { + er (5L); + /* indeks wne spiska */ + goto _L1; + } /*================================*/ /* poisk |l-ta spiska */ /*================================*/ - if (n <= y.smld->elnum) { - points(l, &y.sa); - y.smld->elt[n - 1] = rez; - } else { - n -= y.smld->elnum; - t = y.smld->next; - pointr(t, &y.sa); - while (n > y.sfld->elnum) { - n -= y.sfld->elnum; - t = y.sfld->next; - pointr(t, &y.sa); + if (n <= y.smld->elnum) + { + assert_and_assign_real_pointer (l, &y.sa); + y.smld->elt[n - 1] = rez; } - points(t, &y.sa); - y.sfld->elt[n - 1] = rez; - } -_L1: ; -} /* setind */ + else + { + n -= y.smld->elnum; + t = y.smld->next; + assert_and_assign_real_pointer (t, &y.sa); + while (n > y.sfld->elnum) + { + n -= y.sfld->elnum; + t = y.sfld->next; + assert_and_assign_real_pointer (t, &y.sa); + } + assert_and_assign_real_pointer (t, &y.sa); + y.sfld->elt[n - 1] = rez; + } +_L1:; +} /* setind */ -Void selop(xn, not_atomic, xa, tr_, rez) -long xn; -boolean not_atomic; -long xa, tr_, *rez; +void +selop (xn, not_atomic, xa, tr_, rez) + long xn; + bool not_atomic; + long xa, tr_, *rez; { /*==============================================*/ /* whod: tr x */ @@ -214,7 +243,7 @@ long xa, tr_, *rez; /* wyhod */ mpd x; - a n; /* imq selektora */ + a n; /* imq selektora */ a t; long i; maintreedescriptor *WITH; @@ -223,30 +252,35 @@ long xa, tr_, *rez; *rez = null_; - if (not_atomic) { - if (xa == null_) { - er(21L); - goto _L1; - } - pointr(xa, &x.sa); - if (x.sad->dtype != idatom) { - er(22L); - goto _L1; + if (not_atomic) + { + if (xa == null_) + { + er (21L); + goto _L1; + } + assert_and_assign_real_pointer (xa, &x.sa); + if (x.sad->dtype != idatom) + { + er (22L); + goto _L1; + } + n = x.sad->name; } - n = x.sad->name; - } else + else n = xn; if (tr_ == null_) goto _L1; /* rezulxtat =null */ /* opredelitx tip tr */ - pointr(tr_, &x.sa); - if (x.smtd->dtype != treemain) { /* sna~ala w glawnom derewe */ - /* o{ibka */ - er(23L); - goto _L1; - } + assert_and_assign_real_pointer (tr_, &x.sa); + if (x.smtd->dtype != treemain) + { /* sna~ala w glawnom derewe */ + /* o{ibka */ + er (23L); + goto _L1; + } /*=====================================*/ /* x ukazywaet na glawn.deskr. derewa */ @@ -254,38 +288,44 @@ long xa, tr_, *rez; /*=====================================*/ /* poisk selektora n w derewe x */ - WITH = x.smtd; /* with */ + WITH = x.smtd; /* with */ FORLIM = WITH->arcnum; - for (i = 0; i < FORLIM; i++) { - if (WITH->arc[i].arcname == n) { /* na{li */ - *rez = WITH->arc[i].elt; - goto _L1; + for (i = 0; i < FORLIM; i++) + { + if (WITH->arc[i].arcname == n) + { /* na{li */ + *rez = WITH->arc[i].elt; + goto _L1; + } } - } t = WITH->next; /* prodolvaem poisk w fragmentah */ - while (t != null_) { - pointr(t, &x.sa); - WITH1 = x.sftd; - FORLIM = WITH1->arcnum; - for (i = 0; i < FORLIM; i++) { - if (WITH1->arc[i].arcname == n) { /* na{li */ - *rez = WITH1->arc[i].elt; - goto _L1; - } - } - t = WITH1->next; /* with */ - } /* while */ + while (t != null_) + { + assert_and_assign_real_pointer (t, &x.sa); + WITH1 = x.sftd; + FORLIM = WITH1->arcnum; + for (i = 0; i < FORLIM; i++) + { + if (WITH1->arc[i].arcname == n) + { /* na{li */ + *rez = WITH1->arc[i].elt; + goto _L1; + } + } + t = WITH1->next; /* with */ + } /* while */ /* ne na{li ! */ -_L1: ; -} /* selop */ +_L1:; +} /* selop */ -Void indxop(xx, isobject, xa, l, rez) -long xx; -boolean isobject; -long xa, l, *rez; +void +indxop (xx, isobject, xa, l, rez) + long xx; + bool isobject; + long xa, l, *rez; { /*==============================================*/ /* whod: l xx */ @@ -303,23 +343,27 @@ long xa, l, *rez; *rez = null_; - if (isobject) { - n = numval(xa); - if (n == 0) { - er(3L); - goto _L1; + if (isobject) + { + n = numval (xa); + if (n == 0) + { + er (3L); + goto _L1; + } } - } else + else n = xx; /* w n -zna~enie indeksa */ - if (l == null_) /* rezulxtat= null */ + if (l == null_) /* rezulxtat= null */ goto _L1; /* opredelitx tip l */ - pointr(l, &y.sa); - if (y.smld->dtype != listmain) { - er(4L); - goto _L1; - } + assert_and_assign_real_pointer (l, &y.sa); + if (y.smld->dtype != listmain) + { + er (4L); + goto _L1; + } /*============================================*/ /* y ukazywaet na deskriptor glawnogo spiska */ /*============================================*/ @@ -327,34 +371,38 @@ long xa, l, *rez; k = y.smld->totalelnum; if (n < 0) n += k + 1; - if (n < 1 || n > k) { - er(5L); - /* indeks wne spiska */ - goto _L1; - } + if (n < 1 || n > k) + { + er (5L); + /* indeks wne spiska */ + goto _L1; + } /*================================*/ /* poisk |l-ta spiska */ /*================================*/ if (n <= y.smld->elnum) *rez = y.smld->elt[n - 1]; - else { - n -= y.smld->elnum; - t = y.smld->next; - pointr(t, &y.sa); - while (n > y.sfld->elnum) { - n -= y.sfld->elnum; - t = y.sfld->next; - pointr(t, &y.sa); + else + { + n -= y.smld->elnum; + t = y.smld->next; + assert_and_assign_real_pointer (t, &y.sa); + while (n > y.sfld->elnum) + { + n -= y.sfld->elnum; + t = y.sfld->next; + assert_and_assign_real_pointer (t, &y.sa); + } + *rez = y.sfld->elt[n - 1]; } - *rez = y.sfld->elt[n - 1]; - } /* w rez rezulxtat = l [ x ] */ -_L1: ; -} /* indxop */ +_L1:; +} /* indxop */ -Void concop(a1, a2) -long *a1, a2; +void +concop (a1, a2) + long *a1, a2; { /*======================================*/ /* operaciq a1 !! a2 */ @@ -369,43 +417,51 @@ long *a1, a2; l = *a1; - if (a2 == null_) { - if (l == null_) - goto _L99; - else { - pointr(l, &x.sa); - if (x.smld->dtype == listmain) + if (a2 == null_) + { + if (l == null_) goto _L99; - else { - l = null_; - goto _L99; - } + else + { + assert_and_assign_real_pointer (l, &x.sa); + if (x.smld->dtype == listmain) + goto _L99; + else + { + l = null_; + goto _L99; + } + } } - } - pointr(a2, &x.sa); - if (x.smld->dtype != listmain) { - l = null_; - goto _L99; - } - if (l != null_) { - pointr(l, &x.sa); - if (x.smld->dtype != listmain) { + assert_and_assign_real_pointer (a2, &x.sa); + if (x.smld->dtype != listmain) + { l = null_; goto _L99; } - } - first(a2, &p1); - while (p1.nel != 0) { - lconc(&l, p1.cel); - next(&p1); - } + if (l != null_) + { + assert_and_assign_real_pointer (l, &x.sa); + if (x.smld->dtype != listmain) + { + l = null_; + goto _L99; + } + } + first (a2, &p1); + while (p1.nel != 0) + { + lconc (&l, p1.cel); + next (&p1); + } _L99: *a1 = l; -} /* concop */ +} /* concop */ -Void copyop(ob, rez) -long ob, *rez; +void +copyop (ob, rez) + long ob, *rez; { /*==========================*/ /*whod: ob */ @@ -413,62 +469,66 @@ long ob, *rez; /*==========================*/ /* wyhod */ + long k; mpd x, y, z; a r1, r2, r3; - if (ob == null_) { - *rez = null_; - goto _L99; - } - pointr(ob, &x.sa); - switch (x.sad->dtype) { - - case atom: - case idatom: - case keyword: - case number: - case tatom: - case fatom: - case variable: - case idvariable: - case nvariable: - case fvariable: - case spec: /* coord removed */ - gets1(&r1, &y.sa); - *y.sad = *x.sad; - *rez = r1; - break; - - case rulename: - case object_d: - gets2(&r1, &y.sa); - *y.srd = *x.srd; - *rez = r1; - break; - - case listmain: - case treemain: - gets5(&r1, &y.sa); - /* skopirowatx glawnyj deskriptor */ - *y.smld = *x.smld; - *rez = r1; - r2 = x.smld->next; - while (r2 != null_) { - pointr(r2, &x.sa); - gets5(&r3, &z.sa); - *z.smld = *x.smld; - points(r1, &y.sa); - y.smld->next = r3; - r1 = r3; - r2 = z.smld->next; - } /* while */ - break; - - }/* case */ -_L99: ; /* wyhod */ -} /* copyop */ + if (ob == null_) + { + *rez = null_; + goto _L99; + } + assert_and_assign_real_pointer (ob, &x.sa); + switch (x.sad->dtype) + { + + case atom: + case idatom: + case keyword: + case number: + case tatom: + case fatom: + case variable: + case idvariable: + case nvariable: + case fvariable: + case spec: /* coord removed */ + gets1 (&r1, &y.sa); + *y.sad = *x.sad; + *rez = r1; + break; + + case rulename: + case object_d: + gets2 (&r1, &y.sa); + *y.srd = *x.srd; + *rez = r1; + break; + + case listmain: + case treemain: + gets5 (&r1, &y.sa); + /* skopirowatx glawnyj deskriptor */ + *y.smld = *x.smld; + *rez = r1; + r2 = x.smld->next; + while (r2 != null_) + { + assert_and_assign_real_pointer (r2, &x.sa); + gets5 (&r3, &z.sa); + *z.smld = *x.smld; + assert_and_assign_real_pointer (r1, &y.sa); + y.smld->next = r3; + r1 = r3; + r2 = z.smld->next; + } /* while */ + break; + + } /* case */ +_L99:; /* wyhod */ +} /* copyop */ diff --git a/RIGAL/rigsc.446/src/c3.c b/RIGAL/rigsc.446/src/c3.c index 12be4901de21ae619d2425059a0dcd65c8437abc..b64f5e0c551118a9c899a83fe663b7e5251c0b35 100644 --- a/RIGAL/rigsc.446/src/c3.c +++ b/RIGAL/rigsc.446/src/c3.c @@ -4,7 +4,8 @@ #include "nef2.h" #include "c1.h" -Void prolog() +void +prolog () { /*===============*/ /* inicializaciq */ @@ -18,19 +19,22 @@ Void prolog() /* inicializaciq peremennyh */ - /*if argc>1 then argv(1,printfile_str) else printfile_str:='';*/ + /*if argc>1 then argv(1,printfile_str) else printfile_str:=''; */ *printfile_str = '\0'; - for (i = 1; i < g_argc; i++) { - strcpy(sstr,g_argv[i]); - brt(sstr); - if (!strcmp(sstr, "-p")) { - if (i <= g_argc - 2) { - strcpy(printfile_str,g_argv[i + 1]); - brt(printfile_str); - goto _L18; - } + for (i = 1; i < g_argc; i++) + { + strcpy (sstr, g_argv[i]); + keep_string_up_to_first_space (sstr); + if (!strcmp (sstr, "-p")) + { + if (i <= g_argc - 2) + { + strcpy (printfile_str, g_argv[i + 1]); + keep_string_up_to_first_space (printfile_str); + goto _L18; + } + } } - } _L18: @@ -38,7 +42,7 @@ _L18: /* writeln('Compiled Rigal/SUN /(c)1992 v.',rigal_version, - ', LU, Riga'); + ', LU, Riga'); writeln(''); writeln( ' print-file-name may be s=screen, NUL=dummy, or any file'); @@ -47,17 +51,17 @@ _L18: readln; */ - opens('@'); + opens (); - init_dinform(); - opena(); - if (!strcmp(printfile_str, "s")) - *printfile_str = '\0'; - if ( false ) - { - printf(" Wrong PRINT file name changed to standard output\n"); + init_dinform (); + opena (); + if (!strcmp (printfile_str, "s")) *printfile_str = '\0'; - } + if (!((*printfile_str == '\0') | rightfile (printfile_str))) + { + printf (" Wrong PRINT file name changed to standard output\n"); + *printfile_str = '\0'; + } max_printlevel = max_printconst; @@ -65,362 +69,394 @@ _L18: out_screen = (*printfile_str == '\0'); out_open = !out_screen; - if (!out_screen) { - out = fopen(printfile_str,"w"); - if (out == NULL) - _EscIO(FileNotFound); - } + if (!out_screen) + { + out = fopen (printfile_str, "w"); + if (out == NULL) + _EscIO (FileNotFound); + } debugrule = false; /* all the files are closed */ for (iii = 0; iii < filenum; iii++) filetab[iii].isopen = false; -} /* prolog */ +} /* prolog */ -Void epilog() +void +epilog () { long iii; longint dr, dw, dp; - for (iii = 0; iii < filenum; iii++) { - if (filetab[iii].isopen) { - if (filetab[iii].screen) - putchar('\n'); - else { - putc('\n', files[iii]); - if (files[iii] != NULL) - fclose(files[iii]); - files[iii] = NULL; - } + for (iii = 0; iii < filenum; iii++) + { + if (filetab[iii].isopen) + { + if (filetab[iii].screen) + putchar ('\n'); + else + { + putc ('\n', files[iii]); + if (files[iii] != NULL) + fclose (files[iii]); + files[iii] = NULL; + } + } } - } - if (out_open) { - if (out != NULL) - fclose(out); - out = NULL; - } - vola(&dr, &dw, &dp); + if (out_open) + { + if (out != NULL) + fclose (out); + out = NULL; + } + vola (&dr, &dw, &dp); if (dr + dw + dp > 0) - printf("A-Space:%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); - vols(&dr, &dw, &dp); + printf ("A-Space:%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); + vols (&dr, &dw, &dp); if (dr + dw + dp > 0) - printf("S-Space:%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); - closea(); - closes(); + printf ("S-Space:%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); -} /* epilog */ +} /* epilog */ -Static Void wrg(i, s) -long i; -Char *s; +static void +wrg (i, s) + long i; + char *s; { if (filetab[i - 1].screen) - fputs(s, stdout); + fputs (s, stdout); else - fputs(s, files[i - 1]); + fputs (s, files[i - 1]); } -Static Void wrgln(i) -long i; +static void +wrgln (i) + long i; { if (filetab[i - 1].screen) - putchar('\n'); + putchar ('\n'); else - putc('\n', files[i - 1]); + putc ('\n', files[i - 1]); } -/* Local variables for outxt: */ -struct LOC_outxt { - boolean blanks; +/* static variables for outxt: */ +struct LOC_outxt +{ + bool blanks; - union { - struct { - Char c00; + union + { + struct + { + char c00; bl80 a80_; } U1; string80 s0; } rec00; - long i; /* i - nomer fajla */ + long i; /* i - nomer fajla */ longint rezlong; - long len; /* dlina atoma */ -} ; + long len; /* dlina atoma */ +}; -Local Void line(symlen, LINK) -long symlen; -struct LOC_outxt *LINK; +static void +line (symlen, LINK) + long symlen; + struct LOC_outxt *LINK; { /* kontroliruet zapolnenie stroki fajla */ - /* curlen - tekusaq dlina , symlen - nado wywesti ,*/ + /* curlen - tekusaq dlina , symlen - nado wywesti , */ /* strlen - specifikaciq fajla-dlina stroki */ _REC_filetab *WITH; - WITH = &filetab[LINK->i - 1]; /*with*/ + WITH = &filetab[LINK->i - 1]; /*with */ if (!(LINK->blanks && WITH->curlen + symlen > WITH->strlen)) - { /* esli na |toj stroke ne pomeaetsq */ - WITH->curlen += symlen; - return; - } - if (symlen > WITH->strlen + 1) /* slikom dlinnaq stroka */ - er(17L); - wrgln(LINK->i); + { /* esli na |toj stroke ne pomeaetsq */ + WITH->curlen += symlen; + return; + } + if (symlen > WITH->strlen + 1) /* slikom dlinnaq stroka */ + er (17L); + wrgln (LINK->i); /* perewod na nowu` stroku - */ + */ WITH->curlen = symlen; -} /*line*/ +} /*line */ -Local Void printlist(la, i, LINK) -long la, i; -struct LOC_outxt *LINK; +static void +printlist (la, i, LINK) + long la, i; + struct LOC_outxt *LINK; { /* procedura dlq pe~ati spiska */ /*la-adres, i-nomer fajla */ mpd x; ptr_ lptr; - boolean tatomflag; + bool tatomflag; a a1; longint k; long j; double rref; long FORLIM; - Char STR1[256]; + char STR1[256]; string80 STR2; /* this test is not actual - if ((la mod 512) = 0) and (la > 0) and (la<65536) then - begin - line(20); - wrg(i, ' <!<!!A*!*!!>!> '); - end - else - */ + if ((la mod 512) = 0) and (la > 0) and (la<65536) then + begin + line(20); + wrg(i, ' <!<!!A*!*!!>!> '); + end + else + */ /* pri la=0 - ni~ego ne pe~ataetsq */ - if (la == 0) { - return; - } /* else mod<>512 */ - pointr(la, &x.sa); - - switch (x.sad->dtype) { - - case atom: - case idatom: - case tatom: - case keyword: - case variable: - case fvariable: - case nvariable: - case idvariable: - case rulename: /*atom ...*/ - /* pe~atx otdelxnogo atoma */ - tatomflag = (x.sad->dtype == tatom); - switch (x.sad->dtype) { + if (la == 0) + { + return; + } /* else mod<>512 */ + assert_and_assign_real_pointer (la, &x.sa); + + switch (x.sad->dtype) + { case atom: case idatom: case tatom: case keyword: - a1 = x.sad->name; - break; - case variable: case fvariable: case nvariable: case idvariable: - a1 = x.svd->name; - wrg(i, "$"); - break; - - case rulename: - a1 = x.srd->name; - wrg(i, "#"); - break; - - }/*case*/ - pointa(a1, LINK->rec00.U1.a80_, &LINK->len); /* daet a80 i len */ - LINK->rec00.U1.c00 = (Char)LINK->len; - if (tatomflag) { - line(LINK->len + 2, LINK); - wrg(i, "'"); - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) { - if (LINK->rec00.U1.a80_[j] == '\'') - wrg(i, "''"); - else { - sprintf(STR1, "%c", LINK->rec00.U1.a80_[j]); - wrg(i, STR1); + case rulename: /*atom ... */ + /* pe~atx otdelxnogo atoma */ + tatomflag = (x.sad->dtype == tatom); + switch (x.sad->dtype) + { + + case atom: + case idatom: + case tatom: + case keyword: + a1 = x.sad->name; + break; + + case variable: + case fvariable: + case nvariable: + case idvariable: + a1 = x.svd->name; + wrg (i, "$"); + break; + + case rulename: + a1 = x.srd->name; + wrg (i, "#"); + break; + + } /*case */ + get_data_from_pointa (a1, LINK->rec00.U1.a80_, &LINK->len); /* daet a80 i len */ + LINK->rec00.U1.c00 = (char) LINK->len; + if (tatomflag) + { + line (LINK->len + 2, LINK); + wrg (i, "'"); + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + { + if (LINK->rec00.U1.a80_[j] == '\'') + wrg (i, "''"); + else + { + sprintf (STR1, "%c", LINK->rec00.U1.a80_[j]); + wrg (i, STR1); + } + } + wrg (i, "'"); } - } - wrg(i, "'"); - } else { /* if/else */ - line(LINK->len, LINK); - - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) { - sprintf(STR1, "%c", LINK->rec00.U1.a80_[j]); - wrg(i, STR1); - } - - } - if (LINK->blanks) { - line(1L, LINK); - wrg(i, " "); - } - break; - - case fatom: /* added 17-feb-92 */ - line(12L, LINK); /* standard length of written real */ + else + { /* if/else */ + line (LINK->len, LINK); + + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + { + sprintf (STR1, "%c", LINK->rec00.U1.a80_[j]); + wrg (i, STR1); + } + } + if (LINK->blanks) + { + line (1L, LINK); + wrg (i, " "); + } + break; - rref = take_fatom(x.sad->name); - wrg(i, real_to_string(STR2, rref)); - if (LINK->blanks) - wrg(i, " "); - break; + case fatom: /* added 17-feb-92 */ + line (12L, LINK); /* standard length of written real */ + rref = take_fatom (x.sad->name); + wrg (i, real_to_string (STR2, rref)); + if (LINK->blanks) + wrg (i, " "); + break; - case number: /* pe~atx ~isla */ - LINK->rezlong = x.snd->val; - k = LINK->rezlong; - if (k < 0) /* changed from abs call*/ - k = -k; - j = 0; - do { - k /= 10; - j++; - } while (k >= 1); - line(j, LINK); - wrg(i, long_to_str(STR2, LINK->rezlong)); - if (LINK->blanks) { - line(1L, LINK); - wrg(i, " "); - } - break; - /*number*/ - case listmain: /*listmain*/ - /* raspe~atka spiska */ - /* line(5);*/ - /* garantii koncow spiska */ - first(la, &lptr); - while (lptr.nel != 0) { - printlist(lptr.cel, i, LINK); - next(&lptr); - } /*while*/ - break; + case number: /* pe~atx ~isla */ + LINK->rezlong = x.snd->val; + k = LINK->rezlong; + if (k < 0) /* changed from abs call */ + k = -k; + j = 0; + do + { + k /= 10; + j++; + } + while (k >= 1); + line (j, LINK); + + wrg (i, long_to_str (STR2, LINK->rezlong)); + if (LINK->blanks) + { + line (1L, LINK); + wrg (i, " "); + } + break; + /*number */ + + case listmain: /*listmain */ + /* raspe~atka spiska */ + /* line(5); */ + /* garantii koncow spiska */ + first (la, &lptr); + while (lptr.nel != 0) + { + printlist (lptr.cel, i, LINK); + next (&lptr); + } /*while */ + break; - case treemain: - line(20L, LINK); - wrg(i, " <!<!<*TREE*>!>!> "); - break; + case treemain: + line (20L, LINK); + wrg (i, " <!<!<*TREE*>!>!> "); + break; - default: - line(20L, LINK); - wrg(i, " <!<!<UNK***>!>!> "); /* otherwise */ - break; - }/* case */ + default: + line (20L, LINK); + wrg (i, " <!<!<UNK***>!>!> "); /* otherwise */ + break; + } /* case */ /* if blanks then-- pereneseno wwerh 20.7.88 - wrg(i, ' '); */ + wrg(i, ' '); */ -} /* printlist */ +} /* printlist */ -Void outxt(fname, arg, nl, blanks_) -long fname, arg; -boolean nl, blanks_; +void +outxt (fname, arg, nl, blanks_) + long fname, arg; + bool nl, blanks_; { - /* a-adr.imeni fajla*/ - /* s-adr.wyw.obxekta*/ - /* s now.stroki*/ - /* s probelami*/ + /* a-adr.imeni fajla */ + /* s-adr.wyw.obxekta */ + /* s now.stroki */ + /* s probelami */ /* ===================================== */ /* obespe~iwaet wypolnenie operatorow wywoda */ /* ===================================== */ struct LOC_outxt V; - long openlen; /* dlq pods~eta {iriny fajla */ - a rez; /* rezulxtat expression */ + long openlen; /* dlq pods~eta {iriny fajla */ + a rez; /* rezulxtat expression */ /* ========= osnownaq procedura ========== */ V.blanks = blanks_; /* wywod << << << << */ - /*writeln('OUTXT dlq FNAME=', fname);**********/ - for (V.i = 1; V.i <= filenum; V.i++) { - if (filetab[V.i - 1].name == fname && filetab[V.i - 1].isopen) { - if (nl) { - wrgln(V.i); - filetab[V.i - 1].curlen = 0; - } - printlist(arg, V.i, &V); - goto _L99; - } /* for/ if open */ - } + /*writeln('OUTXT dlq FNAME=', fname);********* */ + for (V.i = 1; V.i <= filenum; V.i++) + { + if (filetab[V.i - 1].name == fname && filetab[V.i - 1].isopen) + { + if (nl) + { + wrgln (V.i); + filetab[V.i - 1].curlen = 0; + } + printlist (arg, V.i, &V); + goto _L99; + } /* for/ if open */ + } - er(14L); /* fajl ne otkryt */ -_L99: ; -} /* outxt */ + er (14L); /* fajl ne otkryt */ +_L99:; +} /* outxt */ -/* Local variables for outatm: */ -struct LOC_outatm { - boolean blanks; +/* static variables for outatm: */ +struct LOC_outatm +{ + bool blanks; long i; -} ; +}; /* curlen - tekusaq dlina , symlen - nado wywesti ,*/ /* strlen - specifikaciq fajla-dlina stroki */ -Local Void line_(symlen, LINK) -long symlen; -struct LOC_outatm *LINK; +static void +line_ (symlen, LINK) + long symlen; + struct LOC_outatm *LINK; { /* kontroliruet zapolnenie stroki fajla */ - /* curlen - tekusaq dlina , symlen - nado wywesti ,*/ + /* curlen - tekusaq dlina , symlen - nado wywesti , */ /* strlen - specifikaciq fajla-dlina stroki */ _REC_filetab *WITH; - WITH = &filetab[LINK->i - 1]; /*with*/ + WITH = &filetab[LINK->i - 1]; /*with */ if (!(LINK->blanks && WITH->curlen + symlen > WITH->strlen)) - { /* esli na |toj stroke ne pomeaetsq */ - WITH->curlen += symlen; - return; - } - if (symlen > WITH->strlen + 1) /* slikom dlinnaq stroka */ - er(17L); - wrgln(LINK->i); + { /* esli na |toj stroke ne pomeaetsq */ + WITH->curlen += symlen; + return; + } + if (symlen > WITH->strlen + 1) /* slikom dlinnaq stroka */ + er (17L); + wrgln (LINK->i); /* perewod na nowu` stroku - */ + */ WITH->curlen = symlen; -} /*line*/ +} /*line */ -Void outatm(fname, arg_, nl, blanks_) -long fname; -Char *arg_; -boolean nl, blanks_; +void +outatm (fname, arg_, nl, blanks_) + long fname; + char *arg_; + bool nl, blanks_; { - /* a-adr.imeni fajla*/ - /* wywodimyj atom*/ - /* s now.stroki*/ - /* s probelami*/ + /* a-adr.imeni fajla */ + /* wywodimyj atom */ + /* s now.stroki */ + /* s probelami */ /* ===================================== */ /* obespe~iwaet wypolnenie bystrogo wywoda ne~islowogo atoma */ /* ===================================== */ @@ -428,161 +464,180 @@ boolean nl, blanks_; string80 arg; _REC_filetab *WITH; - strcpy(arg, arg_); + strcpy (arg, arg_); V.blanks = blanks_; - for (V.i = 1; V.i <= filenum; V.i++) { - if (filetab[V.i - 1].name == fname && filetab[V.i - 1].isopen) { - WITH = &filetab[V.i - 1]; /*with*/ - if (nl) { - wrgln(V.i); - WITH->curlen = 0; - } - /* change 4-dec-92 */ - line_((long)strlen(arg), &V); - wrg(V.i, arg); - if (V.blanks) { - line_(1L, &V); - wrg(V.i, " "); - } /* change 4-dec-92 */ - goto _L99; - } /* for/ if open */ - } + for (V.i = 1; V.i <= filenum; V.i++) + { + if (filetab[V.i - 1].name == fname && filetab[V.i - 1].isopen) + { + WITH = &filetab[V.i - 1]; /*with */ + if (nl) + { + wrgln (V.i); + WITH->curlen = 0; + } + /* change 4-dec-92 */ + line_ ((long) strlen (arg), &V); + wrg (V.i, arg); + if (V.blanks) + { + line_ (1L, &V); + wrg (V.i, " "); + } /* change 4-dec-92 */ + goto _L99; + } /* for/ if open */ + } - er(14L); /* fajl ne otkryt */ -_L99: ; -} /* outatm */ + er (14L); /* fajl ne otkryt */ +_L99:; +} /* outatm */ -/* Local variables for opn: */ -struct LOC_opn { +/* static variables for opn: */ +struct LOC_opn +{ long fspec; bl80 a80_; - long openlen; /* dlq pods~eta {iriny fajla */ + long openlen; /* dlq pods~eta {iriny fajla */ filespecification namestr; mpd x; - long len; /* dlina atoma */ - a fsp; /* a-adres specifikacii fajla */ -} ; + long len; /* dlina atoma */ + a fsp; /* a-adres specifikacii fajla */ +}; -Local boolean makefilespec(LINK) -struct LOC_opn *LINK; +static bool +makefilespec (LINK) + struct LOC_opn *LINK; { - boolean Result; + bool Result; long j, k, k1, FORLIM1; Result = false; - if ((LINK->fspec & 511) == 0 && LINK->fspec < 65536L && LINK->fspec >= 0) { - er(11L); - goto _L99; - } - pointr(LINK->fspec, &LINK->x.sa); - if (((1L << ((long)LINK->x.sad->dtype)) & ((1L << ((long)atom)) | - (1L << ((long)idatom)) | (1L << ((long)tatom)))) == 0) { - er(11L); - goto _L99; - } + if ((LINK->fspec & 511) == 0 && LINK->fspec < 65536L && LINK->fspec >= 0) + { + er (11L); + goto _L99; + } + assert_and_assign_real_pointer (LINK->fspec, &LINK->x.sa); + if (((1L << ((long) LINK->x.sad->dtype)) & ((1L << ((long) atom)) | + (1L << ((long) idatom)) | (1L << + ((long) tatom)))) == 0) + { + er (11L); + goto _L99; + } /* specifikaciq fajla - ne atom */ LINK->fsp = LINK->x.sad->name; - pointa(LINK->fsp, LINK->a80_, &LINK->len); + get_data_from_pointa (LINK->fsp, LINK->a80_, &LINK->len); /* daet a80 i len */ - if (LINK->len > 80) { - er(12L); - goto _L99; - } + if (LINK->len > 80) + { + er (12L); + goto _L99; + } LINK->openlen = 80; - for (k = LINK->len; k >= 1; k--) { - if (LINK->a80_[k - 1] == ',') { - LINK->openlen = 0; - FORLIM1 = LINK->len; - for (k1 = k + 1; k1 <= FORLIM1; k1++) - LINK->openlen = LINK->openlen * 10 + LINK->a80_[k] - '0'; - LINK->len = k - 1; + for (k = LINK->len; k >= 1; k--) + { + if (LINK->a80_[k - 1] == ',') + { + LINK->openlen = 0; + FORLIM1 = LINK->len; + for (k1 = k + 1; k1 <= FORLIM1; k1++) + LINK->openlen = LINK->openlen * 10 + LINK->a80_[k] - '0'; + LINK->len = k - 1; + } } - } *LINK->namestr = '\0'; FORLIM1 = LINK->len; for (j = 0; j < FORLIM1; j++) - sprintf(LINK->namestr + strlen(LINK->namestr), "%c", LINK->a80_[j]); + sprintf (LINK->namestr + strlen (LINK->namestr), "%c", LINK->a80_[j]); Result = true; _L99: return Result; -} /* makefilespec */ +} /* makefilespec */ -Void opn(fname, fspec_) -long fname, fspec_; +void +opn (fname, fspec_) + long fname, fspec_; { - /* a-adres imeni fajla*/ - /* s-adr.*/ + /* a-adres imeni fajla */ + /* s-adr. */ /* ====================== */ /* otkrytie tekstowogo fajla */ /* ====================== */ struct LOC_opn V; - long i; /* i - nomer fajla */ + long i; /* i - nomer fajla */ _REC_filetab *WITH; /* ========= osnownaq procedura ========== */ V.fspec = fspec_; - for (i = 0; i < filenum; i++) { - if (filetab[i].name == fname && filetab[i].isopen) - { /* otkrytx fajl snowa */ - er(16L); - /* nado zakrywatx fajl pered otkrytiem - */ - goto _L99; - } - } - for (i = 0; i < filenum; i++) { - if (!filetab[i].isopen) { - if (!makefilespec(&V)) - goto _L99; - if (!strcmp(V.namestr, " ")) - filetab[i].screen = true; - else { - filetab[i].screen = false; - if (false) { - errstr(19L, V.namestr); + for (i = 0; i < filenum; i++) + { + if (filetab[i].name == fname && filetab[i].isopen) + { /* otkrytx fajl snowa */ + er (16L); + /* nado zakrywatx fajl pered otkrytiem + */ goto _L99; } + } + for (i = 0; i < filenum; i++) + { + if (!filetab[i].isopen) + { + if (!makefilespec (&V)) + goto _L99; + if (!strcmp (V.namestr, " ")) + filetab[i].screen = true; + else + { + filetab[i].screen = false; + if (!rightfile (V.namestr)) + { + errstr (19L, V.namestr); + goto _L99; + } + + files[i] = fopen (V.namestr, "w"); + if (files[i] == NULL) + _EscIO (FileNotFound); + } - files[i] = fopen(V.namestr, "w"); - if (files[i] == NULL) - _EscIO(FileNotFound); - } + WITH = &filetab[i]; - WITH = &filetab[i]; + WITH->isopen = true; + WITH->strlen = V.openlen; + WITH->curlen = 0; + WITH->name = fname; + goto _L99; - WITH->isopen = true; - WITH->strlen = V.openlen; - WITH->curlen = 0; - WITH->name = fname; - goto _L99; + } + /* i{etsq perwoe neotkrytoe gnezdo dlq fajla */ } - /* i{etsq perwoe neotkrytoe gnezdo dlq fajla */ + er (13L); /* sli{kom mnogo otkrytyh fajlow */ +_L99:; - } - er(13L); /* sli{kom mnogo otkrytyh fajlow */ -_L99: ; +} /* opn */ -} /* opn */ - -Void loasav(p, f, paz) -v *p; -long f, paz; +void +loasav (p, f, paz) + v *p; + long f, paz; { - /* 0-load,1 -save, 2-saven*/ + /* 0-load,1 -save, 2-saven */ /* wyhod */ - FILE *specfile; /* vax */ + FILE *specfile; /* vax */ filespecification fname; mpd x; a r; @@ -590,50 +645,60 @@ long f, paz; long i, len; specfile = NULL; - if (f == null_) { - er(11L); - goto _L99; - } - pointr(f, &x.sa); - if (((1L << ((long)x.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)tatom)))) == 0) { - er(11L); - goto _L99; - } + if (f == null_) + { + er (11L); + goto _L99; + } + assert_and_assign_real_pointer (f, &x.sa); + if (((1L << ((long) x.sad->dtype)) & + (((1L << ((long) keyword + 1)) - (1L << ((long) atom))) | + (1L << ((long) tatom)))) == 0) + { + er (11L); + goto _L99; + } r = x.sad->name; - pointa(r, a80_, &len); + get_data_from_pointa (r, a80_, &len); *fname = '\0'; for (i = 0; i < len; i++) - sprintf(fname + strlen(fname), "%c", a80_[i]); - if (paz == 0) { - if (existfile(fname)) - loads(fname, &r); - else { - r = 0; - errstr(18L, fname); + sprintf (fname + strlen (fname), "%c", a80_[i]); + if (paz == 0) + { + if (existfile (fname)) + loads (fname, &r); + else + { + r = 0; + errstr (18L, fname); + } + p->sa = r; } - p->sa = r; - } else { - r = p->sa; - if (r != null_) { - if (*fname != '\0') { - if (paz == 1) - saves(fname, &r); - else - savesn(fname, &r); - } else - errstr(15L, fname); + else + { + r = p->sa; + if (r != null_) + { + if (rightfile (fname) && *fname != '\0') + { + if (paz == 1) + saves (fname, &r); + else + savesn (fname, &r); + } + else + errstr (15L, fname); + } } - } _L99: if (specfile != NULL) - fclose(specfile); -} /* loasav */ + fclose (specfile); +} /* loasav */ -Void explod(kk, rez) -long kk, *rez; +void +explod (kk, rez) + long kk, *rez; { @@ -646,160 +711,185 @@ long kk, *rez; mpd x; longint l; /* changed from integer here and in like-wise - places in c3.pas 17-nov-90 */ - string80 str_val; /* maximum real */ - Char STR1[256]; + places in c3.pas 17-nov-90 */ + string80 str_val; /* maximum real */ + char STR1[256]; long FORLIM; *rez = null_; if (kk == null_) goto _L99; - pointr(kk, &x.sa); + assert_and_assign_real_pointer (kk, &x.sa); - switch (x.sad->dtype) { + switch (x.sad->dtype) + { - case fatom: /* added 17-feb-92 */ - real_to_string(str_val, take_fatom(x.sad->name)); - break; + case fatom: /* added 17-feb-92 */ + real_to_string (str_val, take_fatom (x.sad->name)); + break; - case number: - long_to_str(str_val, x.snd->val); - break; + case number: + long_to_str (str_val, x.snd->val); + break; - case 5: - case 6: - case 7: - case tatom: - aa_str(str_val, x.sad->name); - break; + case 5: + case 6: + case 7: + case tatom: + aa_str (str_val, x.sad->name); + break; - default: - goto _L99; - break; - }/* case */ + default: + goto _L99; + break; + } /* case */ /* w m sformirowan massiw simwolow */ - s = null_; /* rez.spisok */ - FORLIM = strlen(str_val); - for (l = 0; l < FORLIM; l++) { - sprintf(STR1, "%c", str_val[l]); - k = str_to_textatom(STR1); - lconc(&s, k); - } /* for */ + s = null_; /* rez.spisok */ + FORLIM = strlen (str_val); + for (l = 0; l < FORLIM; l++) + { + sprintf (STR1, "%c", str_val[l]); + k = str_to_textatom (STR1); + lconc (&s, k); + } /* for */ *rez = s; -_L99: ; -} /* explode */ +_L99:; +} /* explode */ -/* Local variables for implod: */ -struct LOC_implod { +/* static variables for implod: */ +struct LOC_implod +{ bl80 m, m1; mpd x; a k; - long p1; /* posledn.zanqtyj |l-t w m1 */ - string80 str_val; /* maximum real */ -} ; + long p1; /* posledn.zanqtyj |l-t w m1 */ + string80 str_val; /* maximum real */ +}; -Local Void pass(pl, LINK) -ptr_ *pl; -struct LOC_implod *LINK; +static void +pass (pl, LINK) + ptr_ *pl; + struct LOC_implod *LINK; { ptr_ pl1; long t, l; - while (pl->nel != 0) { - LINK->k = pl->cel; - if (LINK->k != null_) { - pointr(LINK->k, &LINK->x.sa); - if (LINK->x.smld->dtype == listmain) { - first(LINK->k, &pl1); /*, st */ - pass(&pl1, LINK); - } else { /* not list */ - if (((1L << ((long)LINK->x.sad->dtype)) & - ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) == 0) - goto _L99; - if (LINK->x.sad->dtype == fatom) { /* added 17-feb-92 */ - real_to_string(LINK->str_val, take_fatom(LINK->x.sad->name)); - - l = strlen(LINK->str_val); - if (LINK->p1 + l > 80) { - er(25L); - goto _L99; - } - for (t = 0; t < l; t++) - LINK->m1[LINK->p1 + t] = LINK->str_val[t]; - LINK->p1 += l; - } else { - if (((1L << ((long)LINK->x.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)tatom)))) != 0) { - /* wzqtx atom iz a-prostranstwa w m */ - LINK->k = LINK->x.sad->name; - pointa(LINK->k, LINK->m, &l); /* [1] ibm/pc */ - if (LINK->p1 + l > 80) { - er(25L); - goto _L99; + while (pl->nel != 0) + { + LINK->k = pl->cel; + if (LINK->k != null_) + { + assert_and_assign_real_pointer (LINK->k, &LINK->x.sa); + if (LINK->x.smld->dtype == listmain) + { + first (LINK->k, &pl1); /*, st */ + pass (&pl1, LINK); } - for (t = 0; t < l; t++) - LINK->m1[LINK->p1 + t] = LINK->m[t]; - LINK->p1 += l; - } else { - /* number */ + else + { /* not list */ + if (((1L << ((long) LINK->x.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) == 0) + goto _L99; + if (LINK->x.sad->dtype == fatom) + { /* added 17-feb-92 */ + real_to_string (LINK->str_val, + take_fatom (LINK->x.sad->name)); + + l = strlen (LINK->str_val); + if (LINK->p1 + l > 80) + { + er (25L); + goto _L99; + } + for (t = 0; t < l; t++) + LINK->m1[LINK->p1 + t] = LINK->str_val[t]; + LINK->p1 += l; + } + else + { + if (((1L << ((long) LINK->x.sad->dtype)) & + (((1L << ((long) keyword + 1)) - + (1L << ((long) atom))) | (1L << ((long) tatom)))) != + 0) + { + /* wzqtx atom iz a-prostranstwa w m */ + LINK->k = LINK->x.sad->name; + get_data_from_pointa (LINK->k, LINK->m, &l); /* [1] ibm/pc */ + if (LINK->p1 + l > 80) + { + er (25L); + goto _L99; + } + for (t = 0; t < l; t++) + LINK->m1[LINK->p1 + t] = LINK->m[t]; + LINK->p1 += l; + } + else + { + /* number */ /*==============================*/ - /* perewesti ~islo w simwoly i */ - /* pomestitx w m [1..max_digit] */ + /* perewesti ~islo w simwoly i */ + /* pomestitx w m [1..max_digit] */ /*==============================*/ - LINK->k = LINK->x.snd->val; - if (LINK->k < 0) /*changed from abs call */ - LINK->k = -LINK->k; - for (t = max_digit - 1; t >= 0; t--) { - l = LINK->k % 10; + LINK->k = LINK->x.snd->val; + if (LINK->k < 0) /*changed from abs call */ + LINK->k = -LINK->k; + for (t = max_digit - 1; t >= 0; t--) + { + l = LINK->k % 10; /* p2c: c3.z, line 1233: * Note: Using % for possibly-negative arguments [317] */ - LINK->k /= 10; - LINK->m[t] = (Char)(l + '0'); - } - t = 1; - while (t < max_digit && LINK->m[t - 1] == '0') - t++; - if (LINK->x.snd->val < 0) { - if (LINK->p1 == 80) { - er(25L); - goto _L99; - } - LINK->p1++; - LINK->m1[LINK->p1 - 1] = '-'; - } - if (LINK->p1 + max_digit - t > 79) { - er(25L); - goto _L99; - } - for (l = t - 1; l < max_digit; l++) { - LINK->p1++; - LINK->m1[LINK->p1 - 1] = LINK->m[l]; - } - } /* number */ - } - } /* not list */ - } /* k<> null */ - next(pl); - } /* while */ -_L99: ; - - - - -} /* pass */ - - - - - -Void implod(pl, rez) -ptr_ *pl; -long *rez; + LINK->k /= 10; + LINK->m[t] = (char) (l + '0'); + } + t = 1; + while (t < max_digit && LINK->m[t - 1] == '0') + t++; + if (LINK->x.snd->val < 0) + { + if (LINK->p1 == 80) + { + er (25L); + goto _L99; + } + LINK->p1++; + LINK->m1[LINK->p1 - 1] = '-'; + } + if (LINK->p1 + max_digit - t > 79) + { + er (25L); + goto _L99; + } + for (l = t - 1; l < max_digit; l++) + { + LINK->p1++; + LINK->m1[LINK->p1 - 1] = LINK->m[l]; + } + } /* number */ + } + } /* not list */ + } /* k<> null */ + next (pl); + } /* while */ +_L99:; + + + + +} /* pass */ + + + + + +void +implod (pl, rez) + ptr_ *pl; + long *rez; { /* 1-j argument */ /*======================================*/ @@ -807,88 +897,96 @@ long *rez; /* perwogo, otli~nogo ot atoma ili null */ /*======================================*/ struct LOC_implod V; - longint l; /* rab. */ - boolean id; + longint l; /* rab. */ + bool id; long FORLIM; atomdescriptor *WITH; V.p1 = 0; - pass(pl, &V); - if (V.p1 == 0) { - *rez = null_; - return; - } + pass (pl, &V); + if (V.p1 == 0) + { + *rez = null_; + return; + } /* zapisatx nowyj atom w a-prostr. */ - putatm(V.m1, V.p1, &V.k); - id = is_rig_letter(V.m1[0]); + putatm (V.m1, V.p1, &V.k); + id = is_rig_letter (V.m1[0]); FORLIM = V.p1; for (l = 0; l < FORLIM; l++) - id &= is_rig_symbol(V.m1[l]); + id &= is_rig_symbol (V.m1[l]); l = 1; - gets1(rez, &V.x.sa); + gets1 (rez, &V.x.sa); WITH = V.x.sad; if (id) WITH->dtype = idatom; else WITH->dtype = atom; WITH->name = V.k; -} /* implode */ +} /* implode */ -Void bltin1(rez, success, pl, n) -long *rez; -boolean *success; -ptr_ *pl; -long n; +void +bltin1 (rez, success, pl, n) + long *rez; + bool *success; + ptr_ *pl; + long n; { /*=======================*/ /* wyzow bltin w {ablone */ /*=======================*/ v rr; - if (pl->nel == 0) { - *success = false; - *rez = null_; - return; - } - bltin(&rr, success, pl->cel, n); - if (!*success) { - *rez = null_; - return; - } + if (pl->nel == 0) + { + *success = false; + *rez = null_; + return; + } + bltin (&rr, success, pl->cel, n); + if (!*success) + { + *rez = null_; + return; + } if (n == 15) - mknumb(rr.nu, rez); + mknumb (rr.nu, rez); else *rez = rr.sa; - if (pl->ptrtype != ptrtree) /* 26.8.88 */ - next(pl); -} /* bltin1*/ + if (pl->ptrtype != ptrtree) /* 26.8.88 */ + next (pl); +} /* bltin1 */ -Void clsfil(fname) -long fname; -{ /* close */ - /* a-adr.*/ +void +clsfil (fname) + long fname; +{ /* close */ + /* a-adr. */ /* ======================== */ /* zakrytie tekstowogo fajla */ /* ======================== */ - long i; /* i - nomer fajla */ - - - for (i = 0; i < filenum; i++) { - if (filetab[i].name == fname && filetab[i].isopen) { - wrgln(i + 1); - if (!filetab[i].screen) { - if (files[i] != NULL) - fclose(files[i]); - files[i] = NULL; - } - filetab[i].isopen = false; + long i; /* i - nomer fajla */ + + + for (i = 0; i < filenum; i++) + { + if (filetab[i].name == fname && filetab[i].isopen) + { + wrgln (i + 1); + if (!filetab[i].screen) + { + if (files[i] != NULL) + fclose (files[i]); + files[i] = NULL; + } + filetab[i].isopen = false; + } } - } -_L99: ; -} /* clsfil */ +_L99:; +} /* clsfil */ @@ -905,4 +1003,3 @@ _L99: ; /* End. */ - diff --git a/RIGAL/rigsc.446/src/c4.c b/RIGAL/rigsc.446/src/c4.c index 859e2a22f16f04b683ea8940db28fc0fa740d9ea..5dd0daa31459d5a7917e49cf2cdfdecdf7e3424d 100644 --- a/RIGAL/rigsc.446/src/c4.c +++ b/RIGAL/rigsc.446/src/c4.c @@ -4,29 +4,33 @@ #include "nef2.h" #include "c1.h" -boolean eqatom(m1, atm) -long m1, atm; +bool +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); - } + else + { + assert_and_assign_real_pointer (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; +void +varpat (pl, tip, rez, success) + ptr_ *pl; + char tip; + long *rez; + bool *success; { mpd x; atomdescriptor *WITH; @@ -35,24 +39,28 @@ boolean *success; *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 + else + { + assert_and_assign_real_pointer (*rez, &x.sa); + WITH = x.sad; + *success = (WITH->dtype == tip); + } + if (*success) + { + if (pl->ptrtype != ptrtree) + next (pl); + } + else *rez = null_; -} /* varpat */ +} /* varpat */ -Void atmpat(aconval, pl, rez, success) -long aconval; -ptr_ *pl; -long *rez; -boolean *success; +void +atmpat (aconval, pl, rez, success) + long aconval; + ptr_ *pl; + long *rez; + bool *success; { mpd x; atomdescriptor *WITH; @@ -61,25 +69,29 @@ boolean *success; *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 + else + { + assert_and_assign_real_pointer (*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 */ +} /* atmpat */ -boolean eqnum(m1, n) -long m1, n; +bool +eqnum (m1, n) + long m1, n; { mpd x; numberdescriptor *WITH; @@ -87,17 +99,19 @@ long m1, n; if (m1 == null_) return false; - else { - pointr(m1, &x.sa); - WITH = x.snd; - return (WITH->dtype == number && WITH->val == n); - } -} /* eqnum */ + else + { + assert_and_assign_real_pointer (m1, &x.sa); + WITH = x.snd; + return (WITH->dtype == number && WITH->val == n); + } +} /* eqnum */ -boolean eqop(o, a1, a2) -long o, a1, a2; +bool +eqop (o, a1, a2) + long o, a1, a2; { /* cequ(=), cnequ(<>) */ /*====================================*/ @@ -108,102 +122,111 @@ long o, a1, a2; /*wyhod */ mpd x, y; - boolean rez; + bool 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 && + if (a2 == null_) + { + if (a1 == null_) + goto _L1; + else + { + assert_and_assign_real_pointer (a1, &x.sa); + rez = (((1L << ((long) x.smld->dtype)) & + ((1L << ((long) listmain)) | (1L << ((long) treemain)))) != + 0 && x.smld->totalelnum == 0); + goto _L1; + } + } /* a2 =null */ + assert_and_assign_real_pointer (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; } - } /* 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); + assert_and_assign_real_pointer (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 */ + 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 */ +} /* eqop */ /* c4.pas */ -boolean compare(op, a1, a2) -long op, a1, a2; +bool +compare (op, a1, a2) + long op, a1, a2; { /* kod operacii */ /*=======================*/ @@ -214,109 +237,137 @@ long op, a1, a2; /* wyhod: */ /* a1 op a2 */ /*=======================*/ - boolean Result; + bool Result; /* wyhod */ mpd x; - longint n[2]; /* changed 17-nov-90 */ + 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 (a1 == null_) + { + n[0] = 0; + dts[0] = dummy; + } + else + { + assert_and_assign_real_pointer (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 + { + assert_and_assign_real_pointer (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); + (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 */ +} /* compare */ -void indxcon(xx, isobject, xa, l1, l2) -long xx; -boolean isobject; -long xa, l1,l2; +void +indxcon (xx, isobject, xa, l1, l2) + long xx; + bool isobject; + long xa, l1, l2; /* l1[xx]!!:=l2 */ -{ a wrk; - indxop(xx, isobject, xa, l1, &wrk); - if (wrk==null_) { - concop(& wrk,l2); - setind(xx, isobject, xa, l1, wrk); - } - else { - concop(& wrk,l2); - if (wrk==null_) { - setind(xx, isobject, xa, l1, NULL); - } - } +{ + a wrk; + indxop (xx, isobject, xa, l1, &wrk); + if (wrk == NULL) + { + concop (&wrk, l2); + setind (xx, isobject, xa, l1, wrk); + } + else + { + concop (&wrk, l2); + if (wrk == NULL) + { + setind (xx, isobject, xa, l1, NULL); + } + } } -void indxaddtre(xx, isobject, xa, l1, l2) -long xx; -boolean isobject; -long xa, l1,l2; +void +indxaddtre (xx, isobject, xa, l1, l2) + long xx; + bool isobject; + long xa, l1, l2; /* l1[xx]!!:=l2 */ -{ a wrk; - indxop(xx, isobject, xa, l1, &wrk); - if (wrk==null_) { - addtre(& wrk,l2); - setind(xx, isobject, xa, l1, wrk); - } - else { - addtre(& wrk,l2); - if (wrk==null_) { - setind(xx, isobject, xa, l1, NULL); - } - } +{ + a wrk; + indxop (xx, isobject, xa, l1, &wrk); + if (wrk == NULL) + { + addtre (&wrk, l2); + setind (xx, isobject, xa, l1, wrk); + } + else + { + addtre (&wrk, l2); + if (wrk == NULL) + { + setind (xx, isobject, xa, l1, NULL); + } + } } diff --git a/RIGAL/rigsc.446/src/cim.c b/RIGAL/rigsc.446/src/cim.c index 8133c29399f6b136eb68a6a0cef3339e089bc42e..0bd8b07b6a663d606ec8191e495731fa3a4d0b3b 100644 --- a/RIGAL/rigsc.446/src/cim.c +++ b/RIGAL/rigsc.446/src/cim.c @@ -2,29 +2,30 @@ #include "define.h" #include "defpage.h" #include "nef2.h" - + #include "cim.h" -Void alter(rez, success, pl, p) -long *rez; -boolean *success; -ptr_ *pl; -long p; +void +alter (rez, success, pl, p) + long *rez; + bool *success; + ptr_ *pl; + long p; { /* ukaz.na 1-` leksemu */ /* prodwigaetsq wpered */ /* adres |l-ta {ablona - (alxternatiwa) */ + (alxternatiwa) */ /*=================================*/ /* {ablon ( a1 ! a2 ! ... ! an ) */ /*=================================*/ /* wyhod */ a rez1; - boolean success1; - ptr_ pp; /* tek.|l-t {ablona */ - ptr_ pl1; /* tek. leksema */ - boolean ispattern; + bool success1; + ptr_ pp; /* tek.|l-t {ablona */ + ptr_ pl1; /* tek. leksema */ + bool ispattern; /* true - tek.|l-t pp - {ablon, */ /* false - operator */ @@ -37,29 +38,32 @@ long p; rez1 = null_; success1 = true; ispattern = true; - first(p, &pp); /* wojti w spisok {ablonow */ + first (p, &pp); /* wojti w spisok {ablonow */ /* osnownoj cikl */ - while (continue_ && pp.nel != 0 && !fail) { - pl1 = *pl; - rez1 = null_; - success1 = true; - while (pp.nel != 0 && pp.cel != adelim && success1 && continue_) { - if (pp.cel == opdelim) - ispattern = !ispattern; - else if (ispattern) - pattern(&rez1, &success1, &pl1, &pp); - else - statement(pp.cel, &success1, &rez1); - next(&pp); - } /* while */ - if (success1 || !continue_) { - goto _L1; - /* normalxnyj wyhod iz cikla */ - } - while (pp.cel != adelim && pp.nel != 0) - next(&pp); - next(&pp); - } /* while */ + while (continue_ && pp.nel != 0 && !fail) + { + pl1 = *pl; + rez1 = null_; + success1 = true; + while (pp.nel != 0 && pp.cel != adelim && success1 && continue_) + { + if (pp.cel == opdelim) + ispattern = !ispattern; + else if (ispattern) + pattern (&rez1, &success1, &pl1, &pp); + else + statement (pp.cel, &success1, &rez1); + next (&pp); + } /* while */ + if (success1 || !continue_) + { + goto _L1; + /* normalxnyj wyhod iz cikla */ + } + while (pp.cel != adelim && pp.nel != 0) + next (&pp); + next (&pp); + } /* while */ /* esli popali s`da, to ni odna wetwx ne uspe{na */ success1 = false; rez1 = null_; @@ -70,30 +74,31 @@ _L1: *pl = pl1; /* prognatx pp do adelim ili do konca */ -} /* alter */ +} /* alter */ -Void assgn(ot, p) -long ot, p; +void +assgn (ot, p) + long ot, p; { - /* tip operatora (specadres)*/ + /* tip operatora (specadres) */ /* ssylka na deskriptor spiska - operatora */ + operatora */ /* wyhod */ mpd x, y, z; - ptr_ c; /* tek.|l_t spiska operatora */ + ptr_ c; /* tek.|l_t spiska operatora */ long nvar; - a rr; /* rez.praw. ~asti := */ - boolean t; /* lew.~astx w st-prostr.*/ + a rr; /* rez.praw. ~asti := */ + bool t; /* lew.~astx w st-prostr. */ a m, xfrag, xglavn; - long i, xnel; /* :: otli~ie ot inter/rsx !!!!! */ + long i, xnel; /* :: otli~ie ot inter/rsx !!!!! */ fragmtreedescriptor *WITH; long FORLIM; maintreedescriptor *WITH1; - first(p, &c); /* c na na~alo wyrav.lew.~asti */ - objexpr(&c, &nvar, &t); + first (p, &c); /* c na na~alo wyrav.lew.~asti */ + objexpr (&c, &nvar, &t); /*======================================*/ /* wy~islitx lew. ~astx, w nvar nomer */ /* per. w steke , gde nahoditsq ssylka */ @@ -102,142 +107,163 @@ long ot, p; /* sam nomer peremennoj w prawile */ /* ( t=false) */ /*======================================*/ - next(&c); /* na na~alo prawoj ~asti */ - expression(&c, &rr); /* wy~islitx praw.~astx */ + next (&c); /* na na~alo prawoj ~asti */ + expression (&c, &rr); /* wy~islitx praw.~astx */ /* w rr ssylka na rezulxtat */ - if (t) { - if (v[nvar - 1] == null_) { - err(8L); - /* null w lewoj ~asti := */ - goto _L1; + if (t) + { + if (v[nvar - 1] == null_) + { + err (8L); + /* null w lewoj ~asti := */ + goto _L1; + } + assert_and_assign_real_pointer (v[nvar - 1], &x.sa); } - pointr(v[nvar - 1], &x.sa); - } /* polu~itx deskriptor lew.~asti */ - if (t && !x.sobj->variable_) { - /* ~to-to menqem w strukturah */ - xfrag = x.sobj->fragmorvar; - xnel = x.sobj->nel; /* :: !! otli~ie ot inter/rsx !!!!! */ - xglavn = x.sobj->glavn; - /* zapomnim, tak kak cass2..cass5 lista`t s-prostr.*/ - points(xfrag, &y.sa); - /* posmotrim deskr.struktury */ - if (((1L << ((long)y.smld->dtype)) & - ((1L << ((long)listfragm + 1)) - (1L << ((long)listmain)))) != 0) { - /* lew.~astx estx spisok */ - if (ot == cass1) /* prosto := */ - y.sfld->elt[xnel - 1] = rr; - else { - m = y.sfld->elt[xnel - 1]; - if (ot == cass2) - add(&m, &rr); - else if (ot == cass3) - addtre(&m, rr); - else if (ot == cass4) - concop(&m, rr); - else if (ot == cass5) - lconc(&m, rr); - points(xfrag, &y.sa); - /* s-prostr. mogli - prolistatx */ - y.sfld->elt[xnel - 1] = m; - } - } else if (((1L << ((long)y.smtd->dtype)) & - ((1L << ((long)treefragm + 1)) - (1L << ((long)treemain)))) != - 0) { - /* lew.~astx estx derewo */ - if (ot == cass1) { /* prosto := */ - if (y.sftd->dtype == treefragm) - y.sftd->arc[xnel - 1].elt = rr; - else - y.smtd->arc[xnel - 1].elt = rr; - } else { - if (y.sftd->dtype == treefragm) - m = y.sftd->arc[xnel - 1].elt; - else - m = y.smtd->arc[xnel - 1].elt; - if (ot == cass2) - add(&m, &rr); - else if (ot == cass3) - addtre(&m, rr); - else if (ot == cass4) - concop(&m, rr); - else if (ot == cass5) - lconc(&m, rr); - points(xfrag, &y.sa); - /* s-prostr.mogli - prolistatx */ - if (y.sftd->dtype == treefragm) - y.sftd->arc[xnel - 1].elt = m; - else - y.smtd->arc[xnel - 1].elt = m; - } - if (y.sftd->dtype == treefragm) { - WITH = y.sftd; - if (WITH->arc[xnel - 1].elt == null_) { /* with */ - FORLIM = WITH->arcnum; - /* umenx{itx ~islo |l-tow derewa */ - /* sdwinem |l-ty w fragmente */ - for (i = xnel; i < FORLIM; i++) - WITH->arc[i - 1] = WITH->arc[i]; - WITH->arcnum--; - points(xglavn, &z.sa); - z.smtd->totalarcnum--; + if (t && !x.sobj->variable_) + { + /* ~to-to menqem w strukturah */ + xfrag = x.sobj->fragmorvar; + xnel = x.sobj->nel; /* :: !! otli~ie ot inter/rsx !!!!! */ + xglavn = x.sobj->glavn; + /* zapomnim, tak kak cass2..cass5 lista`t s-prostr. */ + assert_and_assign_real_pointer (xfrag, &y.sa); + /* posmotrim deskr.struktury */ + if (((1L << ((long) y.smld->dtype)) & + ((1L << ((long) listfragm + 1)) - (1L << ((long) listmain)))) != 0) + { + /* lew.~astx estx spisok */ + if (ot == cass1) /* prosto := */ + y.sfld->elt[xnel - 1] = rr; + else + { + m = y.sfld->elt[xnel - 1]; + if (ot == cass2) + add (&m, &rr); + else if (ot == cass3) + addtre (&m, rr); + else if (ot == cass4) + concop (&m, rr); + else if (ot == cass5) + lconc (&m, rr); + assert_and_assign_real_pointer (xfrag, &y.sa); + /* s-prostr. mogli + prolistatx */ + y.sfld->elt[xnel - 1] = m; + } } - } else { - WITH1 = y.smtd; - if (WITH1->arc[xnel - 1].elt == null_) { /* with */ - FORLIM = WITH1->arcnum; - /* umenx{itx ~islo |l-tow derewa */ - /* sdwinem |l-ty w fragmente */ - for (i = xnel; i < FORLIM; i++) - WITH1->arc[i - 1] = WITH1->arc[i]; - WITH1->arcnum--; - WITH1->totalarcnum--; + else if (((1L << ((long) y.smtd->dtype)) & + ((1L << ((long) treefragm + 1)) - + (1L << ((long) treemain)))) != 0) + { + /* lew.~astx estx derewo */ + if (ot == cass1) + { /* prosto := */ + if (y.sftd->dtype == treefragm) + y.sftd->arc[xnel - 1].elt = rr; + else + y.smtd->arc[xnel - 1].elt = rr; + } + else + { + if (y.sftd->dtype == treefragm) + m = y.sftd->arc[xnel - 1].elt; + else + m = y.smtd->arc[xnel - 1].elt; + if (ot == cass2) + add (&m, &rr); + else if (ot == cass3) + addtre (&m, rr); + else if (ot == cass4) + concop (&m, rr); + else if (ot == cass5) + lconc (&m, rr); + assert_and_assign_real_pointer (xfrag, &y.sa); + /* s-prostr.mogli + prolistatx */ + if (y.sftd->dtype == treefragm) + y.sftd->arc[xnel - 1].elt = m; + else + y.smtd->arc[xnel - 1].elt = m; + } + if (y.sftd->dtype == treefragm) + { + WITH = y.sftd; + if (WITH->arc[xnel - 1].elt == null_) + { /* with */ + FORLIM = WITH->arcnum; + /* umenx{itx ~islo |l-tow derewa */ + /* sdwinem |l-ty w fragmente */ + for (i = xnel; i < FORLIM; i++) + WITH->arc[i - 1] = WITH->arc[i]; + WITH->arcnum--; + assert_and_assign_real_pointer (xglavn, &z.sa); + z.smtd->totalarcnum--; + } + } + else + { + WITH1 = y.smtd; + if (WITH1->arc[xnel - 1].elt == null_) + { /* with */ + FORLIM = WITH1->arcnum; + /* umenx{itx ~islo |l-tow derewa */ + /* sdwinem |l-ty w fragmente */ + for (i = xnel; i < FORLIM; i++) + WITH1->arc[i - 1] = WITH1->arc[i]; + WITH1->arcnum--; + WITH1->totalarcnum--; + } + } } - } - } else { - /* o{ibka, popytka priswoitx w strukturu , k-q */ - /* ne qwl. ni spiskom ni derewom */ - err(2L); - goto _L1; - } - } /* prisw. w strukture */ - else { /* prisw.peremennoj */ - if (t) { - /* lew.~astx object */ - /* if x.sobj^.variable then */ - nvar = x.sobj->fragmorvar; - } else /* prosto perem. w lew.~asti */ - nvar += mybase; - if (ot == cass1) - v[nvar - 1] = rr; - else if (ot == cass2) - add(&v[nvar - 1], &rr); - else if (ot == cass3) - addtre(&v[nvar - 1], rr); - else if (ot == cass4) - concop(&v[nvar - 1], rr); - else if (ot == cass5) - lconc(&v[nvar - 1], rr); - } /* prisw.peremennoj */ + else + { + /* o{ibka, popytka priswoitx w strukturu , k-q */ + /* ne qwl. ni spiskom ni derewom */ + err (2L); + goto _L1; + } + } /* prisw. w strukture */ + else + { /* prisw.peremennoj */ + if (t) + { + /* lew.~astx object */ + /* if x.sobj^.variable then */ + nvar = x.sobj->fragmorvar; + } + else /* prosto perem. w lew.~asti */ + nvar += mybase; + if (ot == cass1) + v[nvar - 1] = rr; + else if (ot == cass2) + add (&v[nvar - 1], &rr); + else if (ot == cass3) + addtre (&v[nvar - 1], rr); + else if (ot == cass4) + concop (&v[nvar - 1], rr); + else if (ot == cass5) + lconc (&v[nvar - 1], rr); + } /* prisw.peremennoj */ _L1: - if (t) /* oswoboditx w steke per. */ + if (t) /* oswoboditx w steke per. */ base--; -} /* assgn */ +} /* assgn */ -Void cond(p, succ, rez) -long p; -boolean *succ; -long *rez; +void +cond (p, succ, rez) + long p; + bool *succ; + long *rez; { /* s-adres spiska operatora w - sr-prostranstwe*/ + sr-prostranstwe */ /* dlq wozwrata - neuspeha iz fail */ + neuspeha iz fail */ /* dlq wozwrata rezulxtata iz - return */ + return */ /*==================================================*/ /* operator if c1 -> s1 ; elseif c2 -> s2 ; ... fi */ /*==================================================*/ @@ -247,29 +273,35 @@ long *rez; a r; - first(p, &pp); /* wojti w spisok operatora */ - while (pp.nel != 0) { - expression(&pp, &r); - /* razdelitelx proglo~en w expression */ - if (r != null_) { - while (pp.cel != 9216 && pp.nel != 0 && !break_ && !fail && continue_) - { /* added 23.10.89 */ - statement(pp.cel, succ, rez); - next(&pp); - } /* while*/ - goto _L1; - } - do { - next(&pp); - } while (pp.cel != 9216 && pp.nel != 0); - next(&pp); - } /* while */ -_L1: ; -} /* cond */ + first (p, &pp); /* wojti w spisok operatora */ + while (pp.nel != 0) + { + expression (&pp, &r); + /* razdelitelx proglo~en w expression */ + if (r != null_) + { + while (pp.cel != 9216 && pp.nel != 0 && !break_ && !fail + && continue_) + { /* added 23.10.89 */ + statement (pp.cel, succ, rez); + next (&pp); + } /* while */ + goto _L1; + } + do + { + next (&pp); + } + while (pp.cel != 9216 && pp.nel != 0); + next (&pp); + } /* while */ +_L1:; +} /* cond */ -Void conlst(c) -ptr_ *c; +void +conlst (c) + ptr_ *c; { /* na~alo konstruktora, a'13312. */ /* c prodw.wpered, rez. (. .) w */ @@ -280,29 +312,31 @@ ptr_ *c; /*==================================*/ /* wyhod */ - a x; /* rezulxtat */ + a x; /* rezulxtat */ v[base - 1] = null_; - push(); - next(c); /* na na~alo e1 */ - if (c->cel == clist2) /* pustoj spisok */ + push (); + next (c); /* na na~alo e1 */ + if (c->cel == clist2) /* pustoj spisok */ goto _L1; /* sozdatx pustoj spisok */ - crlst(&v[base - 2]); - while (c->cel != clist2) { - /* wy~islitx wyravenie */ - expression(c, &x); - /* c na clistdelim */ - /* dobawitx x k spisku v[base-1] */ - lconc(&v[base - 2], x); - /* clistdelim proglatywaetsq w expression */ - } /* while */ -_L1: ; /* c.cel = clist2 */ -} /* conlst */ - - -Void contre(c) -ptr_ *c; + crlst (&v[base - 2]); + while (c->cel != clist2) + { + /* wy~islitx wyravenie */ + expression (c, &x); + /* c na clistdelim */ + /* dobawitx x k spisku v[base-1] */ + lconc (&v[base - 2], x); + /* clistdelim proglatywaetsq w expression */ + } /* while */ +_L1:; /* c.cel = clist2 */ +} /* conlst */ + + +void +contre (c) + ptr_ *c; { /* na~alo konstruktora a'14848 */ /* c prodw.wpered, rezulxtat */ @@ -317,59 +351,65 @@ ptr_ *c; a x, y; mpd s; long count; - boolean wrong; /* was wrong selector */ + bool wrong; /* was wrong selector */ /* wrong branch ignored and error 22 issued */ wrong = false; v[base - 1] = null_; - push(); + push (); count = 0; - next(c); /* na na~alo e1 */ - if (c->cel == ctree2) /* pustoe derewo */ + next (c); /* na na~alo e1 */ + if (c->cel == ctree2) /* pustoe derewo */ goto _L1; /* sozdatx pustoe derewo */ - crtree(&v[base - 2]); - while (c->cel != ctree2) { - /* wy~islitx ei */ - expression(c, &x); /* selektor */ - /* c na na~alo obi , */ - /* seldelim proglatywaet express */ - if (x == null_) { - /* null ne movet bytx selektorom */ - err(22L); - wrong = true; - goto _L2; - } - pointr(x, &s.sa); - if (s.sad->dtype != idatom) { - /* selektor dolven bytx identifikatorom */ - err(22L); - wrong = true; - goto _L2; - } - x = s.sad->name; - -_L2: - expression(c, &y); /* obxekt */ - /* ctreedelim proglatywaetsq w expression */ - if (y != null_) { - /* added 23.10.89 and 13.11.89 */ - if (!wrong) { - addel3(&v[base - 2], x, y); - count++; - } - } - wrong = false; - } /* while */ + crtree (&v[base - 2]); + while (c->cel != ctree2) + { + /* wy~islitx ei */ + expression (c, &x); /* selektor */ + /* c na na~alo obi , */ + /* seldelim proglatywaet express */ + if (x == null_) + { + /* null ne movet bytx selektorom */ + err (22L); + wrong = true; + goto _L2; + } + assert_and_assign_real_pointer (x, &s.sa); + if (s.sad->dtype != idatom) + { + /* selektor dolven bytx identifikatorom */ + err (22L); + wrong = true; + goto _L2; + } + x = s.sad->name; + + _L2: + expression (c, &y); /* obxekt */ + /* ctreedelim proglatywaetsq w expression */ + if (y != null_) + { + /* added 23.10.89 and 13.11.89 */ + if (!wrong) + { + addel3 (&v[base - 2], x, y); + count++; + } + } + wrong = false; + } /* while */ if (count == 0) v[base - 2] = null_; -_L1: ; -} /* contre */ +_L1:; +} /* contre */ -Void expression(c, rez) -ptr_ *c; -long *rez; +void +expression (c, rez) + ptr_ *c; + long *rez; { /* na~alo obratnoj */ /* polxsk.zapisi wyraveniq . */ @@ -385,7 +425,7 @@ long *rez; /* w st-prostranstwo. */ /* operacii wypolnqet bop v[base-1] v[base-2] */ /* unop v[base-1] */ - /* esli odin iz operandow . ili [] -object, to*/ + /* esli odin iz operandow . ili [] -object, to */ /* i rezulxtat -object. */ /* asdelim rabotaet kak unarnaq operaciq, */ /* wozwr.zna~enie per. iz steka, no ne oswob. */ @@ -395,201 +435,246 @@ long *rez; /* wyhod */ /* oregon'S ERROR */ - boolean notfinished; + bool notfinished; mpd x, y; a n, rez1; - boolean success; + bool success; ptr_ p, pl; notfinished = true; - while (notfinished) { - /* skanirowanie wyraveniq */ - if (c->nel == 0) - notfinished = false; - else if (c->cel != null_ && (c->cel & 511) == 0 && c->cel < 65536L) { - if (c->cel == clast) - lastop(); - else if (c->cel == crule) { - if (debugrule) { - if (out_screen) { - printf("\n=>>>CALLS RULE #"); - pointr(v[base - 3], &x.sa); - pratom(x.srd->name); - printf(" IN STATEMENT"); - } else { - fprintf(out, "\n=>>>CALLS RULE #"); - pointr(v[base - 3], &x.sa); - pratom(x.srd->name); - fprintf(out, " IN STATEMENT"); - } - } - srchrule(v[base - 3], &p); - first(v[base - 2], &pl); - rule(&rez1, &success, &pl, &p); - if (debugrule) { - if (out_screen) { - printf("\n<<<=EXITS FROM RULE #"); - pointr(v[base - 3], &x.sa); - pratom(x.srd->name); - printf(": "); - if (success) - printf("SUCCESS\n"); - else - printf("UNSUCCESS\n"); - printf("RESULT="); - pscr(rez1); - } else { - fprintf(out, "\n<<<=EXITS FROM RULE #"); - pointr(v[base - 3], &x.sa); - pratom(x.srd->name); - fprintf(out, ": "); - if (success) - fprintf(out, "SUCCESS\n"); - else - fprintf(out, "UNSUCCESS\n"); - fprintf(out, "RESULT="); - pout(rez1); - } + while (notfinished) + { + /* skanirowanie wyraveniq */ + if (c->nel == 0) + notfinished = false; + else if (c->cel != null_ && (c->cel & 511) == 0 && c->cel < 65536L) + { + if (c->cel == clast) + lastop (); + else if (c->cel == crule) + { + if (debugrule) + { + if (out_screen) + { + printf ("\n=>>>CALLS RULE #"); + assert_and_assign_real_pointer (v[base - 3], &x.sa); + pratom (x.srd->name); + printf (" IN STATEMENT"); + } + else + { + fprintf (out, "\n=>>>CALLS RULE #"); + assert_and_assign_real_pointer (v[base - 3], &x.sa); + pratom (x.srd->name); + fprintf (out, " IN STATEMENT"); + } + } + srchrule (v[base - 3], &p); + first (v[base - 2], &pl); + rule (&rez1, &success, &pl, &p); + if (debugrule) + { + if (out_screen) + { + printf ("\n<<<=EXITS FROM RULE #"); + assert_and_assign_real_pointer (v[base - 3], &x.sa); + pratom (x.srd->name); + printf (": "); + if (success) + printf ("SUCCESS\n"); + else + printf ("UNSUCCESS\n"); + printf ("RESULT="); + pscr (rez1); + } + else + { + fprintf (out, "\n<<<=EXITS FROM RULE #"); + assert_and_assign_real_pointer (v[base - 3], &x.sa); + pratom (x.srd->name); + fprintf (out, ": "); + if (success) + fprintf (out, "SUCCESS\n"); + else + fprintf (out, "UNSUCCESS\n"); + fprintf (out, "RESULT="); + pout (rez1); + } + } + v[base - 3] = rez1; + base--; + } + else if (c->cel == cin) + { + /* wstroennoe prawilo */ + first (v[base - 2], &pl); + assert_and_assign_real_pointer (v[base - 3], &x.sa); + bltin (&rez1, &success, &pl, x.snd->val); + if (debugrule) + { + if (out_screen) + { + printf ("\n=>>>CALLS BUILT-IN RULE "); + prblt (v[base - 3]); + printf (" IN STATEMENT:"); + if (success) + printf (" SUCCESS\n"); + else + printf (" UNSUCCESS\n"); + printf (" RESULT:"); + pscr (rez1); + } + else + { + fprintf (out, "\n=>>>CALLS BUILT-IN RULE "); + prblt (v[base - 3]); + fprintf (out, " IN STATEMENT:"); + if (success) + fprintf (out, " SUCCESS\n"); + else + fprintf (out, " UNSUCCESS\n"); + fprintf (out, " RESULT:"); + pout (rez1); + } + } + v[base - 3] = rez1; + base--; + } + else if (c->cel == cselect) + selctr (); + else if (c->cel == cindex) + indxop (); + else if (c->cel == cname) + nameop (); + else if (c->cel == cmult || c->cel == cdiv || c->cel == cmod || + c->cel == cadd || c->cel == cminus || c->cel == cgt || + c->cel == clt || c->cel == cge || c->cel == cle) + arithm (c->cel); + else if (c->cel == cconc) + { + getval (&v[base - 3]); + getval (&v[base - 2]); + concop (&v[base - 3], v[base - 2]); + base--; + } + else if (c->cel == clconc) + { + getval (&v[base - 2]); + getval (&v[base - 3]); + lconc (&v[base - 3], v[base - 2]); + base--; + } + else + goto _L3; + goto _L4; + _L3: + if (c->cel == ctradd) + { + getval (&v[base - 2]); + getval (&v[base - 3]); + addtre (&v[base - 3], v[base - 2]); + base--; + } + else if (c->cel == cequ || c->cel == cnequ) + eqop (c->cel); + else if (c->cel == cand) + { + getval (&v[base - 3]); + getval (&v[base - 2]); + if (v[base - 3] != null_ && v[base - 2] != null_) + v[base - 3] = atomt; + else + v[base - 3] = null_; + base--; + } + else if (c->cel == cor) + { + getval (&v[base - 3]); + getval (&v[base - 2]); + if (v[base - 3] != null_ || v[base - 2] != null_) + v[base - 3] = atomt; + else + v[base - 3] = null_; + base--; + } + else if (c->cel == cnot) + { + getval (&v[base - 2]); + if (v[base - 2] == null_) + v[base - 2] = atomt; + else + v[base - 2] = null_; + } + else if (c->cel == cunminus) + unmins (); + else if (c->cel == ccopy) + copyop (); + else if (c->cel == 512) + { + /* spec.perem. $$ ustanawliwaetsq */ + /* iz glob.per. teklexem */ + v[base - 2] = teklexem; + } + else if (c->cel == clist1) + conlst (c); + else if (c->cel == ctree1) + contre (c); + else if (c->cel == asdelim) + { + *rez = v[base - 2]; + goto _L1; + } + else if (c->cel == clist2 || c->cel == ctree2) + { + goto _L2; + /* wozwr.rez., no ne sdwigatx c */ + /* nuvno conlst i contree */ + } + else if (c->cel == 1024) + { + /* ^ w spiske << */ + v[base - 1] = c->cel; + push (); + } + else + notfinished = false; } - v[base - 3] = rez1; - base--; - } else if (c->cel == cin) { - /* wstroennoe prawilo */ - first(v[base - 2], &pl); - pointr(v[base - 3], &x.sa); - bltin(&rez1, &success, &pl, x.snd->val); - if (debugrule) { - if (out_screen) { - printf("\n=>>>CALLS BUILT-IN RULE "); - prblt(v[base - 3]); - printf(" IN STATEMENT:"); - if (success) - printf(" SUCCESS\n"); - else - printf(" UNSUCCESS\n"); - printf(" RESULT:"); - pscr(rez1); - } else { - fprintf(out, "\n=>>>CALLS BUILT-IN RULE "); - prblt(v[base - 3]); - fprintf(out, " IN STATEMENT:"); - if (success) - fprintf(out, " SUCCESS\n"); - else - fprintf(out, " UNSUCCESS\n"); - fprintf(out, " RESULT:"); - pout(rez1); - } + else + { + if (c->cel == null_) + n = null_; + else + { + n = c->cel; + assert_and_assign_real_pointer (n, &x.sa); + + if (x.sspec->dtype == spec) + { + n = x.sspec->val; + /* perewesti zna~enie w specadres */ + } + else if (x.snd->dtype == number) + { + gets1 (&n, &y.sa); + *y.snd = *x.snd; + } + else if (x.sad->dtype == rulename && x.srd->fragmadr == 0) + x.srd->nomintab = c->cel; + /* pomestitx s-adres #l w sr-prostr. */ + /* dlq nastrojki wo wremq wypolneniq */ + } + v[base - 1] = n; + push (); } - v[base - 3] = rez1; - base--; - } else if (c->cel == cselect) - selctr(); - else if (c->cel == cindex) - indxop(); - else if (c->cel == cname) - nameop(); - else if (c->cel == cmult || c->cel == cdiv || c->cel == cmod || - c->cel == cadd || c->cel == cminus || c->cel == cgt || - c->cel == clt || c->cel == cge || c->cel == cle) - arithm(c->cel); - else if (c->cel == cconc) { - getval(&v[base - 3]); - getval(&v[base - 2]); - concop(&v[base - 3], v[base - 2]); - base--; - } else if (c->cel == clconc) { - getval(&v[base - 2]); - getval(&v[base - 3]); - lconc(&v[base - 3], v[base - 2]); - base--; - } else - goto _L3; - goto _L4; -_L3: - if (c->cel == ctradd) { - getval(&v[base - 2]); - getval(&v[base - 3]); - addtre(&v[base - 3], v[base - 2]); - base--; - } else if (c->cel == cequ || c->cel == cnequ) - eqop(c->cel); - else if (c->cel == cand) { - getval(&v[base - 3]); - getval(&v[base - 2]); - if (v[base - 3] != null_ && v[base - 2] != null_) - v[base - 3] = atomt; - else - v[base - 3] = null_; - base--; - } else if (c->cel == cor) { - getval(&v[base - 3]); - getval(&v[base - 2]); - if (v[base - 3] != null_ || v[base - 2] != null_) - v[base - 3] = atomt; - else - v[base - 3] = null_; - base--; - } else if (c->cel == cnot) { - getval(&v[base - 2]); - if (v[base - 2] == null_) - v[base - 2] = atomt; - else - v[base - 2] = null_; - } else if (c->cel == cunminus) - unmins(); - else if (c->cel == ccopy) - copyop(); - else if (c->cel == 512) { - /* spec.perem. $$ ustanawliwaetsq */ - /* iz glob.per. teklexem */ - v[base - 2] = teklexem; - } else if (c->cel == clist1) - conlst(c); - else if (c->cel == ctree1) - contre(c); - else if (c->cel == asdelim) { - *rez = v[base - 2]; - goto _L1; - } else if (c->cel == clist2 || c->cel == ctree2) { - goto _L2; - /* wozwr.rez., no ne sdwigatx c */ - /* nuvno conlst i contree */ - } else if (c->cel == 1024) { - /* ^ w spiske << */ - v[base - 1] = c->cel; - push(); - } else - notfinished = false; - } else { - if (c->cel == null_) - n = null_; - else { - n = c->cel; - points(n, &x.sa); - - if (x.sspec->dtype == spec) { - n = x.sspec->val; - /* perewesti zna~enie w specadres */ - } else if (x.snd->dtype == number) { - gets1(&n, &y.sa); - *y.snd = *x.snd; - } else if (x.sad->dtype == rulename && x.srd->fragmadr == 0) - x.srd->nomintab = c->cel; - /* pomestitx s-adres #l w sr-prostr. */ - /* dlq nastrojki wo wremq wypolneniq */ - } - v[base - 1] = n; - push(); - } -_L4: - next(c); - } /* while */ + _L4: + next (c); + } /* while */ _L2: base--; *rez = v[base - 1]; _L1: - getval(rez); + getval (rez); /* wyzow prawila */ /* (c.cel mod 512)=0 */ @@ -597,11 +682,12 @@ _L1: } -Void facult(rez, success, pl, p) -long *rez; -boolean *success; -ptr_ *pl; -long p; +void +facult (rez, success, pl, p) + long *rez; + bool *success; + ptr_ *pl; + long p; { /* ukaz.na 1-` leksemu, */ /* prodwigaetsq wpered */ @@ -610,334 +696,371 @@ long p; /* {ablon fakulxtatiwa */ /*======================*/ a rez1; - boolean success1; - ptr_ pl1; /* tek.leksema */ - ptr_ pp; /* tek.|l-t {ablona */ - boolean ispattern; + bool success1; + ptr_ pl1; /* tek.leksema */ + ptr_ pp; /* tek.|l-t {ablona */ + bool ispattern; rez1 = null_; *success = true; /* wojti w spisok {ablonow */ - first(p, &pp); + first (p, &pp); ispattern = true; pl1 = *pl; success1 = true; /* osnownoj cikl */ - while (success1 && continue_ && pp.cel != 0) { - if (pp.cel == opdelim) - ispattern = !ispattern; - else { - if (ispattern) - pattern(&rez1, &success1, &pl1, &pp); + while (success1 && continue_ && pp.cel != 0) + { + if (pp.cel == opdelim) + ispattern = !ispattern; else - statement(pp.cel, &success1, &rez1); + { + if (ispattern) + pattern (&rez1, &success1, &pl1, &pp); + else + statement (pp.cel, &success1, &rez1); + } + next (&pp); + } /* while */ + if (success1) + { + *pl = pl1; + *rez = rez1; } - next(&pp); - } /* while */ - if (success1) { - *pl = pl1; - *rez = rez1; - } -} /* facult*/ +} /* facult */ -/* Local variables for inout: */ -struct LOC_inout { +/* static variables for inout: */ +struct LOC_inout +{ bl80 a80_; filespecification namestr; longint rezlong; - long i, openlen; /* dlq pods~eta hiriny fajla */ + long i, openlen; /* dlq pods~eta hiriny fajla */ mpd x; - a rez; /* rezulxtat expression */ - long len; /* dlina atoma */ - a fsp; /* a-adres specifikacii fajla */ - boolean blank; /* nado probely mevdu atomami */ -} ; + a rez; /* rezulxtat expression */ + long len; /* dlina atoma */ + a fsp; /* a-adres specifikacii fajla */ + bool blank; /* nado probely mevdu atomami */ +}; -Local Void make80(ee, LINK) -long ee; -struct LOC_inout *LINK; +static void +make80 (ee, LINK) + long ee; + struct LOC_inout *LINK; { /* sozdaet a80 i len */ - pointa(ee, LINK->a80_, &LINK->len); /* ibm/pc bez [1] */ -} /* make80 */ + get_data_from_pointa (ee, LINK->a80_, &LINK->len); /* ibm/pc bez [1] */ +} /* make80 */ -Local Void line(symlen, LINK) -long symlen; -struct LOC_inout *LINK; +static void +line (symlen, LINK) + long symlen; + struct LOC_inout *LINK; { /* kontroliruet zapolnenie stroki fajla */ - /* curlen - tekusaq dlina , symlen - nado wywesti ,*/ + /* curlen - tekusaq dlina , symlen - nado wywesti , */ /* strlen - specifikaciq fajla-dlina stroki */ _REC_filetab *WITH; - WITH = &filetab[LINK->i - 1]; /*with*/ + WITH = &filetab[LINK->i - 1]; /*with */ if (!(LINK->blank && WITH->curlen + symlen > WITH->strlen)) - { /* esli na |toj stroke ne pomehhaetsq */ - WITH->curlen += symlen; - return; - } - if (symlen > WITH->strlen + 1) /* slihkom dlinnaq stroka */ - err(17L); + { /* esli na |toj stroke ne pomehhaetsq */ + WITH->curlen += symlen; + return; + } + if (symlen > WITH->strlen + 1) /* slihkom dlinnaq stroka */ + err (17L); /* perewod na nowu` stroku */ if (filetab[LINK->i - 1].screen) - putchar('\n'); + putchar ('\n'); else - putc('\n', files[LINK->i - 1]); + putc ('\n', files[LINK->i - 1]); WITH->curlen = symlen; -} /*line*/ +} /*line */ -Local Void printlist(la, i, fil, scr, LINK) -long la, i; -FILE **fil; -boolean scr; -struct LOC_inout *LINK; +static void +printlist (la, i, fil, scr, LINK) + long la, i; + FILE **fil; + bool scr; + struct LOC_inout *LINK; { /* procedura dlq pe~ati spiska */ /*la-adres, i-nomer fajla */ mpd x; ptr_ lptr; - boolean tatomflag; + bool tatomflag; a a1; - longint k; /* changed 17-nov-90 from integer */ + longint k; /* changed 17-nov-90 from integer */ long j, FORLIM; - if ((la & 511) == 0 && la > 0 && la < 65536L) { - line(20L, LINK); - if (scr) - printf(" <!<!!A*!*!!>!> "); - else - fprintf(*fil, " <!<!!A*!*!!>!> "); - return; - } - if (la == 0) { - return; - } /* else mod<>512 */ - pointr(la, &x.sa); - switch (x.sad->dtype) { - - case listmain: /*listmain*/ - /* raspe~atka spiska */ - /*line(5);*/ - /* garantii koncow spiska */ - first(la, &lptr); - while (lptr.nel != 0) { - if (lptr.cel == 1024) { - LINK->blank = !LINK->blank; - /*if not(blank) then line(25);*/ - /* - garantiq neperenosa*/ - } else /* a'1024 - smena revima pe~ati */ - printlist(lptr.cel, i, fil, scr, LINK); - next(&lptr); - } /*while*/ - break; - - case fatom: /* added 17-feb-1992 */ - line(12L, LINK); /* standard length of written real */ - - if (scr) - printf("%E", take_fatom(x.sad->name)); - else - fprintf(*fil, "%E", take_fatom(x.sad->name)); - break; - - case atom: - case idatom: - case tatom: - case keyword: - case variable: - case fvariable: - case nvariable: - case idvariable: - case rulename: /*atom ...*/ - /* pe~atx otdelxnogo atoma */ - tatomflag = (x.sad->dtype == tatom); - switch (x.sad->dtype) { - - case variable: - case fvariable: - case nvariable: - case idvariable: - a1 = x.svd->name; + if ((la & 511) == 0 && la > 0 && la < 65536L) + { + line (20L, LINK); if (scr) - putchar('$'); + printf (" <!<!!A*!*!!>!> "); else - putc('$', *fil); + fprintf (*fil, " <!<!!A*!*!!>!> "); + return; + } + if (la == 0) + { + return; + } /* else mod<>512 */ + assert_and_assign_real_pointer (la, &x.sa); + switch (x.sad->dtype) + { + + case listmain: /*listmain */ + /* raspe~atka spiska */ + /*line(5); */ + /* garantii koncow spiska */ + first (la, &lptr); + while (lptr.nel != 0) + { + if (lptr.cel == 1024) + { + LINK->blank = !LINK->blank; + /*if not(blank) then line(25); */ + /* + garantiq neperenosa */ + } + else /* a'1024 - smena revima pe~ati */ + printlist (lptr.cel, i, fil, scr, LINK); + next (&lptr); + } /*while */ break; - case rulename: - a1 = x.srd->name; + case fatom: /* added 17-feb-1992 */ + line (12L, LINK); /* standard length of written real */ + if (scr) - putchar('#'); + printf ("%E", take_fatom (x.sad->name)); else - putc('#', *fil); + fprintf (*fil, "%E", take_fatom (x.sad->name)); break; + case atom: + case idatom: + case tatom: + case keyword: + case variable: + case fvariable: + case nvariable: + case idvariable: + case rulename: /*atom ... */ + /* pe~atx otdelxnogo atoma */ + tatomflag = (x.sad->dtype == tatom); + switch (x.sad->dtype) + { + + case variable: + case fvariable: + case nvariable: + case idvariable: + a1 = x.svd->name; + if (scr) + putchar ('$'); + else + putc ('$', *fil); + break; - default: - a1 = x.sad->name; - break; - }/*case*/ - make80(a1, LINK); /* daet a80 i len */ - if (tatomflag) { - line(LINK->len + 2, LINK); - if (scr) { - putchar('\''); - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) { - if (LINK->a80_[j] == '\'') - printf("''"); + case rulename: + a1 = x.srd->name; + if (scr) + putchar ('#'); + else + putc ('#', *fil); + break; + + + default: + a1 = x.sad->name; + break; + } /*case */ + make80 (a1, LINK); /* daet a80 i len */ + if (tatomflag) + { + line (LINK->len + 2, LINK); + if (scr) + { + putchar ('\''); + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + { + if (LINK->a80_[j] == '\'') + printf ("''"); + else + putchar (LINK->a80_[j]); + } + putchar ('\''); + } else - putchar(LINK->a80_[j]); + { + putc ('\'', *fil); + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + { + if (LINK->a80_[j] == '\'') + fprintf (*fil, "''"); + else + putc (LINK->a80_[j], *fil); + } + putc ('\'', *fil); + } } - putchar('\''); - } else { - putc('\'', *fil); - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) { - if (LINK->a80_[j] == '\'') - fprintf(*fil, "''"); + else + { /* if/else */ + line (LINK->len, LINK); + if (scr) + { + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + putchar (LINK->a80_[j]); + } else - putc(LINK->a80_[j], *fil); + { + FORLIM = LINK->len; + for (j = 0; j < FORLIM; j++) + putc (LINK->a80_[j], *fil); + } } - putc('\'', *fil); - } - } else { /* if/else */ - line(LINK->len, LINK); - if (scr) { - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) - putchar(LINK->a80_[j]); - } else { - FORLIM = LINK->len; - for (j = 0; j < FORLIM; j++) - putc(LINK->a80_[j], *fil); - } - } - if (LINK->blank) { - line(1L, LINK); - if (scr) - putchar(' '); - else - putc(' ', *fil); - } - break; - - case number: /* pe~atx ~isla */ - LINK->rezlong = x.snd->val; - k = LINK->rezlong; - if (k < 0) /* cahanged from abs call */ - k = -k; - j = 0; - do { - k /= 10; - j++; - } while (k >= 1); - line(j, LINK); - if (scr) - printf("%ld", LINK->rezlong); - else - fprintf(*fil, "%ld", LINK->rezlong); - if (LINK->blank) { - line(1L, LINK); + if (LINK->blank) + { + line (1L, LINK); + if (scr) + putchar (' '); + else + putc (' ', *fil); + } + break; + + case number: /* pe~atx ~isla */ + LINK->rezlong = x.snd->val; + k = LINK->rezlong; + if (k < 0) /* cahanged from abs call */ + k = -k; + j = 0; + do + { + k /= 10; + j++; + } + while (k >= 1); + line (j, LINK); if (scr) - putchar(' '); + printf ("%ld", LINK->rezlong); else - putc(' ', *fil); - } + fprintf (*fil, "%ld", LINK->rezlong); + if (LINK->blank) + { + line (1L, LINK); + if (scr) + putchar (' '); + else + putc (' ', *fil); + } - break; - /*number*/ + break; + /*number */ - case treemain: - line(20L, LINK); + case treemain: + line (20L, LINK); - if (scr) - printf(" <!<!<*TREE*>!>!> "); - else - fprintf(*fil, " <!<!<*TREE*>!>!> "); - break; + if (scr) + printf (" <!<!<*TREE*>!>!> "); + else + fprintf (*fil, " <!<!<*TREE*>!>!> "); + break; - default: - line(20L, LINK); + default: + line (20L, LINK); - if (scr) /* otherwise */ - printf(" <!<!<UNK***>!>!> "); - else - fprintf(*fil, " <!<!<UNK***>!>!> "); - break; - }/* case */ + if (scr) /* otherwise */ + printf (" <!<!<UNK***>!>!> "); + else + fprintf (*fil, " <!<!<UNK***>!>!> "); + break; + } /* case */ /* pri la=0 - ni~ego ne pe~ataetsq */ -} /* printlist */ +} /* printlist */ -Local boolean makefilespec(LINK) -struct LOC_inout *LINK; +static bool +makefilespec (LINK) + struct LOC_inout *LINK; { - boolean Result; + bool Result; long j, k, k1, FORLIM1; Result = false; - if ((LINK->rez & 511) == null_ && LINK->rez < 65536L && LINK->rez >= 0) { - err(11L); - goto _L99; - } /* 17-apr-91 */ - - pointr(LINK->rez, &LINK->x.sa); - if (((1L << ((long)LINK->x.sad->dtype)) & ((1L << ((long)atom)) | - (1L << ((long)idatom)) | (1L << ((long)tatom)))) == 0) { - err(11L); - goto _L99; - } + if ((LINK->rez & 511) == null_ && LINK->rez < 65536L && LINK->rez >= 0) + { + err (11L); + goto _L99; + } /* 17-apr-91 */ + + assert_and_assign_real_pointer (LINK->rez, &LINK->x.sa); + if (((1L << ((long) LINK->x.sad->dtype)) & ((1L << ((long) atom)) | + (1L << ((long) idatom)) | (1L << + ((long) tatom)))) == 0) + { + err (11L); + goto _L99; + } /* specifikaciq fajla - ne atom */ LINK->fsp = LINK->x.sad->name; - make80(LINK->fsp, LINK); /* daet a80 i len */ - if (LINK->len > 80) { - err(12L); - goto _L99; - } + make80 (LINK->fsp, LINK); /* daet a80 i len */ + if (LINK->len > 80) + { + err (12L); + goto _L99; + } LINK->openlen = 80; - for (k = LINK->len; k >= 1; k--) { - if (LINK->a80_[k - 1] == ',') { - LINK->openlen = 0; - FORLIM1 = LINK->len; - for (k1 = k + 1; k1 <= FORLIM1; k1++) - LINK->openlen = LINK->openlen * 10 + LINK->a80_[k] - '0'; - LINK->len = k - 1; + for (k = LINK->len; k >= 1; k--) + { + if (LINK->a80_[k - 1] == ',') + { + LINK->openlen = 0; + FORLIM1 = LINK->len; + for (k1 = k + 1; k1 <= FORLIM1; k1++) + LINK->openlen = LINK->openlen * 10 + LINK->a80_[k] - '0'; + LINK->len = k - 1; + } } - } *LINK->namestr = '\0'; FORLIM1 = LINK->len; for (j = 0; j < FORLIM1; j++) - sprintf(LINK->namestr + strlen(LINK->namestr), "%c", LINK->a80_[j]); + sprintf (LINK->namestr + strlen (LINK->namestr), "%c", LINK->a80_[j]); Result = true; _L99: return Result; -} /* makefilespec */ +} /* makefilespec */ -Void inout(p, ot) -long p, ot; +void +inout (p, ot) + long p, ot; { /* ==================={======================== */ /* obespe~iwaet wypolnenie operatorow wwoda-wywoda */ @@ -945,169 +1068,200 @@ long p, ot; /* p - adres spiska, predstawlq`hego operator */ /* ot - imq spiska */ struct LOC_inout V; - long j; /* i - nomer fajla */ + long j; /* i - nomer fajla */ - ptr_ opptr; /* pointer po s-kodu operatora */ - a aadr; /* a-adres atoma */ - a opcel; /* rawen opptr.cel*/ + ptr_ opptr; /* pointer po s-kodu operatora */ + a aadr; /* a-adres atoma */ + a opcel; /* rawen opptr.cel */ /* ========= osnownaq procedura ========== */ - if (ot == 10752) { /* open , otkrytie fajla */ - first(p, &opptr); - opcel = opptr.cel; - pointr(opcel, &V.x.sa); - aadr = V.x.sad->name; - /* a-adres imeni fajla - */ - for (V.i = 1; V.i <= filenum; V.i++) { - if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) - { /* otkrytx fajl snowa */ - err(16L); - /* nado zakrywatx fajl pered - otkrytiem */ - /* $$$ !!! wyravenie ne wy~islqetsq */ + if (ot == 10752) + { /* open , otkrytie fajla */ + first (p, &opptr); + opcel = opptr.cel; + assert_and_assign_real_pointer (opcel, &V.x.sa); + aadr = V.x.sad->name; + /* a-adres imeni fajla + */ + for (V.i = 1; V.i <= filenum; V.i++) + { + if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) + { /* otkrytx fajl snowa */ + err (16L); + /* nado zakrywatx fajl pered + otkrytiem */ + /* $$$ !!! wyravenie ne wy~islqetsq */ + goto _L99; + } + } + for (V.i = 1; V.i <= filenum; V.i++) + { + if (!filetab[V.i - 1].isopen) + { + j = V.i; + goto _L98; + } + } + /* ihetsq perwoe neotkrytoe gnezda dlq fajla */ + err (13L); + goto _L99; /* slihkom mnogo otkrytyh fajlow */ + + _L98: + next (&opptr); + expression (&opptr, &V.rez); + /* wy~islenie wyraveniq, + rez-rezulxtat */ + if (!makefilespec (&V)) goto _L99; - } - } - for (V.i = 1; V.i <= filenum; V.i++) { - if (!filetab[V.i - 1].isopen) { - j = V.i; - goto _L98; - } - } - /* ihetsq perwoe neotkrytoe gnezda dlq fajla */ - err(13L); - goto _L99; /* slihkom mnogo otkrytyh fajlow */ - -_L98: - next(&opptr); - expression(&opptr, &V.rez); - /* wy~islenie wyraveniq, - rez-rezulxtat */ - if (!makefilespec(&V)) + /* w p80 ustanowitsq sp. fajla */ + if (!strcmp (V.namestr, " ")) + filetab[j - 1].screen = true; + else + { + filetab[j - 1].screen = false; + if (!rightfile (V.namestr)) + { + errstr (19L, V.namestr); + goto _L99; + } + + files[j - 1] = fopen (V.namestr, "w"); + if (files[j - 1] == NULL) + _EscIO (FileNotFound); + } + + + filetab[j - 1].isopen = true; + filetab[j - 1].strlen = V.openlen; + filetab[j - 1].curlen = 0; + filetab[j - 1].name = aadr; + /* rightfile */ goto _L99; - /* w p80 ustanowitsq sp. fajla */ - if (!strcmp(V.namestr, " ")) - filetab[j - 1].screen = true; - else - { - filetab[j - 1].screen = false; - files[j - 1] = fopen(V.namestr, "w"); - if (files[j - 1] == NULL) _EscIO(FileNotFound); - } - filetab[j - 1].isopen = true; - filetab[j - 1].strlen = V.openlen; - filetab[j - 1].curlen = 0; - filetab[j - 1].name = aadr; - - goto _L99; - - } - if (ot == 31744) { /* close */ - first(p, &opptr); - opcel = opptr.cel; - pointr(opcel, &V.x.sa); - aadr = V.x.sad->name; - for (V.i = 1; V.i <= filenum; V.i++) { - if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) { - if (filetab[V.i - 1].screen) - putchar('\n'); - else { - putc('\n', files[V.i - 1]); - if (files[V.i - 1] != NULL) - fclose(files[V.i - 1]); - files[V.i - 1] = NULL; - } - filetab[V.i - 1].isopen = false; - } } - } /*close*/ - else if (ot == 32256) { - first(p, &opptr); - expression(&opptr, &V.rez); - if (out_screen) - pscr(V.rez); - else - pout(V.rez); - if (out_screen) - putchar('\n'); - else - putc('\n', out); - /* otlado~nyj wywod w fajl out*/ - } else if (ot == 11264 || ot == 18432) { - /* write('%'); */ - first(p, &opptr); - opcel = opptr.cel; - pointr(opcel, &V.x.sa); - aadr = V.x.sad->name; - for (V.i = 1; V.i <= filenum; V.i++) { - if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) { - next(&opptr); - if (ot == 11264) { - if (filetab[V.i - 1].screen) - putchar('\n'); - else - putc('\n', files[V.i - 1]); - filetab[V.i - 1].curlen = 0; + if (ot == 31744) + { /* close */ + first (p, &opptr); + opcel = opptr.cel; + assert_and_assign_real_pointer (opcel, &V.x.sa); + aadr = V.x.sad->name; + for (V.i = 1; V.i <= filenum; V.i++) + { + if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) + { + if (filetab[V.i - 1].screen) + putchar ('\n'); + else + { + putc ('\n', files[V.i - 1]); + if (files[V.i - 1] != NULL) + fclose (files[V.i - 1]); + files[V.i - 1] = NULL; + } + filetab[V.i - 1].isopen = false; + } } - if (opptr.cel != 0) { - expression(&opptr, &V.rez); - V.blank = true; - printlist(V.rez, V.i, &files[V.i - 1], filetab[V.i - 1].screen, &V); - } /* if <> 0 */ - goto _L99; - } /* for/ if open */ + } /*close */ + else if (ot == 32256) + { + first (p, &opptr); + expression (&opptr, &V.rez); + if (out_screen) + pscr (V.rez); + else + pout (V.rez); + if (out_screen) + putchar ('\n'); + else + putc ('\n', out); + /* otlado~nyj wywod w fajl out */ } + else if (ot == 11264 || ot == 18432) + { + /* write('%'); */ + first (p, &opptr); + opcel = opptr.cel; + assert_and_assign_real_pointer (opcel, &V.x.sa); + aadr = V.x.sad->name; + for (V.i = 1; V.i <= filenum; V.i++) + { + if (filetab[V.i - 1].name == aadr && filetab[V.i - 1].isopen) + { + next (&opptr); + if (ot == 11264) + { + if (filetab[V.i - 1].screen) + putchar ('\n'); + else + putc ('\n', files[V.i - 1]); + filetab[V.i - 1].curlen = 0; + } + if (opptr.cel != 0) + { + expression (&opptr, &V.rez); + V.blank = true; + printlist (V.rez, V.i, &files[V.i - 1], + filetab[V.i - 1].screen, &V); + } /* if <> 0 */ + goto _L99; + } /* for/ if open */ + } - err(14L); /* fajl ne otkryt */ - /* $$$ !!!! pri |tom wyravenie ne wy~islqetsq */ - - } else if (ot == 9728 || ot == 10240) { - first(p, &opptr); - opcel = opptr.cel; - pointr(opcel, &V.x.sa); - j = V.x.svd->location + mybase; - next(&opptr); - expression(&opptr, &V.rez); - if (!makefilespec(&V)) - goto _L99; - if (ot == 9728) { - if (existfile(V.namestr)) - loads(V.namestr, &v[j - 1]); - else { - v[j - 1] = 0; - errstr(18L, V.namestr); - } + err (14L); /* fajl ne otkryt */ + /* $$$ !!!! pri |tom wyravenie ne wy~islqetsq */ } - if (ot == 10240) { - if (v[j - 1] != 0) { - if ( *V.namestr != '\0') - saves(V.namestr, &v[j - 1]); - else - errstr(15L, V.namestr); - } + else if (ot == 9728 || ot == 10240) + { + first (p, &opptr); + opcel = opptr.cel; + assert_and_assign_real_pointer (opcel, &V.x.sa); + j = V.x.svd->location + mybase; + next (&opptr); + expression (&opptr, &V.rez); + if (!makefilespec (&V)) + goto _L99; + if (ot == 9728) + { + if (existfile (V.namestr)) + loads (V.namestr, &v[j - 1]); + else + { + v[j - 1] = 0; + errstr (18L, V.namestr); + } + + } + if (ot == 10240) + { + if (v[j - 1] != 0) + { + if (rightfile (V.namestr) && *V.namestr != '\0') + saves (V.namestr, &v[j - 1]); + else + errstr (15L, V.namestr); + } + } } - } -_L99: ; +_L99:; - /*print*/ + /*print */ /* wywod << << << << */ /* wywod << */ } -Void list(rez, success, pl, p) -long *rez; -boolean *success; -ptr_ *pl; -long p; +void +list (rez, success, pl, p) + long *rez; + bool *success; + ptr_ *pl; + long p; { /* ukazatelx na deskriptor spiska (leksema) */ /* ukazatelx na |l-t {ablona */ @@ -1125,7 +1279,7 @@ long p; /* tek. leksema wnutri spiska leksem, */ /* esli is~erpan, ili pl=0, to pl.nel=0 */ a rez1; - boolean success1, ispattern; + bool success1, ispattern; /* tek.|l-t spiska- {ablon, */ /* false -operator */ mpd s1; @@ -1134,65 +1288,77 @@ long p; rez1 = null_; /* proweritx ,~to pl ukazywaet na glawnyj */ /* fragment spiska, ina~e fail */ - if (pl->nel == 0) { - *success = false; - goto _L99; - } - if (pl->cel != null_) { - rez1 = pl->cel; - pointr(rez1, &s1.sa); - if (s1.smld->dtype != listmain) { /* leksema ne spisok */ + if (pl->nel == 0) + { *success = false; - rez1 = null_; - goto _L99; /* konec */ + goto _L99; + } + if (pl->cel != null_) + { + rez1 = pl->cel; + assert_and_assign_real_pointer (rez1, &s1.sa); + if (s1.smld->dtype != listmain) + { /* leksema ne spisok */ + *success = false; + rez1 = null_; + goto _L99; /* konec */ + } + /* ustanowitx pl1 na perwyj |l-t wnutri spiska pl */ + first (pl->cel, &pl1); + } + else + { + pl1.nel = 0; + pl1.cel = null_; } - /* ustanowitx pl1 na perwyj |l-t wnutri spiska pl */ - first(pl->cel, &pl1); - } else { - pl1.nel = 0; - pl1.cel = null_; - } /* wojti w spisok {ablonow, */ /* pp-perwyj |l-t {ablona wnutri spiska {ablona */ - first(p, &pp); + first (p, &pp); /* proweritx sowpadenie imeni spiska i */ - /* imeni w {ablone(esli estx )*/ - if ((pp.cel & 511) != 0 || pp.cel >= 65536L || pp.cel < 0) { - /* w {ablone estx atom ili perem. */ - if (!compnames(pp.cel, pl->cel)) { - *success = false; - goto _L99; /* konec */ + /* imeni w {ablone(esli estx ) */ + if ((pp.cel & 511) != 0 || pp.cel >= 65536L || pp.cel < 0) + { + /* w {ablone estx atom ili perem. */ + if (!compnames (pp.cel, pl->cel)) + { + *success = false; + goto _L99; /* konec */ + } } - } - /* ustanowitx pp na perwyj wypolnimyj |l-t {ablona*/ - next(&pp); + /* ustanowitx pp na perwyj wypolnimyj |l-t {ablona */ + next (&pp); success1 = true; /* osnownoj cikl */ ispattern = true; - while (success1 && continue_ && pp.nel != 0 && !fail) { /* while */ - if (pp.cel == opdelim) - ispattern = !ispattern; - else { /*30-aug-89*/ - teklexem = pl1.cel; - if (ispattern) - pattern(&rez1, &success1, &pl1, &pp); + while (success1 && continue_ && pp.nel != 0 && !fail) + { /* while */ + if (pp.cel == opdelim) + ispattern = !ispattern; else - statement(pp.cel, &success1, &rez1); + { /*30-aug-89 */ + teklexem = pl1.cel; + if (ispattern) + pattern (&rez1, &success1, &pl1, &pp); + else + statement (pp.cel, &success1, &rez1); + } + next (&pp); + } + + if (success1 && continue_) + { + if (pl1.nel != 0) + { + /* spisok {ablonow kon~ilsq ranx{e, */ + /* ~em spisok leksem */ + success1 = false; + rez1 = null_; + } + else + rez1 = pl->cel; } - next(&pp); - } - - if (success1 && continue_) { - if (pl1.nel != 0) { - /* spisok {ablonow kon~ilsq ranx{e, */ - /* ~em spisok leksem */ - success1 = false; - rez1 = null_; - } else - rez1 = pl->cel; - } if (success1 && pl->ptrtype == ptrlist) - next(pl); + next (pl); *success = success1; _L99: *rez = rez1; @@ -1200,97 +1366,110 @@ _L99: } -Void loop(p, succ, rez) -long p; -boolean *succ; -long *rez; +void +loop (p, succ, rez) + long p; + bool *succ; + long *rez; { /* s-adres spiska operatora */ /* dlq wozwrata - neuspeha iz fail */ + neuspeha iz fail */ /* dlq wozwrata rez.iz return - */ + */ ptr_ pp; a r, ats; - long nvar; /* nomer per.cikla w steke v[ ]*/ - long nbvar; /* nom. branches-var in stack */ + long nvar; /* nomer per.cikla w steke v[ ] */ + long nbvar; /* nom. branches-var in stack */ mpd x; ptr_ p2, stmtbeg, p3; - boolean islist; + bool islist; /* deskriptor atoma -selektora */ atomdescriptor *WITH; - first(p, &pp); + first (p, &pp); r = pp.cel; if (r == null_) nvar = 0; - else { - pointr(r, &x.sa); - nvar = x.svd->location + mybase; - } - next(&pp); + else + { + assert_and_assign_real_pointer (r, &x.sa); + nvar = x.svd->location + mybase; + } + next (&pp); if (pp.cel == null_) nbvar = 0; - else { - r = pp.cel; - pointr(r, &x.sa); - nbvar = x.svd->location + mybase; - } - next(&pp); /* pp na na~alo wyraveniq */ - expression(&pp, &r); + else + { + r = pp.cel; + assert_and_assign_real_pointer (r, &x.sa); + nbvar = x.svd->location + mybase; + } + next (&pp); /* pp na na~alo wyraveniq */ + expression (&pp, &r); if (r == null_) goto _L1; - pointr(r, &x.sa); + assert_and_assign_real_pointer (r, &x.sa); /* pp na perwom operatore */ stmtbeg = pp; if (x.smld->dtype == listmain) islist = true; else if (x.smld->dtype == treemain) islist = false; - else { - err(24L); - goto _L1; - } - first(r, &p2); /* wojti w spisok/derewo */ - break_ = false; - while (p2.nel != 0 && continue_ && *succ && !break_) { - /* cikl po spisku/derewu */ - if (islist) { - if (nvar == 0 || nbvar != 0) { - err(26L); - goto _L1; - } - v[nvar - 1] = p2.cel; - } else { /* tree */ - if (nvar != 0) { - gets1(&ats, &x.sa); - WITH = x.sad; - WITH->dtype = idatom; - WITH->name = p2.UU.U1.arc; - v[nvar - 1] = ats; - } - if (nbvar != 0) - v[nbvar - 1] = p2.cel; - } /** tree **/ - p3 = stmtbeg; - while (p3.nel != 0 && continue_ && *succ && !fail && !break_) { - /* added 23.10.89 */ - /* wypolnitx telo cikla forall */ - statement(p3.cel, succ, rez); - next(&p3); + else + { + err (24L); + goto _L1; } - next(&p2); - } /* while */ + first (r, &p2); /* wojti w spisok/derewo */ + break_ = false; + while (p2.nel != 0 && continue_ && *succ && !break_) + { + /* cikl po spisku/derewu */ + if (islist) + { + if (nvar == 0 || nbvar != 0) + { + err (26L); + goto _L1; + } + v[nvar - 1] = p2.cel; + } + else + { /* tree */ + if (nvar != 0) + { + gets1 (&ats, &x.sa); + WITH = x.sad; + WITH->dtype = idatom; + WITH->name = p2.UU.U1.arc; + v[nvar - 1] = ats; + } + if (nbvar != 0) + v[nbvar - 1] = p2.cel; + } + /** tree **/ + p3 = stmtbeg; + while (p3.nel != 0 && continue_ && *succ && !fail && !break_) + { + /* added 23.10.89 */ + /* wypolnitx telo cikla forall */ + statement (p3.cel, succ, rez); + next (&p3); + } + next (&p2); + } /* while */ _L1: break_ = false; -} /* loop */ +} /* loop */ -Void objexpr(c, nvar, t) -ptr_ *c; -long *nvar; -boolean *t; +void +objexpr (c, nvar, t) + ptr_ *c; + long *nvar; + bool *t; { /* na~alo obxekta */ /* prodwigaetsq wpered , */ @@ -1307,66 +1486,70 @@ boolean *t; k = c->cel; - next(c); /* c na 2-j |l-t wyr.*/ - pointr(k, &x.sa); + next (c); /* c na 2-j |l-t wyr. */ + assert_and_assign_real_pointer (k, &x.sa); /* 1-j |l-t wyraveniq */ - if (c->cel == asdelim) { /* $e := ... */ - *t = false; - *nvar = x.svd->location; - return; - } + if (c->cel == asdelim) + { /* $e := ... */ + *t = false; + *nvar = x.svd->location; + return; + } *t = true; /* $e.... := ... */ /* #l $e last ... := ... */ - if (x.srd->dtype == rulename) { /* s- adres uzla */ - /* #l $e last ... */ - srchrule1(k, &m); - /* w m ssylka na base dlq prawila */ - k1 = m.cel; - pointr(k1, &x.sa); - /* x na base prawila #l */ - k = x.snd->val; /* base */ - k1 = c->cel; - pointr(k1, &x.sa); /* x na $e */ - k += x.svd->location; - /* nomer w steke dlq last #l $e */ - next(c); - next(c); /* c na sled. za last */ - } /* #l $e last */ - else { /* $e ..... */ - /* x, k na $e */ - k = x.svd->location + mybase; - } + if (x.srd->dtype == rulename) + { /* s- adres uzla */ + /* #l $e last ... */ + srchrule1 (k, &m); + /* w m ssylka na base dlq prawila */ + k1 = m.cel; + assert_and_assign_real_pointer (k1, &x.sa); + /* x na base prawila #l */ + k = x.snd->val; /* base */ + k1 = c->cel; + assert_and_assign_real_pointer (k1, &x.sa); /* x na $e */ + k += x.svd->location; + /* nomer w steke dlq last #l $e */ + next (c); + next (c); /* c na sled. za last */ + } /* #l $e last */ + else + { /* $e ..... */ + /* x, k na $e */ + k = x.svd->location + mybase; + } /*================================*/ /* sformirowatx object */ /* */ /*================================*/ /* abs.adres uzla */ - gets2(&k1, &y.sa); + gets2 (&k1, &y.sa); WITH = y.sobj; WITH->dtype = object_d; WITH->variable_ = true; WITH->fragmorvar = k; - push(); + push (); /* zanqtx perem. w steke , ee nomer ( base -1) */ /* oswoboditx w assgn */ v[base - 2] = k1; /* primenitx select i index i sformirowatx */ /* object s rezulxtatom */ - expression(c, &k); + expression (c, &k); v[base - 2] = k; *nvar = base - 1; /* sformirowatx object */ /* t=true */ -} /* objexpr */ +} /* objexpr */ -Void pattern(rez, success, pl, p) -long *rez; -boolean *success; -ptr_ *pl, *p; +void +pattern (rez, success, pl, p) + long *rez; + bool *success; + ptr_ *pl, *p; { /* tek.leksema */ /* ukazatelx |l-ta {ablona */ @@ -1379,241 +1562,266 @@ ptr_ *pl, *p; /*===========================*/ /* wyhod */ - mpd s; /* wirt.adres |l-ta {ablona */ - mpd s2; /* wirt.adres leksemy */ + mpd s; /* wirt.adres |l-ta {ablona */ + mpd s2; /* wirt.adres leksemy */ ptr_ x; a y, ot; ot = p->cel; - if (ot == cnull) { - /* $e:= null pered {ablonom */ - next(p); /* na varname */ - y = p->cel; - pointr(y, &s.sa); - /* polu~itx dostup k deskr.per. */ - v[mybase + s.svd->location - 1] = null_; - goto _L1; /* wyhod */ - } + if (ot == cnull) + { + /* $e:= null pered {ablonom */ + next (p); /* na varname */ + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + /* polu~itx dostup k deskr.per. */ + v[mybase + s.svd->location - 1] = null_; + goto _L1; /* wyhod */ + } if ((ot & 511) == 0 && ot >= cass1 && ot <= cass5 && ot < 65536L && ot >= 0) - { /* $e:= rez */ - next(p); /* na varname */ - y = p->cel; - pointr(y, &s.sa); /* deskr. per.*/ - y = mybase + s.svd->location; - /* nomer per. w steke */ - if (ot == cass1) /* prosto := */ - v[y - 1] = *rez; - else if (ot == cass2) - add(&v[y - 1], rez); - else if (ot == cass3) - addtre(&v[y - 1], *rez); - else if (ot == cass4) - concop(&v[y - 1], *rez); - else if (ot == cass5) - lconc(&v[y - 1], *rez); - goto _L1; /* wyhod */ - } - if (ot == cin) { - /* wstroennoe prawilo */ - next(p); - y = p->cel; - pointr(y, &s.sa); - bltin(rez, success, pl, s.snd->val); - if (debugrule) { - if (out_screen) { - printf("\n=>>>CALLS BUILT-IN RULE "); - prblt(y); - printf(" IN PATTERN:"); - if (*success) - printf(" SUCCESS\n"); - else - printf(" UNSUCCESS\n"); - printf(" RESULT:"); - pscr(*rez); - } else { - fprintf(out, "\n=>>>CALLS BUILT-IN RULE "); - prblt(y); - fprintf(out, " IN PATTERN:"); - if (*success) - fprintf(out, " SUCCESS\n"); - else - fprintf(out, " UNSUCCESS\n"); - fprintf(out, " RESULT:"); - pout(*rez); - } + { /* $e:= rez */ + next (p); /* na varname */ + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); /* deskr. per. */ + y = mybase + s.svd->location; + /* nomer per. w steke */ + if (ot == cass1) /* prosto := */ + v[y - 1] = *rez; + else if (ot == cass2) + add (&v[y - 1], rez); + else if (ot == cass3) + addtre (&v[y - 1], *rez); + else if (ot == cass4) + concop (&v[y - 1], *rez); + else if (ot == cass5) + lconc (&v[y - 1], *rez); + goto _L1; /* wyhod */ + } + if (ot == cin) + { + /* wstroennoe prawilo */ + next (p); + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + bltin (rez, success, pl, s.snd->val); + if (debugrule) + { + if (out_screen) + { + printf ("\n=>>>CALLS BUILT-IN RULE "); + prblt (y); + printf (" IN PATTERN:"); + if (*success) + printf (" SUCCESS\n"); + else + printf (" UNSUCCESS\n"); + printf (" RESULT:"); + pscr (*rez); + } + else + { + fprintf (out, "\n=>>>CALLS BUILT-IN RULE "); + prblt (y); + fprintf (out, " IN PATTERN:"); + if (*success) + fprintf (out, " SUCCESS\n"); + else + fprintf (out, " UNSUCCESS\n"); + fprintf (out, " RESULT:"); + pout (*rez); + } + } + goto _L1; } - goto _L1; - } /* polu~itx dostup k |l-tu {ablona */ y = p->cel; - pointr(y, &s.sa); - switch (s.sad->dtype) { - - case atom: - case idatom: - case number: - case fatom: /* srawnenie atomow */ - if (pl->nel == 0) /* leksemy net */ - { /* neuspeh */ - *success = false; - *rez = null_; - } else { - if (eqatoms(p->cel, pl->cel)) { /* atomy rawny */ - *success = true; - *rez = pl->cel; - if (pl->ptrtype == ptrlist) /* sdwig leksemy */ - next(pl); - } else { /* ne rawny atomy */ - *success = false; - *rez = null_; - } - } - break; - /* srawnenie atomow */ + assert_and_assign_real_pointer (y, &s.sa); + switch (s.sad->dtype) + { - case spec: - if ((pl->cel & 511) == 0 && pl->cel < 65536L && pl->cel >= 0) { - /* leksema uve priwedena k specadresu */ - *success = (pl->cel == s.sspec->val); - if (*success) - *rez = pl->cel; + case atom: + case idatom: + case number: + case fatom: /* srawnenie atomow */ + if (pl->nel == 0) /* leksemy net */ + { /* neuspeh */ + *success = false; + *rez = null_; + } else - *rez = null_; - } else { - ot = pl->cel; - pointr(ot, &s2.sa); - if (((1L << ((long)s2.smld->dtype)) & - ((1L << ((long)listmain)) | (1L << ((long)treemain)))) != 0 && - s2.smld->totalelnum == 0 && s.sspec->val == null_) - *success = true; + { + if (eqatoms (p->cel, pl->cel)) + { /* atomy rawny */ + *success = true; + *rez = pl->cel; + if (pl->ptrtype == ptrlist) /* sdwig leksemy */ + next (pl); + } + else + { /* ne rawny atomy */ + *success = false; + *rez = null_; + } + } + break; + /* srawnenie atomow */ + + case spec: + if ((pl->cel & 511) == 0 && pl->cel < 65536L && pl->cel >= 0) + { + /* leksema uve priwedena k specadresu */ + *success = (pl->cel == s.sspec->val); + if (*success) + *rez = pl->cel; + else + *rez = null_; + } else - *success = (s.sc8 == s2.sc8); + { + ot = pl->cel; + assert_and_assign_real_pointer (ot, &s2.sa); + if (((1L << ((long) s2.smld->dtype)) & + ((1L << ((long) listmain)) | (1L << ((long) treemain)))) != 0 + && s2.smld->totalelnum == 0 && s.sspec->val == null_) + *success = true; + else + *success = (s.sc8 == s2.sc8); + if (*success) + *rez = s.sspec->val; + else + *rez = null_; + } + if (*success && pl->ptrtype == ptrlist) + next (pl); + break; + /* spec */ + + case rulename: /* #imq w {ablone */ + if (debugrule) + { + if (out_screen) + { + printf ("\n=>>>CALLS RULE #"); + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + pratom (s.srd->name); + printf (" IN PATTERN"); + } + else + { + fprintf (out, "\n=>>>CALLS RULE #"); + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + pratom (s.srd->name); + fprintf (out, " IN PATTERN"); + } + } + srchrule1 (p->cel, &x); + rule (rez, success, pl, &x); + + if (debugrule) + { + if (out_screen) + { + printf ("\n<<<=EXITS FROM RULE #"); + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + pratom (s.srd->name); + printf (": "); + if (*success) + printf ("SUCCESS\n"); + else + printf ("UNSUCCESS\n"); + printf ("RESULT:"); + pscr (*rez); + } + else + { + fprintf (out, "\n<<<=EXITS FROM RULE #"); + y = p->cel; + assert_and_assign_real_pointer (y, &s.sa); + pratom (s.srd->name); + fprintf (out, ": "); + if (*success) + fprintf (out, "SUCCESS\n"); + else + fprintf (out, "UNSUCCESS\n"); + fprintf (out, "RESULT:"); + pout (*rez); + } + } + break; + + case variable: + case idvariable: + case nvariable: + case fvariable: + /* peremennaq w {ablone */ + if (pl->nel == 0) /* neuspeh */ + *success = false; + else + { + y = pl->cel; + if (y != null_) + { + assert_and_assign_real_pointer (y, &s2.sa); + *success = (((s.svd->dtype == variable)) || + ((s.svd->dtype == idvariable) && + (s2.sad->dtype == idatom)) || + ((s.svd->dtype == nvariable) && + (s2.sad->dtype == number))); + } + else + *success = ((s.svd->dtype != idvariable) + && (s.svd->dtype != nvariable)); + /* if y=null */ + } /* pl.nel<>0 */ + if (*success) - *rez = s.sspec->val; + { + v[mybase + s.svd->location - 1] = pl->cel; + *rez = pl->cel; + if (pl->ptrtype == ptrlist) + next (pl); + } else - *rez = null_; - } - if (*success && pl->ptrtype == ptrlist) - next(pl); - break; - /* spec */ - - case rulename: /* #imq w {ablone */ - if (debugrule) { - if (out_screen) { - printf("\n=>>>CALLS RULE #"); - y = p->cel; - pointr(y, &s.sa); - pratom(s.srd->name); - printf(" IN PATTERN"); - } else { - fprintf(out, "\n=>>>CALLS RULE #"); - y = p->cel; - pointr(y, &s.sa); - pratom(s.srd->name); - fprintf(out, " IN PATTERN"); - } - } - srchrule1(p->cel, &x); - rule(rez, success, pl, &x); - - if (debugrule) { - if (out_screen) { - printf("\n<<<=EXITS FROM RULE #"); - y = p->cel; - pointr(y, &s.sa); - pratom(s.srd->name); - printf(": "); - if (*success) - printf("SUCCESS\n"); - else - printf("UNSUCCESS\n"); - printf("RESULT:"); - pscr(*rez); - } else { - fprintf(out, "\n<<<=EXITS FROM RULE #"); - y = p->cel; - pointr(y, &s.sa); - pratom(s.srd->name); - fprintf(out, ": "); - if (*success) - fprintf(out, "SUCCESS\n"); - else - fprintf(out, "UNSUCCESS\n"); - fprintf(out, "RESULT:"); - pout(*rez); - } - } - break; - - case variable: - case idvariable: - case nvariable: - case fvariable: - /* peremennaq w {ablone */ - if (pl->nel == 0) /* neuspeh */ - *success = false; - else { - y = pl->cel; - if (y != null_) { - pointr(y, &s2.sa); - *success = ( - ( - (s.svd->dtype == variable ) )|| - ( - (s.svd->dtype == idvariable) && - (s2.sad->dtype == idatom ) )|| - ( - (s.svd->dtype == nvariable ) && - (s2.sad->dtype == number) ) - ); - } else - *success = ( (s.svd->dtype != idvariable) && (s.svd->dtype != nvariable) ); - /* if y=null */ - } /* pl.nel<>0 */ - - if (*success) { - v[mybase + s.svd->location - 1] = pl->cel; - *rez = pl->cel; - if (pl->ptrtype == ptrlist) - next(pl); - } else { + { + *rez = null_; + v[mybase + s.svd->location - 1] = null_; + } + /* changed 28-jan-90 to null for $e must success + and null for $i - unsuccess */ + break; + /* peremennaq w {abl. */ + + case listmain: + /* spisok rigal s-koda */ *rez = null_; - v[mybase + s.svd->location - 1] = null_; - } - /* changed 28-jan-90 to null for $e must success - and null for $i - unsuccess */ - break; - /* peremennaq w {abl. */ + *success = true; + y = s.smld->name; + + if (y == li) + list (rez, success, pl, p->cel); + else if (y == al) + alter (rez, success, pl, p->cel); + else if (y == se || y == ps) + starlist (rez, success, pl, p->cel, y == ps); + else if (y == fa) + facult (rez, success, pl, p->cel); + else if (y == tr || y == ti) + tree (rez, success, pl, p->cel, y == ti); + else if (y == spat || y == vpat) + spatt (rez, success, pl, p->cel, y); + /* {ablon spiska (. .) */ - case listmain: - /* spisok rigal s-koda */ - *rez = null_; - *success = true; - y = s.smld->name; - - if (y == li) - list(rez, success, pl, p->cel); - else if (y == al) - alter(rez, success, pl, p->cel); - else if (y == se || y == ps) - starlist(rez, success, pl, p->cel, y == ps); - else if (y == fa) - facult(rez, success, pl, p->cel); - else if (y == tr || y == ti) - tree(rez, success, pl, p->cel, y == ti); - else if (y == spat || y == vpat) - spatt(rez, success, pl, p->cel, y); - /* {ablon spiska (. .) */ - - break; - /* spisok rigal s-koda */ - }/* case */ - -_L1: /* wyhod */ - teklexem = pl->cel; /* added 30-aug-89 */ + break; + /* spisok rigal s-koda */ + } /* case */ + +_L1: /* wyhod */ + teklexem = pl->cel; /* added 30-aug-89 */ /* +:= */ /* ++:= */ @@ -1633,10 +1841,11 @@ _L1: /* wyhod */ } -Void rule(rez, success, pl, pp) -long *rez; -boolean *success; -ptr_ *pl, *pp; +void +rule (rez, success, pl, pp) + long *rez; + bool *success; + ptr_ *pl, *pp; { /* tek.leksema */ /* sna~ala ukaz.na sled.posle #l |l-t */ @@ -1648,7 +1857,7 @@ ptr_ *pl, *pp; /* */ /*========================================*/ a rez1, obasep; - boolean success1; + bool success1; ptr_ pl1; numberdescriptor oldbase; long oldmybase; @@ -1662,46 +1871,52 @@ ptr_ *pl, *pp; mybase = base - 1; /* zapomnitx, a pri wyhode iz rule wosstanowitx */ obasep = pp->cel; - points(obasep, &x.sa); + assert_and_assign_real_pointer (obasep, &x.sa); /* dostup k base w spiske prawil */ - oldbase = *x.snd; /* w stek */ + oldbase = *x.snd; /* w stek */ /* deleted sign 3-oct-89 */ x.snd->val = mybase; - next(pp); + next (pp); rez1 = pp->cel; - pointr(rez1, &x.sa); + assert_and_assign_real_pointer (rez1, &x.sa); /* dostup k ~islu lok.per. */ base += x.snd->val + 1; if (base > varnum) - err(1L); + err (1L); pl1 = *pl; - next(pp); /* ustanow.na perwu` wetwx prawila */ + next (pp); /* ustanow.na perwu` wetwx prawila */ rez1 = null_; success1 = true; branch = 0; /* osnownoj cikl */ - do { - branch++; - if (debugrule) { - if (out_screen) { - putchar('\n'); - if (branch > 1) - printf(">> (BRANCH NO %12ld)\n", branch); - printf(" 1-ST ARGUMENT($): "); - pscr(pl1.cel); - } else { - putc('\n', out); - if (branch > 1) - fprintf(out, ">> (BRANCH NO %12ld)\n", branch); - fprintf(out, " 1-ST ARGUMENT($): "); - pout(pl1.cel); - } + do + { + branch++; + if (debugrule) + { + if (out_screen) + { + putchar ('\n'); + if (branch > 1) + printf (">> (BRANCH NO %12ld)\n", branch); + printf (" 1-ST ARGUMENT($): "); + pscr (pl1.cel); + } + else + { + putc ('\n', out); + if (branch > 1) + fprintf (out, ">> (BRANCH NO %12ld)\n", branch); + fprintf (out, " 1-ST ARGUMENT($): "); + pout (pl1.cel); + } + } + simple (&rez1, &success1, &pl1, pp->cel); + next (pp); } - simple(&rez1, &success1, &pl1, pp->cel); - next(pp); - } while (!(success1 || pp->cel == 0) && (success1 || continue_)); + while (!(success1 || pp->cel == 0) && (success1 || continue_)); /* priznak konca prawila */ continue_ = true; @@ -1711,44 +1926,45 @@ ptr_ *pl, *pp; *pl = pl1; /* prodwinutx ukazatelx leksem */ /* wosstanowitx base */ - points(obasep, &x.sa); + assert_and_assign_real_pointer (obasep, &x.sa); *x.snd = oldbase; base = mybase + 1; mybase = oldmybase; -} /* rule */ +} /* rule */ -Void simple(rez, success, pl, p) -long *rez; -boolean *success; -ptr_ *pl; -long p; +void +simple (rez, success, pl, p) + long *rez; + bool *success; + ptr_ *pl; + long p; { /* tek.leksema */ - /* ukazatelx na spisok wetwi (prostogo prawila)*/ + /* ukazatelx na spisok wetwi (prostogo prawila) */ /*=============================*/ /* primenitx prostoe prawilo */ /* ( wetwx ) */ /* */ /*=============================*/ - ptr_ pp; /* |l-t spiska wetwi */ + ptr_ pp; /* |l-t spiska wetwi */ a rez1; - boolean success1; + bool success1; ptr_ pl1; - boolean ispattern; + bool ispattern; /* tek. |l-t spiska wetwi - {ablon, */ /* false -operator */ - /* many: boolean;*/ + /* many: bool; */ /* w wetwi neskolxko |l-w {ablonow */ /* many and statements with many deleted 29-jan-1992 due to - #l <. a : #n .> ## - #n pat pat ## - */ - a onfail; /* ukazatelx na deskr. onfail-spiska */ + #l <. a : #n .> ## + #n pat pat ## + */ + a onfail; /* ukazatelx na deskr. onfail-spiska */ long k, FORLIM; - a oldteklexem; /* added for using $$ in statements / 30-aug-1989 */ + a oldteklexem; /* added for using $$ in statements / 30-aug-1989 */ FORLIM = base; /* o~istka peremennyh */ @@ -1759,43 +1975,49 @@ long p; oldteklexem = teklexem; teklexem = pl->cel; /* ustanowitx pp na na~alo spiska wetwi */ - first(p, &pp); + first (p, &pp); onfail = pp.cel; pl1 = *pl; rez1 = null_; success1 = true; - /* many := false;*/ + /* many := false; */ fail = false; - next(&pp); + next (&pp); /* na~atx so 2-go |l-ta */ /* osnownoj cikl po spisku wetwi */ ispattern = true; continue_ = true; - while (success1 && continue_ && pp.nel != 0 && !fail) { - /* added 23.10.89 */ - if (pp.cel == opdelim) { - ispattern = !ispattern; - /* dlq / perekl`~itx revim */ - } else if (ispattern) - pattern(&rez1, &success1, &pl1, &pp); - else - statement(pp.cel, &success1, &rez1); - next(&pp); - } /* while */ + while (success1 && continue_ && pp.nel != 0 && !fail) + { + /* added 23.10.89 */ + if (pp.cel == opdelim) + { + ispattern = !ispattern; + /* dlq / perekl`~itx revim */ + } + else if (ispattern) + pattern (&rez1, &success1, &pl1, &pp); + else + statement (pp.cel, &success1, &rez1); + next (&pp); + } /* while */ fail = false; - if (success1) /* uspeh */ + if (success1) /* uspeh */ *pl = pl1; - else { /* neuspeh */ - if (onfail != 0) { /* wypolnitx on-fail operatory */ - first(onfail, &pp); - continue_ = true; - while (continue_ && pp.nel != 0) { - statement(pp.cel, &success1, &rez1); - next(&pp); - } /* while */ - } /* onfail */ - } + else + { /* neuspeh */ + if (onfail != 0) + { /* wypolnitx on-fail operatory */ + first (onfail, &pp); + continue_ = true; + while (continue_ && pp.nel != 0) + { + statement (pp.cel, &success1, &rez1); + next (&pp); + } /* while */ + } /* onfail */ + } *success = success1; if (continue_) *rez = null_; @@ -1805,28 +2027,29 @@ long p; teklexem = oldteklexem; /* begin - if not many or (pl1.ptrtype=ptrlist) then */ + if not many or (pl1.ptrtype=ptrlist) then */ /* prodwivenie pl i slu~aj pl1.nel=0 */ /* rassm. w {ablonah */ /* else - begin*/ + begin */ /* popytka primenitx posledowatelxnostx */ /* {ablonow k lekseme, */ /* kotoraq ne whodit w spisok */ /* success1 := false; - rez1 := null - end; - many := true - end */ + rez1 := null + end; + many := true + end */ /* ispattern */ -} /* simple */ +} /* simple */ -Void spatt(rez, success, pl, p, y) -long *rez; -boolean *success; -ptr_ *pl; -long p, y; +void +spatt (rez, success, pl, p, y) + long *rez; + bool *success; + ptr_ *pl; + long p, y; { /* spat or vpat */ /*===================*/ @@ -1840,27 +2063,31 @@ long p, y; /* tek.leksemu w globalxn.per. $$ */ teklexem = pl->cel; /* wojti w spisok (. #wyravenie .) */ - first(p, &c); - expression(&c, &r); /* wy~.wyravenie */ - if (r == null_) { - *rez = null_; - *success = false; - } else { - *rez = pl->cel; - *success = true; - if (pl->ptrtype == ptrlist && y == spat) - next(pl); - } + first (p, &c); + expression (&c, &r); /* wy~.wyravenie */ + if (r == null_) + { + *rez = null_; + *success = false; + } + else + { + *rez = pl->cel; + *success = true; + if (pl->ptrtype == ptrlist && y == spat) + next (pl); + } teklexem = oldteklexem; -} /* spatt */ +} /* spatt */ -Void starlist(rez, success, pl, p, pluslist) -long *rez; -boolean *success; -ptr_ *pl; -long p; -boolean pluslist; +void +starlist (rez, success, pl, p, pluslist) + long *rez; + bool *success; + ptr_ *pl; + long p; + bool pluslist; { /* ukaz.tek.leksemu */ /* s-adres |l-ta {ablona */ @@ -1871,26 +2098,27 @@ boolean pluslist; /*=======================*/ /* wyhod */ - ptr_ razd; /* razdelitelx */ + ptr_ razd; /* razdelitelx */ a rez1, n; - ptr_ pp; /* perwyj |l-t {ablona */ - ptr_ pp2; /* tek.|l-t {ablona */ - ptr_ pl2; /* tek.leksema */ - ptr_ pl3; /* na~alo iteracii leksem */ - boolean sraz; /* uspeh razdelitelq */ - boolean ispattern, wasoneiteration; + ptr_ pp; /* perwyj |l-t {ablona */ + ptr_ pp2; /* tek.|l-t {ablona */ + ptr_ pl2; /* tek.leksema */ + ptr_ pl3; /* na~alo iteracii leksem */ + bool sraz; /* uspeh razdelitelq */ + bool ispattern, wasoneiteration; rez1 = null_; - if (pl->ptrtype == ptrtree) { - /* leksema ne w spiske */ - *success = false; - goto _L1; - } + if (pl->ptrtype == ptrtree) + { + /* leksema ne w spiske */ + *success = false; + goto _L1; + } /* wojti w spisok {ablonow */ - first(p, &pp); - razd = pp; /* zapomnitx razdelitelx */ - next(&pp); /* pp na 1-j |l-t {ablona */ + first (p, &pp); + razd = pp; /* zapomnitx razdelitelx */ + next (&pp); /* pp na 1-j |l-t {ablona */ ispattern = true; wasoneiteration = false; *success = true; @@ -1900,78 +2128,89 @@ boolean pluslist; break_ = false; /* osnownoj cikl */ - while (pl2.nel != 0 && sraz) { - pp2 = pp; + while (pl2.nel != 0 && sraz) + { + pp2 = pp; /*===========================*/ - /* wypolnitx posled.{ablonow */ + /* wypolnitx posled.{ablonow */ /*===========================*/ - while (*success && continue_ && pp2.nel != 0) { - if (pp2.cel == opdelim) - ispattern = !ispattern; - else { /* a */ - if (ispattern) - pattern(&rez1, success, &pl2, &pp2); - else - statement(pp2.cel, success, &rez1); - if (!continue_) { - if (*success) /* return -operator */ - *pl = pl2; - /* dlq fail-operatora pl sohranqetsq */ - goto _L1; - } - if (break_) { - *pl = pl2; - goto _L1; + while (*success && continue_ && pp2.nel != 0) + { + if (pp2.cel == opdelim) + ispattern = !ispattern; + else + { /* a */ + if (ispattern) + pattern (&rez1, success, &pl2, &pp2); + else + statement (pp2.cel, success, &rez1); + if (!continue_) + { + if (*success) /* return -operator */ + *pl = pl2; + /* dlq fail-operatora pl sohranqetsq */ + goto _L1; + } + if (break_) + { + *pl = pl2; + goto _L1; + } + if (!*success) + { + /* esli neuspeh {ablona */ + *pl = pl3; + goto _L1; + } + } /* a */ + next (&pp2); /* sled.|l-t {ablona */ + } /* while */ + /* sdelana odna iteraciq posled.{ablonow */ + wasoneiteration = true; + pl3 = pl2; + /* na na~alo nowoj iterat.gruppy */ + /* teperx primenitx razdelitelx */ + if (razd.cel == 5120) + continue; + if ((razd.cel & 511) != 0 || razd.cel >= 65536L || razd.cel < 0) + { + pattern (&rez1, &sraz, &pl2, &razd); + if (!sraz) + { + *pl = pl3; + goto _L1; + } + continue; } - if (!*success) { - /* esli neuspeh {ablona */ + /* wstroennoe prawilo */ + n = razd.cel / 512 - 10; + /* nomer wstr.pr. */ + bltin (&rez1, &sraz, &pl2, n); + if (!sraz) + { *pl = pl3; goto _L1; } - } /* a */ - next(&pp2); /* sled.|l-t {ablona */ - } /* while */ - /* sdelana odna iteraciq posled.{ablonow */ - wasoneiteration = true; - pl3 = pl2; - /* na na~alo nowoj iterat.gruppy */ - /* teperx primenitx razdelitelx */ - if (razd.cel == 5120) - continue; - if ((razd.cel & 511) != 0 || razd.cel >= 65536L || razd.cel < 0) { - pattern(&rez1, &sraz, &pl2, &razd); - if (!sraz) { - *pl = pl3; - goto _L1; - } - continue; - } - /* wstroennoe prawilo */ - n = razd.cel / 512 - 10; - /* nomer wstr.pr.*/ - bltin(&rez1, &sraz, &pl2, n); - if (!sraz) { - *pl = pl3; - goto _L1; - } - } /* while */ + } /* while */ *pl = pl2; _L1: break_ = false; - if (continue_) { - if (pluslist) - *success = wasoneiteration && (!fail);/* correction as 5-JUN-93 */ - else - *success = !fail; - } + if (continue_) + { + if (pluslist) + *success = wasoneiteration && (!fail); /* correction as 5-JUN-93 */ + else + *success = !fail; + } *rez = rez1; } -Void statement(p, succ, rez) -long p; -boolean *succ; -long *rez; +void +statement (p, succ, rez) + long p; + bool *succ; + long *rez; { /* ukazatelx na spisok operatora */ @@ -1980,63 +2219,78 @@ long *rez; /* wyhod */ mpd x; - ptr_ c; /* tek.|l-t spiska operatora */ - a ot; /* tip operatora (specadres) */ + ptr_ c; /* tek.|l-t spiska operatora */ + a ot; /* tip operatora (specadres) */ - if (p == cfail) { /* fail -operator */ - *succ = false; - fail = true; - *rez = null_; - goto _L1; - } + if (p == cfail) + { /* fail -operator */ + *succ = false; + fail = true; + *rez = null_; + goto _L1; + } - if (p == 16384) { /* break -operator */ - break_ = true; - goto _L1; - } - if ((p & 511) != 0 || p >= 65536L || p < 0) { - pointr(p, &x.sa); - /* polu~itx deskr.spiska operatora */ - ot = x.smld->name; - if (ot == creturn) { /* return-operator */ - first(p, &c); /* c na na~alo wyraveniq */ - expression(&c, rez); - continue_ = false; - } else if ((ot & 511) == 0 && ot >= cass1 && ot <= cass5 && ot < 65536L && - ot >= 0) { - /* assignment */ - assgn(ot, p); - } else if (ot == 9728 || ot == 10240 || ot == 10752 || ot == 11264 || - ot == 18432 || ot == 31744 || ot == 32256) { - /* load , save , open , << , close , print */ - inout(p, ot); - } else if (ot == 8704) - cond(p, succ, rez); - else if (ot == 12800) { - /* forall -operator */ - loop(p, succ, rez); - } else if (ot == 28160) { - break_ = false; - while (continue_ && *succ && !break_) { - first(p, &c); - /* wojti w spisok operatorow - */ - while (c.nel != 0 && continue_ && *succ && !fail && !break_) - { /* added 23.10.89 */ - statement(c.cel, succ, rez); - next(&c); + if (p == 16384) + { /* break -operator */ + break_ = true; + goto _L1; + } + if ((p & 511) != 0 || p >= 65536L || p < 0) + { + assert_and_assign_real_pointer (p, &x.sa); + /* polu~itx deskr.spiska operatora */ + ot = x.smld->name; + if (ot == creturn) + { /* return-operator */ + first (p, &c); /* c na na~alo wyraveniq */ + expression (&c, rez); + continue_ = false; + } + else if ((ot & 511) == 0 && ot >= cass1 && ot <= cass5 && ot < 65536L && + ot >= 0) + { + /* assignment */ + assgn (ot, p); + } + else if (ot == 9728 || ot == 10240 || ot == 10752 || ot == 11264 || + ot == 18432 || ot == 31744 || ot == 32256) + { + /* load , save , open , << , close , print */ + inout (p, ot); + } + else if (ot == 8704) + cond (p, succ, rez); + else if (ot == 12800) + { + /* forall -operator */ + loop (p, succ, rez); + } + else if (ot == 28160) + { + break_ = false; + while (continue_ && *succ && !break_) + { + first (p, &c); + /* wojti w spisok operatorow + */ + while (c.nel != 0 && continue_ && *succ && !fail && !break_) + { /* added 23.10.89 */ + statement (c.cel, succ, rez); + next (&c); + } + + } + /* while */ + break_ = false; + } + else if (ot == 17920 || ot == 27136) + { + first (p, &c); + expression (&c, rez); } - - } - /* while */ - break_ = false; - } else if (ot == 17920 || ot == 27136) { - first(p, &c); - expression(&c, rez); } - } -_L1: ; +_L1:; /* if -operator */ /* loop -operator */ @@ -2044,15 +2298,18 @@ _L1: ; } -/* Local variables for tree: */ -struct LOC_tree { +/* static variables for tree: */ +struct LOC_tree +{ a msel[5]; /* spisok ispolxz.selektorow w <* *> */ - long nsel; /* ~islo |l-tow msel */ -} ; + long nsel; /* ~islo |l-tow msel */ +}; -Local long atomsel(s ) -long s; +static long +atomsel (s, LINK) + long s; + struct LOC_tree *LINK; { /* sozdaet iz selektora s atom i */ /* wozwr. ego deskriptor */ @@ -2061,40 +2318,43 @@ long s; atomdescriptor *WITH; - gets1(&ats, &x.sa); + gets1 (&ats, &x.sa); WITH = x.sad; WITH->dtype = idatom; WITH->name = s; return ats; -} /* atomsel */ +} /* atomsel */ -Local boolean notintom(s, LINK) -long s; -struct LOC_tree *LINK; +static bool +notintom (s, LINK) + long s; + struct LOC_tree *LINK; { /* true , esli s ne sod. w msel */ long k; - boolean found; + bool found; long FORLIM; found = false; FORLIM = LINK->nsel; - for (k = 0; k < FORLIM; k++) { - if (LINK->msel[k] == s) - found = true; - } + for (k = 0; k < FORLIM; k++) + { + if (LINK->msel[k] == s) + found = true; + } return (!found); -} /* notintom */ +} /* notintom */ -Void tree(parmrez, parmsuccess, parmpl, p, star) -long *parmrez; -boolean *parmsuccess; -ptr_ *parmpl; -long p; -boolean star; +void +tree (parmrez, parmsuccess, parmpl, p, star) + long *parmrez; + bool *parmsuccess; + ptr_ *parmpl; + long p; + bool star; { /* ukazatelx na deskriptor derewa leksem */ /* |l-t {ablona */ @@ -2105,19 +2365,19 @@ boolean star; struct LOC_tree V; /* wyhod */ - ptr_ pp; /* tek.|l-t {ablona */ - a sel; /* atom-selektor iz {ablona */ + ptr_ pp; /* tek.|l-t {ablona */ + a sel; /* atom-selektor iz {ablona */ mpd x; - boolean facel; + bool facel; /* true-tek.|l-t {ablona imeet [ ] - */ - ptr_ pt; /* tek.|l-t derewa leksem */ - ptr_ ptold; /* |l-t derewa leksem, s kotorogo */ + */ + ptr_ pt; /* tek.|l-t derewa leksem */ + ptr_ ptold; /* |l-t derewa leksem, s kotorogo */ /* na~at poisk */ a rez1, rez; - boolean success1, found, ispattern; - long nvar; /* nomer per.w steke */ - boolean success; + bool success1, found, ispattern; + long nvar; /* nomer per.w steke */ + bool success; ptr_ pl; @@ -2127,38 +2387,45 @@ boolean star; rez1 = null_; /* proweritx, ~to pl ukazyw.na glawnyj deskriptor */ /* derewa, ina~e fail */ - if (pl.nel == 0) { - success = false; - goto _L99; - } - if (pl.cel != null_) { - rez1 = pl.cel; - pointr(rez1, &x.sa); - if (x.smtd->dtype != treemain) { - /* leksema ne derewo */ + if (pl.nel == 0) + { success = false; - rez1 = null_; goto _L99; } - first(pl.cel, &ptold); - } else { - ptold.nel = 0; - ptold.cel = null_; - ptold.UU.U1.curfragment = null_; - } + if (pl.cel != null_) + { + rez1 = pl.cel; + assert_and_assign_real_pointer (rez1, &x.sa); + if (x.smtd->dtype != treemain) + { + /* leksema ne derewo */ + success = false; + rez1 = null_; + goto _L99; + } + first (pl.cel, &ptold); + } + else + { + ptold.nel = 0; + ptold.cel = null_; + ptold.UU.U1.curfragment = null_; + } /* wojti w spisok {ablonow */ - first(p, &pp); + first (p, &pp); /* proweritx sowpadenie imeni derewa i */ /* imeni w {ablone (esli estx ) */ - if ((pp.cel & 511) != 0 || pp.cel >= 65536L || pp.cel < 0) { - /* w {ablone estx atom ili perem.dlq imeni */ - if (!compnames(pp.cel, pl.cel)) { - success = false; - goto _L99; + if ((pp.cel & 511) != 0 || pp.cel >= 65536L || pp.cel < 0) + { + /* w {ablone estx atom ili perem.dlq imeni */ + if (!compnames (pp.cel, pl.cel)) + { + success = false; + goto _L99; + } } - } - next(&pp); + next (&pp); /* ustanowitx pp na perwyj wyp.|l-t {ablona */ break_ = false; @@ -2167,120 +2434,140 @@ boolean star; /*==========================================*/ success1 = true; V.nsel = 0; - while (pp.nel != 0 && success1 && continue_ && pp.cel != 30208 && !break_) { - facel = (pp.cel == 31232); /* wetwx s [ ] ? */ - next(&pp); - /* pro~itatx atom-selektor */ - sel = pp.cel; - pointr(sel, &x.sa); - sel = x.sad->name; - if (star) { - /* zanesti w massiw msel */ - V.nsel++; - V.msel[V.nsel - 1] = sel; - } + while (pp.nel != 0 && success1 && continue_ && pp.cel != 30208 && !break_) + { + facel = (pp.cel == 31232); /* wetwx s [ ] ? */ + next (&pp); + /* pro~itatx atom-selektor */ + sel = pp.cel; + assert_and_assign_real_pointer (sel, &x.sa); + sel = x.sad->name; + if (star) + { + /* zanesti w massiw msel */ + V.nsel++; + V.msel[V.nsel - 1] = sel; + } /*=====================================*/ - /* poisk w derewe leksem selektora sel */ + /* poisk w derewe leksem selektora sel */ /*=====================================*/ - pt = ptold; - found = false; - do { - if (pt.nel != 0 && pt.UU.U1.arc == sel) - found = true; - else { - next(&pt); - if (pt.nel == 0) - first(pl.cel, &pt); - } - } while (!(found || (pt.nel == ptold.nel && + pt = ptold; + found = false; + do + { + if (pt.nel != 0 && pt.UU.U1.arc == sel) + found = true; + else + { + next (&pt); + if (pt.nel == 0) + first (pl.cel, &pt); + } + } + while (!(found || (pt.nel == ptold.nel && pt.UU.U1.curfragment == ptold.UU.U1.curfragment))); - if (!found) { - if (!facel) { /* ne najden sel */ - success = false; - goto _L99; - } - /* propustitx wetwx w {ablone */ - do { - next(&pp); - } while (pp.nel != 0 && pp.cel != 4096); - } else { + if (!found) + { + if (!facel) + { /* ne najden sel */ + success = false; + goto _L99; + } + /* propustitx wetwx w {ablone */ + do + { + next (&pp); + } + while (pp.nel != 0 && pp.cel != 4096); + } + else + { /*=============================*/ - /* wypolnitx dejstwiq i {ablon */ + /* wypolnitx dejstwiq i {ablon */ /*=============================*/ - next(&pp); - ispattern = true; - while (success1 && continue_ && pp.nel != 0 && pp.cel != 4096 && !break_) { - if (pp.cel == opdelim) - ispattern = !ispattern; - else { /* 30-aug-89 */ - teklexem = pt.cel; - if (ispattern) - pattern(&rez1, &success1, &pt, &pp); - else - statement(pp.cel, &success1, &rez1); - } - next(&pp); - } /* while */ - ptold = pt; - } /* dejstwiq i {ablon */ - next(&pp); - } /* osnownoj cikl */ + next (&pp); + ispattern = true; + while (success1 && continue_ && pp.nel != 0 && pp.cel != 4096 + && !break_) + { + if (pp.cel == opdelim) + ispattern = !ispattern; + else + { /* 30-aug-89 */ + teklexem = pt.cel; + if (ispattern) + pattern (&rez1, &success1, &pt, &pp); + else + statement (pp.cel, &success1, &rez1); + } + next (&pp); + } /* while */ + ptold = pt; + } /* dejstwiq i {ablon */ + next (&pp); + } /* osnownoj cikl */ /*=========================================*/ /* dlq <* *> otrabotatx wetwx $e : sss */ /*=========================================*/ - if (star && !break_ && continue_ && success1) { + if (star && !break_ && continue_ && success1) + { /*===============================================*/ - /* cikl po derewu leksem, primenitx sss ko wsem */ - /* selektoram, krome teh , ~to nah.w msel */ + /* cikl po derewu leksem, primenitx sss ko wsem */ + /* selektoram, krome teh , ~to nah.w msel */ /*===============================================*/ - next(&pp); /* pp na varname */ - rez1 = pp.cel; - pointr(rez1, &x.sa); - nvar = x.svd->location + mybase; - next(&pp); - ptold = pp; - /* na na~alo dejstwij i {ablona dlq - var */ - success1 = true; - first(pl.cel, &pt); - /* na na~alo derewa leksem */ - while (pt.nel != 0 && success1 && continue_ && !break_) { + next (&pp); /* pp na varname */ + rez1 = pp.cel; + assert_and_assign_real_pointer (rez1, &x.sa); + nvar = x.svd->location + mybase; + next (&pp); + ptold = pp; + /* na na~alo dejstwij i {ablona dlq + var */ + success1 = true; + first (pl.cel, &pt); + /* na na~alo derewa leksem */ + while (pt.nel != 0 && success1 && continue_ && !break_) + { /*=========================*/ - /* cikl po derewu leksem */ + /* cikl po derewu leksem */ /*=========================*/ - if (notintom(pt.UU.U1.arc, &V)) { - /* selektor wne msel */ - v[nvar - 1] = atomsel(pt.UU.U1.arc ); /* sozdatx atom */ + if (notintom (pt.UU.U1.arc, &V)) + { + /* selektor wne msel */ + v[nvar - 1] = atomsel (pt.UU.U1.arc, &V); /* sozdatx atom */ /*==============================*/ - /* wypolnitx dejstwiq i {ablon */ + /* wypolnitx dejstwiq i {ablon */ /*==============================*/ - pp = ptold; - ispattern = true; - while (success1 && continue_ && pp.nel != 0 && !break_) { - if (pp.cel == opdelim) - ispattern = !ispattern; - else { /*30-aug-89*/ - teklexem = pt.cel; - if (ispattern) - pattern(&rez1, &success1, &pt, &pp); - else - statement(pp.cel, &success1, &rez1); - } - next(&pp); - } /* while */ - } /* notintom */ - next(&pt); - } /* while, cikl po derewu */ - } /* star */ - - if (success1) { - if (continue_) - rez1 = pl.cel; - if (pl.ptrtype == ptrlist) - next(&pl); - } + pp = ptold; + ispattern = true; + while (success1 && continue_ && pp.nel != 0 && !break_) + { + if (pp.cel == opdelim) + ispattern = !ispattern; + else + { /*30-aug-89 */ + teklexem = pt.cel; + if (ispattern) + pattern (&rez1, &success1, &pt, &pp); + else + statement (pp.cel, &success1, &rez1); + } + next (&pp); + } /* while */ + } /* notintom */ + next (&pt); + } /* while, cikl po derewu */ + } /* star */ + + if (success1) + { + if (continue_) + rez1 = pl.cel; + if (pl.ptrtype == ptrlist) + next (&pl); + } success = success1; _L99: rez = rez1; @@ -2294,4 +2581,3 @@ _L99: /* End. */ - diff --git a/RIGAL/rigsc.446/src/def_tst.c b/RIGAL/rigsc.446/src/def_tst.c index bcc8f99ed3e07cc1e087d7682d0cd3cf0c5de31c..88aa277bab80ca29c190cf1100b0a3cc5f2f4e03 100644 --- a/RIGAL/rigsc.446/src/def_tst.c +++ b/RIGAL/rigsc.446/src/def_tst.c @@ -27,7 +27,7 @@ /* descriptor sizes ******************************** */ -#define listnodenumb 5 /* number of nodes for list descriptor */ +#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 @@ -37,7 +37,7 @@ /*= (listnodenumb - 1) * 2 number of list elements in auxilary list descriptors */ -#define treenodenumb 5 /* number of nodes for tree descriptor */ +#define treenodenumb 5 /* number of nodes for tree descriptor */ #define maintreearcnum 3 /* (treenodenumb - 2) number of list elements in the @@ -47,9 +47,9 @@ #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 */ +#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 @@ -66,25 +66,25 @@ /* 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 */ +#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 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 */ +#define seldelim 30720 /* razd.selektora i obxekta */ /* statements and operators */ @@ -95,7 +95,7 @@ #define cass3 7168 #define cass4 7680 #define cass5 8192 -#define cnull 29184 /* $e:= null w {ablone */ +#define cnull 29184 /* $e:= null w {ablone */ #define clast 17408 #define crule 17920 #define cselect 18432 @@ -135,7 +135,7 @@ typedef long longint; typedef short word; /* must be 2 byte positive integer */ -typedef Char string80[81]; +typedef char string80[81]; typedef short byte_type; @@ -146,12 +146,12 @@ typedef long a; typedef long aa; /* adresses of a-space */ -typedef Char c2[2]; /* =2. bytes */ -typedef Char c4[4]; +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*/ +typedef char bl80[80]; +typedef char a80[80]; +typedef char real_char[sizeof (double)]; /*added 17-feb-92 */ #define dummy 0 #define listmain 1 @@ -226,7 +226,7 @@ typedef Char real_char[sizeof(double)]; /*added 17-feb-92*/ mainlistdescriptor= record (* =40. bytes *) dtype : descriptortype; (* =1. bytes *) flags : 0 ..31; (* =1. bytes *) - xx : array [ 1 .. 1 ] of boolean;(* =1. bytes *) + xx : array [ 1 .. 1 ] of bool;(* =1. bytes *) elnum : 0 ..mainlistelnum; (* =1. bytes *) totalelnum : longint; (* =4. bytes *) name : aa; (* =4. bytes *) @@ -234,120 +234,132 @@ mainlistdescriptor= record (* =40. bytes *) next : a; end; (* =4. bytes *) */ -typedef struct mainlistdescriptor { +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 */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + bool 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 */ +} mainlistdescriptor; /* =4. bytes */ -typedef struct fragmlistdescriptor { +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 */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + char elnum; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ + a elt[fragmlistelnum]; /* =8*4=32. bytes */ a next; -} fragmlistdescriptor; /* =4. bytes */ +} fragmlistdescriptor; /* =4. bytes */ -typedef struct te { - aa arcname; /* =8=4+4. bytes */ +typedef struct te +{ + aa arcname; /* =8=4+4. bytes */ a elt; } te; -typedef struct maintreedescriptor { +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 */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + char arcnum; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ + longint totalarcnum; /* =4. bytes */ + aa name; /* =4. bytes */ + te arc[maintreearcnum]; /* =8*3=24. bytes */ a next; -} maintreedescriptor; /* =4. bytes */ +} maintreedescriptor; /* =4. bytes */ -typedef struct fragmtreedescriptor { +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 */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + char arcnum; /* =1. bytes */ + bool xx[1]; /* =1. bytes */ + te arc[fragmtreearcnum]; /* =8*4=32. bytes */ a next; -} fragmtreedescriptor; /* =4. bytes */ +} fragmtreedescriptor; /* =4. bytes */ -typedef struct atomdescriptor { +typedef struct atomdescriptor +{ /* =8. bytes */ - char dtype; /* =1. bytes */ - char flags; /* =1. bytes */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ word cord; /* unsigned */ /* =2. bytes */ - aa name; /* =4. bytes */ + aa name; /* =4. bytes */ } atomdescriptor; -typedef struct numberdescriptor { +typedef struct numberdescriptor +{ /* =8. bytes */ - char dtype; /* =1. bytes */ - char flags; /* =1. bytes */ - word cord; /* =2. bytes */ - longint val; /* signed */ -} numberdescriptor; /* =4. bytes */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + word cord; /* =2. bytes */ + longint val; /* signed */ +} numberdescriptor; /* =4. bytes */ -typedef struct vardescriptor { +typedef struct vardescriptor +{ /* =8. bytes */ - char dtype; /* =1. bytes */ - char flags; /* =1. bytes */ - boolean guard; /* =1. bytes */ - char location; /* =1. bytes */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + bool guard; /* =1. bytes */ + char location; /* =1. bytes */ aa name; -} vardescriptor; /* =4. bytes */ +} vardescriptor; /* =4. bytes */ -typedef struct ruledescriptor { +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 */ + 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 { +typedef struct specdescriptor +{ /* =8. bytes */ - char dtype; /* =1. bytes */ - char flags; /* =1. bytes */ - boolean xx[2]; /* =2. bytes */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + bool xx[2]; /* =2. bytes */ longint val; -} specdescriptor; /* =4. bytes */ +} specdescriptor; /* =4. bytes */ -typedef struct objdescriptor { +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 */ + char dtype; /* =1. bytes */ + char flags; /* =1. bytes */ + bool 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 { +typedef union mpd +{ /* multiply pointers to descriptors */ a sa; mainlistdescriptor *smld; @@ -361,9 +373,9 @@ typedef union mpd { atomdescriptor *sc8; specdescriptor *sspec; objdescriptor *sobj; - Char *sbl80; + char *sbl80; long *sa10; -} mpd; /* =4. bytes */ +} mpd; /* =4. bytes */ #define ptrlist 0 #define ptrtree 1 @@ -371,29 +383,32 @@ typedef union mpd { /*------------------------------------------------*/ -typedef struct ptr_ { +typedef struct ptr_ +{ /* refers to the current element of agregate */ - unsigned ptrtype : 2; + unsigned ptrtype:2; /* p2c: def_tst.z, line 309: Note: * Field width for PTRTYPE assumes enum ptrtype_enum has 3 elements [105] */ /* type of agregate */ - unsigned nel : 4; + unsigned nel:4; /* number of element in current fragment of agregate, or in array */ /* =0 if no more elements */ - unsigned plistsize : 3; + unsigned plistsize:3; /* current size of array; - used for rule call optimization - with <= 4 arguments. - used only if ptrtype=packedlist , - undefined otherwise */ + 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 cel; /* refers to the current element */ + union + { + struct + { + a arc; /* arc selector a-address */ - a curfragment; /* current fragment descriptor */ + a curfragment; /* current fragment descriptor */ /* main fragment */ a mainadr; @@ -406,29 +421,31 @@ typedef struct ptr_ { /*======================================*/ /* this is used for access to os file names */ -typedef Char filename_type[81]; +typedef char filename_type[81]; -typedef Char checker_message_type[81]; +typedef char checker_message_type[81]; -typedef Char filespecification[81]; +typedef char filespecification[81]; /* this is used for checker and editor common variables */ -typedef struct error_rec_type { +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 */ +typedef struct _REC_filetab +{ + a name; /* a-address of rigal file */ + bool isopen; /* */ + bool screen; + long strlen; /* specified max length */ + long curlen; /* current length */ } _REC_filetab; @@ -445,7 +462,8 @@ FILE *files[filenum]; mpd x; -Static Void cln() +static void +cln () { long i; @@ -454,66 +472,74 @@ Static Void cln() } -Static Void wrx(i) -long i; +static void +wrx (i) + long i; { if (i < 10) - putchar((Char)(i + '0')); + putchar ((char) (i + '0')); else - putchar((Char)(i + 87)); + putchar ((char) (i + 87)); } -Static long consum() +static long +consum () { long rez, i; rez = 0; - for (i = 1; i <= 80; i++) { - rez += x.sbl80[i - 1] * i % 1001; + for (i = 1; i <= 80; i++) + { + rez += x.sbl80[i - 1] * i % 1001; /* p2c: def_tst.z, line 378: * Note: Using % for possibly-negative arguments [317] */ - } + } return rez; } -Static long consum2() +static long +consum2 () { long rez, i; rez = 0; - for (i = 1; i <= 10; i++) { - rez += x.sa10[i - 1] % 1001 * i % 1001; + for (i = 1; i <= 10; i++) + { + rez += x.sa10[i - 1] % 1001 * i % 1001; /* p2c: def_tst.z, line 387: * Note: Using % for possibly-negative arguments [317] */ /* p2c: def_tst.z, line 387: * Note: Using % for possibly-negative arguments [317] */ - } + } return rez; } -Static Void pr() +static void +pr () { long i, j; - printf("%12ld/%12ld\n", consum(), consum2()); - - for (j = 0; j <= 1; j++) { - for (i = j * 20; i <= j * 20 + 19; i++) { - wrx(x.sbl80[i] / 16L); - wrx(x.sbl80[i] & 15L); - putchar(' '); + printf ("%12ld/%12ld\n", consum (), consum2 ()); + + for (j = 0; j <= 1; j++) + { + for (i = j * 20; i <= j * 20 + 19; i++) + { + wrx (x.sbl80[i] / 16L); + wrx (x.sbl80[i] & 15L); + putchar (' '); + } + putchar ('\n'); } - putchar('\n'); - } } -main(argc, argv) -int argc; -Char *argv[]; +main (argc, argv) + int argc; + char *argv[]; { long i; mainlistdescriptor *WITH; @@ -528,11 +554,11 @@ Char *argv[]; objdescriptor *WITH9; /* p2c: def_tst.z: Note: Array of files files should be initialized [257] */ - PASCAL_MAIN(argc, argv); - printf(" STARTUP \n"); - x.sbl80 = (Char *)Malloc(sizeof(bl80)); - printf("smld%12ld\n", sizeof(mainlistdescriptor)); - cln(); + PASCAL_MAIN (argc, argv); + printf (" STARTUP \n"); + x.sbl80 = (char *) //Calloc (sizeof (bl80)); + printf ("smld%12ld\n", sizeof (mainlistdescriptor)); + cln (); WITH = x.smld; WITH->dtype = listmain; WITH->flags = 3; @@ -543,10 +569,10 @@ Char *argv[]; WITH->elt[i - 1] = i + 6; WITH->lastfragm = 12; WITH->next = 13; - pr(); + pr (); - printf("sfld%12ld\n", sizeof(fragmlistdescriptor)); - cln(); + printf ("sfld%12ld\n", sizeof (fragmlistdescriptor)); + cln (); WITH1 = x.sfld; WITH1->dtype = listfragm; WITH1->flags = 3; @@ -555,10 +581,10 @@ Char *argv[]; for (i = 1; i <= 8; i++) WITH1->elt[i - 1] = i + 6; WITH1->next = 15; - pr(); + pr (); - printf("smtd%12ld\n", sizeof(maintreedescriptor)); - cln(); + printf ("smtd%12ld\n", sizeof (maintreedescriptor)); + cln (); WITH2 = x.smtd; WITH2->dtype = treemain; WITH2->flags = 3; @@ -572,10 +598,10 @@ Char *argv[]; for (i = 1; i <= 3; i++) WITH2->arc[i - 1].elt = i + 12; WITH2->next = 23; - pr(); + pr (); - printf("sftd%12ld\n", sizeof(fragmtreedescriptor)); - cln(); + printf ("sftd%12ld\n", sizeof (fragmtreedescriptor)); + cln (); WITH3 = x.sftd; WITH3->dtype = treefragm; WITH3->flags = 3; @@ -587,38 +613,38 @@ Char *argv[]; for (i = 1; i <= 4; i++) WITH3->arc[i - 1].elt = i + 12; WITH3->next = 23; - pr(); + pr (); - printf("sad%12ld\n", sizeof(atomdescriptor)); - cln(); + printf ("sad%12ld\n", sizeof (atomdescriptor)); + cln (); WITH4 = x.sad; WITH4->dtype = idatom; WITH4->flags = 3; WITH4->cord = 50004L; WITH4->name = 90005L; - pr(); + pr (); - printf("snd%12ld\n", sizeof(numberdescriptor)); - cln(); + printf ("snd%12ld\n", sizeof (numberdescriptor)); + cln (); WITH5 = x.snd; WITH5->dtype = idatom; WITH5->flags = 3; WITH5->cord = 50004L; WITH5->val = 10090005L; - pr(); + pr (); - printf("svd%12ld\n", sizeof(vardescriptor)); - cln(); + printf ("svd%12ld\n", sizeof (vardescriptor)); + cln (); WITH6 = x.svd; WITH6->dtype = nvariable; WITH6->flags = 3; WITH6->guard = true; WITH6->location = 77; WITH6->name = 90005L; - pr(); + pr (); - printf("srd%12ld\n", sizeof(ruledescriptor)); - cln(); + printf ("srd%12ld\n", sizeof (ruledescriptor)); + cln (); WITH7 = x.srd; WITH7->dtype = rulename; WITH7->flags = 3; @@ -626,20 +652,20 @@ Char *argv[]; WITH7->name = 90005L; WITH7->fragmadr = 55; WITH7->nomintab = 66; - pr(); + pr (); - printf("sspec%12ld\n", sizeof(specdescriptor)); - cln(); + printf ("sspec%12ld\n", sizeof (specdescriptor)); + cln (); WITH8 = x.sspec; WITH8->dtype = idatom; WITH8->flags = 3; WITH8->xx[0] = true; WITH8->xx[1] = true; WITH8->val = 900009L; - pr(); + pr (); - printf("sobj%12ld\n", sizeof(objdescriptor)); - cln(); + printf ("sobj%12ld\n", sizeof (objdescriptor)); + cln (); WITH9 = x.sobj; WITH9->dtype = idatom; WITH9->flags = 3; @@ -648,12 +674,11 @@ Char *argv[]; WITH9->fragmorvar = 10; WITH9->glavn = 11; WITH9->rezerv = 12; - pr(); - exit(EXIT_SUCCESS); + pr (); + exit (EXIT_SUCCESS); } /* End. */ - diff --git a/RIGAL/rigsc.446/src/defsun3.c b/RIGAL/rigsc.446/src/defsun3.c index 3c44af568b47613f3f6c1f9810fc70a97b6d41a0..745af5874f376d3dc6328ae0c7c4bd2fa99ba665 100644 --- a/RIGAL/rigsc.446/src/defsun3.c +++ b/RIGAL/rigsc.446/src/defsun3.c @@ -1,291 +1,111 @@ -/* Version 5-07-93 */ +// Version 5-07-93 #include "globrig.h" #include "define.h" #include "defpage.h" -#include "unistd.h" -#include <stdint.h> - -#define EXNUMB( n ) ((uint32_t) (n) ) -#define SET_S_ADDRESS_EXNUMB( n ) ((uint32_t) (n) ) - -#define OFFSET( n ) ((uint16_t) ( (uint32_t) (n) >> (16) ) ) -#define PAGE( n ) ((uint16_t) ( (uint32_t) (n) & ( ( uint16_t) 0xffff ) ) ) -#define PAZIME( n ) ((uint8_t ) ( (uint32_t) (n) & ( ( uint8_t) 0xff ) ) ) -#define BYTEPAGE( n ) ((uint8_t ) ( ( (uint32_t) (n) >> (8) ) & ( ( uint8_t) 0xff ) ) ) -#define SET_S_ADDRESS( offset, page ) (uint32_t ) ( ( ((uint16_t)offset)<<(16)) | ((uint16_t) page) ) - - -#ifdef MIPSEL -/* For DEC variant, ULTRIX computers, - Little endian variant of MIPS architecture: - changed ... */ -#define dos 1 -#endif - -#ifdef i386 -/* INTEL architecture: - changed ... */ -#define dos 1 -#endif - -#ifdef LE -/* All other little-endian architectures */ -#define dos 1 -#endif - - /* #define dos 1 */ - /* defines order of bytes */ - /* set to yes if lower byte is first in the word; - * set to no if lower byte is last in the word */ - -/* memory manager error messages */ -#define m_cur_rewrite "1001 - Current disk rewrite error" -#define m_vir_rewrite "1002 - Virtual disk rewrite error" -#define m_cur_read "1003 - Current disk read error" -#define m_vir_read "1004 - Virtual disk read error" -#define m_cur_write "1005 - Current disk write error" -#define m_vir_write "1006 - Virtual disk write error" -#define m_over "1007 - Structured object memory overflow" -#define m_aover "1008 - Atomic memory overflow" -#define m_load "1009 - Disk error during LOAD" -#define m_reset "1010 - Disk reset error during LOAD" -#define m_save "1011 - Disk error during SAVE" -#define m_rewrite "1012 - Disk rewrite error during SAVE" -#define m_uns "1013 - Unsufficient core memory" -#define m_wrong "1014 - Internal error - wrong Spointer" - - -static Void mess(char *messstr) +#include "defsun3.h" + +static void mess (char * ); +static void nextsp (sa_pointer * , uint16_t ); +static void pagecheck (struct LOC_putatm * ); +static void move_ (struct LOC_saves * ); +static void move__ (struct LOC_savesn * ); +static void move___ (struct LOC_reopen * ); +static void writeblock (struct LOC_saves * ); +static void writeblock_ (struct LOC_savesn * ); + +static void mess (char *messstr) { - printf("\n--------------------------\n"); - printf("Paging manager : %s\n", messstr); - printf("------ PRESS ENTER ------ \n"); - scanf("%*[^\n]"); - getchar(); + printf ("\n--------------------------\n"); + printf ("Paging manager : %s\n", messstr); + printf ("------ PRESS ENTER ------ \n"); + scanf ("%*[^\n]"); + getchar (); - exit(0); + exit (0); } - -#define lblksize 128 -#define cblksize 512 -#define asize 32767 /* increased size of a_page, not limited */ -/*2048;*/ -#define ssize 16384 /* must be 2^^shiftpage */ -/*11;*/ -#define shiftpage 14 - -#define andoffs (ssize - 1) - -#define msize 12 -#define fssize (ssize + lblksize) -#define spazime 255 /* tiek lietots izteiksme chr(...). */ -#define apazime 254 /* ja ir problemas,var lietot 127 126 */ -#define one 256 -#define setflag 1 -#define clearflag 126 - -#define minpage 0 - -#define maxpage 32767 /* maxpage */ - /* set to maximum value = 32767 */ - /* Size of S-Space is maxpage*ssize*4 bytes =32 K * 16K * 4=2048 MB */ - - -typedef unsigned char pagenumber; - - -typedef Char x512[512]; - -typedef struct a_block { - word infgar; - Char inform[asize]; -} a_block; - - -typedef a_block a_buf[32]; - - -typedef struct s_buf { - a inform[fssize]; - struct s_buf *nextbuf; /* not used */ - pagenumber pagenr; /* not used */ - boolean modif; /* not used here */ - word infgar; /* not used */ -} s_buf; - - -typedef union sa_pointer -{ - a pointa; -} sa_pointer; - -/* type descriptortype = - (dummy , listmain , listfragm , treemain , treefragm , - atomm , idatom , keyword , number , tatom , - fatom , variable , idvariable , nvariable , fvariable , - rulename, objekts , coord , spec ); *********/ - - -typedef union object_type { - struct { - char dtype; - char flags; - } U1; - sa_pointer pointarray[10]; - longint longintarray[10]; -} object_type; - - -typedef union absadr { - a adrese; - object_type *objpoint; - longint *lintpoint; -} absadr; - - -typedef struct bl80rec { - bl80 c; -} bl80rec; - -typedef union charmas { - Char *cptr1; - bl80rec *cptrec80; - Char *cptr80; -} charmas; - - -typedef struct _REC_dinformtype { - word length, apointbit, spointbit; -} _REC_dinformtype; - -typedef _REC_dinformtype dinformtype[27]; - - -/*========================================*/ -word rezwrite; +//======================================== +uint16_t rezwrite; dinformtype dinform; -Void init_dinform() +void init_dinform () { char dt; _REC_dinformtype *WITH; -#ifdef bad_sets - long SET[4]; - long SET1[4]; - long SET2[4]; - long SET3[5], SET4[5]; - long SET5[5], SET6[5]; - long SET7[9]; - - P_addsetr(P_expset(digit, 0L), '0', '9'); - P_addset(P_expset( SET5, 0L), '~'); - P_addset( SET5, '|'); - P_addset( SET5, '`'); - P_addset( SET5, '{'); - P_setunion(letter, P_setunion( SET6, - P_setunion( SET4, P_setunion( SET2, P_addset(P_expset(SET, 0L), '_'), - P_addsetr(P_expset( SET1, 0L), 'A', 'Z')), - P_addsetr(P_expset( SET3, 0L), 'a', 'z')), - P_addset( SET5, '}')), P_addsetr(P_expset( SET7, 0L), 128, 255)); -/* p2c: defsun3.z, line 805: Note: - * Line breaker spent 0.7+0.19 seconds, 5000 tries on line 1049 [251] */ - /* all these additional characters are added only for compatibility - with old version with russian letters */ - P_setunion(symbols, letter, digit); -#endif - - - for (dt = dummy; (long)dt <= (long)spec; dt = (char)((long)dt + 1)) { - WITH = &dinform[(long)dt]; - WITH->length = 2; - WITH->apointbit = 0; - WITH->spointbit = 0; - } - dinform[(long)dummy].length = 1; - dinform[(long)rulename].length = 4; - dinform[(long)object_d].length = 4; - for (dt = listmain; (long)dt <= (long)treefragm; dt = (char)((long)dt + 1)) - dinform[(long)dt].length = 10; - dinform[(long)listmain].spointbit = 0x3fc; - dinform[(long)listfragm].spointbit = 0x3fe; - dinform[(long)treemain].spointbit = 0x354; - dinform[(long)treefragm].spointbit = 0x354; - dinform[(long)treemain].apointbit = 0xa8; - dinform[(long)treefragm].apointbit = 0xaa; - for (dt = atom; (long)dt <= (long)rulename; dt = (char)((long)dt + 1)) - dinform[(long)dt].apointbit = 2; - dinform[(long)number].apointbit = 0; + for (dt = dummy; (long) dt <= (long) spec; dt = (char) ((long) dt + 1)) + { + WITH = &dinform[(long) dt]; + WITH->length = 2; + WITH->apointbit = 0; + WITH->spointbit = 0; + } + dinform[(long) dummy].length = 1; + dinform[(long) rulename].length = 4; + dinform[(long) object_d].length = 4; + for (dt = listmain; (long) dt <= (long) treefragm; + dt = (char) ((long) dt + 1)) + dinform[(long) dt].length = 10; + dinform[(long) listmain].spointbit = 0x3fc; + dinform[(long) listfragm].spointbit = 0x3fe; + dinform[(long) treemain].spointbit = 0x354; + dinform[(long) treefragm].spointbit = 0x354; + dinform[(long) treemain].apointbit = 0xa8; + dinform[(long) treefragm].apointbit = 0xaa; + for (dt = atom; (long) dt <= (long) rulename; dt = (char) ((long) dt + 1)) + dinform[(long) dt].apointbit = 2; + dinform[(long) number].apointbit = 0; } - - - -boolean sopen_space, dopen; +bool sopen_space, dopen; long dpagenum; a_block *a_bufp; s_buf *prevbuf, *holdbuf; s_buf *addrmas[maxpage - minpage + 1]; sa_pointer ffby; - - -/************************* statistika ******************/ +//************************ statistika ***************** longint adiscread, adiscwrite, adiscpage, sdiscread, sdiscwrite, sdiscpage; -/*******************************************************/ -static void nextsp(sa_pointer *sptr,word length) -{ - uint16_t offset; - uint16_t page; - - offset = OFFSET( sptr->pointa ); - page = PAGE ( sptr->pointa ); - - offset += length; - if (offset < fssize - msize ) - { - sptr->pointa = SET_S_ADDRESS( offset, page ); - return; - } - - if ( page == maxpage ) mess(m_over); - page++; - - sptr->pointa = SET_S_ADDRESS( 0, page ); - - return; +//***************************************************** +static void nextsp (sa_pointer * sptr, uint16_t length) +{ + newstru *WITH; // pazofpa -> newstru, 5-jul-93 + WITH = &sptr->newstruct; +//printf(" Nextsp: page= %d offs=%d \n",WITH->page,WITH->offset); + WITH->offset += length; + if (WITH->offset < fssize - msize) return; + if (WITH->page == maxpage) mess (m_over); + WITH->page++; + WITH->offset = 0; } -/*******************************************************/ -/**** pointx ieksejam vajadzibam - loti lidzigs vecajam pointr(s) ****/ -static long pointx(long e1) +//***************************************************** +//*** pointx // returns a pointer to content in an s_buf->inform[offset] +static uint32_t *pointx (uint32_t e1) { + sa_pointer mm; - uint16_t page = ( PAGE ( e1 ) ); - uint16_t offset = ( OFFSET ( e1 ) ); - prevbuf = addrmas[ page - minpage]; + mm.pointa = e1; + prevbuf = addrmas[mm.newstruct.page - minpage]; + if (prevbuf != NULL) return ( &(prevbuf->inform[mm.newstruct.offset]) ); - if (prevbuf != NULL) return ((long)(&prevbuf->inform[ offset ])); + prevbuf = (s_buf *) Calloc (sizeof (s_buf)); + //printf(" Next buffer page is from %p \n",prevbuf); - prevbuf = (s_buf *)Malloc(sizeof(s_buf)); - /*printf(" Next buffer page is from %p \n",prevbuf);*/ + if (prevbuf == NULL) mess (m_uns); - if (prevbuf == NULL) mess(m_uns); - - - addrmas[ page - minpage] = prevbuf; - return ((long)(&prevbuf->inform[ offset ])); + addrmas[mm.newstruct.page - minpage] = prevbuf; + return ( &(prevbuf->inform[mm.newstruct.offset]) ); } -/******************************************** opena *****/ -void opena() +//******************************************* opena **** +void opena () { long i; a_block *WITH; @@ -293,261 +113,263 @@ void opena() adiscread = 0; adiscwrite = 0; adiscpage = 0; - a_bufp = (a_block *)Malloc(sizeof(a_buf)); - if (a_bufp == NULL) - mess(m_uns); - for (i = 0; i <= 31; i++) { - WITH = &a_bufp[i]; - WITH->infgar = 0; - } -} /* end of opena */ - + a_bufp = (a_block *) Calloc (sizeof (a_buf)); + if (a_bufp == NULL) mess (m_uns); + for (i = 0; i <= 31; i++) + { + WITH = &a_bufp[i]; + WITH->infgar = 0; + } +} // end of opena -/* Local variables for putatm: */ -struct LOC_putatm { - long na; - charmas cptr; - sa_pointer atbilde; - long intpage; -} ; -static void pagecheck(struct LOC_putatm *LINK) +static void pagecheck (struct LOC_putatm *LINK) { - long j, k, l, garums; + uint32_t j, k, l, garums; a_block *WITH; bl80rec *WITH1; - long FORLIM; - /*if intpage>7 then write('[A=',intpage,']');*/ - if (LINK->intpage > 31) - mess(m_aover); - WITH = &a_bufp[LINK->intpage]; /*with*/ + if (LINK->intpage > 31) mess (m_aover); + WITH = &a_bufp[LINK->intpage]; WITH1 = LINK->cptr.cptrec80; j = 1; - while (j < WITH->infgar) { - garums = WITH->inform[j - 1]; /* atoma garums < 128 */ - if (garums == LINK->na) { - l = j + 1; - for (k = 0; k < garums; k++) { - if (WITH1->c[k] != WITH->inform[l - 1]) - goto _Lstep; - l++; + while (j < WITH->infgar) + { + garums = WITH->inform[j - 1]; // atoma garums < 128 + if (garums == LINK->na) + { + l = j + 1; + for (k = 0; k < garums; k++) + { + if (WITH1->c[k] != WITH->inform[l - 1]) break; + l++; + } + if ( k == garums ) + { + LINK->atbilde.struct_.pazime = (char) apazime; + LINK->atbilde.struct_.offset = j; + LINK->atbilde.struct_.page = (char) LINK->intpage; + return; + } + else + { + j += garums + 1; + continue; + } } - goto _Lfind; - } -_Lstep: - j += garums + 1; - } /*while*/ - k = asize - WITH->infgar; + else j += garums + 1; - if (LINK->na >= k) - goto _L99; - WITH->inform[j - 1] = (Char)LINK->na; - l = j; - FORLIM = LINK->na; - for (k = 0; k < FORLIM; k++) { - l++; - WITH->inform[l - 1] = WITH1->c[k]; } - WITH->infgar = l; -_Lfind: - LINK->atbilde.pointa = SET_S_ADDRESS( (j) , - ( ( (uint8_t) LINK->intpage<<8) | - ( (uint8_t) apazime ) - ) - ); - + // the character sequence in c[k] is new (not found in existing data). + // as long as there is room for it, concat it into memory. + k = asize - WITH->infgar; + + if (LINK->na >= k) return; + WITH->inform[j - 1] = (char) LINK->na; + memset ( &(WITH->inform[ j ]), 0 , LINK->na ); + memmove( &(WITH->inform[ j ]), &(WITH1->c[0]), LINK->na ); + WITH->infgar = j + LINK->na; + LINK->atbilde.struct_.pazime = (char) apazime; + LINK->atbilde.struct_.offset = j; + LINK->atbilde.struct_.page = (char) LINK->intpage; -_L99: ; -} /* end of pagecheck */ +} // end of pagecheck -/*********************************** putatm(ad,na,e) *****/ -void putatm(char *ad, long na_,long *e) +//********************************** putatm(ad,na,e) **** +void putatm (char *ad, uint32_t na_, uint32_t *e) { struct LOC_putatm V; + uint32_t i; bl80rec *WITH; - /*** start of putatm (ad , na , e) ***/ + //** start of putatm (ad , na , e) ** - V.na = na_; - V.atbilde.pointa = 0; - V.cptr.cptr1 = ad; - WITH = V.cptr.cptrec80; - if (V.na < 5) - { - V.atbilde.pointa = 0; - memmove( &V.atbilde.pointa, &(WITH->c[0]),V.na); - } else { - V.intpage = WITH->c[0] & 7; - - if (V.na > 9) - V.intpage += 8; - pagecheck(&V); - V.intpage = 15; - while (V.atbilde.pointa == 0) { - V.intpage++; - pagecheck(&V); + V.na = na_; + V.atbilde.pointa = 0; + V.cptr.cptr1 = ad; + WITH = V.cptr.cptrec80; + if (V.na < 5) + { + for (i = 0; i < V.na; i++) V.atbilde.immed[i] = WITH->c[i]; } - } - *e = V.atbilde.pointa; - + else + { + V.intpage = WITH->c[0] & 7; -} /* end of putatm */ + if (V.na > 9) V.intpage += 8; + pagecheck (&V); + V.intpage = 15; + while (V.atbilde.pointa == 0) + { + V.intpage++; + pagecheck (&V); + } + } + *e = V.atbilde.pointa; +// +//fprintf(stderr," offset = %08x\n",V.atbilde.struct_.offset); +//fprintf(stderr," page = %08x\n",V.atbilde.struct_.page ); + +} // end of putatm -/************************************* pointa(e,ad,na) *****/ -void pointa(long e,char *ad,long *na) +//************************************get_data_from_pointa(e,ad,na) **** +void get_data_from_pointa (uint32_t e, char *ad, uint32_t *na) { - int i, j; - int FORLIM; - - a_block *WITH; - - uint8_t page = 0; - uint8_t pazime = 0; - uint16_t offset = 0; + uint32_t i, j; sa_pointer atbilde; - atbilde.pointa = e; - - page = BYTEPAGE ( atbilde.pointa ); - pazime = PAZIME ( atbilde.pointa ); - offset = OFFSET ( atbilde.pointa ); + uint32_t FORLIM; + a_block *WITH; - if ( pazime != ((uint8_t ) apazime)) + atbilde.pointa = e; + if (atbilde.struct_.pazime != (char) apazime) { - *na = 0; - for (i = 0; i <= 3; i++) - { - char temp[4]; - memmove(temp,&(atbilde.pointa),4); - if (temp[i] == '\0') goto _Lalles; - ad[i] = temp[i]; - (*na)++; - } - } - else + *na = 0; + memset (ad,0,4); + for (i = 0; i <= 3; i++) + { + if (atbilde.immed[i] == '\0') goto _Lalles; + ad[i] = atbilde.immed[i]; + (*na)++; + } + } + else { - WITH = &a_bufp[(int) page ]; - *na = WITH->inform[ offset - 1]; - j = offset + 1; - FORLIM = *na; - for (i = 0; i < FORLIM; i++) - { - ad[i] = WITH->inform[j - 1]; - j++; - } + WITH = &a_bufp[(int) atbilde.struct_.page]; + *na = WITH->inform[atbilde.struct_.offset - 1]; + j = atbilde.struct_.offset + 1; + FORLIM = *na; + memset (ad,0,(*na)+1); + memmove(ad,&(WITH->inform[j-1]), *na); } -_Lalles: ; -} /* end of pointa */ - - -/******************************************* closea *****/ -Void closea() -{ -} /* end of savea */ - - -Void savea() -{ - closea(); -} - +_Lalles:; +} // end ofget_data_from_pointa -/******************************************** closes *****/ -Void closes() -{ -} -/******************************************** vola *****/ -void vola(long *dr,long *dw,long *dp) +//******************************************* vola **** +void vola (long *dr, long *dw, long *dp) { *dr = adiscread; *dw = adiscwrite; *dp = adiscpage; -} /* end of vola */ +} // end of vola -/** * * * * * * s - m a n a g e r * * * * * * * * * * **/ -/******************************************** opens *****/ -void opens() +//* * * * * * * s - m a n a g e r * * * * * * * * * * * +//******************************************* opens **** +void opens () { s_buf *ptr; long k; - ptr = (s_buf *)Malloc(sizeof(s_buf)); - /*printf(" First page pointer is %p \n",ptr);*/ - if (ptr == NULL) - mess(m_uns); + ptr = (s_buf *) Calloc (sizeof (s_buf)); + //printf(" First page pointer is %p \n",ptr); + if (ptr == NULL) mess (m_uns); addrmas[0] = ptr; - for (k = minpage + 1; k <= maxpage; k++) - addrmas[k - minpage] = NULL; + for (k = minpage + 1; k <= maxpage; k++) addrmas[k - minpage] = NULL; - ffby.pointa = SET_S_ADDRESS( 0, minpage); + ffby.newstruct.offset = 0; + ffby.newstruct.page = minpage; + prevbuf = ptr; + holdbuf = NULL; + sopen_space = false; + dopen = false; + sdiscread = 0; + sdiscwrite = 0; + sdiscpage = 0; - prevbuf = ptr; - holdbuf = NULL; - sopen_space = false; - dopen = false; - sdiscread = 0; - sdiscwrite = 0; - sdiscpage = 0; - /*???? sun "new" allocatio error handle ??*/ -} /* end of opens */ +} // end of opens -/****************************************** pointr (e1,e2) *****/ -void pointr(long e1,long *e2) +//***************************************** assert_and_assign_real_pointer (e1,e2) **** +void assert_and_assign_real_pointer ( void *e1, void **e2 ) { + assert(e1); + sa_pointer sap; + + uint32_t my_uint = 0; + my_uint = 128; + + char known_stack[my_uint]; + char known_callc[my_uint]; + char value2check[my_uint]; + void *callc = NULL; + callc = sbrk(0); + + memset( known_stack,' ',my_uint); + memset( known_callc,' ',my_uint); + memset( value2check,' ',my_uint); + known_stack[my_uint]=0; + known_callc[my_uint]=0; + value2check[my_uint]=0; + + snprintf(known_stack,my_uint,"%p",&my_uint); + snprintf(known_callc,my_uint,"%p", callc ); + snprintf(value2check,my_uint,"%p", e1 ); + + unsigned int i; + for(i=2;i<my_uint;i++) + { + if ( known_stack[i] != value2check[i] ) break; + } + if ( i > 3 ) //matches at least one byte on the high end + { // possible stack value; + mess(m_STACK_ptr); + } - if ( (OFFSET( e1 ) ) == 0) mess(m_wrong); - - *e2 = e1; -} + + for(i=2;i<my_uint;i++) + { + if ( known_callc[i] != value2check[i] ) break; + } + if ( i > 3 ) //matches at least one byte on the high end + { // possible calloc value; + sap = *(sa_pointer *) (&e1); + if (sap.wstruct.segmentpart == 0) mess (m_wrong); + *e2 = e1; + } + else { mess( m_invalid_ptr ) ; } -/****************************************** points (e1,e2) *****/ -void points(long e1,long *e2) -{ - if ( (OFFSET( e1 )) == 0) mess(m_wrong); - *e2 = e1; } -/***************************************** gets1 (e1,e2) *****/ -void gets1(long *e1,long *e2) + +//**************************************** gets1 (e1,e2) **** +void gets1 (uint32_t **e1, uint32_t **e2) { absadr absa; object_type *WITH; - - *e1 = pointx(ffby.pointa); - nextsp(&ffby, 2); + //printf (" gests1 PAGE=%d bits=%p \n",ffby.newstruct.page,ffby.pointa); + *e1 = pointx (ffby.pointa); + nextsp (&ffby, 2); *e2 = *e1; - absa = *(absadr *)e2; + absa = *(absadr *) e2; WITH = absa.objpoint; WITH->longintarray[0] = 0; WITH->longintarray[1] = 0; -/*printf(" gets1 %p \n",*e1);*/ + //printf(" gets1 %p \n",*e1); } -/***************************************** gets2 (e1,e2) *****/ -void gets2(long *e1,long *e2) +//**************************************** gets2 (e1,e2) **** +void gets2 (uint32_t **e1, uint32_t **e2) { absadr absa; object_type *WITH; - *e1 = pointx(ffby.pointa); - nextsp(&ffby, 4); + *e1 = pointx (ffby.pointa); + nextsp (&ffby, 4); *e2 = *e1; - absa = *(absadr *)e2; + absa = *(absadr *) e2; WITH = absa.objpoint; WITH->longintarray[0] = 0; WITH->longintarray[1] = 0; @@ -556,243 +378,233 @@ void gets2(long *e1,long *e2) } -/***************************************** gets5 (e1,e2) *****/ -void gets5(long *e1,long *e2) +//**************************************** gets5 (e1,e2) **** +void gets5 (uint32_t **e1, uint32_t **e2) { long i; absadr absa; object_type *WITH; - *e1 = pointx(ffby.pointa); - nextsp(&ffby, 10); + *e1 = pointx (ffby.pointa); + nextsp (&ffby, 10); *e2 = *e1; - absa = *(absadr *)e2; + absa = *(absadr *) e2; WITH = absa.objpoint; for (i = 0; i <= 9; i++) WITH->longintarray[i] = 0; } -/*************************************** loads (f,e) *****/ -void loads(char *f, long *e) +//************************************** loads (f,e) **** +void loads (char *f, uint32_t **e) { FILE *infile; sa_pointer bulta1, bulta2, rab1; absadr p1, p2, p3; long m, kp, la; - union { + union + { longint long_[256]; - Char chr[1024]; - struct { + char chr[1024]; + struct + { x512 b1, b2; } U3; } buffer; long i, j, k, garums, biti; longint rab2; - Char STR1[34]; + char STR1[34]; _REC_dinformtype *WITH; object_type *WITH1; sa_pointer *WITH2; - /**** seit sakas loads ( f , e ) ****/ + //*** seit sakas loads ( f , e ) *** infile = NULL; - if ( ( OFFSET( ffby.pointa )) >= ssize) - { - ffby.pointa = SET_S_ADDRESS( 0, ((PAGE(ffby.pointa))+1) ); - } + if (ffby.newstruct.offset >= ssize) + { + ffby.newstruct.page++; + ffby.newstruct.offset = 0; + } - infile = fopen(f,"rb"); + infile = fopen (f, "rb"); if (infile == NULL) - _EscIO(FileNotFound); + _EscIO (FileNotFound); - /**** ievadam s-kodu un korigejam s-pointerus ****/ - if (feof(infile)) { - sprintf(STR1, "%s(2)", m_load); - mess(STR1); - } - fread(buffer.U3.b1, sizeof(x512), 1, infile); - /******** read 1 **************/ - if (feof(infile)) { - sprintf(STR1, "%s(1)", m_load); - mess(STR1); - } - fread(buffer.U3.b2, sizeof(x512), 1, infile); - /******** read 1 **************/ + //*** ievadam s-kodu un korigejam s-pointerus *** + if (feof (infile)) + { + sprintf (STR1, "%s(2)", m_load); + mess (STR1); + } + fread (buffer.U3.b1, sizeof (x512), 1, infile); + //******* read 1 ************* + if (feof (infile)) + { + sprintf (STR1, "%s(1)", m_load); + mess (STR1); + } + fread (buffer.U3.b2, sizeof (x512), 1, infile); + //******* read 1 ************* bulta2.pointa = ffby.pointa; - p2.adrese = pointx(bulta2.pointa); - holdbuf = prevbuf; /*izmantos holdbuf*/ - *e = p2.adrese; /** result of load **/ + p2.adrese = pointx (bulta2.pointa); + holdbuf = prevbuf; //izmantos holdbuf + *e = p2.adrese; //* result of load * kp = buffer.long_[0]; i = 2; - for (m = 1; m <= kp; m++) { /* for each object in infile do */ - p1.lintpoint = &buffer.long_[i - 1]; - WITH = &dinform[(long)p1.objpoint->U1.dtype]; - garums = WITH->length; - biti = WITH->spointbit; - for (k = 1; k <= garums; k++) { /* for each longword in object */ - rab1.pointa = buffer.long_[i - 1]; - uint8_t pazime = PAZIME( rab1.pointa ); - if ( - ( ( biti & 1 ) == 1 ) && - ( ( pazime ) == ( (uint8_t) spazime ) ) - ) - { /* transform offset to s-addr */// - - rab2 = (rab1.pointa / 256) + OFFSET( ffby.pointa ) ; - uint16_t offset = rab2 & andoffs; - uint16_t page = (rab2 / ssize) + PAGE( ffby.pointa ) ; - rab1.pointa = SET_S_ADDRESS( offset, page ); - rab1.pointa = pointx(rab1.pointa);// rab1.pointa is now a real pointer. - } - - - holdbuf->inform[ (OFFSET( bulta2.pointa ))] = rab1.pointa; - bulta2.pointa = SET_S_ADDRESS( - (OFFSET(bulta2.pointa)+1), - PAGE(bulta2.pointa) - ); - - i++; - biti /= 2; - - } - if (i > lblksize) - { /* if end of input block */ - i -= lblksize; - for (k = i - 1; k < lblksize; k++) - buffer.long_[k] = buffer.long_[k + lblksize]; - if (feof(infile)) { - sprintf(STR1, "%s(3)", m_load); - mess(STR1); - } - fread(buffer.U3.b2, sizeof(x512), 1, infile); - /******** read 1 **************/ - } - if ( OFFSET(bulta2.pointa) >= ssize) { /* if end of s-page */ - uint16_t offset = (OFFSET(bulta2.pointa)) - ssize; - uint16_t page = (PAGE (bulta2.pointa)) + 1; - bulta2.pointa = SET_S_ADDRESS( offset, page ); - p2.adrese = pointx(bulta2.pointa); - holdbuf = prevbuf; /* izmantos holdbuf */ - for (k = 0; k <= (OFFSET(bulta2.pointa)); k++) holdbuf->inform[k] = 0; - } + for (m = 1; m <= kp; m++) + { // for each object in infile do + p1.lintpoint = &buffer.long_[i - 1]; + WITH = &dinform[(long) p1.objpoint->U1.dtype]; + garums = WITH->length; + biti = WITH->spointbit; + for (k = 1; k <= garums; k++) + { // for each longword in object + rab1.pointa = buffer.long_[i - 1]; + //fprintf(stderr,"start\trab1.pointa = %08x\n", rab1.pointa); + if ((biti & 1) == 1 && rab1.struct_.pazime == (char) spazime) + { // transform offset to s-addr + rab2 = rab1.pointa / 256 + ffby.newstruct.offset; + rab1.newstruct.offset = rab2 & andoffs; + rab1.newstruct.page = rab2 / ssize + ffby.newstruct.page; + + rab1.ptr_to_information = pointx (rab1.pointa); + //fprintf(stderr,"condition\trab1.pointa = %08x\n", rab1.pointa); + //sleep(20); + } + //fprintf(stderr,"final\trab1.pointa = %08x\n", rab1.pointa); + holdbuf->inform[bulta2.newstruct.offset] = rab1.ptr_to_information; + bulta2.newstruct.offset++; + //sleep(1); + i++; + biti /= 2; + + } + if (i > lblksize) + { // if end of input block + i -= lblksize; + for (k = i - 1; k < lblksize; k++) + buffer.long_[k] = buffer.long_[k + lblksize]; + if (feof (infile)) + { + sprintf (STR1, "%s(3)", m_load); + mess (STR1); + } + fread (buffer.U3.b2, sizeof (x512), 1, infile); + //******* read 1 ************* + } + if (bulta2.newstruct.offset >= ssize) + { // if end of s-page + bulta2.newstruct.offset -= ssize; + bulta2.newstruct.page++; + p2.adrese = pointx (bulta2.pointa); + holdbuf = prevbuf; // izmantos holdbuf + for (k = 0; k <= bulta2.newstruct.offset; k++) holdbuf->inform[k] = 0; + } } - /*** s-kods ir ievadits , tagad ievadisim a-kodu ***/ - /*** bulta2 rada uz vina beigam tas ir jaunais ffby ***/ + //** s-kods ir ievadits , tagad ievadisim a-kodu ** + //** bulta2 rada uz vina beigam tas ir jaunais ffby ** bulta1.pointa = bulta2.pointa; la = buffer.long_[lblksize]; i = cblksize + 5; - for (m = 1; m <= la; m++) { /* for each atom in file */ - j = 17; - if (i <= cblksize * 2) { - garums = buffer.chr[i - 1]; /* >>>>>>>>> chr(?) >>> */ - j = i + garums - cblksize * 2; - } - if (j > 0) { - i -= cblksize; - for (j = i - 1; j < cblksize; j++) - buffer.chr[j] = buffer.chr[j + cblksize]; - if (feof(infile)) { - sprintf(STR1, "%s(4)", m_load); - mess(STR1); - } - fread(buffer.U3.b2, sizeof(x512), 1, infile); - /******** read 1 **************/ - } - garums = buffer.chr[i - 1]; /* >>>>>>>>>>> chr (?) >> */ - i++; - putatm(&buffer.chr[i - 1], garums, &holdbuf->inform[(OFFSET(bulta1.pointa))]); - i += garums; - - bulta1.pointa = SET_S_ADDRESS( (OFFSET(bulta1.pointa))+1, PAGE(bulta1.pointa)); - - if ( (OFFSET(bulta1.pointa) ) >= fssize) { - uint16_t offset = 0; - uint16_t page = ( PAGE( bulta1.pointa) ) + 1; - bulta1.pointa = SET_S_ADDRESS( offset, page ); - p1.adrese = pointx(bulta1.pointa); - holdbuf = prevbuf; /*izmantos holdbuf*/ + for (m = 1; m <= la; m++) + { // for each atom in file + j = 17; + if (i <= cblksize * 2) + { + garums = buffer.chr[i - 1]; // >>>>>>>>> chr(?) >>> + j = i + garums - cblksize * 2; + } + if (j > 0) + { + i -= cblksize; + for (j = i - 1; j < cblksize; j++) + buffer.chr[j] = buffer.chr[j + cblksize]; + if (feof (infile)) + { + sprintf (STR1, "%s(4)", m_load); + mess (STR1); + } + fread (buffer.U3.b2, sizeof (x512), 1, infile); + //******* read 1 ************* + } + garums = buffer.chr[i - 1]; // >>>>>>>>>>> chr (?) >> + i++; + putatm (&buffer.chr[i - 1], garums, + &holdbuf->inform[bulta1.newstruct.offset]); + i += garums; + bulta1.newstruct.offset++; + if (bulta1.newstruct.offset >= fssize) + { + bulta1.newstruct.offset = 0; + bulta1.newstruct.page++; + p1.adrese = pointx (bulta1.pointa); + holdbuf = prevbuf; //izmantos holdbuf + } } - } if (infile != NULL) - fclose(infile); + fclose (infile); infile = NULL; - /*** a-kods ir ievadits , tagad korigejam a-pointerus ***/ - while (ffby.pointa != bulta2.pointa) { - p1.adrese = pointx(ffby.pointa); /* for each loaded object */ - WITH1 = p1.objpoint; /* nextsp (ffby , garums); */ - WITH = &dinform[(long)WITH1->U1.dtype]; - biti = WITH->apointbit; - garums = WITH->length; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH1->pointarray[i - 1]; - uint8_t pazime = PAZIME( WITH2->pointa ); - if ( pazime == (uint8_t) apazime ) { - bulta1.pointa = bulta2.pointa; - k = (OFFSET(bulta1.pointa) ) + ( (EXNUMB(WITH2->pointa)) / 256); - - uint16_t page = PAGE ( bulta1.pointa); - uint16_t offset = OFFSET( bulta1.pointa); - while (k >= fssize) - { - k -= fssize; - page++; - } - offset = k; - bulta1.pointa = SET_S_ADDRESS( offset, page ); - p3.adrese = pointx(bulta1.pointa); - WITH2->pointa = SET_S_ADDRESS_EXNUMB( *p3.lintpoint ); - } - } - - - i++; - biti /= 2; - - } - uint16_t ffby_offset = OFFSET( ffby.pointa ); - uint16_t ffby_page = PAGE ( ffby.pointa ); - ffby_offset += garums; - if (ffby_offset >= ssize) { - ffby_page++; - ffby_offset -= ssize; + //** a-kods ir ievadits , tagad korigejam a-pointerus ** + while (ffby.pointa != bulta2.pointa) + { + p1.adrese = pointx (ffby.pointa); // for each loaded object + WITH1 = p1.objpoint; // nextsp (ffby , garums); + WITH = &dinform[(long) WITH1->U1.dtype]; + biti = WITH->apointbit; + garums = WITH->length; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH1->pointarray[i - 1]; + if (WITH2->struct_.pazime == (char) apazime) + { + bulta1.pointa = bulta2.pointa; + k = bulta1.newstruct.offset + WITH2->exnumb / 256; + + + while (k >= fssize) + { + k -= fssize; + bulta1.newstruct.page++; + } + bulta1.newstruct.offset = k; + p3.adrese = pointx (bulta1.pointa); + WITH2->exnumb = *p3.lintpoint; + } + } + + + i++; + biti /= 2; + + } + + ffby.newstruct.offset += garums; + if (ffby.newstruct.offset >= ssize) + { + ffby.newstruct.page++; + ffby.newstruct.offset -= ssize; + } } - ffby.pointa = SET_S_ADDRESS( ffby_offset, ffby_page ); - } if (infile != NULL) - fclose(infile); -} /* end of loads */ + fclose (infile); +} // end of loads -/* Local variables for saves: */ -struct LOC_saves { - FILE *outfile; - longint kp; - sa_pointer bulta2; - absadr p2, p3; - union { - longint long_[256]; - Char chr[1024]; - struct { - x512 b1, b2; - } U3; - } buffer; -} ; - -static void move_(struct LOC_saves *LINK) +static void move_ (struct LOC_saves *LINK) { long i, garums; object_type *WITH; - /*si procedura parsuta treso (points jau ir) uz otro*/ + //si procedura parsuta treso (assert_and_assign_real_pointer jau ir) uz otro WITH = LINK->p3.objpoint; - garums = dinform[(long)WITH->U1.dtype].length; - LINK->p2.adrese = pointx(LINK->bulta2.pointa); + garums = dinform[(long) WITH->U1.dtype].length; + LINK->p2.adrese = pointx (LINK->bulta2.pointa); for (i = 0; i < garums; i++) LINK->p2.objpoint->longintarray[i] = WITH->longintarray[i]; - /* save two words for restore */ + // save two words for restore LINK->p2.objpoint->pointarray[garums].pointa = LINK->p3.adrese; LINK->p2.objpoint->longintarray[garums + 1] = WITH->longintarray[1]; @@ -800,18 +612,18 @@ static void move_(struct LOC_saves *LINK) WITH->longintarray[1] = LINK->kp; LINK->kp += one * garums; - nextsp(&LINK->bulta2, (int)(garums + 2)); + nextsp (&LINK->bulta2, (int) (garums + 2)); } -static void writeblock(struct LOC_saves *LINK) +static void writeblock (struct LOC_saves *LINK) { - fwrite(LINK->buffer.U3.b1, sizeof(x512), 1, LINK->outfile); - /*** write 1 ***/ + fwrite (LINK->buffer.U3.b1, sizeof (x512), 1, LINK->outfile); + //** write 1 ** } -/*************************************** saves (f,e) *****/ -void saves(char *f,long *e) +//************************************** saves (f,e) **** +void saves (char *f, long *e) { struct LOC_saves V; long i, j, k; @@ -824,194 +636,188 @@ void saves(char *f,long *e) _REC_dinformtype *WITH1; sa_pointer *WITH2; - /*** seit ir saves sakums saves ( f , e ) ***/ + //** seit ir saves sakums saves ( f , e ) ** V.outfile = NULL; bulta1.pointa = ffby.pointa; V.bulta2.pointa = ffby.pointa; V.kp = spazime; m = 0; - pointr(*e, &V.p3.adrese); - move_(&V); - /*** formesanas cikls, kamer pirma bulta panak otro ***/ - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - WITH1 = &dinform[(long)WITH->U1.dtype]; - garums = WITH1->length + 2; - biti = WITH1->spointbit; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH->pointarray[i - 1]; - bulta3.pointa = WITH2->pointa; - if ( (OFFSET(bulta3.pointa)) != 0) + assert_and_assign_real_pointer (*e, &V.p3.adrese); + move_ (&V); + //** formesanas cikls, kamer pirma bulta panak otro ** + while (bulta1.pointa != V.bulta2.pointa) { - V.p3.adrese = bulta3.pointa; - - if ((V.p3.objpoint->U1.flags & setflag) == 1) - WITH2->pointa = SET_S_ADDRESS_EXNUMB( V.p3.objpoint->longintarray[1] ); - else { - WITH2->pointa = SET_S_ADDRESS_EXNUMB( V.kp ); - move_(&V); - } - - } - } - - - i++; - biti /= 2; - + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + WITH1 = &dinform[(long) WITH->U1.dtype]; + garums = WITH1->length + 2; + biti = WITH1->spointbit; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH->pointarray[i - 1]; + bulta3.pointa = WITH2->pointa; + if (bulta3.wstruct.segmentpart != 0) + { + V.p3.adrese = bulta3.pointa; + + if ((V.p3.objpoint->U1.flags & setflag) == 1) + WITH2->exnumb = V.p3.objpoint->longintarray[1]; + else + { + WITH2->exnumb = V.kp; + move_ (&V); + } + + } + } + + + i++; + biti /= 2; + + } + + nextsp (&bulta1, (int) garums); + m++; } - - nextsp(&bulta1, (int)garums); - m++; - } - /*** objekts ir uzbuvets un bulta2 rada uz vina beigam ***/ - /*** tagad atjaunojam esoso objektu , ko sabojaja move ***/ - /*** izstaigajam jauno objektu un nomainam akodus ***/ + //** objekts ir uzbuvets un bulta2 rada uz vina beigam ** + //** tagad atjaunojam esoso objektu , ko sabojaja move ** + //** izstaigajam jauno objektu un nomainam akodus ** bulta1.pointa = ffby.pointa; bulta3.pointa = V.bulta2.pointa; la = 0; - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - WITH1 = &dinform[(long)WITH->U1.dtype]; - garums = WITH1->length + 2; - biti = WITH1->apointbit; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH->pointarray[i - 1]; - rab1.pointa = WITH2->pointa; - uint8_t pazime = PAZIME( rab1.pointa ) ; - if ( pazime == (uint8_t) apazime) { - rab2.pointa = V.bulta2.pointa; - V.p2.adrese = pointx(rab2.pointa); /*izmanto prevbuf*/ - k = (OFFSET( rab2.pointa )); - l = apazime; - for (j = 1; j <= la; j++) { /* tada vel nav */ - if (prevbuf->inform[k] == rab1.pointa) /* tads jau ir */ - goto _Lara; - k++; - if (k >= fssize) { - uint16_t offset = OFFSET( rab2.pointa ); - uint16_t page = PAGE ( rab2.pointa ); - page++; - rab2.pointa = SET_S_ADDRESS( offset, page ); - V.p2.adrese = pointx(rab2.pointa); /* prevbuf! */ - k = 0; - } - l += one; - } - la++; - prevbuf->inform[k] = rab1.pointa; -_Lara: - WITH2->pointa = SET_S_ADDRESS_EXNUMB( l ); - } - } - - - i++; - biti /= 2; - + while (bulta1.pointa != V.bulta2.pointa) + { + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + WITH1 = &dinform[(long) WITH->U1.dtype]; + garums = WITH1->length + 2; + biti = WITH1->apointbit; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH->pointarray[i - 1]; + rab1.pointa = WITH2->pointa; + if (rab1.struct_.pazime == (char) apazime) + { + rab2.pointa = V.bulta2.pointa; + V.p2.adrese = pointx (rab2.pointa); //izmanto prevbuf + k = rab2.newstruct.offset; + l = apazime; + for (j = 1; j <= la; j++) + { // tada vel nav + if (prevbuf->inform[k] == rab1.pointa) // tads jau ir + goto _Lara; + k++; + if (k >= fssize) + { + rab2.newstruct.page++; + V.p2.adrese = pointx (rab2.pointa); // prevbuf! + k = 0; + } + l += one; + } + la++; + prevbuf->inform[k] = rab1.pointa; + _Lara: + WITH2->exnumb = l; + } + } + + + i++; + biti /= 2; + + } + + V.p2.adrese = WITH->pointarray[garums - 2].pointa; + + V.p2.objpoint->U1.flags &= clearflag; + + V.p2.objpoint->longintarray[1] = WITH->longintarray[garums - 1]; + nextsp (&bulta1, (int) garums); } - - V.p2.adrese = WITH->pointarray[garums - 2].pointa; - - V.p2.objpoint->U1.flags &= clearflag; - - V.p2.objpoint->longintarray[1] = WITH->longintarray[garums - 1]; - nextsp(&bulta1, (int)garums); - } - /*** seit visi pointeri ir sataisiti un javada lauka ***/ + //** seit visi pointeri ir sataisiti un javada lauka ** bulta1.pointa = ffby.pointa; - V.outfile = fopen(f, "wb"); + V.outfile = fopen (f, "wb"); if (V.outfile == NULL) - _EscIO(FileNotFound); + _EscIO (FileNotFound); V.buffer.long_[0] = m; i = 2; - - /*writeln('MMMMMM M=',m); -writeln;*/ - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - garums = dinform[(long)WITH->U1.dtype].length; - for (k = 0; k < garums; k++) { - V.buffer.long_[i - 1] = WITH->longintarray[k]; - i++; - } - nextsp(&bulta1, (int)(garums + 2)); - if (i > lblksize) { - writeblock(&V); - i -= lblksize; - for (k = 0; k < i; k++) - V.buffer.long_[k] = V.buffer.long_[k + lblksize]; + + while (bulta1.pointa != V.bulta2.pointa) + { + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + garums = dinform[(long) WITH->U1.dtype].length; + for (k = 0; k < garums; k++) + { + V.buffer.long_[i - 1] = WITH->longintarray[k]; + i++; + } + nextsp (&bulta1, (int) (garums + 2)); + if (i > lblksize) + { + writeblock (&V); + i -= lblksize; + for (k = 0; k < i; k++) + V.buffer.long_[k] = V.buffer.long_[k + lblksize]; + } } - } - writeblock(&V); - /*** talak izvadam klat a_telpu ***/ + writeblock (&V); + //** talak izvadam klat a_telpu ** V.buffer.long_[0] = la; i = 5; - V.p2.adrese = pointx(V.bulta2.pointa); /*izmanto prevbuf*/ - k = OFFSET( V.bulta2.pointa ); - for (j = 1; j <= la; j++) { - cptr.cptr1 = &V.buffer.chr[i]; - pointa(prevbuf->inform[k], cptr.cptr80, &garums); - V.buffer.chr[i - 1] = (Char)garums; - i += garums + 1; - if (i > cblksize) { - writeblock(&V); - i -= cblksize; - for (l = 0; l < i; l++) - V.buffer.chr[l] = V.buffer.chr[l + cblksize]; - } - k++; - if (k >= fssize) { - uint16_t offset = OFFSET( rab2.pointa ); - uint16_t page = PAGE ( rab2.pointa ); - page++; - V.bulta2.pointa = SET_S_ADDRESS( offset, page ); - V.p2.adrese = pointx(V.bulta2.pointa); - k = 0; + V.p2.adrese = pointx (V.bulta2.pointa); //izmanto prevbuf + k = V.bulta2.newstruct.offset; + for (j = 1; j <= la; j++) + { + cptr.cptr1 = &V.buffer.chr[i]; + get_data_from_pointa (prevbuf->inform[k], cptr.cptr80, &garums); + V.buffer.chr[i - 1] = (char) garums; + i += garums + 1; + if (i > cblksize) + { + writeblock (&V); + i -= cblksize; + for (l = 0; l < i; l++) + V.buffer.chr[l] = V.buffer.chr[l + cblksize]; + } + k++; + if (k >= fssize) + { + V.bulta2.newstruct.page++; + V.p2.adrese = pointx (V.bulta2.pointa); + k = 0; + } } - } - writeblock(&V); + writeblock (&V); if (V.outfile != NULL) - fclose(V.outfile); + fclose (V.outfile); V.outfile = NULL; if (V.outfile != NULL) - fclose(V.outfile); -} /* end of saves */ + fclose (V.outfile); +} // end of saves -/* Local variables for savesn: */ -struct LOC_savesn { - FILE *outfile; - longint kp; - sa_pointer bulta2; - absadr p2, p3; - union { - longint long_[256]; - Char chr[1024]; - struct { - x512 b1, b2; - } U3; - } buffer; -} ; -static void move__(struct LOC_savesn *LINK) + +static void move__ (struct LOC_savesn *LINK) { long i, garums; object_type *WITH; - /*si procedura parsuta treso(points jau ir) uz otro*/ + //si procedura parsuta treso(assert_and_assign_real_pointer jau ir) uz otro WITH = LINK->p3.objpoint; - garums = dinform[(long)WITH->U1.dtype].length; - LINK->p2.adrese = pointx(LINK->bulta2.pointa); + garums = dinform[(long) WITH->U1.dtype].length; + LINK->p2.adrese = pointx (LINK->bulta2.pointa); for (i = 0; i < garums; i++) LINK->p2.objpoint->longintarray[i] = WITH->longintarray[i]; @@ -1019,20 +825,20 @@ static void move__(struct LOC_savesn *LINK) WITH->longintarray[1] = LINK->kp; LINK->kp += one * garums; - nextsp(&LINK->bulta2, (int)garums); + nextsp (&LINK->bulta2, (int) garums); } -static void writeblock_(struct LOC_savesn *LINK) +static void writeblock_ (struct LOC_savesn *LINK) { - fwrite(LINK->buffer.U3.b1, sizeof(x512), 1, LINK->outfile); + fwrite (LINK->buffer.U3.b1, sizeof (x512), 1, LINK->outfile); - /*** write 1 ***/ + //** write 1 ** } -/*************************************** savesn (f,e) *****/ -void savesn(char *f, long *e) +//************************************** savesn (f,e) **** +void savesn (char *f, long *e) { struct LOC_savesn V; long i, j, k; @@ -1045,198 +851,205 @@ void savesn(char *f, long *e) _REC_dinformtype *WITH1; sa_pointer *WITH2; - /*** seit ir saves sakums saves ( f , e ) ***/ + //** seit ir saves sakums saves ( f , e ) ** V.outfile = NULL; bulta1.pointa = ffby.pointa; V.bulta2.pointa = ffby.pointa; V.kp = spazime; m = 0; - pointr(*e, &V.p3.adrese); - move__(&V); - /*** formesanas cikls kamer pirma bulta panak otro ***/ - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - WITH1 = &dinform[(long)WITH->U1.dtype]; - garums = WITH1->length; - biti = WITH1->spointbit; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH->pointarray[i - 1]; - bulta3.pointa = WITH2->pointa; - if ( (OFFSET(bulta3.pointa)) != 0) + assert_and_assign_real_pointer (*e, &V.p3.adrese); + move__ (&V); + //** formesanas cikls kamer pirma bulta panak otro ** + while (bulta1.pointa != V.bulta2.pointa) { - V.p3.adrese = bulta3.pointa; - - if ((V.p3.objpoint->U1.flags & setflag) == 1) - {WITH2->pointa = SET_S_ADDRESS_EXNUMB (V.p3.objpoint->longintarray[1]);} - else - {WITH2->pointa = SET_S_ADDRESS_EXNUMB( V.kp ); move__(&V) ;} - + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + WITH1 = &dinform[(long) WITH->U1.dtype]; + garums = WITH1->length; + biti = WITH1->spointbit; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH->pointarray[i - 1]; + bulta3.pointa = WITH2->pointa; + if (bulta3.wstruct.segmentpart != 0) + { + V.p3.adrese = bulta3.pointa; + + if ((V.p3.objpoint->U1.flags & setflag) == 1) + { + WITH2->exnumb = V.p3.objpoint->longintarray[1]; + } + else + { + WITH2->exnumb = V.kp; + move__ (&V); + } + + } + } + + + i++; + biti /= 2; + + } + + nextsp (&bulta1, (int) garums); + m++; } - } - - - i++; - biti /= 2; - - } - - nextsp(&bulta1, (int)garums); - m++; - } - /*** objekts ir uzbuvets un bulta2 rada uz vina beigam ***/ - /*** izstaigajam jauno objektu un nomainam akodus ***/ + //** objekts ir uzbuvets un bulta2 rada uz vina beigam ** + //** izstaigajam jauno objektu un nomainam akodus ** bulta1.pointa = ffby.pointa; bulta3.pointa = V.bulta2.pointa; la = 0; - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - WITH1 = &dinform[(long)WITH->U1.dtype]; - garums = WITH1->length; - biti = WITH1->apointbit; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH->pointarray[i - 1]; - rab1.pointa = WITH2->pointa; - uint8_t pazime = PAZIME( rab1.pointa ); - if ( pazime == ( uint8_t )apazime) { - rab2.pointa = V.bulta2.pointa; - V.p2.adrese = pointx(rab2.pointa); /*izmantos prevbuf*/ - k = OFFSET( rab2.pointa ) ; - l = apazime; - for (j = 1; j <= la; j++) { /* tada vel nav */ - if (prevbuf->inform[k] == rab1.pointa) /* tads jau ir */ - goto _Lara; - k++; - if (k >= fssize) { - uint16_t offset = OFFSET (rab2.pointa); - uint16_t page = PAGE (rab2.pointa); - page++; - rab2.pointa = SET_S_ADDRESS( offset, page ); - V.p2.adrese = pointx(rab2.pointa); - k = 0; - } - l += one; - } - la++; - prevbuf->inform[k] = rab1.pointa; -_Lara: - WITH2->pointa = SET_S_ADDRESS_EXNUMB( l ); - } - } - - - i++; - biti /= 2; - + while (bulta1.pointa != V.bulta2.pointa) + { + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + WITH1 = &dinform[(long) WITH->U1.dtype]; + garums = WITH1->length; + biti = WITH1->apointbit; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH->pointarray[i - 1]; + rab1.pointa = WITH2->pointa; + if (rab1.struct_.pazime == (char) apazime) + { + rab2.pointa = V.bulta2.pointa; + V.p2.adrese = pointx (rab2.pointa); //izmantos prevbuf + k = rab2.newstruct.offset; + l = apazime; + for (j = 1; j <= la; j++) + { // tada vel nav + if (prevbuf->inform[k] == rab1.pointa) // tads jau ir + goto _Lara; + k++; + if (k >= fssize) + { + rab2.newstruct.page++; + V.p2.adrese = pointx (rab2.pointa); + k = 0; + } + l += one; + } + la++; + prevbuf->inform[k] = rab1.pointa; + _Lara: + WITH2->exnumb = l; + } + } + + + i++; + biti /= 2; + + } + + nextsp (&bulta1, (int) garums); } - - nextsp(&bulta1, (int)garums); - } - /*** seit visi pointeri ir sataisiti un javada lauka ***/ + //** seit visi pointeri ir sataisiti un javada lauka ** bulta1.pointa = ffby.pointa; - V.outfile = fopen(f, "wb"); + V.outfile = fopen (f, "wb"); if (V.outfile == NULL) - _EscIO(FileNotFound); + _EscIO (FileNotFound); V.buffer.long_[0] = m; i = 2; - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - garums = dinform[(long)WITH->U1.dtype].length; - for (k = 0; k < garums; k++) { - V.buffer.long_[i - 1] = WITH->longintarray[k]; - i++; - } - nextsp(&bulta1, (int)garums); - if (i > lblksize) { - writeblock_(&V); - i -= lblksize; - for (k = 0; k < i; k++) - V.buffer.long_[k] = V.buffer.long_[k + lblksize]; + while (bulta1.pointa != V.bulta2.pointa) + { + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + garums = dinform[(long) WITH->U1.dtype].length; + for (k = 0; k < garums; k++) + { + V.buffer.long_[i - 1] = WITH->longintarray[k]; + i++; + } + nextsp (&bulta1, (int) garums); + if (i > lblksize) + { + writeblock_ (&V); + i -= lblksize; + for (k = 0; k < i; k++) + V.buffer.long_[k] = V.buffer.long_[k + lblksize]; + } } - } - writeblock_(&V); - /*** talak izvadam klat a_telpu ***/ + writeblock_ (&V); + //** talak izvadam klat a_telpu ** V.buffer.long_[0] = la; i = 5; - V.p2.adrese = pointx(V.bulta2.pointa); /*izmantos prevbuf*/ - k = OFFSET( V.bulta2.pointa ); - for (j = 1; j <= la; j++) { - cptr.cptr1 = &V.buffer.chr[i]; - pointa(prevbuf->inform[k], cptr.cptr80, &garums); - V.buffer.chr[i - 1] = (Char)garums; - i += garums + 1; - if (i > cblksize) { - writeblock_(&V); - i -= cblksize; - for (l = 0; l < i; l++) - V.buffer.chr[l] = V.buffer.chr[l + cblksize]; - } - k++; - if (k >= fssize) { - uint16_t offset = OFFSET (V.bulta2.pointa); - uint16_t page = PAGE (V.bulta2.pointa); - page++; - V.bulta2.pointa = SET_S_ADDRESS( offset, page ); - V.p2.adrese = pointx(V.bulta2.pointa); - k = 0; + V.p2.adrese = pointx (V.bulta2.pointa); //izmantos prevbuf + k = V.bulta2.newstruct.offset; + for (j = 1; j <= la; j++) + { + cptr.cptr1 = &V.buffer.chr[i]; + get_data_from_pointa (prevbuf->inform[k], cptr.cptr80, &garums); + V.buffer.chr[i - 1] = (char) garums; + i += garums + 1; + if (i > cblksize) + { + writeblock_ (&V); + i -= cblksize; + for (l = 0; l < i; l++) + V.buffer.chr[l] = V.buffer.chr[l + cblksize]; + } + k++; + if (k >= fssize) + { + V.bulta2.newstruct.page++; + V.p2.adrese = pointx (V.bulta2.pointa); + k = 0; + } } - } - writeblock_(&V); + writeblock_ (&V); if (V.outfile != NULL) - fclose(V.outfile); + fclose (V.outfile); V.outfile = NULL; if (V.outfile != NULL) - fclose(V.outfile); -} /* end of savesn */ + fclose (V.outfile); +} // end of savesn -/*************************************** vols *****/ -void vols(long *dr,long *dw,long *dp) +//************************************** vols **** +void vols (long *dr, long *dw, long *dp) { *dr = sdiscread; *dw = sdiscwrite; *dp = sdiscpage; -} /* end of vols */ +} // end of vols -/* Local variables for reopen: */ -struct LOC_reopen { - longint kp; - sa_pointer bulta2; - absadr p2, p3; -} ; -static void move___(struct LOC_reopen *LINK) +static void move___ (struct LOC_reopen *LINK) { long i, garums; object_type *WITH; - /* si procedura parsuta treso (points jau ir) uz otro */ + // si procedura parsuta treso (assert_and_assign_real_pointer jau ir) uz otro WITH = LINK->p3.objpoint; - garums = dinform[(long)WITH->U1.dtype].length; - LINK->p2.adrese = pointx(LINK->bulta2.pointa); + garums = dinform[(long) WITH->U1.dtype].length; + LINK->p2.adrese = pointx (LINK->bulta2.pointa); for (i = 0; i < garums; i++) LINK->p2.objpoint->longintarray[i] = WITH->longintarray[i]; WITH->U1.flags |= setflag; - WITH->longintarray[1] = LINK->kp; /* new addr of object */ + WITH->longintarray[1] = LINK->kp; // new addr of object LINK->kp += one * garums; - nextsp(&LINK->bulta2, (int)garums); + nextsp (&LINK->bulta2, (int) garums); } -/*************************************** reopen (f,e) *****/ -void reopen(long *f,long *e) +//************************************** reopen (f,e) **** +void reopen (long *f, long *e) { struct LOC_reopen V; long i, k; @@ -1249,113 +1062,116 @@ void reopen(long *f,long *e) sa_pointer *WITH2; long FORLIM1; - /*** seit ir reopen sakums reopen ( f , e ) ***/ + //** seit ir reopen sakums reopen ( f , e ) ** bulta1.pointa = ffby.pointa; V.bulta2.pointa = ffby.pointa; V.kp = spazime; m = 0; - pointr(*e, &V.p3.adrese); - move___(&V); - /*** formesanas cikls kamer pirma bulta panak otro ***/ - while (bulta1.pointa != V.bulta2.pointa) { - p1.adrese = pointx(bulta1.pointa); - WITH = p1.objpoint; - WITH1 = &dinform[(long)WITH->U1.dtype]; - garums = WITH1->length; - biti = WITH1->spointbit; - i = 1; - while (biti != 0) { - if ((biti & 1) == 1) { - WITH2 = &WITH->pointarray[i - 1]; - bulta3.pointa = WITH2->pointa; - if ( (OFFSET( bulta3.pointa ) ) != 0) { - V.p3.adrese = bulta3.pointa; - - if ((V.p3.objpoint->U1.flags & setflag) == 1) - WITH2->pointa = SET_S_ADDRESS_EXNUMB( V.p3.objpoint->longintarray[1] ); - else { - WITH2->pointa = SET_S_ADDRESS_EXNUMB( V.kp ); - move___(&V); - } - - } - } - - - i++; - biti /= 2; - + assert_and_assign_real_pointer (*e, &V.p3.adrese); + move___ (&V); + //** formesanas cikls kamer pirma bulta panak otro ** + while (bulta1.pointa != V.bulta2.pointa) + { + p1.adrese = pointx (bulta1.pointa); + WITH = p1.objpoint; + WITH1 = &dinform[(long) WITH->U1.dtype]; + garums = WITH1->length; + biti = WITH1->spointbit; + i = 1; + while (biti != 0) + { + if ((biti & 1) == 1) + { + WITH2 = &WITH->pointarray[i - 1]; + bulta3.pointa = WITH2->pointa; + if (bulta3.wstruct.segmentpart != 0) + { + V.p3.adrese = bulta3.pointa; + + if ((V.p3.objpoint->U1.flags & setflag) == 1) + WITH2->exnumb = V.p3.objpoint->longintarray[1]; + else + { + WITH2->exnumb = V.kp; + move___ (&V); + } + + } + } + + + i++; + biti /= 2; + + } + + nextsp (&bulta1, (int) garums); + m++; } - - nextsp(&bulta1, (int)garums); - m++; - } - /*** objekts ir uzbuvets un m ir elementu skaits vina ***/ - /*** tagad vinu parsutam un noskanojam ***/ - bulta1.pointa = ffby.pointa; /*** no bulta1 uz bulta2 ***/ - - V.bulta2.pointa = SET_S_ADDRESS( 0, minpage ); - V.p2.adrese = pointx(V.bulta2.pointa); + //** objekts ir uzbuvets un m ir elementu skaits vina ** + //** tagad vinu parsutam un noskanojam ** + bulta1.pointa = ffby.pointa; //** no bulta1 uz bulta2 ** + V.bulta2.newstruct.offset = 0; + V.bulta2.newstruct.page = minpage; + V.p2.adrese = pointx (V.bulta2.pointa); holdbuf = prevbuf; - *f = V.p2.adrese; /** result of reopen **/ - for (V.kp = 1; V.kp <= m; V.kp++) { /* for each object in infile do */ - p1.adrese = pointx(bulta1.pointa); - WITH1 = &dinform[(long)p1.objpoint->U1.dtype]; - garums = WITH1->length; - biti = WITH1->spointbit; - for (k = 0; k < garums; k++) { /* for each longword in object */ - rab1.pointa = p1.objpoint->pointarray[k].pointa; - uint8_t pazime = PAZIME( rab1.pointa ); - if ( ( (biti & 1) == 1 ) && ( pazime == (uint8_t) spazime ) ) - { /* transform offset to s-addr */ - rab2 = rab1.pointa / 256; - uint16_t offset = OFFSET( rab1.pointa ); - uint16_t page = PAGE ( rab1.pointa ); - offset = rab2 & andoffs; - - page = rab2 / ssize ; - rab1.pointa = SET_S_ADDRESS( offset, page ); - rab1.pointa = pointx(rab1.pointa); - } - - - holdbuf->inform[ ( OFFSET( V.bulta2.pointa ) )] = rab1.pointa; - V.bulta2.pointa = SET_S_ADDRESS( - ( OFFSET( V.bulta2.pointa ) ) + 1, - ( PAGE ( V.bulta2.pointa ) ) - ); - biti /= 2; - + *f = V.p2.adrese; //* result of reopen * + for (V.kp = 1; V.kp <= m; V.kp++) + { // for each object in infile do + p1.adrese = pointx (bulta1.pointa); + WITH1 = &dinform[(long) p1.objpoint->U1.dtype]; + garums = WITH1->length; + biti = WITH1->spointbit; + for (k = 0; k < garums; k++) + { // for each longword in object + rab1.pointa = p1.objpoint->pointarray[k].pointa; + + if ((biti & 1) == 1 && rab1.struct_.pazime == (char) spazime) + { // transform offset to s-addr + rab2 = rab1.pointa / 256; // + ffby.struct.offset; + rab1.newstruct.offset = rab2 & andoffs; + //rab1.newstruct.page = rab2 / ssize + ffby.newstruct.page; + rab1.newstruct.page = rab2 / ssize; + + rab1.pointa = pointx (rab1.pointa); + } + + + holdbuf->inform[V.bulta2.newstruct.offset] = rab1.pointa; + V.bulta2.newstruct.offset++; + + biti /= 2; + + } + nextsp (&bulta1, (int) garums); + if (V.bulta2.newstruct.offset >= ssize) + { // if end of s-page + V.bulta2.newstruct.offset -= ssize; + V.bulta2.newstruct.page++; + V.p2.adrese = pointx (V.bulta2.pointa); + holdbuf = prevbuf; + FORLIM1 = V.bulta2.newstruct.offset; + for (k = 0; k <= FORLIM1; k++) + holdbuf->inform[k] = 0; + } } - nextsp(&bulta1, (int)garums); - if ( OFFSET( V.bulta2.pointa ) >= ssize) { /* if end of s-page */ - uint16_t offset = ( OFFSET( V.bulta2.pointa) ) - ssize; - uint16_t page = ( PAGE ( V.bulta2.pointa) ) + 1; - V.bulta2.pointa = SET_S_ADDRESS( offset, page ); - V.p2.adrese = pointx(V.bulta2.pointa); - holdbuf = prevbuf; - FORLIM1 = (OFFSET(V.bulta2.pointa) ); - for (k = 0; k <= FORLIM1; k++) - holdbuf->inform[k] = 0; - } - } holdbuf = NULL; ffby.pointa = V.bulta2.pointa; -} /* end of reopen */ +} // end of reopen -/*procedure aaa;*/ -/*var dt:descriptortype; -begin -init_dinform; - for dt:=dummy to spec do - if dinform[dt].length<>dinform_1[dt].length then writeln('NO!-'); - if dinform[dt].apointbit<>dinform_1[dt].apointbit then writeln('NO!-'); - if dinform[dt].spointbit<>dinform_1[dt].spointbit then writeln('NO!-'); -*/ +//procedure aaa; +//var dt:descriptortype; +//begin +// init_dinform; +//for dt:=dummy to spec do +// if dinform[dt].length<>dinform_1[dt].length then writeln('NO!-'); +// if dinform[dt].apointbit<>dinform_1[dt].apointbit then writeln('NO!-'); +// if dinform[dt].spointbit<>dinform_1[dt].spointbit then writeln('NO!-'); + -/* End. */ +// End. diff --git a/RIGAL/rigsc.446/src/erm.c b/RIGAL/rigsc.446/src/erm.c index 7ac89fcc3ab719a0d164129f422ab8ef4f0dfe94..5553341b4eea9e2b6edc312b15871f39507ed0ec 100644 --- a/RIGAL/rigsc.446/src/erm.c +++ b/RIGAL/rigsc.446/src/erm.c @@ -5,10 +5,11 @@ #include "cim.h" #include "usemod.h" -Void usepas(n, pl, rez) -long n; -ptr_ *pl; -long *rez; +void +usepas (n, pl, rez) + long n; + ptr_ *pl; + long *rez; { /* number of option */ /* pointer to argument list */ @@ -16,617 +17,619 @@ long *rez; a pp1, pp2; pp1 = pl->cel; - next(pl); + next (pl); pp2 = pl->cel; - next(pl); - switch (n) { + next (pl); + switch (n) + { - /* n: use_x(pp1,pp2,pl.cel,rez) */ - case 1: - use_1(pp1, pp2, pl->cel, rez); - break; + /* n: use_x(pp1,pp2,pl.cel,rez) */ + case 1: + use_1 (pp1, pp2, pl->cel, rez); + break; - case 2: - use_2(pp1, pp2, pl->cel, rez); - break; + case 2: + use_2 (pp1, pp2, pl->cel, rez); + break; - case 3: - use_3(pp1, pp2, pl->cel, rez); - break; + case 3: + use_3 (pp1, pp2, pl->cel, rez); + break; - case 4: - use_4(pp1, pp2, pl->cel, rez); - break; + case 4: + use_4 (pp1, pp2, pl->cel, rez); + break; - case 5: - use_5(pp1, pp2, pl->cel, rez); - break; + case 5: + use_5 (pp1, pp2, pl->cel, rez); + break; - case 6: - use_6(pp1, pp2, pl->cel, rez); - break; + case 6: + use_6 (pp1, pp2, pl->cel, rez); + break; - case 7: - use_7(pp1, pp2, pl->cel, rez); - break; + case 7: + use_7 (pp1, pp2, pl->cel, rez); + break; - case 8: - use_8(pp1, pp2, pl->cel, rez); - break; + case 8: + use_8 (pp1, pp2, pl->cel, rez); + break; - case 9: - use_9(pp1, pp2, pl->cel, rez); - break; + case 9: + use_9 (pp1, pp2, pl->cel, rez); + break; - case 10: - use_10(pp1, pp2, pl->cel, rez); - break; + case 10: + use_10 (pp1, pp2, pl->cel, rez); + break; - case 11: - use_11(pp1, pp2, pl->cel, rez); - break; + case 11: + use_11 (pp1, pp2, pl->cel, rez); + break; - case 12: - use_12(pp1, pp2, pl->cel, rez); - break; + case 12: + use_12 (pp1, pp2, pl->cel, rez); + break; - case 13: - use_13(pp1, pp2, pl->cel, rez); - break; + case 13: + use_13 (pp1, pp2, pl->cel, rez); + break; - case 14: - use_14(pp1, pp2, pl->cel, rez); - break; + case 14: + use_14 (pp1, pp2, pl->cel, rez); + break; - case 15: - use_15(pp1, pp2, pl->cel, rez); - break; + case 15: + use_15 (pp1, pp2, pl->cel, rez); + break; - case 16: - use_16(pp1, pp2, pl->cel, rez); - break; + case 16: + use_16 (pp1, pp2, pl->cel, rez); + break; - case 17: - use_17(pp1, pp2, pl->cel, rez); - break; + case 17: + use_17 (pp1, pp2, pl->cel, rez); + break; - case 18: - use_18(pp1, pp2, pl->cel, rez); - break; + case 18: + use_18 (pp1, pp2, pl->cel, rez); + break; - case 19: - use_19(pp1, pp2, pl->cel, rez); - break; + case 19: + use_19 (pp1, pp2, pl->cel, rez); + break; - case 20: - use_20(pp1, pp2, pl->cel, rez); - break; + case 20: + use_20 (pp1, pp2, pl->cel, rez); + break; - case 21: - use_21(pp1, pp2, pl->cel, rez); - break; + case 21: + use_21 (pp1, pp2, pl->cel, rez); + break; - case 22: - use_22(pp1, pp2, pl->cel, rez); - break; + case 22: + use_22 (pp1, pp2, pl->cel, rez); + break; - case 23: - use_23(pp1, pp2, pl->cel, rez); - break; + case 23: + use_23 (pp1, pp2, pl->cel, rez); + break; - case 24: - use_24(pp1, pp2, pl->cel, rez); - break; + case 24: + use_24 (pp1, pp2, pl->cel, rez); + break; - case 25: - use_25(pp1, pp2, pl->cel, rez); - break; + case 25: + use_25 (pp1, pp2, pl->cel, rez); + break; - case 26: - use_26(pp1, pp2, pl->cel, rez); - break; + case 26: + use_26 (pp1, pp2, pl->cel, rez); + break; - case 27: - use_27(pp1, pp2, pl->cel, rez); - break; + case 27: + use_27 (pp1, pp2, pl->cel, rez); + break; - case 28: - use_28(pp1, pp2, pl->cel, rez); - break; + case 28: + use_28 (pp1, pp2, pl->cel, rez); + break; - case 29: - use_29(pp1, pp2, pl->cel, rez); - break; + case 29: + use_29 (pp1, pp2, pl->cel, rez); + break; - case 30: - use_30(pp1, pp2, pl->cel, rez); - break; + case 30: + use_30 (pp1, pp2, pl->cel, rez); + break; - case 31: - use_31(pp1, pp2, pl->cel, rez); - break; + case 31: + use_31 (pp1, pp2, pl->cel, rez); + break; - case 32: - use_32(pp1, pp2, pl->cel, rez); - break; + case 32: + use_32 (pp1, pp2, pl->cel, rez); + break; - case 33: - use_33(pp1, pp2, pl->cel, rez); - break; + case 33: + use_33 (pp1, pp2, pl->cel, rez); + break; - case 34: - use_34(pp1, pp2, pl->cel, rez); - break; + case 34: + use_34 (pp1, pp2, pl->cel, rez); + break; - case 35: - use_35(pp1, pp2, pl->cel, rez); - break; + case 35: + use_35 (pp1, pp2, pl->cel, rez); + break; - case 36: - use_36(pp1, pp2, pl->cel, rez); - break; + case 36: + use_36 (pp1, pp2, pl->cel, rez); + break; - case 37: - use_37(pp1, pp2, pl->cel, rez); - break; + case 37: + use_37 (pp1, pp2, pl->cel, rez); + break; - case 38: - use_38(pp1, pp2, pl->cel, rez); - break; + case 38: + use_38 (pp1, pp2, pl->cel, rez); + break; - case 39: - use_39(pp1, pp2, pl->cel, rez); - break; + case 39: + use_39 (pp1, pp2, pl->cel, rez); + break; - case 40: - use_40(pp1, pp2, pl->cel, rez); - break; + case 40: + use_40 (pp1, pp2, pl->cel, rez); + break; - case 41: - use_41(pp1, pp2, pl->cel, rez); - break; + case 41: + use_41 (pp1, pp2, pl->cel, rez); + break; - case 42: - use_42(pp1, pp2, pl->cel, rez); - break; + case 42: + use_42 (pp1, pp2, pl->cel, rez); + break; - case 43: - use_43(pp1, pp2, pl->cel, rez); - break; + case 43: + use_43 (pp1, pp2, pl->cel, rez); + break; - case 44: - use_44(pp1, pp2, pl->cel, rez); - break; + case 44: + use_44 (pp1, pp2, pl->cel, rez); + break; - /* 45 & 46 are passed*/ + /* 45 & 46 are passed */ - case 47: - use_47(pp1, pp2, pl->cel, rez); - break; + case 47: + use_47 (pp1, pp2, pl->cel, rez); + break; - case 48: - use_48(pp1, pp2, pl->cel, rez); - break; + case 48: + use_48 (pp1, pp2, pl->cel, rez); + break; - case 49: - use_49(pp1, pp2, pl->cel, rez); - break; + case 49: + use_49 (pp1, pp2, pl->cel, rez); + break; - case 50: - use_50(pp1, pp2, pl->cel, rez); - break; + case 50: + use_50 (pp1, pp2, pl->cel, rez); + break; - case 51: - use_51(pp1, pp2, pl->cel, rez); - break; + case 51: + use_51 (pp1, pp2, pl->cel, rez); + break; - case 52: - use_52(pp1, pp2, pl->cel, rez); - break; + case 52: + use_52 (pp1, pp2, pl->cel, rez); + break; - case 53: - use_53(pp1, pp2, pl->cel, rez); - break; + case 53: + use_53 (pp1, pp2, pl->cel, rez); + break; - case 54: - use_54(pp1, pp2, pl->cel, rez); - break; + case 54: + use_54 (pp1, pp2, pl->cel, rez); + break; - case 55: - use_55(pp1, pp2, pl->cel, rez); - break; + case 55: + use_55 (pp1, pp2, pl->cel, rez); + break; - case 56: - use_56(pp1, pp2, pl->cel, rez); - break; + case 56: + use_56 (pp1, pp2, pl->cel, rez); + break; - case 57: - use_57(pp1, pp2, pl->cel, rez); - break; + case 57: + use_57 (pp1, pp2, pl->cel, rez); + break; - case 58: - use_58(pp1, pp2, pl->cel, rez); - break; + case 58: + use_58 (pp1, pp2, pl->cel, rez); + break; - case 59: - use_59(pp1, pp2, pl->cel, rez); - break; + case 59: + use_59 (pp1, pp2, pl->cel, rez); + break; - case 60: - use_60(pp1, pp2, pl->cel, rez); - break; + case 60: + use_60 (pp1, pp2, pl->cel, rez); + break; - case 61: - use_61(pp1, pp2, pl->cel, rez); - break; + case 61: + use_61 (pp1, pp2, pl->cel, rez); + break; - case 62: - use_62(pp1, pp2, pl->cel, rez); - break; + case 62: + use_62 (pp1, pp2, pl->cel, rez); + break; - case 63: - use_63(pp1, pp2, pl->cel, rez); - break; + case 63: + use_63 (pp1, pp2, pl->cel, rez); + break; - case 64: - use_64(pp1, pp2, pl->cel, rez); - break; + case 64: + use_64 (pp1, pp2, pl->cel, rez); + break; - case 65: - use_65(pp1, pp2, pl->cel, rez); - break; + case 65: + use_65 (pp1, pp2, pl->cel, rez); + break; - case 66: - use_66(pp1, pp2, pl->cel, rez); - break; + case 66: + use_66 (pp1, pp2, pl->cel, rez); + break; - case 67: - use_67(pp1, pp2, pl->cel, rez); - break; + case 67: + use_67 (pp1, pp2, pl->cel, rez); + break; - case 68: - use_68(pp1, pp2, pl->cel, rez); - break; + case 68: + use_68 (pp1, pp2, pl->cel, rez); + break; - case 69: - use_69(pp1, pp2, pl->cel, rez); - break; + case 69: + use_69 (pp1, pp2, pl->cel, rez); + break; - case 70: - use_70(pp1, pp2, pl->cel, rez); - break; + case 70: + use_70 (pp1, pp2, pl->cel, rez); + break; - case 71: - use_71(pp1, pp2, pl->cel, rez); - break; + case 71: + use_71 (pp1, pp2, pl->cel, rez); + break; - case 72: - use_72(pp1, pp2, pl->cel, rez); - break; + case 72: + use_72 (pp1, pp2, pl->cel, rez); + break; - case 73: - use_73(pp1, pp2, pl->cel, rez); - break; + case 73: + use_73 (pp1, pp2, pl->cel, rez); + break; - case 74: - use_74(pp1, pp2, pl->cel, rez); - break; + case 74: + use_74 (pp1, pp2, pl->cel, rez); + break; - case 75: - use_75(pp1, pp2, pl->cel, rez); - break; + case 75: + use_75 (pp1, pp2, pl->cel, rez); + break; - case 76: - use_76(pp1, pp2, pl->cel, rez); - break; + case 76: + use_76 (pp1, pp2, pl->cel, rez); + break; - case 77: - use_77(pp1, pp2, pl->cel, rez); - break; + case 77: + use_77 (pp1, pp2, pl->cel, rez); + break; - case 78: - use_78(pp1, pp2, pl->cel, rez); - break; + case 78: + use_78 (pp1, pp2, pl->cel, rez); + break; - case 79: - use_79(pp1, pp2, pl->cel, rez); - break; + case 79: + use_79 (pp1, pp2, pl->cel, rez); + break; - case 80: - use_80(pp1, pp2, pl->cel, rez); - break; + case 80: + use_80 (pp1, pp2, pl->cel, rez); + break; - case 81: - use_81(pp1, pp2, pl->cel, rez); - break; + case 81: + use_81 (pp1, pp2, pl->cel, rez); + break; - case 82: - use_82(pp1, pp2, pl->cel, rez); - break; + case 82: + use_82 (pp1, pp2, pl->cel, rez); + break; - case 83: - use_83(pp1, pp2, pl->cel, rez); - break; + case 83: + use_83 (pp1, pp2, pl->cel, rez); + break; - case 84: - use_84(pp1, pp2, pl->cel, rez); - break; + case 84: + use_84 (pp1, pp2, pl->cel, rez); + break; - case 85: - use_85(pp1, pp2, pl->cel, rez); - break; + case 85: + use_85 (pp1, pp2, pl->cel, rez); + break; - case 86: - use_86(pp1, pp2, pl->cel, rez); - break; + case 86: + use_86 (pp1, pp2, pl->cel, rez); + break; - case 87: - use_87(pp1, pp2, pl->cel, rez); - break; + case 87: + use_87 (pp1, pp2, pl->cel, rez); + break; - case 88: - use_88(pp1, pp2, pl->cel, rez); - break; + case 88: + use_88 (pp1, pp2, pl->cel, rez); + break; - case 89: - use_89(pp1, pp2, pl->cel, rez); - break; + case 89: + use_89 (pp1, pp2, pl->cel, rez); + break; - case 90: - use_90(pp1, pp2, pl->cel, rez); - break; + case 90: + use_90 (pp1, pp2, pl->cel, rez); + break; - case 91: - use_91(pp1, pp2, pl->cel, rez); - break; + case 91: + use_91 (pp1, pp2, pl->cel, rez); + break; - case 92: - use_92(pp1, pp2, pl->cel, rez); - break; + case 92: + use_92 (pp1, pp2, pl->cel, rez); + break; - case 93: - use_93(pp1, pp2, pl->cel, rez); - break; + case 93: + use_93 (pp1, pp2, pl->cel, rez); + break; - case 94: - use_94(pp1, pp2, pl->cel, rez); - break; + case 94: + use_94 (pp1, pp2, pl->cel, rez); + break; - case 95: - use_95(pp1, pp2, pl->cel, rez); - break; + case 95: + use_95 (pp1, pp2, pl->cel, rez); + break; - case 96: - use_96(pp1, pp2, pl->cel, rez); - break; + case 96: + use_96 (pp1, pp2, pl->cel, rez); + break; - case 97: - use_97(pp1, pp2, pl->cel, rez); - break; + case 97: + use_97 (pp1, pp2, pl->cel, rez); + break; - case 98: - use_98(pp1, pp2, pl->cel, rez); - break; + case 98: + use_98 (pp1, pp2, pl->cel, rez); + break; - case 99: - use_99(pp1, pp2, pl->cel, rez); - break; + case 99: + use_99 (pp1, pp2, pl->cel, rez); + break; - case 100: - use_100(pp1, pp2, pl->cel, rez); - break; + case 100: + use_100 (pp1, pp2, pl->cel, rez); + break; - case 101: - use_101(pp1, pp2, pl->cel, rez); - break; + case 101: + use_101 (pp1, pp2, pl->cel, rez); + break; - case 102: - use_102(pp1, pp2, pl->cel, rez); - break; + case 102: + use_102 (pp1, pp2, pl->cel, rez); + break; - case 103: - use_103(pp1, pp2, pl->cel, rez); - break; + case 103: + use_103 (pp1, pp2, pl->cel, rez); + break; - case 104: - use_104(pp1, pp2, pl->cel, rez); - break; + case 104: + use_104 (pp1, pp2, pl->cel, rez); + break; - case 105: - use_105(pp1, pp2, pl->cel, rez); - break; + case 105: + use_105 (pp1, pp2, pl->cel, rez); + break; - case 106: - use_106(pp1, pp2, pl->cel, rez); - break; + case 106: + use_106 (pp1, pp2, pl->cel, rez); + break; - case 107: - use_107(pp1, pp2, pl->cel, rez); - break; + case 107: + use_107 (pp1, pp2, pl->cel, rez); + break; - case 108: - use_108(pp1, pp2, pl->cel, rez); - break; + case 108: + use_108 (pp1, pp2, pl->cel, rez); + break; - case 109: - use_109(pp1, pp2, pl->cel, rez); - break; + case 109: + use_109 (pp1, pp2, pl->cel, rez); + break; - case 110: - use_110(pp1, pp2, pl->cel, rez); - break; + case 110: + use_110 (pp1, pp2, pl->cel, rez); + break; - case 111: - use_111(pp1, pp2, pl->cel, rez); - break; + case 111: + use_111 (pp1, pp2, pl->cel, rez); + break; - case 112: - use_112(pp1, pp2, pl->cel, rez); - break; + case 112: + use_112 (pp1, pp2, pl->cel, rez); + break; - case 113: - use_113(pp1, pp2, pl->cel, rez); - break; + case 113: + use_113 (pp1, pp2, pl->cel, rez); + break; - case 114: - use_114(pp1, pp2, pl->cel, rez); - break; + case 114: + use_114 (pp1, pp2, pl->cel, rez); + break; - case 115: - use_115(pp1, pp2, pl->cel, rez); - break; + case 115: + use_115 (pp1, pp2, pl->cel, rez); + break; - case 116: - use_116(pp1, pp2, pl->cel, rez); - break; + case 116: + use_116 (pp1, pp2, pl->cel, rez); + break; - case 117: - use_117(pp1, pp2, pl->cel, rez); - break; + case 117: + use_117 (pp1, pp2, pl->cel, rez); + break; - case 118: - use_118(pp1, pp2, pl->cel, rez); - break; + case 118: + use_118 (pp1, pp2, pl->cel, rez); + break; - case 119: - use_119(pp1, pp2, pl->cel, rez); - break; + case 119: + use_119 (pp1, pp2, pl->cel, rez); + break; - case 120: - use_120(pp1, pp2, pl->cel, rez); - break; + case 120: + use_120 (pp1, pp2, pl->cel, rez); + break; - case 121: - use_121(pp1, pp2, pl->cel, rez); - break; + case 121: + use_121 (pp1, pp2, pl->cel, rez); + break; - case 122: - use_122(pp1, pp2, pl->cel, rez); - break; + case 122: + use_122 (pp1, pp2, pl->cel, rez); + break; - case 123: - use_123(pp1, pp2, pl->cel, rez); - break; + case 123: + use_123 (pp1, pp2, pl->cel, rez); + break; - case 124: - use_124(pp1, pp2, pl->cel, rez); - break; + case 124: + use_124 (pp1, pp2, pl->cel, rez); + break; - case 125: - use_125(pp1, pp2, pl->cel, rez); - break; + case 125: + use_125 (pp1, pp2, pl->cel, rez); + break; - case 126: - use_126(pp1, pp2, pl->cel, rez); - break; + case 126: + use_126 (pp1, pp2, pl->cel, rez); + break; - case 127: - use_127(pp1, pp2, pl->cel, rez); - break; + case 127: + use_127 (pp1, pp2, pl->cel, rez); + break; - case 128: - use_128(pp1, pp2, pl->cel, rez); - break; + case 128: + use_128 (pp1, pp2, pl->cel, rez); + break; - case 129: - use_129(pp1, pp2, pl->cel, rez); - break; + case 129: + use_129 (pp1, pp2, pl->cel, rez); + break; - case 130: - use_130(pp1, pp2, pl->cel, rez); - break; + case 130: + use_130 (pp1, pp2, pl->cel, rez); + break; - case 131: - use_131(pp1, pp2, pl->cel, rez); - break; + case 131: + use_131 (pp1, pp2, pl->cel, rez); + break; - case 132: - use_132(pp1, pp2, pl->cel, rez); - break; + case 132: + use_132 (pp1, pp2, pl->cel, rez); + break; - case 133: - use_133(pp1, pp2, pl->cel, rez); - break; + case 133: + use_133 (pp1, pp2, pl->cel, rez); + break; - case 134: - use_134(pp1, pp2, pl->cel, rez); - break; + case 134: + use_134 (pp1, pp2, pl->cel, rez); + break; - case 135: - use_135(pp1, pp2, pl->cel, rez); - break; + case 135: + use_135 (pp1, pp2, pl->cel, rez); + break; - case 136: - use_136(pp1, pp2, pl->cel, rez); - break; + case 136: + use_136 (pp1, pp2, pl->cel, rez); + break; - case 137: - use_137(pp1, pp2, pl->cel, rez); - break; + case 137: + use_137 (pp1, pp2, pl->cel, rez); + break; - case 138: - use_138(pp1, pp2, pl->cel, rez); - break; + case 138: + use_138 (pp1, pp2, pl->cel, rez); + break; - case 139: - use_139(pp1, pp2, pl->cel, rez); - break; + case 139: + use_139 (pp1, pp2, pl->cel, rez); + break; - case 140: - use_140(pp1, pp2, pl->cel, rez); - break; + case 140: + use_140 (pp1, pp2, pl->cel, rez); + break; - case 141: - use_141(pp1, pp2, pl->cel, rez); - break; + case 141: + use_141 (pp1, pp2, pl->cel, rez); + break; - case 142: - use_142(pp1, pp2, pl->cel, rez); - break; + case 142: + use_142 (pp1, pp2, pl->cel, rez); + break; - case 143: - use_143(pp1, pp2, pl->cel, rez); - break; + case 143: + use_143 (pp1, pp2, pl->cel, rez); + break; - case 144: - use_144(pp1, pp2, pl->cel, rez); - break; + case 144: + use_144 (pp1, pp2, pl->cel, rez); + break; - case 145: - use_145(pp1, pp2, pl->cel, rez); - break; + case 145: + use_145 (pp1, pp2, pl->cel, rez); + break; - case 146: - use_146(pp1, pp2, pl->cel, rez); - break; + case 146: + use_146 (pp1, pp2, pl->cel, rez); + break; - case 147: - use_147(pp1, pp2, pl->cel, rez); - break; + case 147: + use_147 (pp1, pp2, pl->cel, rez); + break; - case 148: - use_148(pp1, pp2, pl->cel, rez); - break; + case 148: + use_148 (pp1, pp2, pl->cel, rez); + break; - case 149: - use_149(pp1, pp2, pl->cel, rez); - break; + case 149: + use_149 (pp1, pp2, pl->cel, rez); + break; - case 150: - use_150(pp1, pp2, pl->cel, rez); - break; + case 150: + use_150 (pp1, pp2, pl->cel, rez); + break; - default: - *rez = pp1; - break; - } + default: + *rez = pp1; + break; + } } -Void add(d, r) -long *d, *r; +void +add (d, r) + long *d, *r; { /*==============*/ /* d+:= r */ @@ -635,41 +638,48 @@ long *d, *r; numberdescriptor *WITH; /* deleted sign processing 2-oct-89 */ - if (*d == null_) { - if (*r == null_) + if (*d == null_) + { + if (*r == null_) + return; + assert_and_assign_real_pointer (*r, &y.sa); + if (y.snd->dtype == number) + { + /* instead of d:=r; changed 22-oct-90 */ + gets1 (d, &x.sa); + *x.snd = *y.snd; + } + return; + } + assert_and_assign_real_pointer (*d, &x.sa); + if (x.snd->dtype != number) + { + *d = null_; + err (9L); return; - pointr(*r, &y.sa); - if (y.snd->dtype == number) { - /* instead of d:=r; changed 22-oct-90 */ - gets1(d, &x.sa); - *x.snd = *y.snd; } - return; - } - points(*d, &x.sa); - if (x.snd->dtype != number) { - *d = null_; - err(9L); - return; - } if (*r == null_) return; - pointr(*r, &y.sa); - if (y.snd->dtype == number) { - WITH = x.snd; - WITH->val += y.snd->val; - } else { /* not number */ - *d = null_; - err(10L); - } + assert_and_assign_real_pointer (*r, &y.sa); + if (y.snd->dtype == number) + { + WITH = x.snd; + WITH->val += y.snd->val; + } + else + { /* not number */ + *d = null_; + err (10L); + } /* a */ /* a */ -} /* add */ +} /* add */ -Void arithm(op) -long op; +void +arithm (op) + long op; { /* kod operacii */ /*======================================*/ @@ -683,7 +693,7 @@ long op; /* wyhod */ mpd x; - longint n[2]; /* changed 17-nov-90 */ + longint n[2]; /* changed 17-nov-90 */ a rez; aa a_adr[2]; char dts[2]; @@ -692,127 +702,136 @@ long op; long j; rez = null_; - for (k = 2; k >= 1; k--) { - getval(&v[base - k - 1]); - if (v[base - k - 1] == null_) { - n[2 - k] = 0; - dts[2 - k] = dummy; - /* a_adr - not used ! */ - } else { - pointr(v[base - k - 1], &x.sa); - - dts[2 - k] = x.snd->dtype; - if (dts[2 - k] == number) - n[2 - k] = x.snd->val; + for (k = 2; k >= 1; k--) + { + getval (&v[base - k - 1]); + if (v[base - k - 1] == null_) + { + n[2 - k] = 0; + dts[2 - k] = dummy; + /* a_adr - not used ! */ + } else - n[2 - k] = 0; - a_adr[2 - k] = x.sad->name; + { + assert_and_assign_real_pointer (v[base - k - 1], &x.sa); + + dts[2 - k] = x.snd->dtype; + if (dts[2 - k] == number) + n[2 - k] = x.snd->val; + else + n[2 - k] = 0; + a_adr[2 - k] = x.sad->name; + } } - } - - - - - - if ( - ( - (dts[0] == dummy) && - (dts[1] == dummy) ) || - dts[0] == number || - dts[1] == number - ) - { - if ( - ( - (op == cgt ) && - (n[0] > n[1] ) ) || - ( - (op == clt ) && - (n[0] < n[1] ) ) || - ( - (op == cge ) && - (n[0] >= n[1] ) ) || - ( - (op == cle ) && - (n[0] <= n[1] ) ) - ) - rez = atomt; - else { /* arifmetika */ - if (op >= cmult && op <= cminus) { /* sozdatx atom rezulxtata */ - gets1(&rez, &x.sa); - if (op == cadd) - k = n[0] + n[1]; - else if (op == cminus) - k = n[0] - n[1]; - else if (op == cmult) - k = n[0] * n[1]; - else if (op == cdiv) - k = n[0] / n[1]; - else if (op == cmod) { - k = n[0] % n[1]; + + + + + + if (((dts[0] == dummy) && + (dts[1] == dummy)) || dts[0] == number || dts[1] == number) + { + if (((op == cgt) && + (n[0] > n[1])) || + ((op == clt) && + (n[0] < n[1])) || + ((op == cge) && (n[0] >= n[1])) || ((op == cle) && (n[0] <= n[1]))) + rez = atomt; + else + { /* arifmetika */ + if (op >= cmult && op <= cminus) + { /* sozdatx atom rezulxtata */ + gets1 (&rez, &x.sa); + if (op == cadd) + k = n[0] + n[1]; + else if (op == cminus) + k = n[0] - n[1]; + else if (op == cmult) + k = n[0] * n[1]; + else if (op == cdiv) + k = n[0] / n[1]; + else if (op == cmod) + { + k = n[0] % n[1]; /* p2c: erm.z, line 1070: * Note: Using % for possibly-negative arguments [317] */ + } + x.snd->dtype = number; + x.snd->val = k; + } } - x.snd->dtype = number; - x.snd->val = k; - } - } - } else { - if (op >= cmult && op <= cminus) { - gets1(&rez, &x.sa); - x.snd->dtype = number; - x.snd->val = 0; - } else { /* operations cgt,cge,clt.cle only */ - - 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) { - switch (op) { - - case clt: - j = 1; - break; - - case cle: - j = 2; - break; - - case cgt: - j = 3; - break; - - case cge: - j = 4; - break; - } - - if (compatom(j, a_adr[0], a_adr[1])) - rez = atomt; - } else { - if (dts[1] == dummy) { - if (op == cgt || op == cge) - rez = atomt; - } + } + else + { + if (op >= cmult && op <= cminus) + { + gets1 (&rez, &x.sa); + x.snd->dtype = number; + x.snd->val = 0; } + else + { /* operations cgt,cge,clt.cle only */ + + 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) + { + switch (op) + { + + case clt: + j = 1; + break; + + case cle: + j = 2; + break; + + case cgt: + j = 3; + break; + + case cge: + j = 4; + break; + } + + if (compatom (j, a_adr[0], a_adr[1])) + rez = atomt; + } + else + { + if (dts[1] == dummy) + { + if (op == cgt || op == cge) + rez = atomt; + } + } - } else { - if (dts[0] == dummy) { - if (((1L << ((long)dts[1])) & - ((1L << ((long)atom)) | (1L << ((long)idatom)) | - (1L << ((long)keyword)) | (1L << ((long)tatom)))) != 0) { - if (op == clt || op == cle) - rez = atomt; - } + } + else + { + if (dts[0] == dummy) + { + if (((1L << ((long) dts[1])) & + ((1L << ((long) atom)) | (1L << ((long) idatom)) | + (1L << ((long) keyword)) | (1L << ((long) tatom)))) != + 0) + { + if (op == clt || op == cle) + rez = atomt; + } + } + } } - } - } - } + } base--; v[base - 2] = rez; @@ -833,51 +852,56 @@ long op; -Void unmins() +void +unmins () { mpd x, y; a rez; - getval(&v[base - 2]); + getval (&v[base - 2]); if (v[base - 2] == null_) goto _L99; - pointr(v[base - 2], &y.sa); - if (y.snd->dtype != number) { - v[base - 2] = null_; - goto _L99; - } - gets1(&rez, &x.sa); + assert_and_assign_real_pointer (v[base - 2], &y.sa); + if (y.snd->dtype != number) + { + v[base - 2] = null_; + goto _L99; + } + gets1 (&rez, &x.sa); *x.snd = *y.snd; - x.snd->val = -y.snd->val; /* del sign change 3-oct-89 */ + x.snd->val = -y.snd->val; /* del sign change 3-oct-89 */ v[base - 2] = rez; -_L99: ; -} /* unmins*/ +_L99:; +} /* unmins */ -/* Local variables for bltin: */ -struct LOC_bltin { +/* static variables for bltin: */ +struct LOC_bltin +{ long l; -} ; +}; -Local long alen(k, LINK) -long k; -struct LOC_bltin *LINK; +static long +alen (k, LINK) + long k; + struct LOC_bltin *LINK; { bl80 m; a t; t = k; - pointa(t, m, &LINK->l); /* [1] ibm/pc */ + get_data_from_pointa (t, m, &LINK->l); /* [1] ibm/pc */ return LINK->l; -} /* alen */ +} /* alen */ -Void bltin(rez, success, pl, n) -long *rez; -boolean *success; -ptr_ *pl; -long n; +void +bltin (rez, success, pl, n) + long *rez; + bool *success; + ptr_ *pl; + long n; { /* 1-j argument */ /* nomer wstr.prawila */ @@ -891,7 +915,7 @@ long n; a k, s; mpd x, y; long t; - longint li_; /* 12- mar -91 */ + longint li_; /* 12- mar -91 */ bl80 mm; numberdescriptor *WITH; atomdescriptor *WITH1; @@ -902,336 +926,365 @@ long n; rulenum = n; k = pl->cel; if ((k & 511) != 0 || k >= 65535L || k < 0) - pointr(k, &x.sa); + assert_and_assign_real_pointer (k, &x.sa); *success = true; *rez = k; - switch (rulenum) { + switch (rulenum) + { - case 1: /* #implode */ - implode(pl, rez); - break; + case 1: /* #implode */ + implode (pl, rez); + break; - case 2: /* #explode */ - if (k == null_) - goto _L99; - if (((1L << ((long)x.sad->dtype)) & - ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) != 0) - explode(k, rez); - else - *success = false; - break; - - 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 2: /* #explode */ + if (k == null_) + goto _L99; + if (((1L << ((long) x.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) != 0) + explode (k, rez); + else + *success = false; + 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 12: /* #len */ - if (k == null_) - *rez = 0; - else { - switch (x.sad->dtype) { - - case atom: - case idatom: - case keyword: - case tatom: - case fatom: - *rez = 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++; - *rez = t; - break; - /* number */ + case 3: /* #atom */ + if (k == null_) + goto _L99; + *success = (((1L << ((long) x.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) != + 0); + break; - case listmain: - *rez = x.smld->totalelnum; - break; + case 4: /* #number */ + if (k == null_) + *success = false; + else + *success = (x.sad->dtype == number); + break; - case treemain: - *rez = x.smtd->totalarcnum; - 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; - default: - *rez = 0; - break; - }/* case */ - } - gets1(&k, &x.sa); - WITH = x.snd; - WITH->dtype = number; - WITH->val = *rez; - *rez = k; - break; - /* #len */ - - case 13: /* #_specatom */ - if ((k & 511) != 0 || k >= 65535L || k < 0) - *success = false; - break; - - case 14: /* #_rulename */ - if (k == null_) - *success = false; - else - *success = (x.sad->dtype == rulename); - break; - - case 15: /* #_varname */ - if (k == null_) - *success = false; - else { - *success = (((1L << ((long)x.sad->dtype)) & - ((1L << ((long)fvariable + 1)) - (1L << ((long)variable)))) != 0); - points(k, &x.sa); - x.svd->guard = true; - } - 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); - WITH1 = y.sad; - WITH1->dtype = idatom; - if (rulenum == 16) /* !!! vax !!! */ - WITH1->name = x.srd->name; - else - WITH1->name = x.svd->name; - *rez = s; - } else + case 8: /* #tatom */ + if (k == null_) *success = false; - } - break; - - case 18: /* #_vardesloc */ - if (((1L << ((long)x.svd->dtype)) & - ((1L << ((long)fvariable + 1)) - (1L << ((long)variable)))) != 0) { - next(pl); - s = pl->cel; - pointr(s, &y.sa); - points(k, &x.sa); - x.svd->location = y.snd->val; - } else - *success = false; - break; - - case 19: /* #debug */ - if (eqatoms(pl->cel, atomrules)) { - /* - rules */ - debugrule = true; - } else if (eqatoms(pl->cel, atomnorules)) { - /* norules */ - debugrule = false; - } - break; - - case 20: /* #_spectodsc */ - gets1(&s, &y.sa); - if ((k & 511) == 0 && k < 65535L && k >= 0) { - WITH2 = y.sspec; - WITH2->dtype = spec; - WITH2->val = k; - } else - *y.sspec = *x.sspec; - *rez = s; - break; - - case 21: /* _content2 */ - if ((k & 511) == 0 && k < 65535L && k >= 0) - *success = false; - else { - s = x.snd->val; - gets1(&k, &x.sa); + 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 12: /* #len */ + if (k == null_) + *rez = 0; + else + { + switch (x.sad->dtype) + { + + case atom: + case idatom: + case keyword: + case tatom: + case fatom: + *rez = 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++; + *rez = t; + break; + /* number */ + + case listmain: + *rez = x.smld->totalelnum; + break; + + case treemain: + *rez = x.smtd->totalarcnum; + break; + + + + default: + *rez = 0; + break; + } /* case */ + } + gets1 (&k, &x.sa); WITH = x.snd; WITH->dtype = number; - WITH->val = s; - + WITH->val = *rez; *rez = k; - } - break; - /* _content2 */ + break; + /* #len */ - case 22: /* #chr */ - if ((k & 511) == 0 && k < 65535L && 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; - mm[0] = (Char)t; - V.l = 1; - putatm(mm, V.l, &s); - gets1(&k, &x.sa); - WITH1 = x.sad; - if (is_rig_letter((int)t)) - WITH1->dtype = idatom; + case 13: /* #_specatom */ + if ((k & 511) != 0 || k >= 65535L || k < 0) + *success = false; + break; + + case 14: /* #_rulename */ + if (k == null_) + *success = false; else - WITH1->dtype = atom; - WITH1->name = s; - *rez = k; - } - break; - /* chr */ + *success = (x.sad->dtype == rulename); + break; - case 23: /* parameter */ - *rez = null_; - FORLIM = run_param_cnt; - for (V.l = 1; V.l <= FORLIM; V.l++) { /* see glovar.pas */ - printf(" %s", run_param_array[V.l - 1]); - lconc(rez, str_to_atom(run_param_array[V.l - 1])); - } - putchar('\n'); - break; - - case 24: /* #_totatom */ - if (k == null_) - *success = false; - else { - gets1(&s, &y.sa); - WITH1 = y.sad; - WITH1->dtype = tatom; - WITH1->name = x.sad->name; - WITH1->flags = 0; + case 15: /* #_varname */ + if (k == null_) + *success = false; + else + { + *success = (((1L << ((long) x.sad->dtype)) & + ((1L << ((long) fvariable + 1)) - + (1L << ((long) variable)))) != 0); + assert_and_assign_real_pointer (k, &x.sa); + x.svd->guard = true; + } + 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); + WITH1 = y.sad; + WITH1->dtype = idatom; + if (rulenum == 16) /* !!! vax !!! */ + WITH1->name = x.srd->name; + else + WITH1->name = x.svd->name; + *rez = s; + } + else + *success = false; + } + break; + + case 18: /* #_vardesloc */ + if (((1L << ((long) x.svd->dtype)) & + ((1L << ((long) fvariable + 1)) - (1L << ((long) variable)))) != 0) + { + next (pl); + s = pl->cel; + assert_and_assign_real_pointer (s, &y.sa); + assert_and_assign_real_pointer (k, &x.sa); + x.svd->location = y.snd->val; + } + else + *success = false; + break; + + case 19: /* #debug */ + if (eqatoms (pl->cel, atomrules)) + { + /* + rules */ + debugrule = true; + } + else if (eqatoms (pl->cel, atomnorules)) + { + /* norules */ + debugrule = false; + } + break; + + case 20: /* #_spectodsc */ + gets1 (&s, &y.sa); + if ((k & 511) == 0 && k < 65535L && k >= 0) + { + WITH2 = y.sspec; + WITH2->dtype = spec; + WITH2->val = k; + } + else + *y.sspec = *x.sspec; *rez = s; - } - break; + break; - case 25: /* #ord */ - if ((k & 511) == 0 && k < 65535L && k >= 0) - goto _L99; - if (((1L << ((long)x.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)tatom)))) != 0) { - s = x.sad->name; - pointa(s, mm, &V.l); - gets1(&k, &y.sa); - WITH = y.snd; - WITH->dtype = number; - WITH->val = mm[0]; - *rez = k; - } else - *success = false; - break; - /* ord */ + case 21: /* _content2 */ + if ((k & 511) == 0 && k < 65535L && k >= 0) + *success = false; + else + { + s = x.snd->val; + gets1 (&k, &x.sa); + WITH = x.snd; + WITH->dtype = number; + WITH->val = s; + + *rez = k; + } + break; + /* _content2 */ + + case 22: /* #chr */ + if ((k & 511) == 0 && k < 65535L && 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; + mm[0] = (char) t; + V.l = 1; + putatm (mm, V.l, &s); + gets1 (&k, &x.sa); + WITH1 = x.sad; + if (is_rig_letter ((int) t)) + WITH1->dtype = idatom; + else + WITH1->dtype = atom; + WITH1->name = s; + *rez = k; + } + break; + /* chr */ - case 26: /* call_pas */ - if ((k & 511) == 0 && k < 65535L && k >= 0) { - *rez = null_; - goto _L99; - } - if (x.snd->dtype != number) { + case 23: /* parameter */ *rez = null_; - goto _L99; - } - next(pl); - if (debugrule) { - if (out_screen) - printf("(%12ld)", x.snd->val); + FORLIM = run_param_cnt; + for (V.l = 1; V.l <= FORLIM; V.l++) + { /* see glovar.pas */ + printf (" %s", run_param_array[V.l - 1]); + lconc (rez, str_to_atom (run_param_array[V.l - 1])); + } + putchar ('\n'); + break; + + case 24: /* #_totatom */ + if (k == null_) + *success = false; else - fprintf(out, "(%12ld)", x.snd->val); - } - usepas(x.snd->val, pl, rez); - break; + { + gets1 (&s, &y.sa); + WITH1 = y.sad; + WITH1->dtype = tatom; + WITH1->name = x.sad->name; + WITH1->flags = 0; + *rez = s; + } + break; + + case 25: /* #ord */ + if ((k & 511) == 0 && k < 65535L && k >= 0) + goto _L99; + if (((1L << ((long) x.sad->dtype)) & + (((1L << ((long) keyword + 1)) - (1L << ((long) atom))) | + (1L << ((long) tatom)))) != 0) + { + s = x.sad->name; + get_data_from_pointa (s, mm, &V.l); + gets1 (&k, &y.sa); + WITH = y.snd; + WITH->dtype = number; + WITH->val = mm[0]; + *rez = k; + } + else + *success = false; + break; + /* ord */ + + case 26: /* call_pas */ + if ((k & 511) == 0 && k < 65535L && k >= 0) + { + *rez = null_; + goto _L99; + } + if (x.snd->dtype != number) + { + *rez = null_; + goto _L99; + } + next (pl); + if (debugrule) + { + if (out_screen) + printf ("(%12ld)", x.snd->val); + else + fprintf (out, "(%12ld)", x.snd->val); + } + usepas (x.snd->val, pl, rez); + break; - }/* case */ + } /* case */ _L99: - if (*success) { - if (pl->ptrtype != ptrtree) - next(pl); - } else + if (*success) + { + if (pl->ptrtype != ptrtree) + next (pl); + } + else *rez = null_; } -boolean compnames(p, ld) -long p, ld; +bool +compnames (p, ld) + long p, ld; { /* adres w sr-prostr. (<>0) deskr.atoma */ /* ili peremennoj w {ablone */ @@ -1245,38 +1298,40 @@ long p, ld; /* imq ili null, esli imeni */ /* net, wozwr. true. */ /*=======================================*/ - boolean Result; + bool Result; mpd x, y; a w; - pointr(p, &x.sa); + assert_and_assign_real_pointer (p, &x.sa); /* polu~itx dostup k deskr. atoma ili peremennoj */ Result = false; if (ld == null_) return Result; - pointr(ld, &y.sa); + assert_and_assign_real_pointer (ld, &y.sa); /* polu~itx dostup k deskr.spiska */ - if (((1L << ((long)x.sad->dtype)) & - ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) != 0) - { /* atom */ - w = y.smld->name; - if ((w & 511) == 0 && w < 65536L && w >= 0) { - /* u spiska net imeni */ - return false; - } - /* posmotretx deskr. imeni (atom ili spisok) */ - pointr(w, &y.sa); - if (((1L << ((long)y.sad->dtype)) & - ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) != 0) - return (eqatoms(p, w)); - return Result; - } /* atom */ - if (x.sad->dtype != spec) { - v[mybase + x.svd->location - 1] = y.smld->name; - /* peremennoj priswoitx spisok imen iz y.smld^.name */ - return true; - } /* specadres */ + if (((1L << ((long) x.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) != 0) + { /* atom */ + w = y.smld->name; + if ((w & 511) == 0 && w < 65536L && w >= 0) + { + /* u spiska net imeni */ + return false; + } + /* posmotretx deskr. imeni (atom ili spisok) */ + assert_and_assign_real_pointer (w, &y.sa); + if (((1L << ((long) y.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) != 0) + return (eqatoms (p, w)); + return Result; + } /* atom */ + if (x.sad->dtype != spec) + { + v[mybase + x.svd->location - 1] = y.smld->name; + /* peremennoj priswoitx spisok imen iz y.smld^.name */ + return true; + } /* specadres */ /* specadres */ w = y.smld->name; @@ -1288,8 +1343,9 @@ long p, ld; } -Void concop(a1, a2) -long *a1, a2; +void +concop (a1, a2) + long *a1, a2; { /*======================================*/ /* operaciq a1 !! a2 */ @@ -1303,42 +1359,50 @@ long *a1, a2; l = *a1; - if (a2 == null_) { - if (l == null_) - goto _L99; - else { - pointr(l, &x.sa); - if (x.smld->dtype == listmain) - goto _L99; - else { - l = null_; + if (a2 == null_) + { + if (l == null_) goto _L99; - } + else + { + assert_and_assign_real_pointer (l, &x.sa); + if (x.smld->dtype == listmain) + goto _L99; + else + { + l = null_; + goto _L99; + } + } } - } - pointr(a2, &x.sa); - if (x.smld->dtype != listmain) { - l = null_; - goto _L99; - } - if (l != null_) { - pointr(l, &x.sa); - if (x.smld->dtype != listmain) { + assert_and_assign_real_pointer (a2, &x.sa); + if (x.smld->dtype != listmain) + { l = null_; goto _L99; } - } - first(a2, &p1); - while (p1.nel != 0) { - lconc(&l, p1.cel); - next(&p1); - } + if (l != null_) + { + assert_and_assign_real_pointer (l, &x.sa); + if (x.smld->dtype != listmain) + { + l = null_; + goto _L99; + } + } + first (a2, &p1); + while (p1.nel != 0) + { + lconc (&l, p1.cel); + next (&p1); + } _L99: *a1 = l; -} /* concop */ +} /* concop */ -Void copyop() +void +copyop () { /*======================*/ /* v[base -1] */ @@ -1351,100 +1415,106 @@ Void copyop() a r1, r2, r3; - getval(&v[base - 2]); + getval (&v[base - 2]); if (v[base - 2] == null_) goto _L99; - pointr(v[base - 2], &x.sa); - switch (x.sad->dtype) { - - case atom: - case idatom: - case keyword: - case number: - case tatom: - case fatom: - case variable: - case idvariable: - case nvariable: - case fvariable: - case spec: /* coord removed */ - gets1(&r1, &y.sa); - *y.sad = *x.sad; - v[base - 2] = r1; - break; - - case rulename: - case object_d: - gets2(&r1, &y.sa); - *y.srd = *x.srd; - v[base - 2] = r1; - break; - - case listmain: - case treemain: - gets5(&r1, &y.sa); - /* skopirowatx glawnyj deskriptor */ - *y.smld = *x.smld; - v[base - 2] = r1; - r2 = x.smld->next; - while (r2 != null_) { - pointr(r2, &x.sa); - gets5(&r3, &z.sa); - *z.smld = *x.smld; - points(r1, &y.sa); - y.smld->next = r3; - r1 = r3; - r2 = z.smld->next; - } /* while */ - break; - - }/* case */ -_L99: ; /* wyhod */ -} /* copyop */ - - -Void epilog() + assert_and_assign_real_pointer (v[base - 2], &x.sa); + switch (x.sad->dtype) + { + + case atom: + case idatom: + case keyword: + case number: + case tatom: + case fatom: + case variable: + case idvariable: + case nvariable: + case fvariable: + case spec: /* coord removed */ + gets1 (&r1, &y.sa); + *y.sad = *x.sad; + v[base - 2] = r1; + break; + + case rulename: + case object_d: + gets2 (&r1, &y.sa); + *y.srd = *x.srd; + v[base - 2] = r1; + break; + + case listmain: + case treemain: + gets5 (&r1, &y.sa); + /* skopirowatx glawnyj deskriptor */ + *y.smld = *x.smld; + v[base - 2] = r1; + r2 = x.smld->next; + while (r2 != null_) + { + assert_and_assign_real_pointer (r2, &x.sa); + gets5 (&r3, &z.sa); + *z.smld = *x.smld; + assert_and_assign_real_pointer (r1, &y.sa); + y.smld->next = r3; + r1 = r3; + r2 = z.smld->next; + } /* while */ + break; + + } /* case */ +_L99:; /* wyhod */ +} /* copyop */ + + +void +epilog () { long iii; longint dr, dw, dp; - for (iii = 0; iii < filenum; iii++) { - if (filetab[iii].isopen) { - if (filetab[iii].screen) - putchar('\n'); - else { - putc('\n', files[iii]); - if (files[iii] != NULL) - fclose(files[iii]); - files[iii] = NULL; - } + for (iii = 0; iii < filenum; iii++) + { + if (filetab[iii].isopen) + { + if (filetab[iii].screen) + putchar ('\n'); + else + { + putc ('\n', files[iii]); + if (files[iii] != NULL) + fclose (files[iii]); + files[iii] = NULL; + } + } } - } - printf("\n========== End of execution ==========\n"); - vola(&dr, &dw, &dp); + printf ("\n========== End of execution ==========\n"); + vola (&dr, &dw, &dp); if (dr + dw + dp > 0) - printf("A-Space:%12ld/%12ld/%12ld pages \n", dr, dw, dp); - vols(&dr, &dw, &dp); + printf ("A-Space:%12ld/%12ld/%12ld pages \n", dr, dw, dp); + vols (&dr, &dw, &dp); if (dr + dw + dp > 0) - printf("S-Space :%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); - if (out_open) { - if (out != NULL) - fclose(out); - out = NULL; - } + printf ("S-Space :%12ld reads %12ld writes %12ld pages \n", dr, dw, dp); + if (out_open) + { + if (out != NULL) + fclose (out); + out = NULL; + } - closea(); - closes(); -} /* epilog */ +} /* epilog */ -Void eqop(o) -long o; +void +eqop (o) + long o; { /* cequ(=), cnequ(<>) */ /*====================================*/ @@ -1453,23 +1523,24 @@ long o; /* a1 a2 */ /* wyhod: t / null oswob. */ /*====================================*/ - boolean rez; + bool rez; - getval(&v[base - 3]); - getval(&v[base - 2]); - eqop1(o, v[base - 3], v[base - 2], &rez); - if ( (rez && (o == cequ) ) || ( !rez && (o == cnequ) ) ) + getval (&v[base - 3]); + getval (&v[base - 2]); + eqop1 (o, v[base - 3], v[base - 2], &rez); + if ((rez && (o == cequ)) || (!rez && (o == cnequ))) v[base - 3] = atomt; else - v[base - 3] = null_; + v[base - 3] = null_; base--; -} /* eqop */ +} /* eqop */ -Void eqop1(o, a1, a2, rez1) -long o, a1, a2; -boolean *rez1; +void +eqop1 (o, a1, a2, rez1) + long o, a1, a2; + bool *rez1; { /* cequ(=), cnequ(<>) */ /*====================================*/ @@ -1480,262 +1551,297 @@ boolean *rez1; /*wyhod */ mpd x, y; - boolean rez; + bool 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 && + if (a2 == null_) + { + if (a1 == null_) + goto _L1; + else + { + assert_and_assign_real_pointer (a1, &x.sa); + rez = (((1L << ((long) x.smld->dtype)) & + ((1L << ((long) listmain)) | (1L << ((long) treemain)))) != + 0 && x.smld->totalelnum == 0); + goto _L1; + } + } /* a2 =null */ + /* oba ne null */ + + assert_and_assign_real_pointer (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; } - } /* a2 =null */ - /* oba ne null */ + assert_and_assign_real_pointer (a1, &y.sa); + switch (x.smld->dtype) + { - 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); - 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: - /* added 20-jul-1989 in pc/at, changed 3-oct sign */ - rez = (y.snd->dtype == number && x.snd->val == y.snd->val); - break; - - - - case atom: - case idatom: - case keyword: - case tatom: - rez = (((1L << ((long)y.sad->dtype)) & (((1L << ((long)keyword + 1)) - - (1L << ((long)atom))) | (1L << ((long)tatom)))) != 0 && - x.sad->name == y.sad->name); - break; - - case fatom: - rez = (y.sad->dtype == fatom && 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) { - eqop1(o, px.cel, py.cel, &rez); - 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 - eqop1(o, px.cel, py.cel, &rez); - next(&px); - } /* while */ - } - break; - }/* case */ + 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: + /* added 20-jul-1989 in pc/at, changed 3-oct sign */ + rez = (y.snd->dtype == number && x.snd->val == y.snd->val); + break; + + + + case atom: + case idatom: + case keyword: + case tatom: + rez = (((1L << ((long) y.sad->dtype)) & (((1L << ((long) keyword + 1)) - + (1L << ((long) atom))) | (1L + << + ((long) tatom)))) != 0 && x.sad->name == y.sad->name); + break; + + case fatom: + rez = (y.sad->dtype == fatom && 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) + { + eqop1 (o, px.cel, py.cel, &rez); + 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 + eqop1 (o, px.cel, py.cel, &rez); + next (&px); + } /* while */ + } + break; + } /* case */ _L1: *rez1 = rez; /* a2 <>null */ -} /* eqop */ +} /* eqop */ -Void explode(kk, rez) -long kk, *rez; +void +explode (kk, rez) + long kk, *rez; { /*=====================================*/ /* sozdaet spisok odnobukwennyh atomow */ /*=====================================*/ a s, k; mpd x; - longint l; /* changed fron integer 17-nov-90 */ + longint l; /* changed fron integer 17-nov-90 */ string80 str_val; - Char STR1[256]; + char STR1[256]; long FORLIM; *rez = null_; if (kk == null_) goto _L99; - pointr(kk, &x.sa); - switch (x.sad->dtype) { + assert_and_assign_real_pointer (kk, &x.sa); + switch (x.sad->dtype) + { - case fatom: /* added 17-feb-92 */ - real_to_string(str_val, take_fatom(x.sad->name)); - break; + case fatom: /* added 17-feb-92 */ + real_to_string (str_val, take_fatom (x.sad->name)); + break; - case number: - long_to_str(str_val, x.snd->val); - break; + case number: + long_to_str (str_val, x.snd->val); + break; - case 5: - case 6: - case 7: - case tatom: - aa_str(str_val, x.sad->name); - break; + case 5: + case 6: + case 7: + case tatom: + aa_str (str_val, x.sad->name); + break; - default: - goto _L99; - break; - }/* case */ + default: + goto _L99; + break; + } /* case */ /* w m sformirowan massiw simwolow */ - s = null_; /* rez.spisok */ - FORLIM = strlen(str_val); - for (l = 0; l < FORLIM; l++) { - sprintf(STR1, "%c", str_val[l]); - k = str_to_textatom(STR1); - lconc(&s, k); - } /* for */ + s = null_; /* rez.spisok */ + FORLIM = strlen (str_val); + for (l = 0; l < FORLIM; l++) + { + sprintf (STR1, "%c", str_val[l]); + k = str_to_textatom (STR1); + lconc (&s, k); + } /* for */ *rez = s; -_L99: ; -} /* explode */ +_L99:; +} /* explode */ -#define max_digit 10 /* maximum for longint type */ +#define max_digit 10 /* maximum for longint type */ -/* Local variables for implode: */ -struct LOC_implode { +/* static variables for implode: */ +struct LOC_implode +{ bl80 m, m1; mpd x; a k; - long p1; /* posledn.zanqtyj |l-t w m1 */ + long p1; /* posledn.zanqtyj |l-t w m1 */ string80 str_val; -} ; +}; -Local Void pass(pl, LINK) -ptr_ *pl; -struct LOC_implode *LINK; +static void +pass (pl, LINK) + ptr_ *pl; + struct LOC_implode *LINK; { ptr_ pl1; long t, l; - while (pl->nel != 0) { - LINK->k = pl->cel; - if (LINK->k != null_) { - pointr(LINK->k, &LINK->x.sa); - if (LINK->x.smld->dtype == listmain) { - first(LINK->k, &pl1); /*, st */ - pass(&pl1, LINK); - } else { /* not list */ - if (((1L << ((long)LINK->x.sad->dtype)) & - ((1L << ((long)fatom + 1)) - (1L << ((long)atom)))) == 0) - goto _L99; - - if (LINK->x.sad->dtype == fatom) { /* added 17-feb-92 */ - real_to_string(LINK->str_val, take_fatom(LINK->x.sad->name)); - l = strlen(LINK->str_val); - if (LINK->p1 + l > 80) { - err(25L); - goto _L99; - } - for (t = 0; t < l; t++) - LINK->m1[LINK->p1 + t] = LINK->str_val[t]; - LINK->p1 += l; - } else { - if (((1L << ((long)LINK->x.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)tatom)))) != 0) { - /* wzqtx atom iz a-prostranstwa w m */ - LINK->k = LINK->x.sad->name; - pointa(LINK->k, LINK->m, &l); /* [1] ibm/pc */ - if (LINK->p1 + l > 80) { - err(25L); - goto _L99; + while (pl->nel != 0) + { + LINK->k = pl->cel; + if (LINK->k != null_) + { + assert_and_assign_real_pointer (LINK->k, &LINK->x.sa); + if (LINK->x.smld->dtype == listmain) + { + first (LINK->k, &pl1); /*, st */ + pass (&pl1, LINK); } - for (t = 0; t < l; t++) - LINK->m1[LINK->p1 + t] = LINK->m[t]; - LINK->p1 += l; - } else { /* number */ + else + { /* not list */ + if (((1L << ((long) LINK->x.sad->dtype)) & + ((1L << ((long) fatom + 1)) - (1L << ((long) atom)))) == 0) + goto _L99; + + if (LINK->x.sad->dtype == fatom) + { /* added 17-feb-92 */ + real_to_string (LINK->str_val, + take_fatom (LINK->x.sad->name)); + l = strlen (LINK->str_val); + if (LINK->p1 + l > 80) + { + err (25L); + goto _L99; + } + for (t = 0; t < l; t++) + LINK->m1[LINK->p1 + t] = LINK->str_val[t]; + LINK->p1 += l; + } + else + { + if (((1L << ((long) LINK->x.sad->dtype)) & + (((1L << ((long) keyword + 1)) - + (1L << ((long) atom))) | (1L << ((long) tatom)))) != + 0) + { + /* wzqtx atom iz a-prostranstwa w m */ + LINK->k = LINK->x.sad->name; + get_data_from_pointa (LINK->k, LINK->m, &l); /* [1] ibm/pc */ + if (LINK->p1 + l > 80) + { + err (25L); + goto _L99; + } + for (t = 0; t < l; t++) + LINK->m1[LINK->p1 + t] = LINK->m[t]; + LINK->p1 += l; + } + else + { /* number */ /*==============================*/ - /* perewesti ~islo w simwoly i */ - /* pomestitx w m [1..max_digit] */ + /* perewesti ~islo w simwoly i */ + /* pomestitx w m [1..max_digit] */ /*==============================*/ - LINK->k = LINK->x.snd->val; - if (LINK->k < 0) /* changed from abs call */ - LINK->k = -LINK->k; - for (t = max_digit - 1; t >= 0; t--) { - l = LINK->k % 10; + LINK->k = LINK->x.snd->val; + if (LINK->k < 0) /* changed from abs call */ + LINK->k = -LINK->k; + for (t = max_digit - 1; t >= 0; t--) + { + l = LINK->k % 10; /* p2c: erm.z, line 1925: * Note: Using % for possibly-negative arguments [317] */ - LINK->k /= 10; - LINK->m[t] = (Char)(l + '0'); - } - t = 1; - while (t < max_digit && LINK->m[t - 1] == '0') - t++; - if (LINK->x.snd->val < 0) { - if (LINK->p1 == 80) { - err(25L); - goto _L99; - } - LINK->p1++; - LINK->m1[LINK->p1 - 1] = '-'; - } - if (LINK->p1 + max_digit - t > 79) { - err(25L); - goto _L99; - } - for (l = t - 1; l < max_digit; l++) { - LINK->p1++; - LINK->m1[LINK->p1 - 1] = LINK->m[l]; - } - } /* number */ - } - } /* not list */ - } /* k<> null */ - next(pl); - } /* while */ -_L99: ; - - -} /* pass */ - - -Void implode(pl, rez) -ptr_ *pl; -long *rez; + LINK->k /= 10; + LINK->m[t] = (char) (l + '0'); + } + t = 1; + while (t < max_digit && LINK->m[t - 1] == '0') + t++; + if (LINK->x.snd->val < 0) + { + if (LINK->p1 == 80) + { + err (25L); + goto _L99; + } + LINK->p1++; + LINK->m1[LINK->p1 - 1] = '-'; + } + if (LINK->p1 + max_digit - t > 79) + { + err (25L); + goto _L99; + } + for (l = t - 1; l < max_digit; l++) + { + LINK->p1++; + LINK->m1[LINK->p1 - 1] = LINK->m[l]; + } + } /* number */ + } + } /* not list */ + } /* k<> null */ + next (pl); + } /* while */ +_L99:; + + +} /* pass */ + + +void +implode (pl, rez) + ptr_ *pl; + long *rez; { /* 1-j argument */ /*======================================*/ @@ -1745,25 +1851,26 @@ long *rez; struct LOC_implode V; longint l; /* rab. */ - /* change from integer 17-nov-90*/ - boolean id; + /* change from integer 17-nov-90 */ + bool id; long FORLIM; atomdescriptor *WITH; V.p1 = 0; - pass(pl, &V); - if (V.p1 == 0) { - *rez = null_; - return; - } - putatm(V.m1, V.p1, &V.k); - id = is_rig_letter(V.m1[0]); + pass (pl, &V); + if (V.p1 == 0) + { + *rez = null_; + return; + } + putatm (V.m1, V.p1, &V.k); + id = is_rig_letter (V.m1[0]); FORLIM = V.p1; for (l = 0; l < FORLIM; l++) - id &= is_rig_symbol(V.m1[l]); + id &= is_rig_symbol (V.m1[l]); l = 1; - gets1(rez, &V.x.sa); + gets1 (rez, &V.x.sa); WITH = V.x.sad; if (id) WITH->dtype = idatom; @@ -1778,7 +1885,8 @@ long *rez; #undef max_digit -Void indxop() +void +indxop () { /*==============================================*/ /* whod: v[base-2] v[base-1] */ @@ -1794,74 +1902,82 @@ Void indxop() mpd x, y, z; long k, n; a r, t; - boolean wasobject, mainlist; + bool wasobject, mainlist; objdescriptor *WITH; - getval(&v[base - 2]); - if (v[base - 2] == null_) { - err(5L); - v[base - 3] = null_; - goto _L1; - } + getval (&v[base - 2]); + if (v[base - 2] == null_) + { + err (5L); + v[base - 3] = null_; + goto _L1; + } /* proweritx, ~to x -~islo */ - pointr(v[base - 2], &x.sa); - if (x.snd->dtype != number) { - err(3L); - v[base - 3] = null_; - goto _L1; - } + assert_and_assign_real_pointer (v[base - 2], &x.sa); + if (x.snd->dtype != number) + { + err (3L); + v[base - 3] = null_; + goto _L1; + } n = x.snd->val; - /* delete sign proc.*/ + /* delete sign proc. */ wasobject = false; - getval(&v[base - 3]); - if (v[base - 3] == null_) /* rezulxtat= null */ + getval (&v[base - 3]); + if (v[base - 3] == null_) /* rezulxtat= null */ goto _L1; /* opredelitx tip l */ - pointr(v[base - 3], &z.sa); + assert_and_assign_real_pointer (v[base - 3], &z.sa); if (z.smld->dtype == listmain) y = z; - else { - if (z.smld->dtype != object_d) { - err(4L); - v[base - 3] = null_; - goto _L1; - } - wasobject = true; - if (z.sobj->variable_) - t = v[z.sobj->fragmorvar - 1]; - else { - t = z.sobj->fragmorvar; - pointr(t, &x.sa); - switch (x.smld->dtype) { - - case listmain: - case listfragm: - t = x.sfld->elt[z.sobj->nel - 1]; - break; - - /* ****** very strange ******* */ - case treemain: - t = x.smtd->arc[z.sobj->nel - 1].elt; - break; - - case treefragm: - t = x.sftd->arc[z.sobj->nel - 1].elt; - break; - }/* case */ - } - /* t ukazywaet na glawn. deskriptor spiska */ - if (t == null_) { - v[base - 3] = null_; - goto _L1; - } - pointr(t, &y.sa); - if (y.smld->dtype != listmain) { - err(4L); - v[base - 3] = null_; - goto _L1; - } - } /* object */ + else + { + if (z.smld->dtype != object_d) + { + err (4L); + v[base - 3] = null_; + goto _L1; + } + wasobject = true; + if (z.sobj->variable_) + t = v[z.sobj->fragmorvar - 1]; + else + { + t = z.sobj->fragmorvar; + assert_and_assign_real_pointer (t, &x.sa); + switch (x.smld->dtype) + { + + case listmain: + case listfragm: + t = x.sfld->elt[z.sobj->nel - 1]; + break; + + /* ****** very strange ******* */ + case treemain: + t = x.smtd->arc[z.sobj->nel - 1].elt; + break; + + case treefragm: + t = x.sftd->arc[z.sobj->nel - 1].elt; + break; + } /* case */ + } + /* t ukazywaet na glawn. deskriptor spiska */ + if (t == null_) + { + v[base - 3] = null_; + goto _L1; + } + assert_and_assign_real_pointer (t, &y.sa); + if (y.smld->dtype != listmain) + { + err (4L); + v[base - 3] = null_; + goto _L1; + } + } /* object */ /*============================================*/ /* y ukazywaet na deskriptor glawnogo spiska */ /* z - na object, esli takoj byl */ @@ -1870,51 +1986,58 @@ Void indxop() k = y.smld->totalelnum; if (n < 0) n += k + 1; - if (n < 1 || n > k) { - err(5L); - /* indeks wne spiska */ - v[base - 3] = null_; - goto _L1; - } + if (n < 1 || n > k) + { + err (5L); + /* indeks wne spiska */ + v[base - 3] = null_; + goto _L1; + } /*================================*/ /* poisk |l-ta spiska */ /*================================*/ - if (n <= y.smld->elnum) { - mainlist = true; - r = y.smld->elt[n - 1]; - } else { - mainlist = false; - n -= y.smld->elnum; - t = y.smld->next; - pointr(t, &y.sa); - while (n > y.sfld->elnum) { - n -= y.sfld->elnum; - t = y.sfld->next; - pointr(t, &y.sa); + if (n <= y.smld->elnum) + { + mainlist = true; + r = y.smld->elt[n - 1]; + } + else + { + mainlist = false; + n -= y.smld->elnum; + t = y.smld->next; + assert_and_assign_real_pointer (t, &y.sa); + while (n > y.sfld->elnum) + { + n -= y.sfld->elnum; + t = y.sfld->next; + assert_and_assign_real_pointer (t, &y.sa); + } + r = y.sfld->elt[n - 1]; } - r = y.sfld->elt[n - 1]; - } /* w r rezulxtat = l [ x ] */ - if (wasobject) { - points(v[base - 3], &z.sa); - WITH = z.sobj; - WITH->variable_ = false; - if (mainlist) - WITH->nel = n + 2; - else - WITH->nel = n; - WITH->fragmorvar = t; /* with */ - } /* wasobject */ + if (wasobject) + { + assert_and_assign_real_pointer (v[base - 3], &z.sa); + WITH = z.sobj; + WITH->variable_ = false; + if (mainlist) + WITH->nel = n + 2; + else + WITH->nel = n; + WITH->fragmorvar = t; /* with */ + } /* wasobject */ else v[base - 3] = r; _L1: base--; /* o{ibka */ -} /* indxop */ +} /* indxop */ -Void nameop() +void +nameop () { /*================================================*/ /* operaciq a :: l */ @@ -1928,34 +2051,38 @@ Void nameop() mpd x, y; - getval(&v[base - 2]); - if (v[base - 2] == null_) { - v[base - 3] = null_; - goto _L1; - } - getval(&v[base - 3]); + getval (&v[base - 2]); + if (v[base - 2] == null_) + { + v[base - 3] = null_; + goto _L1; + } + getval (&v[base - 3]); /* if v[base - 2] = null then goto 1; */ /* deleted 23-1-1992 for null::<.a:b.> <> null */ - if ((v[base - 3] & 511) != 0 || v[base - 3] >= 65536L || v[base - 3] < 0) { - pointr(v[base - 3], &y.sa); - /* dostup k atomu */ - if (((1L << ((long)y.sad->dtype)) & - (((1L << ((long)fatom + 1)) - (1L << ((long)atom))) | - (1L << ((long)spec)))) == 0) { - err(7L); + if ((v[base - 3] & 511) != 0 || v[base - 3] >= 65536L || v[base - 3] < 0) + { + assert_and_assign_real_pointer (v[base - 3], &y.sa); + /* dostup k atomu */ + if (((1L << ((long) y.sad->dtype)) & + (((1L << ((long) fatom + 1)) - (1L << ((long) atom))) | + (1L << ((long) spec)))) == 0) + { + err (7L); + v[base - 3] = null_; + goto _L1; + } + } + assert_and_assign_real_pointer (v[base - 2], &x.sa); + /* polu~itx deskriptor spiska (derewa) */ + if (((1L << ((long) x.smld->dtype)) & + ((1L << ((long) listmain)) | (1L << ((long) treemain)))) == 0) + { + err (6L); v[base - 3] = null_; goto _L1; } - } - points(v[base - 2], &x.sa); - /* polu~itx deskriptor spiska (derewa) */ - if (((1L << ((long)x.smld->dtype)) & - ((1L << ((long)listmain)) | (1L << ((long)treemain)))) == 0) { - err(6L); - v[base - 3] = null_; - goto _L1; - } x.smld->name = v[base - 3]; v[base - 3] = v[base - 2]; _L1: @@ -1963,18 +2090,19 @@ _L1: } -Void prolog(y, debug, code) -ptr_ *y; -boolean debug; -long code; +void +prolog (y, debug, code) + ptr_ *y; + bool debug; + long code; { /*===============*/ /* inicializaciq */ /*===============*/ - long k1; + long k1; mpd x; long iii; - Char m[10]; + char m[10]; a rez, s; atomdescriptor *WITH; @@ -1988,8 +2116,8 @@ long code; /* sozdatx atom t */ m[0] = 'T'; k1 = 1; - putatm(m, k1, &s); - gets1(&atomt, &x.sa); + putatm (m, k1, &s); + gets1 (&atomt, &x.sa); WITH = x.sad; WITH->dtype = idatom; WITH->name = s; @@ -2002,8 +2130,8 @@ long code; m[3] = 'E'; m[4] = 'S'; k1 = 5; - putatm(m, k1, &s); - gets1(&atomrules, &x.sa); + putatm (m, k1, &s); + gets1 (&atomrules, &x.sa); WITH = x.sad; WITH->dtype = idatom; WITH->name = s; @@ -2018,8 +2146,8 @@ long code; m[5] = 'E'; m[6] = 'S'; k1 = 7; - putatm(m, k1, &s); - gets1(&atomnorules, &x.sa); + putatm (m, k1, &s); + gets1 (&atomnorules, &x.sa); WITH = x.sad; WITH->dtype = idatom; WITH->name = s; @@ -2027,28 +2155,28 @@ long code; base++; /* wojti w s-kod rigal */ - first(vs[0], y); - next(y); /* mybase */ + first (vs[0], y); + next (y); /* mybase */ rez = y->cel; - points(rez, &x.sa); + assert_and_assign_real_pointer (rez, &x.sa); mybase = base - 1; x.snd->val = mybase; - next(y); /* ~islo lok.peremennyh */ + next (y); /* ~islo lok.peremennyh */ rez = y->cel; - pointr(rez, &x.sa); + assert_and_assign_real_pointer (rez, &x.sa); base += x.snd->val + 1; /* inicializaciq lok.per. glawn.progr. */ for (iii = mybase; iii < varnum; iii++) v[iii] = null_; - next(y); + next (y); fail = false; break_ = false; continue_ = true; teklexem = null_; - printf("=========Start of execution ==========\n"); + printf ("=========Start of execution ==========\n"); -} /* prolog */ +} /* prolog */ @@ -2059,7 +2187,8 @@ long code; -Void selctr() +void +selctr () { /*==============================================*/ /* whod: v[ base -2 ] v[ base -1 ] */ @@ -2071,136 +2200,149 @@ Void selctr() /* wyhod */ mpd x, y, z; - a n; /* imq selektora */ - a t, glavnder; /* s-adr.glawn.derewa */ + a n; /* imq selektora */ + a t, glavnder; /* s-adr.glawn.derewa */ long ai, i; - boolean wasobject; + bool wasobject; maintreedescriptor *WITH; long FORLIM; fragmtreedescriptor *WITH1; objdescriptor *WITH2; - t=0; - getval(&v[base - 2]); - if (v[base - 2] == null_) { - err(21L); - v[base - 3] = null_; - goto _L1; - } + + getval (&v[base - 2]); + if (v[base - 2] == null_) + { + err (21L); + v[base - 3] = null_; + goto _L1; + } /* prowerim, ~to x -ne~islowoj atom */ - pointr(v[base - 2], &x.sa); - if (x.sad->dtype != idatom) { - err(22L); - v[base - 3] = null_; - goto _L1; - } + assert_and_assign_real_pointer (v[base - 2], &x.sa); + if (x.sad->dtype != idatom) + { + err (22L); + v[base - 3] = null_; + goto _L1; + } n = x.sad->name; wasobject = false; - getval(&v[base - 3]); + getval (&v[base - 3]); if (v[base - 3] == null_) goto _L1; /* rezulxtat =null */ /* opredelitx tip t */ - pointr(v[base - 3], &z.sa); - if ( z.smtd->dtype == treemain ) y = z; - else - { - if (z.smtd->dtype != object_d) + assert_and_assign_real_pointer (v[base - 3], &z.sa); + if (z.smtd->dtype == treemain) + y = z; + else { - err(23L); - v[base - 3] = null_; - goto _L1; - } - - wasobject = true; - if (z.sobj->variable_) t = v[z.sobj->fragmorvar - 1]; - else - { - t = z.sobj->fragmorvar; - pointr(t, &x.sa); - switch (x.smld->dtype) { - - case listmain: - case listfragm: - t = x.sfld->elt[z.sobj->nel - 1]; - break; - - case treemain: - t = x.smtd->arc[z.sobj->nel - 1].elt; - break; - - case treefragm: - t = x.sftd->arc[z.sobj->nel - 1].elt; - break; - }/* case */ - } - if (t == null_) { - v[base - 3] = null_; - goto _L1; - } - /* added 20-jul-1989 in pc/at from 10-jul-89 on vax */ + if (z.smtd->dtype != object_d) + { + err (23L); + v[base - 3] = null_; + goto _L1; + } - pointr(t, &y.sa); - if (y.smtd->dtype != treemain) { - err(23L); - v[base - 3] = null_; - goto _L1; + wasobject = true; + if (z.sobj->variable_) + t = v[z.sobj->fragmorvar - 1]; + else + { + t = z.sobj->fragmorvar; + assert_and_assign_real_pointer (t, &x.sa); + switch (x.smld->dtype) + { + + case listmain: + case listfragm: + t = x.sfld->elt[z.sobj->nel - 1]; + break; + + case treemain: + t = x.smtd->arc[z.sobj->nel - 1].elt; + break; + + case treefragm: + t = x.sftd->arc[z.sobj->nel - 1].elt; + break; + } /* case */ + } + if (t == null_) + { + v[base - 3] = null_; + goto _L1; + } + /* added 20-jul-1989 in pc/at from 10-jul-89 on vax */ + + assert_and_assign_real_pointer (t, &y.sa); + if (y.smtd->dtype != treemain) + { + err (23L); + v[base - 3] = null_; + goto _L1; + } } - } /*=====================================*/ /* y ukazywaet na glawn.deskr. derewa */ /* z na object, esli takoj byl */ /* t na deskr.glawn. derewa */ /*=====================================*/ - glavnder = t; /* sna~ala w glawnom derewe */ + glavnder = t; /* sna~ala w glawnom derewe */ /* wy~islenie y.x */ /* poisk selektora n w derewe y */ - WITH = y.smtd; /* with */ + WITH = y.smtd; /* with */ FORLIM = WITH->arcnum; - for (i = 1; i <= FORLIM; i++) { - if (WITH->arc[i - 1].arcname == n) { /* na{li */ - ai = i; - n = WITH->arc[i - 1].elt; - goto _L2; + for (i = 1; i <= FORLIM; i++) + { + if (WITH->arc[i - 1].arcname == n) + { /* na{li */ + ai = i; + n = WITH->arc[i - 1].elt; + goto _L2; + } } - } t = WITH->next; /* prodolvaem poisk w fragmentah */ - while (t != null_) { - pointr(t, &y.sa); - WITH1 = y.sftd; - FORLIM = WITH1->arcnum; - for (i = 1; i <= FORLIM; i++) { - if (WITH1->arc[i - 1].arcname == n) { /* na{li */ - ai = i; - n = WITH1->arc[i - 1].elt; - goto _L2; - } - } - t = WITH1->next; /* with */ - } /* while */ + while (t != null_) + { + assert_and_assign_real_pointer (t, &y.sa); + WITH1 = y.sftd; + FORLIM = WITH1->arcnum; + for (i = 1; i <= FORLIM; i++) + { + if (WITH1->arc[i - 1].arcname == n) + { /* na{li */ + ai = i; + n = WITH1->arc[i - 1].elt; + goto _L2; + } + } + t = WITH1->next; /* with */ + } /* while */ /* ne na{li ! */ v[base - 3] = null_; goto _L1; -_L2: /* na{li */ +_L2: /* na{li */ /*==============================*/ /* w n -rezulxtat t.x */ /* w ai -nomer w arc[...] */ /* w t -s-ssylka na fragment */ /*==============================*/ - if (wasobject) { - points(v[base - 3], &z.sa); - WITH2 = z.sobj; - WITH2->variable_ = false; - WITH2->nel = ai; - WITH2->fragmorvar = t; - WITH2->glavn = glavnder; - /* with */ - } /* wasobject */ + if (wasobject) + { + assert_and_assign_real_pointer (v[base - 3], &z.sa); + WITH2 = z.sobj; + WITH2->variable_ = false; + WITH2->nel = ai; + WITH2->fragmorvar = t; + WITH2->glavn = glavnder; + /* with */ + } /* wasobject */ else v[base - 3] = n; _L1: @@ -2208,31 +2350,34 @@ _L1: /* t ukazywaet na glawn.deskriptor derewa */ /* o{ibka */ -} /* selctr */ +} /* selctr */ -Void int11(debug, code) -boolean debug; -long code; +void +int11 (debug, code) + bool debug; + long code; { ptr_ y; - boolean success; + bool success; a rez; /* inicializaciq */ - prolog(&y, debug, code); + prolog (&y, debug, code); /* osnownoj cikl */ success = true; - while (y.cel != null_ && continue_) { - statement(y.cel, &success, &rez); - next(&y); - } - epilog(); + while (y.cel != null_ && continue_) + { + statement (y.cel, &success, &rez); + next (&y); + } + epilog (); } -Void push() +void +push () { /*========================================*/ /* zanqtx w steke peremennu`, nomer */ @@ -2240,12 +2385,17 @@ Void push() /*========================================*/ base++; if (base > varnum) - {err(1L); epilog();exit(1); } /* VADIM CHANGED 8/6/95, MA added argument 1 to exit() */ + { + err (1L); + epilog (); + exit (1); + } /* VADIM CHANGED 8/6/95, MA added argument 1 to exit() */ } -Void pratom(aa_) -long aa_; +void +pratom (aa_) + long aa_; { /* pe~atx atoma */ bl80 m; @@ -2253,152 +2403,156 @@ long aa_; a k; k = aa_; - pointa(k, m, &l); /* ibm/pc [1] */ - for (s = 0; s < l; s++) { - if (out_screen) - putchar(m[s]); - else - putc(m[s], out); - } -} /* pratom */ - - -Void prblt(nn) -long nn; + get_data_from_pointa (k, m, &l); /* ibm/pc [1] */ + for (s = 0; s < l; s++) + { + if (out_screen) + putchar (m[s]); + else + putc (m[s], out); + } +} /* pratom */ + + +void +prblt (nn) + long nn; { /* adres nom.wstr.prawila */ mpd x; long bn; string80 rn; - pointr(nn, &x.sa); + assert_and_assign_real_pointer (nn, &x.sa); bn = x.snd->val; - switch (bn) { + switch (bn) + { - case 1: - strcpy(rn, "#IMPLODE"); - break; + case 1: + strcpy (rn, "#IMPLODE"); + break; - case 2: - strcpy(rn, "#EXPLODE"); - break; + case 2: + strcpy (rn, "#EXPLODE"); + break; - case 3: - strcpy(rn, "#ATOM"); - break; + case 3: + strcpy (rn, "#ATOM"); + break; - case 4: - strcpy(rn, "#NUMBER"); - break; + case 4: + strcpy (rn, "#NUMBER"); + break; - case 5: - strcpy(rn, "#IDENT"); - break; + case 5: + strcpy (rn, "#IDENT"); + break; - case 6: - strcpy(rn, "#LIST"); - break; + case 6: + strcpy (rn, "#LIST"); + break; - case 7: - strcpy(rn, "#TREE"); - break; + case 7: + strcpy (rn, "#TREE"); + break; - case 8: - strcpy(rn, "#TATOM"); - break; + case 8: + strcpy (rn, "#TATOM"); + break; - case 9: - strcpy(rn, "#FATOM"); - break; + case 9: + strcpy (rn, "#FATOM"); + break; - case 10: - strcpy(rn, "#_KEYWORD"); - break; + case 10: + strcpy (rn, "#_KEYWORD"); + break; - case 11: - strcpy(rn, "#_SPECDESC"); - break; + case 11: + strcpy (rn, "#_SPECDESC"); + break; - case 12: - strcpy(rn, "#LEN"); - break; + case 12: + strcpy (rn, "#LEN"); + break; - case 13: - strcpy(rn, "#_SPECATOM"); - break; + case 13: + strcpy (rn, "#_SPECATOM"); + break; - case 14: - strcpy(rn, "#_RULENAME"); - break; + case 14: + strcpy (rn, "#_RULENAME"); + break; - case 15: - strcpy(rn, "#_VARNAME"); - break; + case 15: + strcpy (rn, "#_VARNAME"); + break; - case 16: - strcpy(rn, "#_RULETOATOM"); - break; + case 16: + strcpy (rn, "#_RULETOATOM"); + break; - case 17: - strcpy(rn, "#_VARNTOATOM"); - break; + case 17: + strcpy (rn, "#_VARNTOATOM"); + break; - case 18: - strcpy(rn, "#_VARDESLOC"); - break; + case 18: + strcpy (rn, "#_VARDESLOC"); + break; - case 19: - strcpy(rn, "#DEBUG"); - break; + case 19: + strcpy (rn, "#DEBUG"); + break; - case 20: - strcpy(rn, "#_SPECTODSC"); - break; + case 20: + strcpy (rn, "#_SPECTODSC"); + break; - case 21: - strcpy(rn, "#_CONTENT2"); - break; + case 21: + strcpy (rn, "#_CONTENT2"); + break; - case 22: - strcpy(rn, "#CHR"); - break; + case 22: + strcpy (rn, "#CHR"); + break; - case 23: - strcpy(rn, "#PARM"); - break; + case 23: + strcpy (rn, "#PARM"); + break; - case 24: - strcpy(rn, "#_TOTATOM"); - break; + case 24: + strcpy (rn, "#_TOTATOM"); + break; - case 25: - strcpy(rn, "#ORD"); - break; + case 25: + strcpy (rn, "#ORD"); + break; - case 26: - strcpy(rn, "#CALL_PAS"); - break; - }/* case */ + case 26: + strcpy (rn, "#CALL_PAS"); + break; + } /* case */ if (out_screen) - fputs(rn, stdout); + fputs (rn, stdout); else - fputs(rn, out); -} /* prblt */ + fputs (rn, out); +} /* prblt */ -Void srchrule(rd, pp) -long rd; -ptr_ *pp; +void +srchrule (rd, pp) + long rd; + ptr_ *pp; { /*=================*/ /* rd w st-prostr. */ /*=================*/ /*(rd: a; (* adres deskriptora #l * ) - (* w st-prostranstwe + (* w st-prostranstwe - var - pp: ptr (* ukaz. na sled. posle #l |l-t w spiske - programmy * ) ); */ + var + pp: ptr (* ukaz. na sled. posle #l |l-t w spiske + programmy * ) ); */ /*====================================*/ /* poisk w spiske programmy |l-ta, */ /* sled. za #l. */ @@ -2412,63 +2566,67 @@ ptr_ *pp; ruledescriptor *WITH; - pointr(rd, &x.sa); + assert_and_assign_real_pointer (rd, &x.sa); /* polu~itx deskriptor #l */ - if (x.srd->fragmadr == 0) { - /* nuven poisk w spiske programmy */ - name = x.srd->name; - v1 = x.srd->nomintab; - /* s-adres #l w sr-prostranstwe */ - first(vs[0], &y); - /* y na na~alo spiska - programmy */ - v = y.cel; - pointr(v, &z.sa); - while (z.srd->name != name) { - while (y.cel != 0) - next(&y); - next(&y); + if (x.srd->fragmadr == 0) + { + /* nuven poisk w spiske programmy */ + name = x.srd->name; + v1 = x.srd->nomintab; + /* s-adres #l w sr-prostranstwe */ + first (vs[0], &y); + /* y na na~alo spiska + programmy */ v = y.cel; - pointr(v, &z.sa); - } /* #l najden */ - next(&y); - /* y na "base prawila #l" */ - /* zapisatx informaci` w deskriptor #l */ - points(v1, &x.sa); - x.srd->fragmadr = y.UU.U1.curfragment; - x.srd->nomintab = y.nel; - } /* poisk */ - else { - /* w deskriptore #l estx ssylka na spisok - programmy*/ - v = x.srd->fragmadr; - pointr(v, &z.sa); - WITH = x.srd; - if (z.smld->dtype == listmain) - y.cel = z.smld->elt[WITH->nomintab - 1]; - else - y.cel = z.sfld->elt[WITH->nomintab - 1]; - y.ptrtype = ptrlist; - y.nel = WITH->nomintab; - y.UU.U1.curfragment = WITH->fragmadr; - } + assert_and_assign_real_pointer (v, &z.sa); + while (z.srd->name != name) + { + while (y.cel != 0) + next (&y); + next (&y); + v = y.cel; + assert_and_assign_real_pointer (v, &z.sa); + } /* #l najden */ + next (&y); + /* y na "base prawila #l" */ + /* zapisatx informaci` w deskriptor #l */ + assert_and_assign_real_pointer (v1, &x.sa); + x.srd->fragmadr = y.UU.U1.curfragment; + x.srd->nomintab = y.nel; + } /* poisk */ + else + { + /* w deskriptore #l estx ssylka na spisok + programmy */ + v = x.srd->fragmadr; + assert_and_assign_real_pointer (v, &z.sa); + WITH = x.srd; + if (z.smld->dtype == listmain) + y.cel = z.smld->elt[WITH->nomintab - 1]; + else + y.cel = z.sfld->elt[WITH->nomintab - 1]; + y.ptrtype = ptrlist; + y.nel = WITH->nomintab; + y.UU.U1.curfragment = WITH->fragmadr; + } *pp = y; -} /* srchrule */ +} /* srchrule */ -Void srchrule1(rd, pp) -long rd; -ptr_ *pp; +void +srchrule1 (rd, pp) + long rd; + ptr_ *pp; { /*=================*/ /* rd w sr-prostr. */ /*=================*/ /*(rd: a; (* adres deskriptora #l * ) - (* w sr-prostranstwe * ) + (* w sr-prostranstwe * ) var pp: ptr (* ukaz. na sled. - posle #l |l-t w spiske - programmy * ) ); - */ + posle #l |l-t w spiske + programmy * ) ); + */ /*====================================*/ /* poisk w spiske programmy |l-ta, */ /* sled. za #l. */ @@ -2482,49 +2640,53 @@ ptr_ *pp; ruledescriptor *WITH; - pointr(rd, &x.sa); + assert_and_assign_real_pointer (rd, &x.sa); /* polu~itx deskriptor #l */ - if (x.srd->fragmadr == 0) { - /* nuven poisk w spiske programmy */ - name = x.srd->name; - first(vs[0], &y); - /* y na na~alo spiska - programmy */ - v = y.cel; - pointr(v, &z.sa); - while (z.srd->name != name) { - while (y.cel != 0) - next(&y); - next(&y); + if (x.srd->fragmadr == 0) + { + /* nuven poisk w spiske programmy */ + name = x.srd->name; + first (vs[0], &y); + /* y na na~alo spiska + programmy */ v = y.cel; - pointr(v, &z.sa); - } /* #l najden */ - next(&y); - /* y na "base prawila #l" */ - /* zapisatx informaci` w deskriptor #l */ - points(rd, &x.sa); - x.srd->fragmadr = y.UU.U1.curfragment; - x.srd->nomintab = y.nel; - } /* poisk */ - else { - /* w deskriptore #l estx ssylka na spisok - programmy*/ - v = x.srd->fragmadr; - pointr(v, &z.sa); - WITH = x.srd; - if (z.smld->dtype == listmain) - y.cel = z.smld->elt[WITH->nomintab - 1]; - else - y.cel = z.sfld->elt[WITH->nomintab - 1]; - y.ptrtype = ptrlist; - y.nel = WITH->nomintab; - y.UU.U1.curfragment = WITH->fragmadr; - } + assert_and_assign_real_pointer (v, &z.sa); + while (z.srd->name != name) + { + while (y.cel != 0) + next (&y); + next (&y); + v = y.cel; + assert_and_assign_real_pointer (v, &z.sa); + } /* #l najden */ + next (&y); + /* y na "base prawila #l" */ + /* zapisatx informaci` w deskriptor #l */ + assert_and_assign_real_pointer (rd, &x.sa); + x.srd->fragmadr = y.UU.U1.curfragment; + x.srd->nomintab = y.nel; + } /* poisk */ + else + { + /* w deskriptore #l estx ssylka na spisok + programmy */ + v = x.srd->fragmadr; + assert_and_assign_real_pointer (v, &z.sa); + WITH = x.srd; + if (z.smld->dtype == listmain) + y.cel = z.smld->elt[WITH->nomintab - 1]; + else + y.cel = z.sfld->elt[WITH->nomintab - 1]; + y.ptrtype = ptrlist; + y.nel = WITH->nomintab; + y.UU.U1.curfragment = WITH->fragmadr; + } *pp = y; -} /* srchrule */ +} /* srchrule */ -Void lastop() +void +lastop () { /*================================================*/ /* whod: v[base -2] v[base -1] */ @@ -2538,173 +2700,181 @@ Void lastop() a k; - srchrule(v[base - 3], &p); - /* p ukaz. na sled.posle #l |l-t w tabl.prawil*/ + srchrule (v[base - 3], &p); + /* p ukaz. na sled.posle #l |l-t w tabl.prawil */ k = p.cel; - pointr(k, &x.sa); + assert_and_assign_real_pointer (k, &x.sa); /* polu~itx dostup k base poslednego wyzowa #l */ k = x.snd->val; - if (k >= 0) { /* change from x.snd^.sign=true 3-oct-89 */ - pointr(v[base - 2], &x.sa); - /* polu~itx dostup k deskr.$e */ - v[base - 3] = v[k + x.svd->location - 1]; - } else + if (k >= 0) + { /* change from x.snd^.sign=true 3-oct-89 */ + assert_and_assign_real_pointer (v[base - 2], &x.sa); + /* polu~itx dostup k deskr.$e */ + v[base - 3] = v[k + x.svd->location - 1]; + } + else v[base - 3] = null_; - base--; /* osw.stek */ -} /* lastop */ + base--; /* osw.stek */ +} /* lastop */ -Static Void errstrmes(n, m) -long n; -Char *m; +static void +errstrmes (n, m) + long n; + char *m; { - switch (n) { + switch (n) + { - case 1: - sprintf(m, "Interpreter stack size overflow (stack size = %d);", - varnum); - break; + case 1: + sprintf (m, "Interpreter stack size overflow (stack size = %d);", + varnum); + break; - case 2: - strcpy(m, "Assignment left side is not list or tree"); - 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 3: + strcpy (m, "List index is not number"); + break; - case 4: - strcpy(m, "Using [..] not for list"); - break; + case 4: + strcpy (m, "Using [..] not for list"); + break; - case 5: - strcpy(m, "Index value exceeds list bounds"); - break; + case 5: + strcpy (m, "Index value exceeds list bounds"); + break; - case 6: - strcpy(m, "Not list or tree after \"::\""); - break; + case 6: + strcpy (m, "Not list or tree after \"::\""); + break; - case 7: - strcpy(m, "Not atomic name before \"::\""); - break; + case 7: + strcpy (m, "Not atomic name before \"::\""); + break; - case 8: - strcpy(m, "NULL in left side of assignment"); - 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 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 10: + strcpy (m, "Not numerical value in right side of \"+:=\" statement"); + break; - case 11: - strcpy(m, "File specification is not atom"); - break; + case 11: + strcpy (m, "File specification is not atom"); + break; - case 12: - strcpy(m, "Too long file specification"); - break; + case 12: + strcpy (m, "Too long file specification"); + break; - case 13: - strcpy(m, "Too much open text files"); - break; + case 13: + strcpy (m, "Too much open text files"); + break; - case 14: - strcpy(m, "File not open for output"); - break; + case 14: + strcpy (m, "File not open for output"); + break; - case 15: - strcpy(m, "Wrong file name in SAVE statement "); - 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 16: + strcpy (m, "File was not closed before new opening"); + break; - case 17: - strcpy(m, "Atom length exceeds file record length"); - break; + case 17: + strcpy (m, "Atom length exceeds file record length"); + break; - case 18: - strcpy(m, "Not exist file in LOAD statement "); - break; + case 18: + strcpy (m, "Not exist file in LOAD statement "); + break; - case 19: - strcpy(m, "Wrong file name in OPEN statement "); - break; + case 19: + strcpy (m, "Wrong file name in OPEN statement "); + break; - case 21: - strcpy(m, "Selector after \".\" is not identifier "); - break; + case 21: + strcpy (m, "Selector after \".\" is not identifier "); + break; - case 22: - strcpy(m, "Selector in tree constructor 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 23: + strcpy (m, "Not tree before \".\" operation "); + break; - case 24: - strcpy(m, "Not tree or list as base of FORALL-IN statement "); - 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 25: + strcpy (m, "Atom length more than 80 bytes in #IMPLODE "); + break; - case 26: - strcpy(m, "\"BRANCHES\" option cannot be used for lists "); - break; + case 26: + strcpy (m, "\"BRANCHES\" option cannot be used for lists "); + break; - default: - strcpy(m, "Unknown error"); - break; - } + default: + strcpy (m, "Unknown error"); + break; + } } -Void err(n) -long n; +void +err (n) + long n; { /* kod o{ibki */ string80 m, STR1; - Char STR2[174]; + char STR2[174]; - errstrmes(n, m); - sprintf(m, "*** ERROR %s %s", long_to_str(STR1, n), strcpy(STR2, m)); + errstrmes (n, m); + sprintf (m, "*** ERROR %s %s", long_to_str (STR1, n), strcpy (STR2, m)); if (out_open) - fprintf(out, "%s\n", m); - puts(m); -} /* err */ + fprintf (out, "%s\n", m); + puts (m); +} /* err */ -Void errstr(n, s) -long n; -Char *s; +void +errstr (n, s) + long n; + char *s; { /* kod o{ibki */ string80 m, STR1; - Char STR3[254]; + char STR3[254]; - errstrmes(n, m); - sprintf(m, "*** ERROR %s %s%s", long_to_str(STR1, n), strcpy(STR3, m), s); + errstrmes (n, m); + sprintf (m, "*** ERROR %s %s%s", long_to_str (STR1, n), strcpy (STR3, m), + s); if (out_open) - fprintf(out, "%s\n", m); - puts(m); -} /* err */ + fprintf (out, "%s\n", m); + puts (m); +} /* err */ -Void getval(m) -long *m; +void +getval (m) + long *m; { /* ssylka na perem.ili obxekt */ @@ -2718,9 +2888,9 @@ long *m; if (((*m) & 511) == 0 && *m < 65535L && *m >= 0) return; - pointr(*m, &x.sa); - if (((1L << ((long)x.svd->dtype)) & - ((1L << ((long)fvariable + 1)) - (1L << ((long)variable)))) != 0 && + assert_and_assign_real_pointer (*m, &x.sa); + if (((1L << ((long) x.svd->dtype)) & + ((1L << ((long) fvariable + 1)) - (1L << ((long) variable)))) != 0 && !x.svd->guard) *m = v[mybase + x.svd->location - 1]; } diff --git a/RIGAL/rigsc.446/src/genrig/xcrg.c b/RIGAL/rigsc.446/src/genrig/xcrg.c index bbc060807f34243ec997ac751d328d94b5b58384..ea53e90fdb135c48f42675feae8840fb4c463de8 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg.c @@ -18,7 +18,7 @@ #include "def180.h" #include "xcrg.h" #include "xcrga.h" -a rez1;boolean success1;long k;mpd x; +a rez1;bool success1;long k;mpd x; v loc3;/* $SUN*/ v loc4;/* $FL*/ v loc5;/* $FN*/ @@ -38,10 +38,10 @@ v wrk9; v wrk10; ptr_ pl1; ptr_ pl2; -boolean flag1; -boolean flag2; +bool flag1; +bool flag2; main(argc, argv) -int argc;Char *argv[]; +int argc;char *argv[]; { out = NULL; g_argc=argc; g_argv=argv; prolog(argc,argv); acon(); acop(); diff --git a/RIGAL/rigsc.446/src/genrig/xcrg.h b/RIGAL/rigsc.446/src/genrig/xcrg.h index 9b0ca97c96607f4d0fe92a7c57ca4f750dc2f61b..a51c8e19955aaaa4eae023cfbf8692213470b9c1 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg.h +++ b/RIGAL/rigsc.446/src/genrig/xcrg.h @@ -1,5 +1,3 @@ -#ifndef _MONTEREYPHOENIXGENRIGXCRG_ -#define _MONTEREYPHOENIXGENRIGXCRG_ v cnst[95]; a acnst[131]; @@ -24,76 +22,75 @@ v glob24_2; v glob24_3; v glob30_1; v glob71_1; -extern Void r2 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r3 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r4 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r5 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r6 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r7 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r8 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r9 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r10 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r11 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r12 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r13 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r14 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r15 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r16 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r17 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r18 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r19 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r20 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r21 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r22 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r23 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r24 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r25 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r26 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r27 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r28 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r29 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r30 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r31 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r32 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r33 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r34 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r35 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r36 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r37 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r38 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r39 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r40 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r41 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r42 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r43 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r44 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r45 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r46 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r47 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r48 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r49 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r50 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r51 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r52 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r53 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r54 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r55 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r56 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r57 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r58 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r59 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r60 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r61 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r62 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r63 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r64 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r65 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r66 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r67 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r68 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r69 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r70 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r71 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r72 PP((long *rez, boolean *success, ptr_ *pl)); -extern Void r73 PP((long *rez, boolean *success, ptr_ *pl)); -#endif +extern void r2 PP((long *rez, bool *success, ptr_ *pl)); +extern void r3 PP((long *rez, bool *success, ptr_ *pl)); +extern void r4 PP((long *rez, bool *success, ptr_ *pl)); +extern void r5 PP((long *rez, bool *success, ptr_ *pl)); +extern void r6 PP((long *rez, bool *success, ptr_ *pl)); +extern void r7 PP((long *rez, bool *success, ptr_ *pl)); +extern void r8 PP((long *rez, bool *success, ptr_ *pl)); +extern void r9 PP((long *rez, bool *success, ptr_ *pl)); +extern void r10 PP((long *rez, bool *success, ptr_ *pl)); +extern void r11 PP((long *rez, bool *success, ptr_ *pl)); +extern void r12 PP((long *rez, bool *success, ptr_ *pl)); +extern void r13 PP((long *rez, bool *success, ptr_ *pl)); +extern void r14 PP((long *rez, bool *success, ptr_ *pl)); +extern void r15 PP((long *rez, bool *success, ptr_ *pl)); +extern void r16 PP((long *rez, bool *success, ptr_ *pl)); +extern void r17 PP((long *rez, bool *success, ptr_ *pl)); +extern void r18 PP((long *rez, bool *success, ptr_ *pl)); +extern void r19 PP((long *rez, bool *success, ptr_ *pl)); +extern void r20 PP((long *rez, bool *success, ptr_ *pl)); +extern void r21 PP((long *rez, bool *success, ptr_ *pl)); +extern void r22 PP((long *rez, bool *success, ptr_ *pl)); +extern void r23 PP((long *rez, bool *success, ptr_ *pl)); +extern void r24 PP((long *rez, bool *success, ptr_ *pl)); +extern void r25 PP((long *rez, bool *success, ptr_ *pl)); +extern void r26 PP((long *rez, bool *success, ptr_ *pl)); +extern void r27 PP((long *rez, bool *success, ptr_ *pl)); +extern void r28 PP((long *rez, bool *success, ptr_ *pl)); +extern void r29 PP((long *rez, bool *success, ptr_ *pl)); +extern void r30 PP((long *rez, bool *success, ptr_ *pl)); +extern void r31 PP((long *rez, bool *success, ptr_ *pl)); +extern void r32 PP((long *rez, bool *success, ptr_ *pl)); +extern void r33 PP((long *rez, bool *success, ptr_ *pl)); +extern void r34 PP((long *rez, bool *success, ptr_ *pl)); +extern void r35 PP((long *rez, bool *success, ptr_ *pl)); +extern void r36 PP((long *rez, bool *success, ptr_ *pl)); +extern void r37 PP((long *rez, bool *success, ptr_ *pl)); +extern void r38 PP((long *rez, bool *success, ptr_ *pl)); +extern void r39 PP((long *rez, bool *success, ptr_ *pl)); +extern void r40 PP((long *rez, bool *success, ptr_ *pl)); +extern void r41 PP((long *rez, bool *success, ptr_ *pl)); +extern void r42 PP((long *rez, bool *success, ptr_ *pl)); +extern void r43 PP((long *rez, bool *success, ptr_ *pl)); +extern void r44 PP((long *rez, bool *success, ptr_ *pl)); +extern void r45 PP((long *rez, bool *success, ptr_ *pl)); +extern void r46 PP((long *rez, bool *success, ptr_ *pl)); +extern void r47 PP((long *rez, bool *success, ptr_ *pl)); +extern void r48 PP((long *rez, bool *success, ptr_ *pl)); +extern void r49 PP((long *rez, bool *success, ptr_ *pl)); +extern void r50 PP((long *rez, bool *success, ptr_ *pl)); +extern void r51 PP((long *rez, bool *success, ptr_ *pl)); +extern void r52 PP((long *rez, bool *success, ptr_ *pl)); +extern void r53 PP((long *rez, bool *success, ptr_ *pl)); +extern void r54 PP((long *rez, bool *success, ptr_ *pl)); +extern void r55 PP((long *rez, bool *success, ptr_ *pl)); +extern void r56 PP((long *rez, bool *success, ptr_ *pl)); +extern void r57 PP((long *rez, bool *success, ptr_ *pl)); +extern void r58 PP((long *rez, bool *success, ptr_ *pl)); +extern void r59 PP((long *rez, bool *success, ptr_ *pl)); +extern void r60 PP((long *rez, bool *success, ptr_ *pl)); +extern void r61 PP((long *rez, bool *success, ptr_ *pl)); +extern void r62 PP((long *rez, bool *success, ptr_ *pl)); +extern void r63 PP((long *rez, bool *success, ptr_ *pl)); +extern void r64 PP((long *rez, bool *success, ptr_ *pl)); +extern void r65 PP((long *rez, bool *success, ptr_ *pl)); +extern void r66 PP((long *rez, bool *success, ptr_ *pl)); +extern void r67 PP((long *rez, bool *success, ptr_ *pl)); +extern void r68 PP((long *rez, bool *success, ptr_ *pl)); +extern void r69 PP((long *rez, bool *success, ptr_ *pl)); +extern void r70 PP((long *rez, bool *success, ptr_ *pl)); +extern void r71 PP((long *rez, bool *success, ptr_ *pl)); +extern void r72 PP((long *rez, bool *success, ptr_ *pl)); +extern void r73 PP((long *rez, bool *success, ptr_ *pl)); diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_1.c b/RIGAL/rigsc.446/src/genrig/xcrg_1.c index c3bfb4f84281acbaeba4c869e710031ccfde07b8..d7195a0f4224ea9329ed44cbd5122818ebeb5330 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_1.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_1.c @@ -18,9 +18,9 @@ /* R12 G_LABELS */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_LOC_dekl */ - Void r2(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r2(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $prawilo*/ v loc2;/* $VARS*/ v loc3;/* $GVARS*/ @@ -35,7 +35,7 @@ v wrk7; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_LOC_dekl", 2 ,pl->cel,0); #endif @@ -64,7 +64,7 @@ loc3 .sa= wrk1 .sa ;xxx; /*FORALL-op.*/ if( loc2.sa==NULL ) goto _L102; -pointr ( loc2 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L102;}; first(loc2.sa,&pl2); @@ -107,9 +107,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_WRK_dekl */ - Void r4(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r4(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $MAXWRK*/ v loc2;/* $X*/ v wrk1; @@ -159,9 +159,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_PL_dekl */ - Void r5(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r5(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $NPL*/ v loc2;/* $X*/ v wrk1; @@ -210,9 +210,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_FLAG_dekl */ - Void r6(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r6(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $NFLAG*/ v loc2;/* $X*/ v wrk1; @@ -244,7 +244,7 @@ if( wrk1 .bo) /*BREAK*/ goto _L102;xxx; ;} _L101:;xxx; -outatm(acnst[15],"boolean flag",true, false); +outatm(acnst[15],"bool flag",true, false); outxt(acnst[ 15 ], loc2 .sa , false, false); outatm(acnst[15],";",false, false); ;xxx; /* operator +:= */ @@ -261,9 +261,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_OLDGLOB_dekl */ - Void r7(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r7(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $prawilo*/ v loc2;/* $NUM*/ v loc3;/* $X*/ @@ -299,7 +299,7 @@ loc3 .sa= wrk1 .sa ;xxx; /*FORALL-op.*/ if( loc3.sa==NULL ) goto _L101; -pointr ( loc3 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc3 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L101;}; first(loc3.sa,&pl2); @@ -327,9 +327,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_sohranitx_GLOB */ - Void r8(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r8(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $prawilo*/ v loc2;/* $sohranitx*/ v loc3;/* $NUM*/ @@ -398,7 +398,7 @@ _L101:;xxx; /*FORALL-op.*/ if( loc4.sa==NULL ) goto _L102; -pointr ( loc4 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc4 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L102;}; first(loc4.sa,&pl2); @@ -435,9 +435,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_INIT_VARS */ - Void r9(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r9(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $prawilo*/ v loc2;/* $VARS*/ v loc3;/* $NOM*/ @@ -451,7 +451,7 @@ v wrk4; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_INIT_VARS", 9 ,pl->cel,0); #endif @@ -488,7 +488,7 @@ outatm(acnst[15],"/* inicializaciq peremennyh */",true, true); ;xxx; /*FORALL-op.*/ if( loc2.sa==NULL ) goto _L103; -pointr ( loc2 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L103;}; first(loc2.sa,&pl2); @@ -546,16 +546,16 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_ATOM_FROM_REZ */ - Void r11(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r11(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $E1*/ v wrk1; v wrk2; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_ATOM_FROM_REZ", 11 ,pl->cel,0); #endif @@ -568,7 +568,7 @@ loc2.sa=NULL;/* $E1*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; ;}; @@ -615,7 +615,7 @@ loc2.sa=NULL;/* $E1*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L103;}; ;}; @@ -677,9 +677,9 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_LABELS */ - Void r12(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r12(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $N*/ ptr_ pl1; #ifdef XX diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_10.c b/RIGAL/rigsc.446/src/genrig/xcrg_10.c index 1fc330f2d3fb053e9338182cbe89b14f8a380359..6f1c65c67ba6310026303296039b3dc144bbba02 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_10.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_10.c @@ -14,9 +14,9 @@ /* R73 good_atom */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_PATTERN2 */ - Void r15(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r15(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc2;/* $P*/ v loc3;/* $NPL*/ v loc4;/* $LABEL*/ @@ -43,7 +43,7 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_PATTERN2", 15 ,pl->cel,0); #endif @@ -64,7 +64,7 @@ loc9.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L113; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L113;}; /* prowerka imeni */ @@ -145,7 +145,7 @@ glob10_2 .sa= loc4 .sa ;xxx; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L113; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L113;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -294,7 +294,7 @@ loc12.sa=NULL;/* $L*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L121; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L121;}; /* prowerka imeni */ @@ -373,7 +373,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L117; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L117;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -469,7 +469,7 @@ loc15.sa=NULL;/* $OLDLABEL*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L126;}; /* prowerka imeni */ @@ -512,7 +512,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L126;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -575,7 +575,7 @@ loc18.sa=NULL;/* $M*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L131; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L131;}; /* prowerka imeni */ @@ -699,9 +699,9 @@ glob15_1=oldglob15_1; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_alternative_pat */ - Void r70(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r70(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $LABEL*/ v loc2;/* $WORK_PL*/ @@ -724,7 +724,7 @@ ptr_ pl5; ptr_ pl6; ptr_ pl7; ptr_ pl8; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_alternative_pat", 70 ,pl->cel,0); #endif @@ -757,7 +757,7 @@ loc10.sa=NULL;/* $SUCC*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L127; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L127;}; /* prowerka imeni */ @@ -812,7 +812,7 @@ selop(acnst[130],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L105;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -830,7 +830,7 @@ outatm(acnst[15],".nel==0) || (rez1==NULL)) goto _L",false, false); outxt(acnst[ 15 ], loc3 .sa , false, false); outatm(acnst[15],";",false, false); ;xxx; -outatm(acnst[15],"else { pointr(rez1,&x.sa);",true, true); ;xxx; +outatm(acnst[15],"else { assert_and_assign_real_pointer (rez1,&x.sa);",true, true); ;xxx; outatm(acnst[15],"if (!((x.sad->dtype==atom)||",true, true); outatm(acnst[15],"(x.sad->dtype==idatom)||(x.sad->dtype==keyword)",false, true); @@ -847,7 +847,7 @@ outatm(acnst[15],"else x.sa=x.sad->name ;};",true, true); ;xxx; /* shablon listmain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L110; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L110;}; {pl5.ptrtype=ptrlist; pl5.nel=1; @@ -955,7 +955,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L112; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L112;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -985,7 +985,7 @@ _L113:;xxx; /* shablon listmain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L126;}; {pl5.ptrtype=ptrlist; pl5.nel=1; @@ -1130,9 +1130,9 @@ goto _L99; _L127:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #split_branches */ - Void r71(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r71(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $branch_label*/ v loc2;/* $L*/ @@ -1175,7 +1175,7 @@ loc9.sa=NULL;/* $body*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L111;}; /* prowerka imeni */ @@ -1189,7 +1189,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L111;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -1202,7 +1202,7 @@ pl3.cel=x.smld->elt[0];pl3.UU.U1.curfragment=rez1;} /* shablon listmain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; {pl5.ptrtype=ptrlist; pl5.nel=1; @@ -1228,7 +1228,7 @@ pl7=pl5; /* shablon treemain */ rez1=pl5.cel; success1=false;if(pl5.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -1274,7 +1274,7 @@ pl5=pl6; /* shablon treemain */ rez1=pl5.cel; success1=false;if(pl5.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L106;}; /* prowerka imeni */ @@ -1288,7 +1288,7 @@ selop(acnst[39],false,0L,pl5.cel,&rez1);pl7.cel=rez1; /* shablon listmain */ rez1=pl7.cel; success1=false;if(pl7.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L106;}; {pl8.ptrtype=ptrlist; pl8.nel=1; @@ -1298,7 +1298,7 @@ pl8.cel=x.smld->elt[0];pl8.UU.U1.curfragment=rez1;} /* shablon listmain */ rez1=pl8.cel; success1=false;if(pl8.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L106;}; {pl9.ptrtype=ptrlist; pl9.nel=1; @@ -1314,7 +1314,7 @@ if( !success1 ) goto _L106; /* shablon treemain */ rez1=pl9.cel; success1=false;if(pl9.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L106;}; /* prowerka imeni */ @@ -1442,9 +1442,9 @@ glob71_1=oldglob71_1; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #notin */ - Void r72(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r72(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v wrk1; v wrk2; @@ -1468,7 +1468,7 @@ if( !success1 ) goto _L102; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -1510,14 +1510,14 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #good_atom */ - Void r73(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r73(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v wrk1; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"good_atom", 73 ,pl->cel,0); #endif diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_2.c b/RIGAL/rigsc.446/src/genrig/xcrg_2.c index a963d37b052ba41e0f670ab98079b3ca0914c1f0..b2202b14e047d9accc4f198b9c71d94a26d27ed7 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_2.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_2.c @@ -23,9 +23,9 @@ /* R28 TAIL */ /*===============================================*/ /* GENERATED TEXT OF RULE #ZZZ */ - Void r13(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r13(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ ptr_ pl1; #ifdef XX @@ -43,7 +43,7 @@ loc1 .sa=NULL; if ((pl1.nel==0)||(rez1==NULL)) { success1=false; goto _L101;}; - pointr(rez1,&x.sa); + assert_and_assign_real_pointer (rez1,&x.sa); success1=(x.sad->dtype ==number) &&(x.snd->val== 5 ); if (success1){ @@ -61,9 +61,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GEN_TREE_ELT */ - Void r14(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r14(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OLDPL*/ v loc2;/* $NPL*/ v loc3;/* $FAC*/ @@ -101,7 +101,7 @@ if( !success1 ) goto _L111; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L111;}; /* prowerka imeni */ @@ -216,9 +216,9 @@ goto _L99; _L111:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GEN_TREE_LOOP */ - Void r16(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r16(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OLDPL*/ v loc2;/* $NPL*/ v loc3;/* $acnst_LIST*/ @@ -228,7 +228,7 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; +bool flag1; #ifdef XX d(1,"GEN_TREE_LOOP", 16 ,pl->cel,0); #endif @@ -260,7 +260,7 @@ if( !success1 ) goto _L107; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L107; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L107;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -356,9 +356,9 @@ goto _L99; _L107:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GEN_acnst_COND */ - Void r17(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r17(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $NPL*/ v loc2;/* $N1*/ ptr_ pl1; @@ -381,7 +381,7 @@ if( !success1 ) goto _L102; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -435,15 +435,15 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_NAME_CHECK */ - Void r18(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r18(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v loc2;/* $E*/ v wrk1; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_NAME_CHECK", 18 ,pl->cel,0); #endif @@ -457,7 +457,7 @@ outatm(acnst[15],"/* prowerka imeni */",true, true); ;xxx; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -494,7 +494,7 @@ loc1.sa=NULL;/* $A*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -567,9 +567,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_CALL */ - Void r19(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r19(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $ID*/ v loc2;/* $NPL*/ v loc3;/* $WRK*/ @@ -583,7 +583,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_CALL", 19 ,pl->cel,0); #endif @@ -609,7 +609,7 @@ loc8.sa=NULL;/* $NUM*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L106;}; /* prowerka imeni */ @@ -788,9 +788,9 @@ goto _L99; _L106:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_OPEN */ - Void r20(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r20(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $ANOM*/ v loc2;/* $E*/ ptr_ pl1; @@ -807,7 +807,7 @@ loc2.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -852,9 +852,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_OUTXT */ - Void r21(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r21(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $ANOM*/ v loc2;/* $OP*/ @@ -872,7 +872,7 @@ ptr_ pl4; ptr_ pl5; ptr_ pl6; ptr_ pl7; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_OUTXT", 21 ,pl->cel,0); #endif @@ -889,7 +889,7 @@ loc5.sa=NULL;/* $I*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L118; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L118;}; /* prowerka imeni */ @@ -919,7 +919,7 @@ selop(acnst[33],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L101;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -935,7 +935,7 @@ pl3.cel=x.smld->elt[0];pl3.UU.U1.curfragment=rez1;} pl5=pl3; rez1=pl3.cel; if ((pl3.nel==0) || (rez1==NULL)) goto _L104; -else { pointr(rez1,&x.sa); +else { assert_and_assign_real_pointer (rez1,&x.sa); if (!((x.sad->dtype==atom)|| (x.sad->dtype==idatom)||(x.sad->dtype==keyword) ||(x.sad->dtype==fatom)) ) goto _L104; else x.sa=x.sad->name ;}; @@ -1099,9 +1099,9 @@ goto _L99; _L118:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_CLOSE */ - Void r22(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r22(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $ANOM*/ ptr_ pl1; ptr_ pl2; @@ -1116,7 +1116,7 @@ loc1.sa=NULL;/* $ANOM*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -1152,9 +1152,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_LOOP */ - Void r23(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r23(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $LABEL*/ v loc2;/* $OLDBL*/ v loc3;/* $NPL*/ @@ -1167,7 +1167,7 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_LOOP", 23 ,pl->cel,0); #endif @@ -1180,7 +1180,7 @@ loc2.sa=NULL;/* $OLDBL*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L103;}; /* prowerka imeni */ @@ -1210,7 +1210,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L101;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -1256,7 +1256,7 @@ loc6.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L111;}; /* prowerka imeni */ @@ -1331,7 +1331,7 @@ outatm(acnst[15],"==NULL ) goto _L",false, false); outxt(acnst[ 15 ], loc1 .sa , false, false); outatm(acnst[15],";",false, false); ;xxx; -outatm(acnst[15],"pointr (",true, true); +outatm(acnst[15],"assert_and_assign_real_pointer (",true, true); outxt(acnst[ 15 ], loc6 .sa , false, true); outatm(acnst[15],",&x.sa); ",false, true); ;xxx; @@ -1407,7 +1407,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L109; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L109;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -1454,9 +1454,9 @@ goto _L99; _L111:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_BREAK */ - Void r25(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r25(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; ptr_ pl2; #ifdef XX @@ -1469,7 +1469,7 @@ ptr_ pl2; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -1506,9 +1506,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_BLTIN */ - Void r26(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r26(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $N*/ v loc2;/* $E*/ v loc3;/* $WRK*/ @@ -1519,7 +1519,7 @@ v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_BLTIN", 26 ,pl->cel,0); #endif @@ -1534,7 +1534,7 @@ loc4.sa=NULL;/* $NFLAG*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -1596,7 +1596,7 @@ loc5.sa=NULL;/* $NPL*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -1673,7 +1673,7 @@ loc3.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -1722,9 +1722,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_CALL_PAS */ - Void r27(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r27(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $NPL*/ v loc2;/* $WRK*/ v loc3;/* $E*/ @@ -1738,7 +1738,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_CALL_PAS", 27 ,pl->cel,0); #endif @@ -1756,7 +1756,7 @@ loc8.sa=NULL;/* $A*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L108;}; /* prowerka imeni */ @@ -1943,9 +1943,9 @@ goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #TAIL */ - Void r28(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r28(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v loc2;/* $E*/ v loc3;/* $B*/ @@ -1963,7 +1963,7 @@ loc2.sa=NULL;/* $E*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; {pl2.ptrtype=ptrlist; pl2.nel=1; diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_3.c b/RIGAL/rigsc.446/src/genrig/xcrg_3.c index 075c602a9f3c03e1db00c8c569f954b169276c04..72b7f184e9c93a3227c812f76f65f3bd5fafe2f1 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_3.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_3.c @@ -15,9 +15,9 @@ /* R10 G_SIMPLE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_programma */ - Void r24(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r24(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc3;/* $MAXWRK*/ v loc4;/* $MAXPL*/ v loc5;/* $MAX_FLAG*/ @@ -31,7 +31,7 @@ v oldglob24_2; v oldglob24_3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_programma", 24 ,pl->cel,0); #endif @@ -57,7 +57,7 @@ if( !success1 ) goto _L105; /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -161,7 +161,7 @@ outatm(acnst[15],"#include \"xcrg.h\" ",true, true); ;xxx; outatm(acnst[15],"#include \"xcrga.h\" ",true, true); ;xxx; -outatm(acnst[15],"a rez1;boolean success1;long k;mpd x;",true, true); ;xxx; +outatm(acnst[15],"a rez1;bool success1;long k;mpd x;",true, true); ;xxx; /* CALL #L */ pl2.ptrtype=packedlist;pl2.nel=1;pl2.cel=glob24_3.sa; @@ -199,7 +199,7 @@ glob24_2 .sa= glob24_3 .sa ;xxx; outatm(acnst[15],"main(argc, argv)",true, true); ;xxx; -outatm(acnst[15],"int argc;Char *argv[];",true, true); ;xxx; +outatm(acnst[15],"int argc;char *argv[];",true, true); ;xxx; outatm(acnst[15],"{ out = NULL; ",true, true); ;xxx; @@ -209,7 +209,7 @@ outatm(acnst[15]," prolog(argc,argv); acon(); acop();",true, true); ;xxx; /*FORALL-op.*/ if( glob1_4.sa==NULL ) goto _L104; -pointr ( glob1_4 .sa ,&x.sa); +assert_and_assign_real_pointer ( glob1_4 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L104;}; first(glob1_4.sa,&pl2); @@ -259,7 +259,7 @@ if( !success1 ) goto _L106; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L106;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -287,7 +287,7 @@ if( !success1 ) goto _L107; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L107; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L107;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -322,9 +322,9 @@ glob24_3=oldglob24_3; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_UNIT */ - Void r29(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r29(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $FN*/ v loc2;/* $imq*/ v loc3;/* $MAXWRK*/ @@ -334,7 +334,7 @@ v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_UNIT", 29 ,pl->cel,0); #endif @@ -380,7 +380,7 @@ outatm(acnst[15],"#include \"xcrg.h\" ",true, true); ;xxx; /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -451,9 +451,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_telo_glawn */ - Void r30(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r30(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $total*/ v wrk1; v wrk2; @@ -461,7 +461,7 @@ v oldglob30_1; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_telo_glawn", 30 ,pl->cel,0); #endif @@ -480,7 +480,7 @@ loc1 .sa= wrk2 .sa ;xxx; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -518,16 +518,16 @@ glob30_1=oldglob30_1; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #Print_name */ - Void r31(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r31(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $imq*/ v loc2;/* $EXPL*/ v loc3;/* $LETTER*/ v wrk1; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"Print_name", 31 ,pl->cel,0); #endif @@ -551,7 +551,7 @@ loc2 .sa= wrk1 .sa ;xxx; /*FORALL-op.*/ if( loc2.sa==NULL ) goto _L103; -pointr ( loc2 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L103;}; first(loc2.sa,&pl2); @@ -590,9 +590,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_prawilo */ - Void r3(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r3(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc2;/* $MAXWRK*/ v loc3;/* $MAXLABEL*/ v loc4;/* $MAX_FLAG*/ @@ -613,7 +613,7 @@ ptr_ pl4; ptr_ pl5; ptr_ pl6; ptr_ pl7; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_prawilo", 3 ,pl->cel,0); #endif @@ -638,7 +638,7 @@ loc10.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L108;}; /* prowerka imeni */ @@ -705,13 +705,13 @@ r31(&wrk1.sa,&flag1,&pl3);/* #Print_name*/ ;xxx; outatm(acnst[15]," */",false, true); ;xxx; -outatm(acnst[15]," Void r",true, false); +outatm(acnst[15]," void r",true, false); outxt(acnst[ 15 ], loc6 .sa , false, false); outatm(acnst[15],"(rez,success,pl)",false, false); ;xxx; -outatm(acnst[15],"long *rez;boolean *success;ptr_ *pl;",true, true); ;xxx; +outatm(acnst[15],"long *rez;bool *success;ptr_ *pl;",true, true); ;xxx; -outatm(acnst[15],"{ a rez1; boolean success1; long k; mpd x;",true, true); +outatm(acnst[15],"{ a rez1; bool success1; long k; mpd x;",true, true); ;xxx; /* CALL #L */ @@ -795,7 +795,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -821,7 +821,7 @@ pl6=pl3; /* shablon treemain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L103;}; ;}; @@ -905,9 +905,9 @@ glob3_3=oldglob3_3; ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_SIMPLE */ - Void r10(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r10(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v wrk1; v oldglob10_1; v oldglob10_2; @@ -918,7 +918,7 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_SIMPLE", 10 ,pl->cel,0); #endif @@ -946,7 +946,7 @@ r9(&wrk1.sa,&flag1,&pl2);/* #G_INIT_VARS*/ ;xxx; /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L107; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L107;}; ;}; @@ -972,7 +972,7 @@ glob10_3 .sa= wrk1 .sa ;xxx; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L107; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L107;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -1021,7 +1021,7 @@ outatm(acnst[15],"/* ONFAIL-dejstwiq */",true, true); ;xxx; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L105;}; {pl3.ptrtype=ptrlist; pl3.nel=1; diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_4.c b/RIGAL/rigsc.446/src/genrig/xcrg_4.c index c9153c851cca7c5e6b0c0b10022eabce47d6378f..4c881ca2326c593a8bc0348138fc98a4055b238a 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_4.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_4.c @@ -18,9 +18,9 @@ /* R40 ACONST_ili_obxekt */ /*===============================================*/ /* GENERATED TEXT OF RULE #QQQ */ - Void r32(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r32(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $S*/ ptr_ pl1; #ifdef XX @@ -47,16 +47,16 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_ASSGN */ - Void r33(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r33(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $R*/ v loc2;/* $OP*/ v wrk1; v wrk2; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_ASSGN", 33 ,pl->cel,0); #endif @@ -71,7 +71,7 @@ loc1 .sa=NULL; /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -130,9 +130,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_ANORM */ - Void r34(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r34(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $A1*/ v loc2;/* $A2*/ @@ -157,7 +157,7 @@ ptr_ pl12; ptr_ pl13; ptr_ pl14; ptr_ pl15; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_ANORM", 34 ,pl->cel,0); #endif @@ -173,7 +173,7 @@ loc4.sa=NULL;/* $E1*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L111;}; /* prowerka imeni */ @@ -201,7 +201,7 @@ pl4=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -258,7 +258,7 @@ pl5=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -364,7 +364,7 @@ loc5.sa=NULL;/* $W*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ @@ -400,7 +400,7 @@ pl8=pl6; /* shablon treemain */ rez1=pl6.cel; success1=false;if(pl6.nel==0 ) goto _L112; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L112;}; /* prowerka imeni */ @@ -468,7 +468,7 @@ pl9=pl6; /* shablon treemain */ rez1=pl6.cel; success1=false;if(pl6.nel==0 ) goto _L115; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L115;}; /* prowerka imeni */ @@ -575,7 +575,7 @@ loc6.sa=NULL;/* $A3*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L133; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L133;}; /* prowerka imeni */ @@ -623,7 +623,7 @@ pl12=pl10; /* shablon treemain */ rez1=pl10.cel; success1=false;if(pl10.nel==0 ) goto _L123; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L123;}; /* prowerka imeni */ @@ -689,7 +689,7 @@ pl13=pl10; /* shablon treemain */ rez1=pl10.cel; success1=false;if(pl10.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L126;}; /* prowerka imeni */ @@ -794,9 +794,9 @@ goto _L99; _L133:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_ALONGLIST */ - Void r35(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r35(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $B*/ v loc2;/* $A1*/ v loc3;/* $A2*/ @@ -819,7 +819,7 @@ ptr_ pl11; ptr_ pl12; ptr_ pl13; ptr_ pl14; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_ALONGLIST", 35 ,pl->cel,0); #endif @@ -835,7 +835,7 @@ loc6.sa=NULL;/* $EL*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ @@ -856,7 +856,7 @@ selop(acnst[72],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ @@ -889,7 +889,7 @@ pl4=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -946,7 +946,7 @@ pl5=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -1030,7 +1030,7 @@ selop(acnst[72],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; ;}; @@ -1041,7 +1041,7 @@ selop(acnst[39],false,0L,pl2.cel,&rez1);pl7.cel=rez1; /* shablon listmain */ rez1=pl7.cel; success1=false;if(pl7.nel==0 ) goto _L112; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L112;}; {pl8.ptrtype=ptrlist; pl8.nel=1; @@ -1102,7 +1102,7 @@ pl8=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L114; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L114;}; /* prowerka imeni */ @@ -1143,7 +1143,7 @@ pl9=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L117; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L117;}; /* prowerka imeni */ @@ -1205,7 +1205,7 @@ loc7.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L133; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L133;}; /* prowerka imeni */ @@ -1239,7 +1239,7 @@ pl11=pl9; /* shablon treemain */ rez1=pl9.cel; success1=false;if(pl9.nel==0 ) goto _L123; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L123;}; /* prowerka imeni */ @@ -1296,7 +1296,7 @@ pl12=pl9; /* shablon treemain */ rez1=pl9.cel; success1=false;if(pl9.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L126;}; /* prowerka imeni */ @@ -1404,9 +1404,9 @@ goto _L99; _L133:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_ALONGTREE */ - Void r36(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r36(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $B*/ v loc2;/* $REZ*/ v loc3;/* $A1*/ @@ -1431,7 +1431,7 @@ ptr_ pl11; ptr_ pl12; ptr_ pl13; ptr_ pl14; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_ALONGTREE", 36 ,pl->cel,0); #endif @@ -1449,7 +1449,7 @@ loc8.sa=NULL;/* $EL2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ @@ -1470,7 +1470,7 @@ selop(acnst[72],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ @@ -1511,7 +1511,7 @@ pl4=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -1568,7 +1568,7 @@ pl5=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -1657,7 +1657,7 @@ selop(acnst[72],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; ;}; @@ -1668,7 +1668,7 @@ selop(acnst[39],false,0L,pl2.cel,&rez1);pl7.cel=rez1; /* shablon listmain */ rez1=pl7.cel; success1=false;if(pl7.nel==0 ) goto _L112; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L112;}; {pl8.ptrtype=ptrlist; pl8.nel=1; @@ -1722,7 +1722,7 @@ pl8=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L114; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L114;}; /* prowerka imeni */ @@ -1763,7 +1763,7 @@ pl9=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L117; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L117;}; /* prowerka imeni */ @@ -1825,7 +1825,7 @@ loc9.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L133; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L133;}; /* prowerka imeni */ @@ -1859,7 +1859,7 @@ pl11=pl9; /* shablon treemain */ rez1=pl9.cel; success1=false;if(pl9.nel==0 ) goto _L123; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L123;}; /* prowerka imeni */ @@ -1916,7 +1916,7 @@ pl12=pl9; /* shablon treemain */ rez1=pl9.cel; success1=false;if(pl9.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L126;}; /* prowerka imeni */ @@ -2024,9 +2024,9 @@ goto _L99; _L133:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #obqzatelxno_obxekt */ - Void r37(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r37(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $M*/ v wrk1; @@ -2034,7 +2034,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"obqzatelxno_obxekt", 37 ,pl->cel,0); #endif @@ -2102,9 +2102,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #obxekt_ili_NULL */ - Void r38(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r38(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $M*/ v wrk1; @@ -2112,7 +2112,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"obxekt_ili_NULL", 38 ,pl->cel,0); #endif @@ -2167,9 +2167,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #INTEGER_ili_obxekt */ - Void r39(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r39(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $M*/ v loc3;/* $T*/ @@ -2178,7 +2178,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"INTEGER_ili_obxekt", 39 ,pl->cel,0); #endif @@ -2261,9 +2261,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ACONST_ili_obxekt */ - Void r40(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r40(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v loc2;/* $M*/ v loc3;/* $T*/ @@ -2273,7 +2273,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"ACONST_ili_obxekt", 40 ,pl->cel,0); #endif diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_5.c b/RIGAL/rigsc.446/src/genrig/xcrg_5.c index 95cd735a0d515d8b3b69675542a9651fd2e5f07d..c90947a18fec6a00e88e614916cf5ec55e006038 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_5.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_5.c @@ -17,9 +17,9 @@ /* R48 ~islo_ili_0 */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_wyravenie */ - Void r41(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r41(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $ID*/ v loc2;/* $X*/ @@ -61,7 +61,7 @@ ptr_ pl5; ptr_ pl6; ptr_ pl7; ptr_ pl8; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_wyravenie", 41 ,pl->cel,0); #endif @@ -76,7 +76,7 @@ loc3.sa=NULL;/* $mesto*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -137,7 +137,7 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -168,7 +168,7 @@ loc4.sa=NULL;/* $ID1*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -219,7 +219,7 @@ loc5.sa=NULL;/* $REZ*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L107; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L107;}; /* prowerka imeni */ @@ -273,7 +273,7 @@ loc7.sa=NULL;/* $E2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L110; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L110;}; /* prowerka imeni */ @@ -304,7 +304,7 @@ selop(acnst[39],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -356,7 +356,7 @@ loc8.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L111; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L111;}; /* prowerka imeni */ @@ -423,7 +423,7 @@ loc8.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L112; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L112;}; /* prowerka imeni */ @@ -506,7 +506,7 @@ loc9.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L119; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L119;}; /* prowerka imeni */ @@ -605,7 +605,7 @@ loc8.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L124; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L124;}; /* prowerka imeni */ @@ -663,7 +663,7 @@ loc11.sa=NULL;/* $E22*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L129; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L129;}; /* prowerka imeni */ @@ -702,7 +702,7 @@ pl3=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L126;}; /* prowerka imeni */ @@ -716,7 +716,7 @@ selop(acnst[39],false,0L,pl2.cel,&rez1);pl4.cel=rez1; /* shablon listmain */ rez1=pl4.cel; success1=false;if(pl4.nel==0 ) goto _L126; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L126;}; {pl5.ptrtype=ptrlist; pl5.nel=1; @@ -807,7 +807,7 @@ loc12.sa=NULL;/* $EL2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L137; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L137;}; /* prowerka imeni */ @@ -849,7 +849,7 @@ pl5=pl3; /* shablon treemain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L132; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L132;}; /* prowerka imeni */ @@ -863,7 +863,7 @@ selop(acnst[39],false,0L,pl3.cel,&rez1);pl6.cel=rez1; /* shablon listmain */ rez1=pl6.cel; success1=false;if(pl6.nel==0 ) goto _L130; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L130;}; {pl7.ptrtype=ptrlist; pl7.nel=1; @@ -909,7 +909,7 @@ if( success1 ) { outatm(acnst[15],"if(",true, true); outxt(acnst[ 15 ], loc6 .sa , false, true); outatm(acnst[15],"!=NULL ) {",false, true); -outatm(acnst[15],"pointr(",false, true); +outatm(acnst[15],"assert_and_assign_real_pointer (",false, true); outxt(acnst[ 15 ], loc6 .sa , false, true); outatm(acnst[15],",&x.sa);",false, true); outatm(acnst[15],"if( x.smtd->dtype!=treemain )",false, true); @@ -957,7 +957,7 @@ goto _L99; _L137:; /* metka wyhoda po neuspehu wetwi */ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L138; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L138;}; /* prowerka imeni */ @@ -991,7 +991,7 @@ loc15.sa=NULL;/* $E11*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L144; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L144;}; /* prowerka imeni */ @@ -1192,7 +1192,7 @@ loc9.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L145; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L145;}; /* prowerka imeni */ @@ -1242,7 +1242,7 @@ loc8.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L146; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L146;}; /* prowerka imeni */ @@ -1277,7 +1277,7 @@ loc8.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L150; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L150;}; /* prowerka imeni */ @@ -1335,7 +1335,7 @@ if( wrk5 .bo) outatm(acnst[15],"if(",true, true); selop( acnst[ 19 ],false,NULL, loc7 .sa ,& wrk1 .sa); outxt(acnst[ 15 ], wrk1 .sa , false, true); -outatm(acnst[15],".sa!=NULL ) { points(",false, true); +outatm(acnst[15],".sa!=NULL ) { assert_and_assign_real_pointer (",false, true); selop( acnst[ 19 ],false,NULL, loc7 .sa ,& wrk1 .sa); outxt(acnst[ 15 ], wrk1 .sa , false, true); outatm(acnst[15],".sa,&x.sa);",false, true); ;xxx; @@ -1381,7 +1381,7 @@ loc9.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L151; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L151;}; /* prowerka imeni */ @@ -1439,9 +1439,9 @@ goto _L99; _L152:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_AND */ - Void r42(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r42(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $WRK*/ v loc2;/* $E1*/ v loc3;/* $tip*/ @@ -1454,7 +1454,7 @@ v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_AND", 42 ,pl->cel,0); #endif @@ -1472,7 +1472,7 @@ loc7.sa=NULL;/* $mesto2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -1636,9 +1636,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_OR */ - Void r43(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r43(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $WRK*/ v loc2;/* $E1*/ v loc3;/* $tip*/ @@ -1651,7 +1651,7 @@ v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_OR", 43 ,pl->cel,0); #endif @@ -1669,7 +1669,7 @@ loc7.sa=NULL;/* $mesto2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -1825,9 +1825,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #IS_CONSTRUCTOR */ - Void r44(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r44(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OP*/ v loc2;/* $R*/ v wrk1; @@ -1847,7 +1847,7 @@ loc1.sa=NULL;/* $OP*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -1884,9 +1884,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #CONLIST */ - Void r45(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r45(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $REZ*/ v loc2;/* $E*/ ptr_ pl1; @@ -1910,7 +1910,7 @@ if( !success1 ) goto _L102; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L102;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -1952,9 +1952,9 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_EQOP */ - Void r46(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r46(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $OP*/ v loc2;/* $E1*/ v loc3;/* $tip*/ @@ -1977,7 +1977,7 @@ v wrk10; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_EQOP", 46 ,pl->cel,0); #endif @@ -1997,7 +1997,7 @@ loc9.sa=NULL;/* $mesto2*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L120; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L120;}; /* prowerka imeni */ @@ -2388,9 +2388,9 @@ goto _L99; _L120:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #mesto */ - Void r47(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r47(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $M*/ v loc2;/* $C*/ v wrk1; @@ -2407,7 +2407,7 @@ loc1.sa=NULL;/* $M*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; ;}; @@ -2444,7 +2444,7 @@ loc2.sa=NULL;/* $C*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L103;}; /* prowerka imeni */ @@ -2492,7 +2492,7 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; ;}; @@ -2517,7 +2517,7 @@ loc1.sa=NULL;/* $M*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; ;}; @@ -2551,9 +2551,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #~islo_ili_0 */ - Void r48(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r48(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $N*/ v loc2;/* $WRK*/ @@ -2563,7 +2563,7 @@ v wrk3; v wrk4; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"~islo_ili_0", 48 ,pl->cel,0); #endif @@ -2576,7 +2576,7 @@ loc1.sa=NULL;/* $N*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; ;}; @@ -2612,7 +2612,7 @@ loc2.sa=NULL;/* $WRK*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; ;}; diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_6.c b/RIGAL/rigsc.446/src/genrig/xcrg_6.c index c9a5c4d4cdf9ed14afbadb6205c722d09608b2b6..9a5467d6a6c3adca0e19e60630f1d3e6e1d120e1 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_6.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_6.c @@ -14,9 +14,9 @@ /* R53 G_COMMON_PART */ /*===============================================*/ /* GENERATED TEXT OF RULE #WW */ - Void r49(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r49(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $w*/ v loc2;/* $dd*/ ptr_ pl1; @@ -47,9 +47,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_INIT_GLOB */ - Void r50(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r50(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $TABL*/ v loc2;/* $X*/ v loc3;/* $VARS*/ @@ -79,7 +79,7 @@ outatm(acnst[15],"/* inicializaciq LAST-perem.*/",true, true); ;xxx; /*FORALL-op.*/ if( loc1.sa==NULL ) goto _L103; -pointr ( loc1 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc1 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L103;}; first(loc1.sa,&pl2); @@ -101,7 +101,7 @@ selop( 0L,true, loc2 .sa, glob1_3 .sa ,& wrk1 .sa); loc4 .sa= wrk1 .sa ;xxx; /*FORALL-op.*/ if( loc3.sa==NULL ) goto _L102; -pointr ( loc3 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc3 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L102;}; first(loc3.sa,&pl3); @@ -132,9 +132,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #GEN_ATOM_INITIALIZATION */ - Void r51(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r51(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $LISTACON*/ v loc2;/* $LISTACOP*/ v wrk1; @@ -142,7 +142,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"GEN_ATOM_INITIALIZATION", 51 ,pl->cel,0); #endif @@ -167,11 +167,11 @@ if( !success1 ) goto _L101; opn(acnst[ 101 ], cnst[50] .sa ) ;xxx; -outatm(acnst[101],"/* Local variables for acon: */ ",true, true); ;xxx; +outatm(acnst[101],"/* static variables for acon: */ ",true, true); ;xxx; outatm(acnst[101],"struct LOC_acon {a k;allpacked r;} ;",true, true); ;xxx; -outatm(acnst[101],"Local Void uc(l, cn, dt, LINK) ",true, true); ;xxx; +outatm(acnst[101],"static void uc(l, cn, dt, LINK) ",true, true); ;xxx; outatm(acnst[101],"long l, cn; char dt; ",true, true); ;xxx; @@ -181,7 +181,7 @@ outatm(acnst[101],"{ putatm(LINK->r.bl, l, &LINK->k); ",true, true); ;xxx; outatm(acnst[101]," mkatom(LINK->k, dt, &cnst[cn ].sa);}",true, true); ;xxx; -outatm(acnst[101],"Static Void acon() ",true, true); ;xxx; +outatm(acnst[101],"static void acon() ",true, true); ;xxx; outatm(acnst[101],"{ struct LOC_acon V; mpd x; ",true, true); ;xxx; @@ -212,11 +212,11 @@ outatm(acnst[101]," WITH->name = null_; ",true, true); ;xxx; outatm(acnst[101]," WITH->next = null_;} ",true, true); ;xxx; -outatm(acnst[101],"/* Local variables for acop: */ ",true, true); ;xxx; +outatm(acnst[101],"/* static variables for acop: */ ",true, true); ;xxx; outatm(acnst[101],"struct LOC_acop { allpacked r;} ; ",true, true); ;xxx; -outatm(acnst[101],"Local Void uc_(l, cn, dt, LINK) ",true, true); ;xxx; +outatm(acnst[101],"static void uc_(l, cn, dt, LINK) ",true, true); ;xxx; outatm(acnst[101],"long l, cn; char dt; ",true, true); ;xxx; @@ -224,7 +224,7 @@ outatm(acnst[101],"struct LOC_acop *LINK; ",true, true); ;xxx; outatm(acnst[101],"{putatm(LINK->r.bl, l, &acnst[cn ]);} ",true, true); ;xxx; -outatm(acnst[101],"Static Void acop() ",true, true); ;xxx; +outatm(acnst[101],"static void acop() ",true, true); ;xxx; outatm(acnst[101],"{struct LOC_acop V; ",true, true); ;xxx; @@ -248,9 +248,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ACON_LIST */ - Void r52(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r52(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $MARK*/ v loc2;/* $E*/ v loc3;/* $I*/ @@ -263,7 +263,7 @@ ptr_ pl1; ptr_ pl2; ptr_ pl3; ptr_ pl4; -boolean flag1; +bool flag1; #ifdef XX d(1,"ACON_LIST", 52 ,pl->cel,0); #endif @@ -285,7 +285,7 @@ if( !success1 ) goto _L105; /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L105;}; {pl2.ptrtype=ptrlist; pl2.nel=1; @@ -392,9 +392,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_COMMON_PART */ - Void r53(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r53(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $P*/ v loc2;/* $X*/ v loc3;/* $VAR*/ @@ -406,7 +406,7 @@ v wrk3; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_COMMON_PART", 53 ,pl->cel,0); #endif @@ -438,7 +438,7 @@ outatm(acnst[104],"];",false, false); ;xxx; /*FORALL-op.*/ if( glob1_2.sa==NULL ) goto _L102; -pointr ( glob1_2 .sa ,&x.sa); +assert_and_assign_real_pointer ( glob1_2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L102;}; first(glob1_2.sa,&pl2); @@ -453,7 +453,7 @@ selop( 0L,true, loc1 .sa, glob1_2 .sa ,& wrk1 .sa); loc2 .sa= wrk1 .sa ;xxx; /*FORALL-op.*/ if( loc2.sa==NULL ) goto _L101; -pointr ( loc2 .sa ,&x.sa); +assert_and_assign_real_pointer ( loc2 .sa ,&x.sa); if( (x.smld->dtype!=listmain)&&(x.smld->dtype!=treemain) ) { er(24L);goto _L101;}; first(loc2.sa,&pl3); @@ -494,9 +494,9 @@ if( wrk1 .bo) /*BREAK*/ goto _L104;xxx; ;} _L103:;xxx; -outatm(acnst[104],"extern Void r",true, false); +outatm(acnst[104],"extern void r",true, false); outxt(acnst[ 104 ], loc2 .sa , false, false); -outatm(acnst[104]," PP((long *rez, boolean *success, ptr_ *pl));",false, false); +outatm(acnst[104]," PP((long *rez, bool *success, ptr_ *pl));",false, false); ;xxx; /* operator +:= */ addnum(& loc2 .sa, 1L ) ;xxx; diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_7.c b/RIGAL/rigsc.446/src/genrig/xcrg_7.c index e64df879336db6f0a44ca0f40369454a83dc0cd7..dd74ee712f4e567f1fd8a68bec32b418a1ba24e3 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_7.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_7.c @@ -18,9 +18,9 @@ /* R62 ss17 */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss6 */ - Void r54(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r54(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss6", 54 ,pl->cel,0); @@ -47,9 +47,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss7 */ - Void r55(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r55(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss7", 55 ,pl->cel,0); @@ -74,9 +74,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss9 */ - Void r56(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r56(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss9", 56 ,pl->cel,0); @@ -102,7 +102,7 @@ outxt(acnst[ 15 ], cnst[57] .sa , false, false); outxt(acnst[ 15 ], glob10_2 .sa , false, false); outatm(acnst[15],";};",false, false); ;xxx; -outatm(acnst[15]," pointr(rez1,&x.sa);",true, true); ;xxx; +outatm(acnst[15]," assert_and_assign_real_pointer (rez1,&x.sa);",true, true); ;xxx; outatm(acnst[15]," success1=(x.sad->dtype ",true, true); ;xxx; goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ @@ -116,9 +116,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss10 */ - Void r57(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r57(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss10", 57 ,pl->cel,0); @@ -152,9 +152,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss11 */ - Void r58(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r58(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $wid*/ ptr_ pl1; #ifdef XX @@ -186,7 +186,7 @@ outxt(acnst[ 15 ], cnst[63] .sa , false, false); outxt(acnst[ 15 ], glob10_2 .sa , false, false); outatm(acnst[15],";",false, true); ;xxx; -outatm(acnst[15]," if (rez1!=NULL ) { pointr(rez1,&x.sa);",true, true); ;xxx; +outatm(acnst[15]," if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa);",true, true); ;xxx; outatm(acnst[15]," if (x.smld->dtype!=",true, true); outxt(acnst[ 15 ], loc1 .sa , false, true); @@ -206,9 +206,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss12 */ - Void r59(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r59(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $NPL*/ ptr_ pl1; #ifdef XX @@ -247,9 +247,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss13 */ - Void r60(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r60(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss13", 60 ,pl->cel,0); @@ -283,9 +283,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss14 */ - Void r61(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r61(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss14", 61 ,pl->cel,0); @@ -309,9 +309,9 @@ goto _L99; _L101:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #ss17 */ - Void r62(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r62(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; ptr_ pl1; #ifdef XX d(1,"ss17", 62 ,pl->cel,0); diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_8.c b/RIGAL/rigsc.446/src/genrig/xcrg_8.c index 14a40d48906385cc1f37156ad177436004907049..7f09b1b25ec813baf4351a0e6c751b7949d223e6 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_8.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_8.c @@ -15,9 +15,9 @@ /* R68 G_FAIL */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_STMT */ - Void r63(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r63(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ ptr_ pl1; ptr_ pl2; @@ -145,9 +145,9 @@ goto _L99; _L118:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_IF */ - Void r64(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r64(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $LABEL*/ v loc2;/* $BNUM*/ @@ -165,7 +165,7 @@ ptr_ pl4; ptr_ pl5; ptr_ pl6; ptr_ pl7; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_IF", 64 ,pl->cel,0); #endif @@ -181,7 +181,7 @@ loc4.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L105;}; /* prowerka imeni */ @@ -209,7 +209,7 @@ selop(acnst[106],false,0L,pl1.cel,&rez1);pl2.cel=rez1; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L105; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L105;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -227,7 +227,7 @@ addnum(& loc3 .sa, 1L ) ;xxx; /* shablon treemain */ rez1=pl3.cel; success1=false;if(pl3.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L104;}; ;}; @@ -283,7 +283,7 @@ selop(acnst[39],false,0L,pl3.cel,&rez1);pl5.cel=rez1; /* shablon listmain */ rez1=pl5.cel; success1=false;if(pl5.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L104;}; {pl6.ptrtype=ptrlist; pl6.nel=1; @@ -350,9 +350,9 @@ goto _L99; _L105:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_PRINT */ - Void r65(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r65(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $A*/ v loc2;/* $M*/ v wrk1; @@ -361,7 +361,7 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_PRINT", 65 ,pl->cel,0); #endif @@ -374,7 +374,7 @@ loc2.sa=NULL;/* $M*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L108; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L108;}; /* prowerka imeni */ @@ -394,7 +394,7 @@ pl4=pl2; /* shablon treemain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -479,9 +479,9 @@ goto _L99; _L108:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_LOAD_SAVE */ - Void r66(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r66(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $OP*/ v loc2;/* $V*/ @@ -491,7 +491,7 @@ v wrk2; v wrk3; ptr_ pl1; ptr_ pl2; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_LOAD_SAVE", 66 ,pl->cel,0); #endif @@ -506,7 +506,7 @@ loc3.sa=NULL;/* $E*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L103;}; /* prowerka imeni */ @@ -602,16 +602,16 @@ goto _L99; _L103:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_RETURN */ - Void r67(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r67(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $E*/ v wrk1; v wrk2; ptr_ pl1; ptr_ pl2; ptr_ pl3; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_RETURN", 67 ,pl->cel,0); #endif @@ -623,7 +623,7 @@ loc1.sa=NULL;/* $E*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L104; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L104;}; /* prowerka imeni */ @@ -710,9 +710,9 @@ goto _L99; _L104:; /* metka wyhoda po neuspehu wetwi */ ;};/* RULE */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_FAIL */ - Void r68(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r68(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc1;/* $X*/ ptr_ pl1; ptr_ pl2; @@ -727,7 +727,7 @@ loc1.sa=NULL;/* $X*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L103;}; /* prowerka imeni */ diff --git a/RIGAL/rigsc.446/src/genrig/xcrg_9.c b/RIGAL/rigsc.446/src/genrig/xcrg_9.c index be64e48ac581174f86d7547383e1310b8e64a010..10ea7dc8fb57f58714de02dcd1daa16800ec1d35 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrg_9.c +++ b/RIGAL/rigsc.446/src/genrig/xcrg_9.c @@ -10,9 +10,9 @@ /* R69 G_PATTERN */ /*===============================================*/ /* GENERATED TEXT OF RULE #G_PATTERN */ - Void r69(rez,success,pl) -long *rez;boolean *success;ptr_ *pl; -{ a rez1; boolean success1; long k; mpd x; + void r69(rez,success,pl) +long *rez;bool *success;ptr_ *pl; +{ a rez1; bool success1; long k; mpd x; v loc0;/* $_*/ v loc1;/* $N*/ v loc2;/* $D*/ @@ -29,7 +29,7 @@ ptr_ pl2; ptr_ pl3; ptr_ pl4; ptr_ pl5; -boolean flag1; +bool flag1; #ifdef XX d(1,"G_PATTERN", 69 ,pl->cel,0); #endif @@ -44,7 +44,7 @@ outxt(acnst[ 15 ],NULL,true,false) ;xxx; /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L101; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L101;}; /* prowerka imeni */ @@ -82,7 +82,7 @@ loc1.sa=NULL;/* $N*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L102; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L102;}; /* prowerka imeni */ @@ -123,7 +123,7 @@ goto _L99; _L102:; /* metka wyhoda po neuspehu wetwi */ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L103; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L103;}; /* prowerka imeni */ @@ -170,7 +170,7 @@ loc4.sa=NULL;/* $TIP*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L106; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L106;}; /* prowerka imeni */ @@ -267,7 +267,7 @@ loc6.sa=NULL;/* $OLDPL*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L113; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L113;}; /* prowerka imeni */ @@ -317,7 +317,7 @@ r62(&wrk1.sa,&flag1,&pl3);/* #ss17*/ ;xxx; /* shablon listmain */ rez1=pl2.cel; success1=false;if(pl2.nel==0 ) goto _L113; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L113;}; {pl3.ptrtype=ptrlist; pl3.nel=1; @@ -383,7 +383,7 @@ loc7.sa=NULL;/* $ID*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L114; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L114;}; /* prowerka imeni */ @@ -426,7 +426,7 @@ loc1.sa=NULL;/* $N*/ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L115; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L115;}; /* prowerka imeni */ @@ -463,7 +463,7 @@ goto _L99; _L115:; /* metka wyhoda po neuspehu wetwi */ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L116; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L116;}; /* prowerka imeni */ @@ -492,7 +492,7 @@ goto _L99; _L116:; /* metka wyhoda po neuspehu wetwi */ /* shablon listmain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L117; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= listmain ) { rez1=NULL;goto _L117;}; /* prowerka imeni */ @@ -527,7 +527,7 @@ loc8.sa=NULL;/* $P*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L118; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L118;}; /* prowerka imeni */ @@ -582,7 +582,7 @@ loc8.sa=NULL;/* $P*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L119; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L119;}; /* prowerka imeni */ @@ -634,7 +634,7 @@ loc8.sa=NULL;/* $P*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L120; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L120;}; /* prowerka imeni */ @@ -686,7 +686,7 @@ loc8.sa=NULL;/* $P*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L121; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L121;}; /* prowerka imeni */ @@ -738,7 +738,7 @@ loc8.sa=NULL;/* $P*/ /* shablon treemain */ rez1=pl1.cel; success1=false;if(pl1.nel==0 ) goto _L122; - if (rez1!=NULL ) { pointr(rez1,&x.sa); + if (rez1!=NULL ) { assert_and_assign_real_pointer (rez1,&x.sa); if (x.smld->dtype!= treemain ) { rez1=NULL;goto _L122;}; /* prowerka imeni */ diff --git a/RIGAL/rigsc.446/src/genrig/xcrga.h b/RIGAL/rigsc.446/src/genrig/xcrga.h index 104279c9aae46c0e2fa29d5f9bdcf4d6e12f4a87..aefb202a79eed7294d7118b4e89ad6e43e876115 100644 --- a/RIGAL/rigsc.446/src/genrig/xcrga.h +++ b/RIGAL/rigsc.446/src/genrig/xcrga.h @@ -1,14 +1,12 @@ -#ifndef _MONTEREYPHOENIXANRIGXCRGA_ -#define _MONTEREYPHOENIXANRIGXCRGA_ -/* Local variables for acon: */ +/* static variables for acon: */ struct LOC_acon {a k;allpacked r;} ; -Local Void uc(l, cn, dt, LINK) +static void uc(l, cn, dt, LINK) long l, cn; char dt; struct LOC_acon *LINK; { putatm(LINK->r.bl, l, &LINK->k); mkatom(LINK->k, dt, &cnst[cn ].sa);} -Static Void acon() +static void acon() { struct LOC_acon V; mpd x; mainlistdescriptor *WITH; V.r.p1='T'; @@ -204,13 +202,13 @@ uc (8L,93L,atom,&V); WITH->totalelnum = 1; WITH->name = null_; WITH->next = null_;} -/* Local variables for acop: */ +/* static variables for acop: */ struct LOC_acop { allpacked r;} ; -Local Void uc_(l, cn, dt, LINK) +static void uc_(l, cn, dt, LINK) long l, cn; char dt; struct LOC_acop *LINK; {putatm(LINK->r.bl, l, &acnst[cn ]);} -Static Void acop() +static void acop() {struct LOC_acop V; V.r.p1='T'; uc_(1L,1L,idatom,&V); @@ -473,4 +471,3 @@ uc_(22L,129L,idatom,&V); memcpy(V.r.p6,"atomic",6L); uc_(6L,130L,idatom,&V); } -#endif diff --git a/RIGAL/rigsc.446/src/ic.c b/RIGAL/rigsc.446/src/ic.c index e7ad1a2a8ba5a7093ddb21417c5f09966769c24f..027aa780ca4b6302e8c6365f1dc78f7b7700aa37 100644 --- a/RIGAL/rigsc.446/src/ic.c +++ b/RIGAL/rigsc.446/src/ic.c @@ -11,107 +11,122 @@ a ttt, tt1, tt2, tt3, middle; long arnum; filespecification p1, p2, p3; string80 printfile_str, sstr; -boolean debug; +bool debug; long pp1, pp2, pp3, i; -int main(int argc, char *argv[]) +int +main (int argc, char *argv[]) { out = NULL; out_open = false; debug = false; - if (argc > 1) { - strcpy(p1,argv[1]); - brt(p1); - } else + if (argc > 1) + { + strcpy (p1, argv[1]); + keep_string_up_to_first_space (p1); + } + else *p1 = '\0'; *printfile_str = '\0'; - if (*p1 == '\0') { - printf(" Rigal Interpreter V.%s\n", rigal_version); - printf(" ic codefile [ -p printfilename ] [ -d ] [ parameter ...]\n"); - printf(" codefile must be without extension, .RSC is appended \n"); - if (*p1 == '\0') - goto _L99; - } + if (*p1 == '\0') + { + printf (" Rigal Interpreter V.%s\n", rigal_version); + printf (" ic codefile [ -p printfilename ] [ -d ] [ parameter ...]\n"); + printf (" codefile must be without extension, .RSC is appended \n"); + if (*p1 == '\0') + goto _L99; + } - init_dinform(); - opens('@'); - opena(); + init_dinform (); + opens (); + opena (); - for (i = 1; i < argc; i++) { - strcpy(printfile_str,argv[(int)i]); - brt(printfile_str); - if (!strcmp(printfile_str, "-d")) { - pp1 = i; - debug = true; - goto _L17; + for (i = 1; i < argc; i++) + { + strcpy (printfile_str, argv[(int) i]); + keep_string_up_to_first_space (printfile_str); + if (!strcmp (printfile_str, "-d")) + { + pp1 = i; + debug = true; + goto _L17; + } } - } _L17: *printfile_str = '\0'; - for (i = 1; i < argc; i++) { - strcpy(sstr,argv[(int)i]); - brt(sstr); - if (!strcmp(sstr, "-p")) { - pp2 = i; - if (i <= argc - 2) { - pp3 = i + 1; - strcpy(printfile_str,argv[(int)(i + 1)]); - brt(printfile_str); - goto _L18; - } + for (i = 1; i < argc; i++) + { + strcpy (sstr, argv[(int) i]); + keep_string_up_to_first_space (sstr); + if (!strcmp (sstr, "-p")) + { + pp2 = i; + if (i <= argc - 2) + { + pp3 = i + 1; + strcpy (printfile_str, argv[(int) (i + 1)]); + keep_string_up_to_first_space (printfile_str); + goto _L18; + } + } } - } _L18: - if (*printfile_str != '\0') { - printf(" Wrong PRINT file changed to Screen \n"); - *printfile_str = '\0'; - - } + if (*printfile_str != '\0') + { + if (!rightfile (printfile_str)) + { + printf (" Wrong PRINT file changed to Screen \n"); + *printfile_str = '\0'; + } + } out_screen = (*printfile_str == '\0'); out_open = !out_screen; - if (out_open) { - out = fopen(printfile_str,"w"); - if (out == NULL) _EscIO(FileNotFound); - } + if (out_open) + { + out = fopen (printfile_str, "w"); + if (out == NULL) + _EscIO (FileNotFound); + } max_printlevel = max_printconst; - memset (p2,0,80); - memmove(p2,p1,75); - memmove(&(p2[(int) strlen(p2)]),".rsc",4); + sprintf (p2, "%s.rsc", p1); - if (!existfile(p2)) - { - printf("\nERROR: Code %s not found\n", p2); - goto _L99; - } - loads(p2, &ttt); + if (!existfile (p2)) + { + printf ("\nERROR: Code %s not found\n", p2); + + + goto _L99; + } + loads (p2, &ttt); run_param_cnt = 0; - for (arnum = 2; arnum < argc; arnum++) { - if (arnum != pp1 && arnum != pp2 && arnum != pp3) { - run_param_cnt++; - strcpy(run_param_array[run_param_cnt - 1],argv[(int)arnum]); - brt(run_param_array[run_param_cnt - 1]); + for (arnum = 2; arnum < argc; arnum++) + { + if (arnum != pp1 && arnum != pp2 && arnum != pp3) + { + run_param_cnt++; + strcpy (run_param_array[run_param_cnt - 1], argv[(int) arnum]); + keep_string_up_to_first_space (run_param_array[run_param_cnt - 1]); + } } - } - int11(debug, ttt); + int11 (debug, ttt); _L99: if (out != NULL) - fclose(out); - exit(0); + fclose (out); + exit (0); } /* End. */ - diff --git a/RIGAL/rigsc.446/src/ley_.c b/RIGAL/rigsc.446/src/ley_.c index d22d2cee03a4ed032c8ce3c32aebca9e370b1faf..3bf9a11d2ac5f4d10241866262ce74722df83156 100644 --- a/RIGAL/rigsc.446/src/ley_.c +++ b/RIGAL/rigsc.446/src/ley_.c @@ -5,7 +5,8 @@ #include "nef2.h" -/* lexic analysis for rigal language +/* + lexic analysis for rigal language input : text file with name first_file and if 'NOT_INCLUDE' is false then all included files @@ -20,67 +21,68 @@ exception: first_file never returned as first lexem. added letter to filename i if %included file c if returned from %include -*/ - -#define filemax 4 /* ~islo wlovenij dlq include */ -#define bufmaxlen 10 /* dlina malogo bufera , kak minimum - 8 */ -#define two_char_sym_max 50 /* maks. massiwa */ - - -typedef union bufrectype { - Char lexbuf[bufmaxlen]; - Char b1; - Char b2[2]; - Char b3[3]; - Char b4[4]; - Char b5[5]; - Char b6[6]; - Char b7[7]; - Char b8[8]; - Char b9[9]; - Char b10[10]; +*/ + +#define filemax 4 // ~islo wlovenij dlq include +#define bufmaxlen 10 // dlina malogo bufera , kak minimum - 8 +#define two_char_sym_max 50 // maks. massiwa + + +typedef union bufrectype +{ + char lexbuf[bufmaxlen]; + char b1; + char b2[2]; + char b3[3]; + char b4[4]; + char b5[5]; + char b6[6]; + char b7[7]; + char b8[8]; + char b9[9]; + char b10[10]; } bufrectype; -FILE *infile[filemax]; /* fajly ish. teksta */ -bufrectype bufrec; /* sohranenie dlq leksera !!!! */ +FILE *infile[filemax]; // fajly ish. teksta +bufrectype bufrec; // sohranenie dlq leksera !!!! c2 twochar_symbols[two_char_sym_max]; char twochar_symbols_num; -typedef Char a146[146]; /* source string type */ +typedef char a146[146]; // source string type -typedef Char bigstr_type[146]; +typedef char bigstr_type[146]; -typedef struct _REC_fistack { - long curline; /* current line of this file */ - filespecification f; /* file name */ +typedef struct _REC_fistack +{ + long curline; // current line of this file + filespecification f; // file name } _REC_fistack; -/* Local variables for ley: */ -struct LOC_ley { +// static variables for ley: +struct LOC_ley +{ error_rec_type *error_rec; a satomadr; - long i; /* current byte */ - boolean errflag; + long i; // current byte + bool errflag; a146 s; _REC_fistack fistack[filemax + 1]; long fistacklen; -} ; +}; -Local Void newlist(pp) -ptr_ *pp; +static void newlist (ptr_ *pp ) { - /* nowyj ukazatelx spiska */ - /* sozdaet nowyj spisok */ + mpd x; a a1; - gets5(&a1, &x.sa); - points(a1, &x.sa); + gets5 (&a1, &x.sa); + assert_and_assign_real_pointer (a1, &x.sa); x.smld->dtype = listmain; x.smld->lastfragm = a1; pp->ptrtype = ptrlist; @@ -90,199 +92,196 @@ ptr_ *pp; pp->UU.U1.mainadr = a1; } -Local Void push(pp, adr) -ptr_ *pp; -long adr; +static void push (ptr_ *pp, long adr) { mpd x, x1; a a1; - /* dobawlqet po pojnteru spiska nowyj |lement k spisku*/ - /* i sdwigaet pojnter pp */ - if (pp->ptrtype != ptrlist) { - printf("Rigal internal error Push-102\n"); - return; - } /* if/then */ - points(pp->UU.U1.mainadr, &x.sa); + + if (pp->ptrtype != ptrlist) + { + printf ("Rigal internal error Push-102\n"); + return; + } // if/then + assert_and_assign_real_pointer (pp->UU.U1.mainadr, &x.sa); if (x.smld->dtype == listmain) x.smld->totalelnum++; else - printf("Rigal internal error Push-101\n"); - points(pp->UU.U1.curfragment, &x.sa); - if ( - ( - (x.smld->dtype == listmain ) && - (pp->nel == mainlistelnum ) ) || - ( - (x.sfld->dtype == listfragm ) && - (pp->nel == fragmlistelnum ) ) - ) - { - /* w slu~ae dostiveniq konca fragmenta spiska */ - gets5(&a1, &x1.sa); - if (x.smld->dtype == listmain) /* podceplenie */ - x.smld->next = a1; - else - x.sfld->next = a1; - /* obrazuem i zapolnqem nowyj */ - x1.sfld->dtype = listfragm; - x1.sfld->elnum = 1; - x1.sfld->elt[0] = adr; - points(pp->UU.U1.mainadr, &x.sa); - x.smld->lastfragm = a1; - /* sdwig pojntera */ - pp->nel = 1; - pp->cel = adr; - pp->UU.U1.curfragment = a1; - return; - } /* then */ - /* ob{ij clu~aj dobawleniq |lementa wnutri fragmenta */ - switch (x.smld->dtype) { - - case listmain: - x.smld->elnum++; - x.smld->elt[pp->nel] = adr; - break; - - case listfragm: - x.sfld->elnum++; - x.sfld->elt[pp->nel] = adr; - break; - }/* case */ + printf ("Rigal internal error Push-101\n"); + assert_and_assign_real_pointer (pp->UU.U1.curfragment, &x.sa); + if (((x.smld->dtype == listmain) && + (pp->nel == mainlistelnum)) || + ((x.sfld->dtype == listfragm) && (pp->nel == fragmlistelnum))) + { + // w slu~ae dostiveniq konca fragmenta spiska + gets5 (&a1, &x1.sa); + if (x.smld->dtype == listmain) // podceplenie + x.smld->next = a1; + else + x.sfld->next = a1; + // obrazuem i zapolnqem nowyj + x1.sfld->dtype = listfragm; + x1.sfld->elnum = 1; + x1.sfld->elt[0] = adr; + assert_and_assign_real_pointer (pp->UU.U1.mainadr, &x.sa); + x.smld->lastfragm = a1; + // sdwig pojntera + pp->nel = 1; + pp->cel = adr; + pp->UU.U1.curfragment = a1; + return; + } // then + // ob{ij clu~aj dobawleniq |lementa wnutri fragmenta + switch (x.smld->dtype) + { + + case listmain: + x.smld->elnum++; + x.smld->elt[pp->nel] = adr; + break; + + case listfragm: + x.sfld->elnum++; + x.sfld->elt[pp->nel] = adr; + break; + } // case pp->nel++; pp->cel = adr; - /* else */ -} /* push */ + // else +} // push -Local Void mistake(mistake_num, LINK) -long mistake_num; -struct LOC_ley *LINK; +static void +mistake (mistake_num, LINK) + long mistake_num; + struct LOC_ley *LINK; { string80 com; - printf("Error...%12ld M=%s\n", mistake_num, LINK->error_rec->message); - switch (mistake_num) { + printf ("Error...%12ld M=%s\n", mistake_num, LINK->error_rec->message); + switch (mistake_num) + { - case 1: - strcpy(com, "MAIN PROGRAM FILE IS NOT FOUND "); - break; + case 1: + strcpy (com, "MAIN PROGRAM FILE IS NOT FOUND "); + break; - case 2: - strcpy(com, "MORE THAN 2 NESTED %INCLUDE FILES"); - break; + case 2: + strcpy (com, "MORE THAN 2 NESTED %INCLUDE FILES"); + break; - case 3: - strcpy(com, "THIS %INCLUDE FILE IS NOT FOUND "); - break; + case 3: + strcpy (com, "THIS %INCLUDE FILE IS NOT FOUND "); + break; - case 4: - strcpy(com, "TOO LONG (>80 BYTES) TOKEN"); - break; + case 4: + strcpy (com, "TOO LONG (>80 BYTES) TOKEN"); + break; - case 5: - strcpy(com, "WRONG CHARACTER AFTER NUMBER"); - break; + case 5: + strcpy (com, "WRONG CHARACTER AFTER NUMBER"); + break; - case 6: - strcpy(com, "TOO BIG NUMBER (> 2.**31) "); - break; + case 6: + strcpy (com, "TOO BIG NUMBER (> 2.**31) "); + break; - case 8: - strcpy(com, "ENDING APOSTROPHE NOT FOUND IN THIS LINE"); - break; + case 8: + strcpy (com, "ENDING APOSTROPHE NOT FOUND IN THIS LINE"); + break; - case 11: - strcpy(com, "THIS CHARACTER NOT ALLOWED "); - break; + case 11: + strcpy (com, "THIS CHARACTER NOT ALLOWED "); + break; - case 12: - strcpy(com, "NUMBER AFTER \"A'\" NOT FOUND "); - break; + case 12: + strcpy (com, "NUMBER AFTER \"A'\" NOT FOUND "); + break; - case 13: - strcpy(com, "ZERO LENGTH STRING NOT ALLOWED"); - break; + case 13: + strcpy (com, "ZERO LENGTH STRING NOT ALLOWED"); + break; - case 14: - strcpy(com, "RULE NAME AFTER \"#\" NOT FOUND "); - break; + case 14: + strcpy (com, "RULE NAME AFTER \"#\" NOT FOUND "); + break; - case 17: - strcpy(com, "NUMBER AFTER \"A'\" MUST BE N*512"); - break; + case 17: + strcpy (com, "NUMBER AFTER \"A'\" MUST BE N*512"); + break; - case 18: - strcpy(com, "WRONG DIGIT (8 or 9) IN OCTAL NUMBER "); - break; + case 18: + strcpy (com, "WRONG DIGIT (8 or 9) IN OCTAL NUMBER "); + break; - default: - strcpy(com, "UNKNOWN LEXICAL ERROR"); - break; - } - printf("...\n"); + default: + strcpy (com, "UNKNOWN LEXICAL ERROR"); + break; + } + printf ("...\n"); LINK->errflag = true; - strcpy(LINK->error_rec->message, com); + strcpy (LINK->error_rec->message, com); LINK->error_rec->address = LINK->fistack[LINK->fistacklen - 1].curline * 80 + LINK->i; - strcpy(LINK->error_rec->filename, LINK->fistack[LINK->fistacklen - 1].f); - printf(" LEXICAL ERROR : %s\n", com); - printf(" LINE=%12ld SYMBOL=%12ld\n", - LINK->fistack[LINK->fistacklen - 1].curline, LINK->i); + strcpy (LINK->error_rec->filename, LINK->fistack[LINK->fistacklen - 1].f); + printf (" LEXICAL ERROR : %s\n", com); + printf (" LINE=%12ld SYMBOL=%12ld\n", + LINK->fistack[LINK->fistacklen - 1].curline, LINK->i); } -Local Void makeatom(ik, jk, desk, LINK) -long ik, jk; -char desk; -struct LOC_ley *LINK; +static void +makeatom (ik, jk, desk, LINK) + long ik, jk; + char desk; + struct LOC_ley *LINK; { - /* makes s-atom - from array s, starting ik, length jk - */ + // makes s-atom + //from array s, starting ik, length jk + mpd x; a a1m; atomdescriptor *WITH; - putatm(&LINK->s[ik - 1], jk, &a1m); - gets1(&LINK->satomadr, &x.sa); + putatm (&LINK->s[ik - 1], jk, &a1m); + gets1 (&LINK->satomadr, &x.sa); WITH = x.sad; WITH->cord = LINK->fistack[LINK->fistacklen - 1].curline * 80 + LINK->i; - /*!!*/ + //!! WITH->dtype = desk; WITH->name = a1m; } -Void ley(first_file, lesrez, not_include, error_rec_) -Char *first_file; -long *lesrez; -boolean not_include; -error_rec_type *error_rec_; +void +ley (first_file, lesrez, not_include, error_rec_) + char *first_file; + long *lesrez; + bool not_include; + error_rec_type *error_rec_; { - /* added lastfragm 12-jul-91 */ + // added lastfragm 12-jul-91 struct LOC_ley V; - /*string80 first_file;*/ + //string80 first_file; char dt; longint ilong; a adr; char jcase; long j, nn, jj, ii; mpd x; - long len; /* current line length */ + long len; // current line length ptr_ p; mpd y; - boolean is_ident; - /* srb,srl,slb,sll: string; */ -/* Char table[256]; */ - boolean maybe_octal; - bigstr_type a_long; /*varying[145] of char;*/ + bool is_ident; + + bool maybe_octal; + bigstr_type a_long; //varying[145] of char; a146 s1; filespecification ff1; string80 ssint; - Char twochar_string[161]; + char twochar_string[161]; long FORLIM; int fff; numberdescriptor *WITH; @@ -290,39 +289,41 @@ error_rec_type *error_rec_; vardescriptor *WITH2; specdescriptor *WITH3; - /* start of main program */ - -/* strcpy(first_file, first_file_); */ + // start of main program + memset(V.s, 0, 146); +// strcpy(first_file, first_file_); V.error_rec = error_rec_; - strcpy(twochar_string, - ":= :: >= <> (. .) <= -> (* *) (+ +) ## ;; !! ++ !. <. .> <* *> << >> IF FI IN DO OD OR $$ <] S' V'"); - /* file stack initialization */ + strcpy (twochar_string, + ":= :: >= <> (. .) <= -> (* *) (+ +) ## ;; !! ++ !. <. .> <* *> << >> IF FI IN DO OD OR $$ <] S' V'"); + // file stack initialization V.fistacklen = 1; V.fistack[0].curline = 0; - strcpy(V.fistack[0].f, first_file); + strcpy (V.fistack[0].f, first_file); V.errflag = false; - for (V.i = 1; V.i <= 33; V.i++) { - twochar_symbols[V.i - 1][0] = twochar_string[V.i * 3 - 3]; - twochar_symbols[V.i - 1][1] = twochar_string[V.i * 3 - 2]; - } + for (V.i = 1; V.i <= 33; V.i++) + { + twochar_symbols[V.i - 1][0] = twochar_string[V.i * 3 - 3]; + twochar_symbols[V.i - 1][1] = twochar_string[V.i * 3 - 2]; + } twochar_symbols_num = 33; - if (!existfile(first_file)) { - strcpy(V.error_rec->message, first_file); - mistake(1L, &V); - goto _L199; - } - infile[0] = fopen(first_file, "r"); + if (!existfile (first_file)) + { + strcpy (V.error_rec->message, first_file); + mistake (1L, &V); + goto _L199; + } + infile[0] = fopen (first_file, "r"); if (infile[0] == NULL) - _EscIO(FileNotFound); - newlist( &p ); /* create list descriptor */ + _EscIO (FileNotFound); + newlist (&p); // create list descriptor *lesrez = p.UU.U1.mainadr; - /* for (ii = 0; ii <= 255; ii++) - table[(Char)ii] = (Char)ii;*/ + // for (ii = 0; ii <= 255; ii++) + // table[(char)ii] = (char)ii; - ii = 0; /* token number */ + ii = 0; // token number - /* file stack initialization */ + // file stack initialization V.i = 1; @@ -330,485 +331,495 @@ error_rec_type *error_rec_; _L1: - /* len - current line length - i - byte number in this line where first letter of - token stays */ - - if (V.i == len + 1) { - /* go to next line of source text */ - if (feof(infile[V.fistacklen - 1])) { - if (V.fistacklen == 1) - goto _L99; /* exit from lexer */ - else { - if (infile[V.fistacklen - 1] != NULL) - fclose(infile[V.fistacklen - 1]); - infile[V.fistacklen - 1] = NULL; - V.fistacklen--; - /* adding letter 'C'=continuation flag */ - if (strlen(ff1) < 80) ff1[(int)strlen(ff1)]='C'; - else exit(0); - //sprintf(ff1, "%sC", V.fistack[V.fistacklen - 1].f); - FORLIM = strlen(ff1); - for (j = 0; j < FORLIM; j++) - V.s[j] = ff1[j]; - makeatom(1L, (long)strlen(ff1), tatom, &V); - goto _L33; - } - } - - /* next line take */ - - /*readln(infile[fistacklen],a_long);*/ - - - -#ifdef xxx - *a_long = '\0'; - while (true) { - if (feoln(infile[V.fistacklen - 1])) { - c = getc(infile[V.fistacklen - 1]); - if (c == '\n') - c = ' '; - rline = 4; - goto _L95; - } - c = getc(infile[V.fistacklen - 1]); - if (c == '\n') - c = ' '; - sprintf(a_long + strlen(a_long), "%c", c); - if (feof(infile[V.fistacklen - 1])) { - rline = 1; - goto _L95; - } - if (!feoln(infile[V.fistacklen - 1])) - continue; - c = getc(infile[V.fistacklen - 1]); - if (c == '\n') - c = ' '; - if (feof(infile[V.fistacklen - 1])) - rline = 2; - else - rline = 3; - goto _L95; + // len - current line length + // i - byte number in this line where first letter of + // token stays + + if (V.i == len + 1) + { + // go to next line of source text + if (feof (infile[V.fistacklen - 1])) + { + if (V.fistacklen == 1) goto _L99;// exit from lexer + else + { + if (infile[V.fistacklen - 1] != NULL) + fclose (infile[V.fistacklen - 1]); + infile[V.fistacklen - 1] = NULL; + V.fistacklen--; + // adding letter 'C'=continuation flag + //if (strlen (ff1) < 80) ff1[(int) strlen (ff1)] = 'C'; + //else exit (0); + sprintf (ff1, "%sC", V.fistack[V.fistacklen - 1].f); + FORLIM = strlen (ff1); + for (j = 0; j < FORLIM; j++) V.s[j] = ff1[j]; + makeatom (1L, (long) strlen (ff1), tatom, &V); + goto _L33; + } + } + + // next line take + + //readln(infile[fistacklen],a_long); + + + + + fgets (a_long, 145, infile[V.fistacklen - 1]); + if (a_long[strlen (a_long) - 1] == '\n') + { + a_long[strlen (a_long) - 1] = 0; + fff = fgetc (infile[V.fistacklen - 1]); + if (fff != 10) + { + ungetc (fff, infile[V.fistacklen - 1]); + } + else + V.fistack[V.fistacklen - 1].curline++; + } + + V.fistack[V.fistacklen - 1].curline++; + // line counter + len = strlen (a_long); + memmove( V.s, a_long, len); + V.s[len] = ' '; + V.i = 1; } -_L95: -#endif - - fgets(a_long,145,infile[V.fistacklen-1]); - if (a_long[strlen(a_long)-1]=='\n') - { a_long[strlen(a_long)-1]=0; - fff=fgetc(infile[V.fistacklen-1]); - if (fff!=10) - { ungetc(fff,infile[V.fistacklen-1]);} - else - V.fistack[V.fistacklen - 1].curline++; - } - - V.fistack[V.fistacklen - 1].curline++; - /* line counter */ - len = strlen(a_long); - for (V.i = 1; V.i <= len; V.i++) - V.s[V.i - 1] = a_long[V.i - 1]; - V.s[len] = ' '; - V.i = 1; - } for (j = 1; j <= 10; j++) bufrec.b10[j - 1] = V.s[V.i + j - 2]; - if (!strncmp(bufrec.b2, "--", 2)) { /* koa_longmentarii */ - V.i = len + 1; - goto _L1; - } - switch (bufrec.b1) { - - case ' ': - case '\t': /*tabulator*/ - while ((V.s[V.i - 1] == ' ' || V.s[V.i - 1] == '\t') && V.i <= len) - V.i++; - /* when exits i=len+1 or s[i]<>' ' */ - goto _L1; - break; - - case '\'': - memcpy(s1, V.s, sizeof(a146)); - /* saving line to s1, analise, write to s - and give s to makeatom */ - j = 1; - jj = 1; - while ( - ( - ( V.i + j <= len ) && - ( - ( s1[V.i + j - 1] != '\'' ) || - ( ( s1[V.i + j - 1] == '\'' ) && - ( s1[V.i + j ] == '\'' ) ) ) - ) - ) - { - if (s1[V.i + j - 1] == '\'' && s1[V.i + j] == '\'') - j++; - /* if two apostrophes then we move to second - and write only one */ - V.s[V.i + jj - 1] = s1[V.i + j - 1]; - /* s filled not from [1] for right diagnostics*/ - jj++; - j++; - } - - is_ident = is_rig_letter (V.s[V.i]); - for (nn = 1; nn <= jj - 2; nn++) { - if (! is_rig_symbol (V.s[V.i + nn])) - is_ident = false; - } - if (is_ident) - dt = idatom; - else - dt = atom; - - if (jj == 1) { - mistake(13L, &V); - goto _L199; - } - if (s1[V.i + j - 1] != '\'') { - mistake(8L, &V); - goto _L199; - } - makeatom(V.i + 1, jj - 1, dt, &V); - V.i += j + 1; - memcpy(V.s, s1, sizeof(a146)); /* return saved line */ - goto _L33; - break; - - case '%': - if (!strncmp(bufrec.b6, "%INCLU", 6)) { - for (j = -1; j <= 6; j++) - V.s[V.i + j] = ' '; - *ff1 = '\0'; - for (j = 7; j <= len - 2; j++) { - /* file name we take till the end of line */ - if (V.s[V.i + j] != ' ') - sprintf(ff1 + strlen(ff1), "%c", V.s[V.i + j]); - } + if (!strncmp (bufrec.b2, "--", 2)) + { // koa_longmentarii V.i = len + 1; - if (!not_include) { - if (V.fistacklen == filemax) { - mistake(2L, &V); - goto _L199; - } - - V.fistacklen++; - - if (!existfile(ff1)) { - V.fistacklen--; - strcpy(V.error_rec->message, ff1); - mistake(3L, &V); - goto _L199; - } - - - - infile[V.fistacklen - 1] = fopen(ff1, "r"); - - if (infile[V.fistacklen - 1] == NULL) - _EscIO(FileNotFound); - printf("reading %s\n", ff1); - - - V.fistack[V.fistacklen - 1].curline = 0; - strcpy(V.fistack[V.fistacklen - 1].f, ff1); - /* establish %include flag='I' */ - strcat(ff1, "I"); - FORLIM = strlen(ff1); - for (j = 0; j < FORLIM; j++) - V.s[j] = ff1[j]; - makeatom(1L, (long)strlen(ff1), tatom, &V); - V.i = 1; - len = 0; - goto _L33; - } - V.i = 1; - len = 0; goto _L1; - } else { - mistake(11L, &V); - goto _L199; } - break; + switch (bufrec.b1) + { + + case ' ': + case '\t': //tabulator + while ((V.s[V.i - 1] == ' ' || V.s[V.i - 1] == '\t') && V.i <= len) + V.i++; + // when exits i=len+1 or s[i]<>' ' + goto _L1; + break; - case '#': - j = 1; - if (!strncmp(bufrec.b2, "##", 2)) { - makeatom(V.i, 2L, keyword, &V); - V.i += 2; + case '\'': + //memcpy (s1, V.s, sizeof (a146)); + memmove( s1, V.s, sizeof(a146)); + // saving line to s1, analise, write to s + // and give s to makeatom + j = 1; + jj = 1; + while (((V.i + j <= len) && + ((s1[V.i + j - 1] != '\'') || + ((s1[V.i + j - 1] == '\'') && (s1[V.i + j] == '\''))))) + { + if (s1[V.i + j - 1] == '\'' && s1[V.i + j] == '\'') + j++; + // if two apostrophes then we move to second + // and write only one + V.s[V.i + jj - 1] = s1[V.i + j - 1]; + // s filled not from [1] for right diagnostics + jj++; + j++; + } + + is_ident = is_rig_letter (V.s[V.i]); + for (nn = 1; nn <= jj - 2; nn++) + { + if (!is_rig_symbol (V.s[V.i + nn])) + is_ident = false; + } + if (is_ident) + dt = idatom; + else + dt = atom; + + if (jj == 1) + { + mistake (13L, &V); + goto _L199; + } + if (s1[V.i + j - 1] != '\'') + { + mistake (8L, &V); + goto _L199; + } + makeatom (V.i + 1, jj - 1, dt, &V); + V.i += j + 1; + //memcpy (V.s, s1, sizeof (a146)); // return saved line + memmove(V.s, s1, sizeof( a146) ); goto _L33; - } + break; - while ( is_rig_symbol (V.s[V.i + j - 1])) - j++; - if (j == 1) { - mistake(14L, &V); - goto _L199; - } - j--; - putatm(&V.s[V.i], j, &adr); - gets2(&V.satomadr, &y.sa); - WITH1 = y.srd; - WITH1->dtype = rulename; - WITH1->cord = V.fistack[V.fistacklen - 1].curline * 80 + V.i; - WITH1->fragmadr = 0; - WITH1->nomintab = 0; - WITH1->name = adr; - V.i += j + 1; - goto _L33; - break; - - case '$': - j = 1; - if (V.s[V.i] == '$') { - j = 2; - putatm(&V.s[V.i - 1], j, &adr); - makeatom(V.i, 2L, keyword, &V); - V.i += 2; - goto _L33; - } - while (is_rig_symbol(V.s[V.i + j - 1])) - j++; - j--; - if (j > 0) - putatm(&V.s[V.i], j, &adr); - j++; - if (j == 1) { - V.s[V.i - 1] = '_'; + case '%': + if (!strncmp (bufrec.b6, "%INCLU", 6)) + { + for (j = -1; j <= 6; j++) + V.s[V.i + j] = ' '; + *ff1 = '\0'; + for (j = 7; j <= len - 2; j++) + { + // file name we take till the end of line + if (V.s[V.i + j] != ' ') sprintf (ff1 + strlen (ff1), "%c", V.s[V.i + j]); + } + V.i = len + 1; + if (!not_include) + { + if (V.fistacklen == filemax) + { + mistake (2L, &V); + goto _L199; + } + + V.fistacklen++; + + if (!existfile (ff1)) + { + V.fistacklen--; + strcpy (V.error_rec->message, ff1); + mistake (3L, &V); + goto _L199; + } + + + + infile[V.fistacklen - 1] = fopen (ff1, "r"); + + if (infile[V.fistacklen - 1] == NULL) + _EscIO (FileNotFound); + printf ("reading %s\n", ff1); + + + V.fistack[V.fistacklen - 1].curline = 0; + strcpy (V.fistack[V.fistacklen - 1].f, ff1); + // establish %include flag='I' + strcat (ff1, "I"); + FORLIM = strlen (ff1); + for (j = 0; j < FORLIM; j++) + V.s[j] = ff1[j]; + makeatom (1L, (long) strlen (ff1), tatom, &V); + V.i = 1; + len = 0; + goto _L33; + } + V.i = 1; + len = 0; + goto _L1; + } + else + { + mistake (11L, &V); + goto _L199; + } + break; + + case '#': j = 1; - putatm(&V.s[V.i - 1], j, &adr); - } - gets1(&V.satomadr, &x.sa); - WITH2 = x.svd; /* with */ - switch (V.s[V.i]) { + if (!strncmp (bufrec.b2, "##", 2)) + { + makeatom (V.i, 2L, keyword, &V); + V.i += 2; + goto _L33; + } + + while (is_rig_symbol (V.s[V.i + j - 1])) + j++; + if (j == 1) + { + mistake (14L, &V); + goto _L199; + } + j--; + putatm (&V.s[V.i], j, &adr); + gets2 (&V.satomadr, &y.sa); + WITH1 = y.srd; + WITH1->dtype = rulename; + WITH1->cord = V.fistack[V.fistacklen - 1].curline * 80 + V.i; + WITH1->fragmadr = 0; + WITH1->nomintab = 0; + WITH1->name = adr; + V.i += j + 1; + goto _L33; + break; - case 'N': - WITH2->dtype = nvariable; + case '$': + j = 1; + if (V.s[V.i] == '$') + { + j = 2; + putatm (&V.s[V.i - 1], j, &adr); + makeatom (V.i, 2L, keyword, &V); + V.i += 2; + goto _L33; + } + while (is_rig_symbol (V.s[V.i + j - 1])) + j++; + j--; + if (j > 0) + putatm (&V.s[V.i], j, &adr); + j++; + if (j == 1) + { + V.s[V.i - 1] = '_'; + j = 1; + putatm (&V.s[V.i - 1], j, &adr); + } + gets1 (&V.satomadr, &x.sa); + WITH2 = x.svd; // with + switch (V.s[V.i]) + { + + case 'N': + WITH2->dtype = nvariable; + break; + + case 'I': + WITH2->dtype = idvariable; + break; + + + default: + WITH2->dtype = variable; + break; + } + WITH2->location = 0; + WITH2->name = adr; + WITH2->guard = false; + V.i += j; + goto _L33; break; - case 'I': - WITH2->dtype = idvariable; + case '(': + case ':': + case '*': + case '<': + case '>': + case '.': + case '-': + case '+': + case ';': + case '!': + if (bufrec.b2[1] == ']' || bufrec.b2[1] == '<' || bufrec.b2[1] == '!' || + bufrec.b2[1] == ';' || bufrec.b2[1] == '+' || bufrec.b2[1] == ':' || + bufrec.b2[1] == '*' || bufrec.b2[1] == ')' || bufrec.b2[1] == '>' || + bufrec.b2[1] == '.' || bufrec.b2[1] == '=') + { + FORLIM = twochar_symbols_num; + for (nn = 0; nn < FORLIM; nn++) + { + if (bufrec.b2[0] == twochar_symbols[nn][0] && + bufrec.b2[1] == twochar_symbols[nn][1]) + { + makeatom (V.i, 2L, keyword, &V); + V.i += 2; + goto _L33; + } + } + } + makeatom (V.i, 1L, keyword, &V); + V.i++; + goto _L33; break; + case ')': + case '=': + case ',': + case '/': + case '^': + case '@': + case ']': + case '[': + makeatom (V.i, 1L, keyword, &V); + V.i++; + goto _L33; + break; default: - WITH2->dtype = variable; + if (isdigit (bufrec.b1)) + { + *ssint = '\0'; + jj = 0; + j = 0; + ilong = 0; + maybe_octal = true; + while (isdigit (V.s[V.i + j - 1])) + { + if (V.s[V.i + j - 1] == '8' || V.s[V.i + j - 1] == '9') + maybe_octal = false; + ilong = ilong * 8 + V.s[V.i + j - 1] - '0'; + sprintf (ssint + strlen (ssint), "%c", V.s[V.i + j - 1]); + j++; + } + if (V.s[V.i + j - 1] == 'B' || V.s[V.i + j - 1] == 'b') + { + if (!maybe_octal) + { + mistake (18L, &V); + goto _L199; + } + j++; + } + else if (is_rig_symbol (V.s[V.i + j - 1])) + { + mistake (5L, &V); + goto _L199; + } + else + val (ssint, &ilong, &jj); + if (jj == 0 && ilong < 2147483647) + { + gets1 (&V.satomadr, &x.sa); + WITH = x.snd; // with + WITH->dtype = number; + WITH->cord = V.fistack[V.fistacklen - 1].curline * 80 + V.i; //!! + WITH->val = ilong; + V.i += j; + goto _L33; + } + else + { + mistake (6L, &V); + goto _L199; + } + + } + else + { + + + + + + if (is_rig_letter (bufrec.b1)) + { + j = 1; + while (is_rig_symbol (V.s[V.i + j - 1])) + j++; + dt = idatom; + jcase = j; + switch (jcase) + { + + case 1: + if (!strncmp (bufrec.b2, "S'", 2) + || !strncmp (bufrec.b2, "V'", 2)) + { + j = 2; + dt = keyword; + } + break; + + case 2: + if (!strncmp (bufrec.b2, "OD", 2) + || !strncmp (bufrec.b2, "IF", 2) + || !strncmp (bufrec.b2, "FI", 2) + || !strncmp (bufrec.b2, "IN", 2) + || !strncmp (bufrec.b2, "DO", 2) + || !strncmp (bufrec.b2, "OR", 2)) + dt = keyword; + break; + + case 3: + if (!strncmp (bufrec.b3, "AND", 3) || + !strncmp (bufrec.b3, "MOD", 3) || + !strncmp (bufrec.b3, "DIV", 3) || + !strncmp (bufrec.b3, "END", 3) + || !strncmp (bufrec.b3, "NOT", 3)) + dt = keyword; + break; + + case 4: + if (!strncmp (bufrec.b4, "NULL", 4)) + { + V.i += 4; + gets1 (&V.satomadr, &x.sa); + WITH3 = x.sspec; + WITH3->dtype = spec; + WITH3->val = 0; + goto _L33; + } + + if (!strncmp (bufrec.b4, "LAST", 4) || + !strncmp (bufrec.b4, "LOOP", 4) || + !strncmp (bufrec.b4, "OPEN", 4) || + !strncmp (bufrec.b4, "SAVE", 4) || + !strncmp (bufrec.b4, "FAIL", 4) || + !strncmp (bufrec.b4, "COPY", 4) || + !strncmp (bufrec.b4, "LOAD", 4)) + dt = keyword; + break; + + case 5: + if (!strncmp (bufrec.b5, "ELSIF", 5) || + !strncmp (bufrec.b5, "CLOSE", 5) || + !strncmp (bufrec.b5, "BREAK", 5) || + !strncmp (bufrec.b5, "PRINT", 5)) + dt = keyword; + break; + + case 6: + if (!strncmp (bufrec.b6, "ONFAIL", 6) || + !strncmp (bufrec.b6, "RETURN", 6) || + !strncmp (bufrec.b6, "FORALL", 6)) + dt = keyword; + break; + + case 8: + if (!strncmp (bufrec.b8, "BRANCHES", 8)) + dt = keyword; + break; + + case 9: + if (!strncmp (bufrec.b9, "SELECTORS", 9)) + dt = keyword; + break; + + + } //case + + makeatom (V.i, j, dt, &V); + V.i += j; + goto _L33; + } + else + { + mistake (11L, &V); + goto _L199; + } + } break; - } - WITH2->location = 0; - WITH2->name = adr; - WITH2->guard = false; - V.i += j; - goto _L33; - break; - - case '(': - case ':': - case '*': - case '<': - case '>': - case '.': - case '-': - case '+': - case ';': - case '!': - if (bufrec.b2[1] == ']' || bufrec.b2[1] == '<' || bufrec.b2[1] == '!' || - bufrec.b2[1] == ';' || bufrec.b2[1] == '+' || bufrec.b2[1] == ':' || - bufrec.b2[1] == '*' || bufrec.b2[1] == ')' || bufrec.b2[1] == '>' || - bufrec.b2[1] == '.' || bufrec.b2[1] == '=') { - FORLIM = twochar_symbols_num; - for (nn = 0; nn < FORLIM; nn++) { - if (bufrec.b2[0] == twochar_symbols[nn][0] && - bufrec.b2[1] == twochar_symbols[nn][1]) { - makeatom(V.i, 2L, keyword, &V); - V.i += 2; - goto _L33; - } - } - } - makeatom(V.i, 1L, keyword, &V); - V.i++; - goto _L33; - break; - - case ')': - case '=': - case ',': - case '/': - case '^': - case '@': - case ']': - case '[': - makeatom(V.i, 1L, keyword, &V); - V.i++; - goto _L33; - break; - - default: - if (isdigit(bufrec.b1)) { - *ssint = '\0'; - jj = 0; - j = 0; - ilong = 0; - maybe_octal = true; - while (isdigit (V.s[V.i + j - 1]) ) { - if (V.s[V.i + j - 1] == '8' || V.s[V.i + j - 1] == '9') - maybe_octal = false; - ilong = ilong * 8 + V.s[V.i + j - 1] - '0'; - sprintf(ssint + strlen(ssint), "%c", V.s[V.i + j - 1]); - j++; - } - if (V.s[V.i + j - 1] == 'B' || V.s[V.i + j - 1] == 'b') { - if (!maybe_octal) { - mistake(18L, &V); - goto _L199; - } - j++; - } else if (is_rig_symbol (V.s[V.i + j - 1])) { - mistake(5L, &V); - goto _L199; - } else - val(ssint, &ilong, &jj); - if (jj == 0 && ilong < 2147483647 ) { - gets1(&V.satomadr, &x.sa); - WITH = x.snd; /* with */ - WITH->dtype = number; - WITH->cord = V.fistack[V.fistacklen - 1].curline * 80 + V.i; /*!!*/ - WITH->val = ilong; - V.i += j; - goto _L33; - } else { - mistake(6L, &V); - goto _L199; - } - - } else { - - - - - - if ( is_rig_letter (bufrec.b1)) { - j = 1; - while ( is_rig_symbol (V.s[V.i + j - 1])) - j++; - dt = idatom; - jcase = j; - switch (jcase) { - - case 1: - if (!strncmp(bufrec.b2, "S'", 2) || !strncmp(bufrec.b2, "V'", 2)) { - j = 2; - dt = keyword; - } - break; - - case 2: - if (!strncmp(bufrec.b2, "OD", 2) || !strncmp(bufrec.b2, "IF", 2) || - !strncmp(bufrec.b2, "FI", 2) || !strncmp(bufrec.b2, "IN", 2) || - !strncmp(bufrec.b2, "DO", 2) || !strncmp(bufrec.b2, "OR", 2)) - dt = keyword; - break; - - case 3: - if (!strncmp(bufrec.b3, "AND", 3) || - !strncmp(bufrec.b3, "MOD", 3) || - !strncmp(bufrec.b3, "DIV", 3) || - !strncmp(bufrec.b3, "END", 3) || !strncmp(bufrec.b3, "NOT", 3)) - dt = keyword; - break; - - case 4: - if (!strncmp(bufrec.b4, "NULL", 4)) { - V.i += 4; - gets1(&V.satomadr, &x.sa); - WITH3 = x.sspec; - WITH3->dtype = spec; - WITH3->val = 0; - goto _L33; - } - - if (!strncmp(bufrec.b4, "LAST", 4) || - !strncmp(bufrec.b4, "LOOP", 4) || - !strncmp(bufrec.b4, "OPEN", 4) || - !strncmp(bufrec.b4, "SAVE", 4) || - !strncmp(bufrec.b4, "FAIL", 4) || - !strncmp(bufrec.b4, "COPY", 4) || - !strncmp(bufrec.b4, "LOAD", 4)) - dt = keyword; - break; - - case 5: - if (!strncmp(bufrec.b5, "ELSIF", 5) || - !strncmp(bufrec.b5, "CLOSE", 5) || - !strncmp(bufrec.b5, "BREAK", 5) || - !strncmp(bufrec.b5, "PRINT", 5)) - dt = keyword; - break; - - case 6: - if (!strncmp(bufrec.b6, "ONFAIL", 6) || - !strncmp(bufrec.b6, "RETURN", 6) || - !strncmp(bufrec.b6, "FORALL", 6)) - dt = keyword; - break; - - case 8: - if (!strncmp(bufrec.b8, "BRANCHES", 8)) - dt = keyword; - break; - - case 9: - if (!strncmp(bufrec.b9, "SELECTORS", 9)) - dt = keyword; - break; - - - }/*case*/ - - makeatom(V.i, j, dt, &V); - V.i += j; - goto _L33; - } else { - mistake(11L, &V); - goto _L199; - } - } - break; - }/* case */ + } // case _L33: ii++; - push(&p, V.satomadr ); /* adding to list */ - goto _L1; /*with*/ + push (&p, V.satomadr); // adding to list + goto _L1; //with _L99: if (V.errflag) - printf("... RIGAL lexic errors found\n"); - /* writeln('Tokens count=',ii,' ');*/ + printf ("... RIGAL lexic errors found\n"); + // writeln('Tokens count=',ii,' '); if (infile[0] != NULL) - fclose(infile[0]); + fclose (infile[0]); infile[0] = NULL; -/* printf(" TOTAL RESULT=\n"); - pscr(*lesrez); - printf("\n"); */ +// printf(" TOTAL RESULT=\n"); +// pscr(*lesrez); +// printf("\n"); -_L199: ; +_L199:; - /* prints current line counter */ - /*write(fistack[fistacklen].curline,' ');*/ - /* go to more common file */ + // prints current line counter + //write(fistack[fistacklen].curline,' '); + // go to more common file - /* no mistake */ + // no mistake } -/* End. */ +// End. diff --git a/RIGAL/rigsc.446/src/nef2.c b/RIGAL/rigsc.446/src/nef2.c index 0a1d15c9f9433693fb43241e961fd89191def83c..ff1ea22a2f1e3e5b0dc0a947284df59afd2f4c12 100644 --- a/RIGAL/rigsc.446/src/nef2.c +++ b/RIGAL/rigsc.446/src/nef2.c @@ -5,55 +5,56 @@ #include "nef2.h" /***************** nef2.inc ***************/ -extern Void next PP((ptr_ *p)); +extern void next PP ((ptr_ * p)); -extern boolean eqatoms PP((long p1, long p2)); +extern bool eqatoms PP ((long p1, long p2)); -extern Void first PP((long p, ptr_ *pp)); +extern void first PP ((long p, ptr_ * pp)); -extern Void lconc PP((long *a1, long a2)); +extern void lconc PP ((long *a1, long a2)); /* add an element*/ -extern Void crlst PP((long *l)); +extern void crlst PP ((long *l)); /* s-adr. added element */ /* s- adr. new fragment */ -extern Void crlistfr PP((long el, long *f)); +extern void crlistfr PP ((long el, long *f)); -extern Void crtree PP((long *t)); +extern void crtree PP ((long *t)); /* make empty tree */ /* s-address of new tree fragment */ -extern Void crtreefr PP((long sel, long ob, long *frag)); +extern void crtreefr PP ((long sel, long ob, long *frag)); /* where to change */ /* change to adr */ -extern Void changeel PP((ptr_ *pp, long adr)); +extern void changeel PP ((ptr_ * pp, long adr)); /* input - s-address */ /* output:long integer value */ -extern boolean plnum PP((long sval, long *intval)); +extern bool plnum PP ((long sval, long *intval)); /* input - any number */ -extern Void mknumb PP((long n, long *r)); +extern void mknumb PP ((long n, long *r)); /* output - new descriptor (number) */ /* s-address of main tree descr*/ /* selector, a-address */ /* object*/ -extern Void addel3 PP((long *tr_, long sel, long ob)); +extern void addel3 PP ((long *tr_, long sel, long ob)); /* 1-st tree */ /* 2-nd tree */ -extern Void addtre PP((long *m, long t2)); +extern void addtre PP ((long *m, long t2)); -extern boolean compatom PP((long op, long adr1, long adr2)); +extern bool compatom PP ((long op, long adr1, long adr2)); -extern double take_fatom PP((long a1)); +extern double take_fatom PP ((long a1)); -Void next(p) -ptr_ *p; +void +next (p) + ptr_ *p; { /* refers to list/tree element */ /*=======================================*/ @@ -65,189 +66,233 @@ ptr_ *p; a y, a1; - if (p->nel != 0) { - switch (p->ptrtype) { - - case ptrlist: - a1 = p->UU.U1.curfragment; - pointr(a1, &x.sa); /* access fragment */ - switch (x.smld->dtype) { - - case listmain: - if (p->nel < x.smld->elnum) { /* may stay in this descriptor */ - p->nel++; - p->cel = x.smld->elt[p->nel - 1]; - } else { - /* to next deskriptor */ - y = x.smld->next; - if (y == 0) { /* end of list */ - p->nel = 0; - p->cel = 0; - } else { - pointr(y, &x.sa); - p->nel = 1; - p->cel = x.sfld->elt[0]; - p->UU.U1.curfragment = y; - } - } - break; - - case listfragm: - if (p->nel < x.sfld->elnum) { /* may stay here */ - p->nel++; - p->cel = x.sfld->elt[p->nel - 1]; - } else { - do { - y = x.sfld->next; - /* go next */ - if (y == 0) { /* end of list */ + if (p->nel != 0) + { + switch (p->ptrtype) + { + + case ptrlist: + a1 = p->UU.U1.curfragment; + assert_and_assign_real_pointer (a1, &x.sa); /* access fragment */ + switch (x.smld->dtype) + { + + case listmain: + if (p->nel < x.smld->elnum) + { /* may stay in this descriptor */ + p->nel++; + p->cel = x.smld->elt[p->nel - 1]; + } + else + { + /* to next deskriptor */ + y = x.smld->next; + if (y == 0) + { /* end of list */ + p->nel = 0; + p->cel = 0; + } + else + { + assert_and_assign_real_pointer (y, &x.sa); + p->nel = 1; + p->cel = x.sfld->elt[0]; + p->UU.U1.curfragment = y; + } + } + break; + + case listfragm: + if (p->nel < x.sfld->elnum) + { /* may stay here */ + p->nel++; + p->cel = x.sfld->elt[p->nel - 1]; + } + else + { + do + { + y = x.sfld->next; + /* go next */ + if (y == 0) + { /* end of list */ + p->nel = 0; + p->cel = 0; + } + else + { + assert_and_assign_real_pointer (y, &x.sa); + if (x.sfld->elnum > 0) + { + p->nel = 1; + p->cel = x.sfld->elt[0]; + p->UU.U1.curfragment = y; + goto _L99; + } + } + } + while (x.sfld->next != 0); /* next.deskr. */ + } + break; + + default: + printf (" Internal error (NEXT-1)\n"); + break; + } /* case */ + + + break; + /* ptrlist */ + + + case ptrtree: + /*------ tree --------*/ + a1 = p->UU.U1.curfragment; + assert_and_assign_real_pointer (a1, &x.sa); /* access to fragment */ + switch (x.smtd->dtype) + { + + case treemain: + if (p->nel < x.smtd->arcnum) + { /* may stay here */ + p->nel++; + p->cel = x.smtd->arc[p->nel - 1].elt; + p->UU.U1.arc = x.smtd->arc[p->nel - 1].arcname; + } + else + { + /* go to next descriptor */ + y = x.smtd->next; + if (y == 0) + { /* end of tree */ + p->nel = 0; + p->cel = 0; + } + else + { + assert_and_assign_real_pointer (y, &x.sa); + + while (x.sftd->next != 0 && x.sftd->arcnum == 0) + { + y = x.sftd->next; + assert_and_assign_real_pointer (y, &x.sa); + } + if (x.sftd->arcnum > 0) + { + p->nel = 1; + p->cel = x.sftd->arc[0].elt; + p->UU.U1.arc = x.sftd->arc[0].arcname; + p->UU.U1.curfragment = y; + + } + else + { + p->cel = 0; + p->nel = 0; + } + + } + } + break; + + case treefragm: + if (p->nel < x.sftd->arcnum) + { /* may stay here */ + p->nel++; + p->cel = x.sftd->arc[p->nel - 1].elt; + p->UU.U1.arc = x.sftd->arc[p->nel - 1].arcname; + } + else + { + do + { + + y = x.sftd->next; + /* go to next */ + if (y == 0) + { /* end of tree */ + p->nel = 0; + p->cel = 0; + } + else + { + assert_and_assign_real_pointer (y, &x.sa); + + + while (x.sftd->next != 0 && x.sftd->arcnum == 0) + { + y = x.sftd->next; + assert_and_assign_real_pointer (y, &x.sa); + } + + + if (x.sftd->arcnum > 0) + { + p->nel = 1; + p->cel = x.sftd->arc[0].elt; + p->UU.U1.arc = x.sftd->arc[0].arcname; + p->UU.U1.curfragment = y; + goto _L99; + } + + p->cel = 0; + p->nel = 0; + } /*else */ + + + } + while (x.sftd->next != 0); /* else */ + } + break; + + + default: + printf (" Internal error NEXT-2\n"); + break; + } /* case */ + + + break; + + /* ptrtree */ + + case packedlist: + /* ---- list built-in in ptr ---------- */ + if (p->nel == p->plistsize) + { p->nel = 0; - p->cel = 0; - } else { - pointr(y, &x.sa); - if (x.sfld->elnum > 0) { - p->nel = 1; - p->cel = x.sfld->elt[0]; - p->UU.U1.curfragment = y; - goto _L99; - } + p->cel = null_; } - } while (x.sfld->next != 0); /* next.deskr. */ - } - break; - - default: - printf(" Internal error (NEXT-1)\n"); - break; - }/* case */ - - - break; - /* ptrlist */ - - - case ptrtree: /*------ tree --------*/ - a1 = p->UU.U1.curfragment; - pointr(a1, &x.sa); /* access to fragment */ - switch (x.smtd->dtype) { - - case treemain: - if (p->nel < x.smtd->arcnum) { /* may stay here */ - p->nel++; - p->cel = x.smtd->arc[p->nel - 1].elt; - p->UU.U1.arc = x.smtd->arc[p->nel - 1].arcname; - } else { - /* go to next descriptor */ - y = x.smtd->next; - if (y == 0) { /* end of tree */ - p->nel = 0; - p->cel = 0; - } else { - pointr(y, &x.sa); - - while (x.sftd->next != 0 && x.sftd->arcnum == 0) { - y = x.sftd->next; - pointr(y, &x.sa); + else + { + p->nel++; + /* nel <= plistsize <= 4 */ + p->cel = p->UU.plistelt[p->nel - 2]; } - if (x.sftd->arcnum > 0) { - p->nel = 1; - p->cel = x.sftd->arc[0].elt; - p->UU.U1.arc = x.sftd->arc[0].arcname; - p->UU.U1.curfragment = y; - - } else { - p->cel = 0; - p->nel = 0; - } - - } - } - break; - - case treefragm: - if (p->nel < x.sftd->arcnum) { /* may stay here */ - p->nel++; - p->cel = x.sftd->arc[p->nel - 1].elt; - p->UU.U1.arc = x.sftd->arc[p->nel - 1].arcname; - } else { - do { - - y = x.sftd->next; - /* go to next */ - if (y == 0) { /* end of tree */ - p->nel = 0; - p->cel = 0; - } else { - pointr(y, &x.sa); - - - while (x.sftd->next != 0 && x.sftd->arcnum == 0) { - y = x.sftd->next; - pointr(y, &x.sa); - } - - - if (x.sftd->arcnum > 0) { - p->nel = 1; - p->cel = x.sftd->arc[0].elt; - p->UU.U1.arc = x.sftd->arc[0].arcname; - p->UU.U1.curfragment = y; - goto _L99; - } - - p->cel = 0; - p->nel = 0; - } /*else */ - - - } while (x.sftd->next != 0); /* else */ - } - break; - - - default: - printf(" Internal error NEXT-2\n"); - break; - }/* case */ - - - break; + break; - /* ptrtree */ - case packedlist: - /* ---- list built-in in ptr ---------- */ - if (p->nel == p->plistsize) { - p->nel = 0; - p->cel = null_; - } else { - p->nel++; - /* nel <= plistsize <= 4 */ - p->cel = p->UU.plistelt[p->nel - 2]; - } - break; + default: + printf (" Internal error NEXT-3 \n"); + break; + } /* big case */ + } - default: - printf(" Internal error NEXT-3 \n"); - - break; - }/* big case */ - } - -_L99: ; /*exit*/ +_L99:; /*exit */ -} /* next */ +} /* next */ -boolean eqatoms(p1, p2) -long p1, p2; +bool +eqatoms (p1, p2) + long p1, p2; { /* atom address */ /* atom address */ @@ -258,52 +303,58 @@ long p1, p2; if (p1 == p2) return true; - else if (p1 != 0) { - pointr(p1, &s1.sa); - if (p2 != 0) { - pointr(p2, &s2.sa); - - - return (!memcmp(s1.sc8, s2.sc8, sizeof(atomdescriptor)) || - (((1L << ((long)s1.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)fatom)))) != - 0 && - ((1L << ((long)s2.sad->dtype)) & - (((1L << ((long)keyword + 1)) - (1L << ((long)atom))) | - (1L << ((long)fatom)))) != - 0 && - s1.sad->name == s2.sad->name) || - (s1.sad->dtype == tatom && - s2.sad->dtype == tatom && - s1.sad->name == s2.sad->name) || - (s1.sad->dtype == number && - s2.sad->dtype == number && - s1.snd->val == s2.snd->val)); + else if (p1 != 0) + { + assert_and_assign_real_pointer (p1, &s1.sa); + if (p2 != 0) + { + assert_and_assign_real_pointer (p2, &s2.sa); + + + return (!memcmp (s1.sc8, s2.sc8, sizeof (atomdescriptor)) || + (((1L << ((long) s1.sad->dtype)) & + (((1L << ((long) keyword + 1)) - (1L << ((long) atom))) | + (1L << ((long) fatom)))) != + 0 && + ((1L << ((long) s2.sad->dtype)) & + (((1L << ((long) keyword + 1)) - (1L << ((long) atom))) | + (1L << ((long) fatom)))) != + 0 && + s1.sad->name == s2.sad->name) || + (s1.sad->dtype == tatom && + s2.sad->dtype == tatom && + s1.sad->name == s2.sad->name) || + (s1.sad->dtype == number && + s2.sad->dtype == number && s1.snd->val == s2.snd->val)); /* p2c: nef2.z, line 710: Note: * Line breaker spent 0.9+0.49 seconds, 5000 tries on line 811 [251] */ - /* added 20-jul-1989 in pc/at */ + /* added 20-jul-1989 in pc/at */ - } else /* p2 = 0 */ - return (s1.smld->totalelnum == 0); + } + else /* p2 = 0 */ + return (s1.smld->totalelnum == 0); - } else if (p2 != 0) { - pointr(p2, &s2.sa); - return (s2.smld->totalelnum == 0); - } else + } + else if (p2 != 0) + { + assert_and_assign_real_pointer (p2, &s2.sa); + return (s2.smld->totalelnum == 0); + } + else return true; /* p1 = 0 */ -} /* eqatoms */ +} /* eqatoms */ -Void first(p, pp) -long p; -ptr_ *pp; +void +first (p, pp) + long p; + ptr_ *pp; { /* address of main descriptor of tree/list */ /* result */ @@ -316,84 +367,99 @@ ptr_ *pp; pp->ptrtype = ptrlist; - if (p == null_) { - pp->nel = 0; - pp->cel = 0; - } else { /*1*/ - pointr(p, &x.sa); + if (p == null_) + { + pp->nel = 0; + pp->cel = 0; + } + else + { /*1 */ + assert_and_assign_real_pointer (p, &x.sa); - if (x.smld->dtype == listmain) - pp->ptrtype = ptrlist; - else - pp->ptrtype = ptrtree; - switch (pp->ptrtype) { + if (x.smld->dtype == listmain) + pp->ptrtype = ptrlist; + else + pp->ptrtype = ptrtree; + switch (pp->ptrtype) + { - case ptrlist: + case ptrlist: /*----------- for lists -----------------*/ - if (x.smld->totalelnum == 0) { /* empty list */ - pp->nel = 0; - pp->cel = 0; - } /*2*/ - else { /*2*/ - pp->nel = 1; - pp->cel = x.smld->elt[0]; - pp->UU.U1.curfragment = p; - } /*2*/ - /*2*/ - break; - - - case ptrtree: + if (x.smld->totalelnum == 0) + { /* empty list */ + pp->nel = 0; + pp->cel = 0; + } /*2 */ + else + { /*2 */ + pp->nel = 1; + pp->cel = x.smld->elt[0]; + pp->UU.U1.curfragment = p; + } /*2 */ + /*2 */ + break; + + + case ptrtree: /*----------- for trees -----------------*/ - if (x.smtd->totalarcnum == 0) { /* empty tree */ - pp->nel = 0; - pp->cel = 0; - } else { /*2*/ - if (x.smtd->arcnum != 0) { - pp->nel = 1; - pp->cel = x.smtd->arc[0].elt; - pp->UU.U1.arc = x.smtd->arc[0].arcname; - pp->UU.U1.curfragment = p; - } else { - while (x.sftd->next != 0 && x.sftd->arcnum == 0) { - y = x.sftd->next; - pointr(y, &x.sa); - } - pp->nel = 1; - pp->cel = x.sftd->arc[0].elt; - pp->UU.U1.arc = x.sftd->arc[0].arcname; - pp->UU.U1.curfragment = y; - } - } /*2*/ - break; - - - default: - printf("Internal FIRST error (not agregate)\n"); - - break; - }/* case */ - } /*1*/ + if (x.smtd->totalarcnum == 0) + { /* empty tree */ + pp->nel = 0; + pp->cel = 0; + } + else + { /*2 */ + if (x.smtd->arcnum != 0) + { + pp->nel = 1; + pp->cel = x.smtd->arc[0].elt; + pp->UU.U1.arc = x.smtd->arc[0].arcname; + pp->UU.U1.curfragment = p; + } + else + { + while (x.sftd->next != 0 && x.sftd->arcnum == 0) + { + y = x.sftd->next; + assert_and_assign_real_pointer (y, &x.sa); + } + pp->nel = 1; + pp->cel = x.sftd->arc[0].elt; + pp->UU.U1.arc = x.sftd->arc[0].arcname; + pp->UU.U1.curfragment = y; + } + } /*2 */ + break; + + + default: + printf ("Internal FIRST error (not agregate)\n"); + + break; + } /* case */ + } /*1 */ pp->UU.U1.mainadr = p; -} /* first */ +} /* first */ -Void crlst(l) -long *l; +void +crlst (l) + long *l; { /* sozdatx pustoj spisok */ mpd x; - gets5(l, &x.sa); + gets5 (l, &x.sa); x.smld->dtype = listmain; x.smld->lastfragm = *l; -} /* crlst */ +} /* crlst */ -Void crlistfr(el, f) -long el, *f; +void +crlistfr (el, f) + long el, *f; { /* s-adr. dob.|l-ta */ /* s- adr.sozdannogo fragmenta */ @@ -404,28 +470,30 @@ long el, *f; mpd y; fragmlistdescriptor *WITH; - gets5(f, &y.sa); + gets5 (f, &y.sa); WITH = y.sfld; WITH->dtype = listfragm; WITH->elnum = 1; WITH->elt[0] = el; -} /* crlistfr */ +} /* crlistfr */ -Void crtree(t) -long *t; +void +crtree (t) + long *t; { /* make empty tree */ mpd x; - gets5(t, &x.sa); + gets5 (t, &x.sa); x.smtd->dtype = treemain; -} /* creatree */ +} /* creatree */ -Void crtreefr(sel, ob, frag) -long sel, ob, *frag; +void +crtreefr (sel, ob, frag) + long sel, ob, *frag; { /* s-address of new tree fragment */ /*===========================================*/ @@ -435,17 +503,18 @@ long sel, ob, *frag; mpd y; fragmtreedescriptor *WITH; - gets5(frag, &y.sa); - WITH = y.sftd; /* with */ + gets5 (frag, &y.sa); + WITH = y.sftd; /* with */ WITH->dtype = treefragm; WITH->arcnum = 1; WITH->arc[0].arcname = sel; WITH->arc[0].elt = ob; -} /* crtreefr */ +} /* crtreefr */ -Void lconc(a1, a2) -long *a1, a2; +void +lconc (a1, a2) + long *a1, a2; { /*==========================*/ /* a1 - mainlist, */ @@ -454,67 +523,81 @@ long *a1, a2; /*==========================*/ /* wyhod */ - a l; /* s-nomer glawn.deskr.spiska */ + a l; /* s-nomer glawn.deskr.spiska */ a m; mpd x, y, z; mainlistdescriptor *WITH; fragmlistdescriptor *WITH1; - if (*a1 == null_) { - /* creates empty list */ - gets5(&l, &x.sa); - x.smld->dtype = listmain; - x.smld->lastfragm = l; - } else { - l = *a1; - points(l, &x.sa); - } + if (*a1 == null_) + { + /* creates empty list */ + gets5 (&l, &x.sa); + x.smld->dtype = listmain; + x.smld->lastfragm = l; + } + else + { + l = *a1; + assert_and_assign_real_pointer (l, &x.sa); + } /* fi */ WITH = x.smld; - if (WITH->dtype != listmain) { - l = null_; - goto _L1; - } + if (WITH->dtype != listmain) + { + l = null_; + goto _L1; + } WITH->totalelnum++; - if (WITH->lastfragm == l) { /* ends on the same first descriptor */ - if (WITH->elnum == mainlistelnum) { - gets5(&m, &y.sa); - WITH1 = y.sfld; - WITH1->dtype = listfragm; - WITH1->elnum = 1; - WITH1->elt[0] = a2; - WITH->lastfragm = m; - WITH->next = m; - } else { - WITH->elnum++; - WITH->elt[WITH->elnum - 1] = a2; + if (WITH->lastfragm == l) + { /* ends on the same first descriptor */ + if (WITH->elnum == mainlistelnum) + { + gets5 (&m, &y.sa); + WITH1 = y.sfld; + WITH1->dtype = listfragm; + WITH1->elnum = 1; + WITH1->elt[0] = a2; + WITH->lastfragm = m; + WITH->next = m; + } + else + { + WITH->elnum++; + WITH->elt[WITH->elnum - 1] = a2; + } } - } else { - points(WITH->lastfragm, &z.sa); - if (z.sfld->elnum == fragmlistelnum) { - gets5(&m, &y.sa); - WITH1 = y.sfld; - WITH1->dtype = listfragm; - WITH1->elnum = 1; - WITH1->elt[0] = a2; - z.sfld->next = m; - points(l, &x.sa); - WITH->lastfragm = m; - } else { - /* using with is danger here */ - z.sfld->elnum++; - z.sfld->elt[z.sfld->elnum - 1] = a2; + else + { + assert_and_assign_real_pointer (WITH->lastfragm, &z.sa); + if (z.sfld->elnum == fragmlistelnum) + { + gets5 (&m, &y.sa); + WITH1 = y.sfld; + WITH1->dtype = listfragm; + WITH1->elnum = 1; + WITH1->elt[0] = a2; + z.sfld->next = m; + assert_and_assign_real_pointer (l, &x.sa); + WITH->lastfragm = m; + } + else + { + /* using with is danger here */ + z.sfld->elnum++; + z.sfld->elt[z.sfld->elnum - 1] = a2; + } } - } _L1: - *a1 = l; /* nuvno, esli l sozdaw.zanowo */ -} /* lconc */ + *a1 = l; /* nuvno, esli l sozdaw.zanowo */ +} /* lconc */ -Void changeel(pp, adr) -ptr_ *pp; -long adr; +void +changeel (pp, adr) + ptr_ *pp; + long adr; { /* where to change */ /* change to adr */ @@ -522,12 +605,13 @@ long adr; mpd x; a a1; - if (pp->ptrtype != ptrlist) { - printf(" Internal error (Changeel) "); - return; - } + if (pp->ptrtype != ptrlist) + { + printf (" Internal error (Changeel) "); + return; + } a1 = pp->UU.U1.curfragment; - points(a1, &x.sa); + assert_and_assign_real_pointer (a1, &x.sa); if (x.sfld->dtype == listfragm) x.sfld->elt[pp->nel - 1] = adr; else @@ -536,48 +620,53 @@ long adr; } -boolean plnum(sval, intval) -long sval, *intval; +bool +plnum (sval, intval) + long sval, *intval; { - /* input - s-address*/ + /* input - s-address */ /* output:long integer value */ /* returns integer if it is list parameter; */ mpd x; if (sval == 0) return false; - else { - pointr(sval, &x.sa); /* access to atom in memory */ - if (x.snd->dtype != number) - return false; - else { - *intval = x.snd->val; /* access to number */ - return true; + else + { + assert_and_assign_real_pointer (sval, &x.sa); /* access to atom in memory */ + if (x.snd->dtype != number) + return false; + else + { + *intval = x.snd->val; /* access to number */ + return true; + } } - } -} /*plnum*/ +} /*plnum */ -Void mknumb(n, r) -long n, *r; +void +mknumb (n, r) + long n, *r; { mpd x; numberdescriptor *WITH; - gets1(r, &x.sa); - WITH = x.snd; /* with */ + gets1 (r, &x.sa); + WITH = x.snd; /* with */ WITH->dtype = number; WITH->val = n; -} /* mknumb */ +} /* mknumb */ -Void addel3(tr_, sel, ob) -long *tr_, sel, ob; +void +addel3 (tr_, sel, ob) + long *tr_, sel, ob; { - /* s-address of main tree descr*/ + /* s-address of main tree descr */ /* selector, a-address */ - /* object*/ + /* object */ /*===============================*/ /* add element to tree */ /* tr := tr ++ <. sel : ob .> */ @@ -585,8 +674,8 @@ long *tr_, sel, ob; /* wyhod s tr:=l */ /* wyhod bez tr:=l */ - a l; /* s-adres glawnogo derewa */ - mpd x; /* dostup k glawnomu deskr.derewa */ + a l; /* s-adres glawnogo derewa */ + mpd x; /* dostup k glawnomu deskr.derewa */ mpd y; a n, npred; long i; @@ -596,106 +685,119 @@ long *tr_, sel, ob; - if (*tr_ == null_) /* sozdatx pustoe derewo */ - crtree(&l); + if (*tr_ == null_) /* sozdatx pustoe derewo */ + crtree (&l); else l = *tr_; - pointr(l, &x.sa); + assert_and_assign_real_pointer (l, &x.sa); /* dostup k glawn.fragmentu */ - if (x.smtd->dtype != treemain) { /* tr ne derewo */ - l = null_; - goto _L1; - } - if (ob == null_) /* ni~ego ne menqem */ + if (x.smtd->dtype != treemain) + { /* tr ne derewo */ + l = null_; + goto _L1; + } + if (ob == null_) /* ni~ego ne menqem */ goto _L2; - if (x.smtd->totalarcnum == 0) { - points(l, &x.sa); - WITH = x.smtd; /* with */ - WITH->totalarcnum = 1; - WITH->arcnum = 1; - WITH->arc[0].arcname = sel; - WITH->arc[0].elt = ob; - goto _L1; - } + if (x.smtd->totalarcnum == 0) + { + assert_and_assign_real_pointer (l, &x.sa); + WITH = x.smtd; /* with */ + WITH->totalarcnum = 1; + WITH->arcnum = 1; + WITH->arc[0].arcname = sel; + WITH->arc[0].elt = ob; + goto _L1; + } - WITH = x.smtd; /* with */ + WITH = x.smtd; /* with */ FORLIM = WITH->arcnum; /*======================*/ /* poisk sel w l */ /*======================*/ - for (i = 0; i < FORLIM; i++) { - if (WITH->arc[i].arcname == sel) { - points(l, &y.sa); - y.smtd->arc[i].elt = ob; - goto _L1; + for (i = 0; i < FORLIM; i++) + { + if (WITH->arc[i].arcname == sel) + { + assert_and_assign_real_pointer (l, &y.sa); + y.smtd->arc[i].elt = ob; + goto _L1; + } } - } npred = l; n = WITH->next; /* prodolvaem poisk w fragmentah */ - while (n != null_) { - pointr(n, &y.sa); - WITH1 = y.sftd; - /* with */ - FORLIM = WITH1->arcnum; - for (i = 0; i < FORLIM; i++) { - if (WITH1->arc[i].arcname == sel) { - points(n, &y.sa); - y.sftd->arc[i].elt = ob; - goto _L1; - } - } - npred = n; - n = WITH1->next; - } /* while */ + while (n != null_) + { + assert_and_assign_real_pointer (n, &y.sa); + WITH1 = y.sftd; + /* with */ + FORLIM = WITH1->arcnum; + for (i = 0; i < FORLIM; i++) + { + if (WITH1->arc[i].arcname == sel) + { + assert_and_assign_real_pointer (n, &y.sa); + y.sftd->arc[i].elt = ob; + goto _L1; + } + } + npred = n; + n = WITH1->next; + } /* while */ /*========================================*/ /* |l-ta w tr net. */ /* w npred s-adres poslednego fragmenta , */ /* nuvno dobawitx |l-t w konce */ /*========================================*/ - points(l, &x.sa); - WITH = x.smtd; /* with */ + assert_and_assign_real_pointer (l, &x.sa); + WITH = x.smtd; /* with */ WITH->totalarcnum++; - if (WITH->arcnum != maintreearcnum) { - /* dobawim tut-ve */ - WITH->arcnum++; - WITH->arc[WITH->arcnum - 1].arcname = sel; - WITH->arc[WITH->arcnum - 1].elt = ob; - goto _L1; - } - if (WITH->next == null_) { + if (WITH->arcnum != maintreearcnum) + { + /* dobawim tut-ve */ + WITH->arcnum++; + WITH->arc[WITH->arcnum - 1].arcname = sel; + WITH->arc[WITH->arcnum - 1].elt = ob; + goto _L1; + } + if (WITH->next == null_) + { /*===========================================*/ - /* pricepim nowyj fragment k glawnomu fragm. */ - /* i pomestim tuda |l-t */ + /* pricepim nowyj fragment k glawnomu fragm. */ + /* i pomestim tuda |l-t */ /*===========================================*/ - crtreefr(sel, ob, &n); - WITH->next = n; - goto _L1; - } + crtreefr (sel, ob, &n); + WITH->next = n; + goto _L1; + } /* dobawlqem |l-t w ne glawnom fragmente */ - points(npred, &x.sa); - WITH1 = x.sftd; /* with */ - if (WITH1->arcnum != fragmtreearcnum) { - /* dobawim tut-ve */ - WITH1->arcnum++; - WITH1->arc[WITH1->arcnum - 1].arcname = sel; - WITH1->arc[WITH1->arcnum - 1].elt = ob; - } else { /* pricepim nowyj fragment */ - crtreefr(sel, ob, &n); - WITH1->next = n; - } + assert_and_assign_real_pointer (npred, &x.sa); + WITH1 = x.sftd; /* with */ + if (WITH1->arcnum != fragmtreearcnum) + { + /* dobawim tut-ve */ + WITH1->arcnum++; + WITH1->arc[WITH1->arcnum - 1].arcname = sel; + WITH1->arc[WITH1->arcnum - 1].elt = ob; + } + else + { /* pricepim nowyj fragment */ + crtreefr (sel, ob, &n); + WITH1->next = n; + } _L1: *tr_ = l; -_L2: ; -} /* addel */ +_L2:; +} /* addel */ -Void addtre(m, t2) -long *m, t2; +void +addtre (m, t2) + long *m, t2; { /* 1-st tree */ /* 2-nd tree */ @@ -713,30 +815,33 @@ long *m, t2; if (t2 == null_) goto _L1; - pointr(t2, &x.sa); - if (x.smtd->dtype != treemain) { - *m = null_; - goto _L1; - } + assert_and_assign_real_pointer (t2, &x.sa); + if (x.smtd->dtype != treemain) + { + *m = null_; + goto _L1; + } /* cikl po t2, prisoedinqem |l-ty po odnomu */ mx = *x.smtd; for (i = 0; i < mx.arcnum; i++) - addel3(m, mx.arc[i].arcname, mx.arc[i].elt); - n = mx.next; /* with */ + addel3 (m, mx.arc[i].arcname, mx.arc[i].elt); + n = mx.next; /* with */ /* prodolvaem w fragmentah */ - while (n != null_) { - pointr(n, &x.sa); - fx = *x.sftd; - for (i = 0; i < fx.arcnum; i++) - addel3(m, fx.arc[i].arcname, fx.arc[i].elt); - n = fx.next; /* with */ - } /* while */ -_L1: ; -} /* addtre */ - - -boolean compatom(op, adr1, adr2) -long op, adr1, adr2; + while (n != null_) + { + assert_and_assign_real_pointer (n, &x.sa); + fx = *x.sftd; + for (i = 0; i < fx.arcnum; i++) + addel3 (m, fx.arc[i].arcname, fx.arc[i].elt); + n = fx.next; /* with */ + } /* while */ +_L1:; +} /* addtre */ + + +bool +compatom (op, adr1, adr2) + long op, adr1, adr2; { /* op in 1..4 1 < 2 <= 3 > 4 >= compares valid a-adresses of two valid atoms of types @@ -746,38 +851,41 @@ long op, adr1, adr2; if (adr1 == adr2) return (op == 2 || op == 4); - else { - pointa(adr1, a1, &l1); - pointa(adr2, a2, &l2); - - - i = 1; -_L1: - if (i > l1) - return (op <= 2); - else if (i > l2) - return (op >= 3); - else if (a1[i - 1] > a2[i - 1]) - return (op >= 3); - else if (a1[i - 1] < a2[i - 1]) - return (op <= 2); - else { - i++; - goto _L1; + else + { + get_data_from_pointa (adr1, a1, &l1); + get_data_from_pointa (adr2, a2, &l2); + + + i = 1; + _L1: + if (i > l1) + return (op <= 2); + else if (i > l2) + return (op >= 3); + else if (a1[i - 1] > a2[i - 1]) + return (op >= 3); + else if (a1[i - 1] < a2[i - 1]) + return (op <= 2); + else + { + i++; + goto _L1; + } } - } } -double take_fatom(a1) -long a1; +double +take_fatom (a1) + long a1; { bl80 a80_; long j; double *rre; - pointa(a1, a80_, &j); - rre = (double *)a80_; + get_data_from_pointa (a1, a80_, &j); + rre = (double *) a80_; return (*rre); } @@ -789,4 +897,3 @@ long a1; /* End. */ - diff --git a/RIGAL/rigsc.446/src/ou2.c b/RIGAL/rigsc.446/src/ou2.c index 256f148fb6997229c354871eb9d2a98b2a0cad97..34a8175216d0442bc9648d6b335f18aa80ab4159 100644 --- a/RIGAL/rigsc.446/src/ou2.c +++ b/RIGAL/rigsc.446/src/ou2.c @@ -4,721 +4,396 @@ #include "ley.h" #include "nef2.h" - - #define sh_depth 2 - -/* Local variables for pscr: */ -struct LOC_pscr { +typedef struct LOCAL_printing +{ mpd x; long shift; bl80 str80; -} ; +} PSCR, POUT; -Local long sh_atom(atm, LINK) -long atm; -struct LOC_pscr *LINK; -{ - /*length of atom*/ - long len; +static void poutrec ( uint32_t, bool, struct LOCAL_printing *, FILE * ); +static void printunit ( uint32_t, struct LOCAL_printing *, FILE * ); - pointa(atm, LINK->str80, &len); - return (len + 1); -} +static bool is_length_less_than_80 ( uint32_t, struct LOCAL_printing * ); +static uint32_t get_length_of_atom ( uint32_t, struct LOCAL_printing * ); +static uint32_t get_length_of_rigal_object( uint32_t, struct LOCAL_printing * ); -Local long sh_rec(root, LINK) -long root; -struct LOC_pscr *LINK; -{ - /*length of rigal object*/ - /** recursive **/ - long Result, sum; - ptr_ pp; - - if (root == 0) { - Result = 5; - goto _L99; - } - if ((root & 511) == 0 && root < 65536L && root >= 0) { - Result = 8; - goto _L99; - } - pointr(root, &LINK->x.sa); - switch (LINK->x.sad->dtype) { /* with */ - - case listmain: - LINK->shift += sh_depth; - if (LINK->shift / sh_depth > max_printlevel) { - Result = 12; - LINK->shift -= sh_depth; - goto _L99; - } - sum = 0; - if (LINK->x.smld->name != 0) - sum += sh_rec(LINK->x.smld->name, LINK) + 1; - first(root, &pp); - while (pp.nel != 0) { - sum += sh_rec(pp.cel, LINK); - if (sum > 150) { - Result = sum; - LINK->shift -= sh_depth; - goto _L99; - } - next(&pp); - } - Result = sum + 5; - LINK->shift -= sh_depth; - break; - - case treemain: - LINK->shift += sh_depth; - if (LINK->shift / sh_depth > max_printlevel) { - Result = 12; - LINK->shift -= sh_depth; - goto _L99; - } - sum = 0; - if (LINK->x.smtd->name != 0) - sum += sh_rec(LINK->x.smtd->name, LINK) + 2; - first(root, &pp); - while (pp.nel != 0) { - sum += sh_atom(pp.UU.U1.arc, LINK) + sh_rec(pp.cel, LINK) + 2; - if (sum > 150) { - Result = sum; - LINK->shift -= sh_depth; - goto _L99; - } - next(&pp); - } - Result = sum + 4; - LINK->shift -= sh_depth; - break; - - case idatom: - case atom: - case tatom: - case keyword: - Result = sh_atom(LINK->x.sad->name, LINK) + 2; - break; - - case fatom: - Result = 14; - break; - - case number: - if (LINK->x.snd->val > 65536L) - Result = 10; - else { - if (LINK->x.snd->val > 99) - Result = 5; - else - Result = 2; - } - break; - - case variable: - case idvariable: - case fvariable: - case nvariable: - Result = sh_atom(LINK->x.svd->name, LINK) + 1; - break; - - case rulename: - Result = sh_atom(LINK->x.srd->name, LINK) + 1; - break; - - - - default: - Result = 80; - break; - }/* case */ -_L99: - return Result; -} +/* ********************* pscr_.pas ******************* */ -Local boolean is_short(root, LINK) -long root; -struct LOC_pscr *LINK; +void pscr ( long root) { - long i_shorts; + POUT V; + FILE *output_stream = stdout; + V.shift = 0; //shift from the left end of the input -- the offset. + memset( V.str80,0,81); + poutrec (root, false, &V, output_stream ) ; - i_shorts = sh_rec(root, LINK); - return (i_shorts < 80 - LINK->shift); } -Local Void printunit(un, LINK) -long un; -struct LOC_pscr *LINK; +/* ********************* poutx.pas ******************* */ +void pout (uint32_t root) { - long ilen, i; - - pointa(un, LINK->str80, &ilen); - for (i = 0; i < ilen; i++) { - putchar(LINK->str80[i]); - if (LINK->str80[i] == '\'') - putchar('\''); - } + POUT V; + FILE *output_stream = out; + if (out_open) + { + V.shift = 0; + memset( V.str80,0,81); + poutrec (root, false, &V, output_stream ); + } + else + { + fprintf(stderr, "internal file named: out, not open\n"); + } } -Local Void poutrec(root, sm, LINK) -long root; -boolean sm; -struct LOC_pscr *LINK; +/*****************************************************/ +// called from pout -- called by cim.c +static void poutrec (uint32_t root,bool sm, POUT *LINK, FILE * output_stream) { - /** recursive **/ + ptr_ pp; - boolean nofirstflag; + bool nofirstflag; - if (!sm) { - if (is_short(root, LINK)) { - poutrec(root, true, LINK); - goto _L99; + if (!sm) + { + if (is_length_less_than_80 (root, LINK)) + { + if (output_stream == stdout ) fprintf(output_stream,"\nfinding short"); + poutrec( root, true, LINK, output_stream );//done + return; + } } - } - - if (root == 0) { - printf(" NULL "); - goto _L99; - } - if ((root & 511) == 0 && root < 65536L && root >= 0) { - printf(" a'%5ld ", root); - goto _L99; - } - pointr(root, &LINK->x.sa); - /* write( ' '); */ - switch (LINK->x.sad->dtype) { /* with */ - - case listmain: - if (!sm) - putchar('\n'); - LINK->shift += sh_depth; - if (!sm) - printf("%*s", (int)LINK->shift, " "); - /* pe~atx spiska - pe~atx zagolowka, - ustanowka na perwyj |lement, */ - if (LINK->x.smld->name != 0) { - poutrec(LINK->x.smld->name, sm, LINK); - printf("::"); - if (!sm) - putchar('\n'); - if (!sm) - printf("%*s", (int)LINK->shift, " "); + if (root == 0) + { + fprintf (output_stream, " NULL "); + return; } - printf("(."); - if (LINK->shift / sh_depth > max_printlevel) { - printf(" .. .)"); - if (!sm) - putchar('\n'); - } else { - first(root, &pp); - while (pp.nel != 0) { - poutrec(pp.cel, sm, LINK); - next(&pp); - - if (pp.nel == mainlistelnum) { - putchar('\n'); - if (!sm) - printf("%*s", (int)(LINK->shift + sh_depth), " "); - } - putchar(' '); - } - - if (!sm) - putchar('\n'); - if (!sm) - printf("%*s", (int)LINK->shift, " "); - printf(".)"); - if (!sm) - putchar('\n'); + if ( ((root & 511 ) == 0) && + ( root < 65536L ) + ) //-- root is uint32_t. + { + fprintf (output_stream, " a'%5ld ", root); + return; } - if (!sm) - printf("%*c", (int)LINK->shift, ' '); - LINK->shift -= sh_depth; - break; - - case treemain: - if (!sm) - putchar('\n'); - LINK->shift += sh_depth; - if (!sm) - printf("%*c", (int)LINK->shift, ' '); - - if (LINK->x.smtd->name != 0) { - poutrec(LINK->x.smtd->name, sm, LINK); - printf("::"); - if (!sm) - putchar('\n'); + + assert_and_assign_real_pointer (root, &LINK->x.sa); + if (output_stream == stdout ) fprintf(output_stream,"\nprinting to stdout"); + if (output_stream == stdout ) + fprintf(output_stream,"\nroot = %08x\n",root); + + switch (LINK->x.sad->dtype) + { + + case listmain: + if (!sm) putc ('\n', output_stream); + LINK->shift += sh_depth; + if (!sm) fprintf (output_stream, "%*s", (int) LINK->shift, " "); + + if (LINK->x.smld->name != 0) + { + fprintf(output_stream,"\ncase listmain"); + poutrec (LINK->x.smld->name, sm, LINK, output_stream ); + fprintf (output_stream, "::"); + if (!sm) + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*s", (int) LINK->shift, " "); + } + fprintf (output_stream, "(."); + if (LINK->shift / sh_depth > max_printlevel) + { + fprintf (output_stream, " .. .)"); + if (!sm) + putc ('\n', output_stream); + } + else + { + first (root, &pp); + while (pp.nel != 0) + { + fprintf(output_stream,"\ncase listmain (2)"); + poutrec (pp.cel, sm, LINK, output_stream ); + next (&pp); + + if (pp.nel == mainlistelnum) + { + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*s", (int) (LINK->shift + sh_depth), + " "); + } + putc (' ', output_stream); + } + + if (!sm) + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*s", (int) LINK->shift, " "); + fprintf (output_stream, ".)"); + if (!sm) + putc ('\n', output_stream); + } if (!sm) - printf("%*c", (int)LINK->shift, ' '); - } - if (LINK->shift / sh_depth > max_printlevel) - printf("<. .. .>\n"); - else { - printf("<."); - first(root, &pp); - nofirstflag = false; - while (pp.nel != 0) { - if (nofirstflag) { - putchar(','); - if (!sm) - putchar('\n'); - if (!sm) - printf("%*c", (int)(LINK->shift + sh_depth), ' '); - } - nofirstflag = true; - /* pe~atx |lementow derewa */ - printunit(pp.UU.U1.arc, LINK); - putchar(':'); - poutrec(pp.cel, sm, LINK); - next(&pp); - } + fprintf (output_stream, "%*c", (int) LINK->shift, ' '); + LINK->shift -= sh_depth; + break; + + case treemain: if (!sm) - putchar('\n'); + putc ('\n', output_stream); + LINK->shift += sh_depth; if (!sm) - printf("%*c", (int)LINK->shift, ' '); - printf(".>"); - } - LINK->shift -= sh_depth; - /*if not sm then write( ' ': shift);*/ - break; - - case idatom: - case atom: - case tatom: - putchar('\''); - printunit(LINK->x.sad->name, LINK); - putchar('\''); - break; - - case keyword: - printunit(LINK->x.sad->name, LINK); - break; - - case fatom: -/* printf("% .5E", take_fatom(LINK->x.sad->name));*/ - printf("%E",take_fatom(LINK->x.sad->name)); - break; - - case number: - printf("%12ld", LINK->x.snd->val); - break; - - case variable: - case idvariable: - case fvariable: - case nvariable: - putchar('$'); - printunit(LINK->x.svd->name, LINK); - /* if ((svd^.location <> 0) and bb3) then - write('(', svd^.location: 3, ')');*/ - break; - - case rulename: - printf(" #"); - printunit(LINK->x.srd->name, LINK); - /* if ((srd^.fragmadr <> 0) and bb3) then - write('[[', srd^.fragmadr, ']]');*/ - - break; - - case spec: - printf("aspec'%6ld", LINK->x.sspec->val); - break; - - - - - default: - printf("--/ ?? /--"); - break; - }/* case */ -_L99: ; - - -} /* poutrec */ - - -/*procedure pscr(xxx:a); begin end;*/ -/* #include "p4.inc" */ -/* #include "pscr.pas" */ -/* #include "poutx.pas" */ - - - -/* ********************* pscr_.pas ******************* */ -/* only procedure text/ implementation part of poutlexu */ - -Void pscr(root) -long root; + fprintf (output_stream, "%*c", (int) LINK->shift, ' '); + + if (LINK->x.smtd->name != 0) + { + fprintf(output_stream,"\ncase treemain"); + poutrec (LINK->x.smtd->name, sm, LINK,output_stream ); + fprintf (output_stream, "::"); + if (!sm) + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*c", (int) LINK->shift, ' '); + } + if (LINK->shift / sh_depth > max_printlevel) + fprintf (output_stream, "<. .. .>\n"); + else + { + fprintf (output_stream, "<."); + first (root, &pp); + nofirstflag = false; + while (pp.nel != 0) + { + if (nofirstflag) + { + putc (',', output_stream); + if (!sm) + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*c", (int) (LINK->shift + sh_depth), ' '); + } + nofirstflag = true; + + printunit (pp.UU.U1.arc, LINK, output_stream ); + putc (':', output_stream); + poutrec (pp.cel, sm, LINK, output_stream ); + next (&pp); + } + if (!sm) + putc ('\n', output_stream); + if (!sm) + fprintf (output_stream, "%*c", (int) LINK->shift, ' '); + fprintf (output_stream, ".>"); + } + LINK->shift -= sh_depth; + break; + + case idatom: + case atom: + case tatom: + fprintf(output_stream,"\ncase atom"); + putc ('\'', output_stream); + printunit (LINK->x.sad->name, LINK, output_stream ); + putc ('\'', output_stream); + break; + + case keyword: + fprintf(output_stream,"\ncase keyword"); + printunit (LINK->x.sad->name, LINK, output_stream ); + break; + + case number: + fprintf(output_stream,"\ncase number"); + fprintf (output_stream, "%12ld", LINK->x.snd->val); + break; + + case fatom: + fprintf(output_stream,"\ncase fatom"); + fprintf (output_stream, "%E", take_fatom (LINK->x.sad->name)); + break; + + + case variable: + case idvariable: + case fvariable: + case nvariable: + fprintf(output_stream,"\ncase variable\n"); + putc ('$', output_stream); + printunit (LINK->x.svd->name, LINK, output_stream ); + break; + + case rulename: + fprintf(output_stream,"\ncase rule"); + fprintf (output_stream, " #"); + printunit (LINK->x.srd->name, LINK, output_stream ); + break; + + case spec: + fprintf (output_stream, "aspec'%6ld", LINK->x.sspec->val); + break; + + + default: + fprintf (output_stream, "--/ ?? /--"); + break; + } + + +} //poutrec + +/**************************************************************************/ +/* Supporting functions ***************************************************/ +/**************************************************************************/ +static void printunit (uint32_t unit, struct LOCAL_printing *LINK, FILE *output_stream ) { - /* have some local procedures */ - struct LOC_pscr V; + uint32_t ilen, i; + get_data_from_pointa (unit, LINK->str80, &ilen); + fprintf(output_stream,"\n"); + for (i = 0; i < ilen; i++) + { + putc (LINK->str80[i], output_stream ); + if (LINK->str80[i] == '\'') putc ('\'', output_stream); + } + fprintf(output_stream,"\n\n"); - if (true) { /*out_open*/ - V.shift = 0; /* sdwig ot lewogo kraq stroki wywoda */ - poutrec(root, false, &V); - } /* wyzow rekursiwnoj ~asti iz postoqnnoj pout */ } -#undef sh_depth - +static bool is_length_less_than_80 (uint32_t root,struct LOCAL_printing *LINK) +{ + uint32_t i_shorts; -#define sh_depth 2 + i_shorts = get_length_of_rigal_object (root, LINK); + return (i_shorts < ( 80 - LINK->shift )); -/* Local variables for pout: */ -struct LOC_pout { - mpd x; - long shift; - bl80 str80; -} ; +} -Local long sh_atom_(atm, LINK) -long atm; -struct LOC_pout *LINK; +static uint32_t get_length_of_atom (uint32_t atm, struct LOCAL_printing *LINK) { - /*length of atom*/ - long len; + //length of atom + uint32_t len; + + get_data_from_pointa (atm, LINK->str80, &len); - pointa(atm, LINK->str80, &len); return (len + 1); } -Local long sh_rec_(root, LINK) -long root; -struct LOC_pout *LINK; +static uint32_t get_length_of_rigal_object (uint32_t root, PSCR *LINK) { - /*length of rigal object*/ - /** recursive **/ - long Result, sum; + // recursive + uint32_t Result, sum; ptr_ pp; - if (root == 0) { - Result = 5; - goto _L99; - } - if ((root & 511) == 0 && root < 65536L && root >= 0) { - Result = 8; - goto _L99; - } - pointr(root, &LINK->x.sa); - switch (LINK->x.sad->dtype) { /* with */ - - case listmain: - LINK->shift += sh_depth; - if (LINK->shift / sh_depth > max_printlevel) { - Result = 12; - LINK->shift -= sh_depth; - goto _L99; - } - sum = 0; - if (LINK->x.smld->name != 0) - sum += sh_rec_(LINK->x.smld->name, LINK) + 1; - first(root, &pp); - while (pp.nel != 0) { - sum += sh_rec_(pp.cel, LINK); - if (sum > 150) { - Result = sum; - LINK->shift -= sh_depth; - goto _L99; + if (root == 0) return 5; + + if ((root & 511) == 0 && root < 65536L && root >= 0) return 8; + + assert_and_assign_real_pointer (root, &LINK->x.sa); + switch (LINK->x.sad->dtype) + { + + case listmain: + LINK->shift += sh_depth; + if (LINK->shift / sh_depth > max_printlevel) + { + LINK->shift -= sh_depth; + return 12; + } + sum = 0; + if (LINK->x.smld->name != 0) + sum += get_length_of_rigal_object (LINK->x.smld->name, LINK) + 1; + + first (root, &pp); + while (pp.nel != 0) + { + sum += get_length_of_rigal_object(pp.cel, LINK); + if (sum > 150) + { + LINK->shift -= sh_depth; + return sum; + } + next (&pp); } - next(&pp); - } - Result = sum + 5; - LINK->shift -= sh_depth; - break; - - case treemain: - LINK->shift += sh_depth; - if (LINK->shift / sh_depth > max_printlevel) { - Result = 12; + Result = sum + 5; LINK->shift -= sh_depth; - goto _L99; - } - sum = 0; - if (LINK->x.smtd->name != 0) - sum += sh_rec_(LINK->x.smtd->name, LINK) + 2; - first(root, &pp); - while (pp.nel != 0) { - sum += sh_atom_(pp.UU.U1.arc, LINK) + sh_rec_(pp.cel, LINK) + 2; - if (sum > 150) { - Result = sum; - LINK->shift -= sh_depth; - goto _L99; - } - next(&pp); - } - Result = sum + 4; - LINK->shift -= sh_depth; - break; - - case idatom: - case atom: - case tatom: - case keyword: - Result = sh_atom_(LINK->x.sad->name, LINK) + 2; - break; - - case fatom: - Result = 14; - break; - - case number: - if (LINK->x.snd->val > 65536L) - Result = 10; - else { - if (LINK->x.snd->val > 99) - Result = 5; - else - Result = 2; - } - break; - - case variable: - case idvariable: - case fvariable: - case nvariable: - Result = sh_atom_(LINK->x.svd->name, LINK) + 1; - break; + break; + + case treemain: + LINK->shift += sh_depth; + if (LINK->shift / sh_depth > max_printlevel) + { + LINK->shift -= sh_depth; + return 12; + } + sum = 0; + if (LINK->x.smtd->name != 0) + sum += get_length_of_rigal_object (LINK->x.smtd->name, LINK) + 2; + + first (root, &pp); + while (pp.nel != 0) + { + sum += ( get_length_of_atom (pp.UU.U1.arc, LINK) + + get_length_of_rigal_object (pp.cel, LINK) + 2 ); + if (sum > 150) + { + LINK->shift -= sh_depth; + return sum; + } + next (&pp); + } + Result = sum + 4; + LINK->shift -= sh_depth; + break; - case rulename: - Result = sh_atom_(LINK->x.srd->name, LINK) + 1; - break; + case idatom: + case atom: + case tatom: + case keyword: + Result = get_length_of_atom (LINK->x.sad->name, LINK) + 2; + break; + case fatom: + Result = 14; + break; - default: - Result = 80; - break; - }/* case */ -_L99: + case number: + if (LINK->x.snd->val > 65536L) Result = 10; + else + { + if (LINK->x.snd->val > 99) Result = 5; + else Result = 2; + } + break; + + case variable: + case idvariable: + case fvariable: + case nvariable: + Result = get_length_of_atom (LINK->x.svd->name, LINK) + 1; + break; + + case rulename: + Result = get_length_of_atom (LINK->x.srd->name, LINK) + 1; + break; + + default: + Result = 80; + break; + } // end switch + return Result; -} - -Local boolean is_short_(root, LINK) -long root; -struct LOC_pout *LINK; -{ - long i_shorts; - - i_shorts = sh_rec_(root, LINK); - return (i_shorts < 80 - LINK->shift); } -Local Void printunit_(un, LINK) -long un; -struct LOC_pout *LINK; -{ - long ilen, i; - pointa(un, LINK->str80, &ilen); - for (i = 0; i < ilen; i++) { - putc(LINK->str80[i], out); - if (LINK->str80[i] == '\'') - putc('\'', out); - } -} - - -static void poutrec_(root, sm, LINK) -long root; -boolean sm; -struct LOC_pout *LINK; -{ - /** recursive **/ - ptr_ pp; - bool nofirstflag; - - if (!sm) { - if (is_short_(root, LINK)) { - poutrec_(root, true, LINK); - goto _L99; - } - } - - if (root == 0) { - fprintf(out, " NULL "); - goto _L99; - } - if ((root & 511) == 0 && root < 65536L && root >= 0) { - fprintf(out, " a'%5ld ", root); - goto _L99; - } - - pointr(root, &LINK->x.sa); - /* write(out, ' '); */ - switch (LINK->x.sad->dtype) { /* with */ - - case listmain: - if (!sm) - putc('\n', out); - LINK->shift += sh_depth; - if (!sm) - fprintf(out, "%*s", (int)LINK->shift, " "); - /* pe~atx spiska - pe~atx zagolowka, - ustanowka na perwyj |lement, */ - if (LINK->x.smld->name != 0) { - poutrec_(LINK->x.smld->name, sm, LINK); - fprintf(out, "::"); - if (!sm) - putc('\n', out); - if (!sm) - fprintf(out, "%*s", (int)LINK->shift, " "); - } - fprintf(out, "(."); - if (LINK->shift / sh_depth > max_printlevel) { - fprintf(out, " .. .)"); - if (!sm) - putc('\n', out); - } else { - first(root, &pp); - while (pp.nel != 0) { - poutrec_(pp.cel, sm, LINK); - next(&pp); - - if (pp.nel == mainlistelnum) { - putc('\n', out); - if (!sm) - fprintf(out, "%*s", (int)(LINK->shift + sh_depth), " "); - } - putc(' ', out); - } - - if (!sm) - putc('\n', out); - if (!sm) - fprintf(out, "%*s", (int)LINK->shift, " "); - fprintf(out, ".)"); - if (!sm) - putc('\n', out); - } - if (!sm) - fprintf(out, "%*c", (int)LINK->shift, ' '); - LINK->shift -= sh_depth; - break; - - case treemain: - if (!sm) - putc('\n', out); - LINK->shift += sh_depth; - if (!sm) - fprintf(out, "%*c", (int)LINK->shift, ' '); - - if (LINK->x.smtd->name != 0) { - poutrec_(LINK->x.smtd->name, sm, LINK); - fprintf(out, "::"); - if (!sm) - putc('\n', out); - if (!sm) - fprintf(out, "%*c", (int)LINK->shift, ' '); - } - if (LINK->shift / sh_depth > max_printlevel) - fprintf(out, "<. .. .>\n"); - else { - fprintf(out, "<."); - first(root, &pp); - nofirstflag = false; - while (pp.nel != 0) { - if (nofirstflag) { - putc(',', out); - if (!sm) - putc('\n', out); - if (!sm) - fprintf(out, "%*c", (int)(LINK->shift + sh_depth), ' '); - } - nofirstflag = true; - /* pe~atx |lementow derewa */ - printunit_(pp.UU.U1.arc, LINK); - putc(':', out); - poutrec_(pp.cel, sm, LINK); - next(&pp); - } - if (!sm) - putc('\n', out); - if (!sm) - fprintf(out, "%*c", (int)LINK->shift, ' '); - fprintf(out, ".>"); - } - LINK->shift -= sh_depth; - /*if not sm then write(out, ' ': shift);*/ - break; - - case idatom: - case atom: - case tatom: - putc('\'', out); - printunit_(LINK->x.sad->name, LINK); - putc('\'', out); - break; - - case keyword: - printunit_(LINK->x.sad->name, LINK); - break; - - case number: - fprintf(out, "%12ld", LINK->x.snd->val); - break; - - case fatom: - fprintf(out,"%E", take_fatom(LINK->x.sad->name)); - break; - - - case variable: - case idvariable: - case fvariable: - case nvariable: - putc('$', out); - printunit_(LINK->x.svd->name, LINK); - /*--$ifdef harddeb*/ - /* if ((svd^.location <> 0) and bb3) then - write('(', svd^.location: 3, ')');*/ - /*--$endif*/ - break; - - case rulename: - fprintf(out, " #"); - printunit_(LINK->x.srd->name, LINK); - /*--$ifdef harddeb*/ - /* if ((srd^.fragmadr <> 0) and bb3) then - write('[[', srd^.fragmadr, ']]');*/ - /*--$endif*/ - break; - - case spec: - fprintf(out, "aspec'%6ld", LINK->x.sspec->val); - break; - - - default: - fprintf(out, "--/ ?? /--"); - break; - }/* case */ -_L99: ; - - -} /* poutrec */ -/* ********************* poutx.pas ******************* */ -/* only procedure text/ implementation part of poutlexu */ - -Void pout(root) -long root; -{ - /* have some local procedures */ - struct LOC_pout V; - - if (out_open) { - V.shift = 0; /* sdwig ot lewogo kraq stroki wywoda */ - poutrec_(root, false, &V); - } /* wyzow rekursiwnoj ~asti iz postoqnnoj pout */ -} #undef sh_depth diff --git a/RIGAL/rigsc.446/src/rc_.c b/RIGAL/rigsc.446/src/rc_.c index cd302c8cdac1262766d5a189311c85ffac23381f..df96c4bd4799ca14a30645ecdbe76ac856801fe3 100644 --- a/RIGAL/rigsc.446/src/rc_.c +++ b/RIGAL/rigsc.446/src/rc_.c @@ -3,798 +3,841 @@ #include "defpage.h" #include "ley.h" #include "nef2.h" +#include "rc_.h" -/* ******************* rclib ******************** */ - -#define filemax 3 /* ~islo wlovenij dlq include */ -#define bufmaxlen 10 /* dlina malogo bufera , kak minimum - 8 */ -#define rulemaxnum 400 /* ~islo prawil w programme */ -#define two_char_sym_max 50 /* maks. ~islo dwuhbajtowyh simwolow */ - - - -typedef char keyint; - /* nomer kl`~ewogo slowa, ograni~en dlq case */ - +// static variables for che11: +struct LOC_che11 +{ + mpd x; + a a1; + FILE *batfile; + long icc; +}; + +// ******************* rclib ******************** +static void close_and_exit_rc(FILE *, FILE* , FILE * ); +static void process_error(); +static void chepil (ptr_ *); +static void makekey (key_type_as_int, bufrectype); +static void chepro (); +static void incfile (struct LOC_che11 *); +static void che11 (long, long *, char *, error_rec_type *, int, char *[]); +static void namelist (ptr_, long); +static void newlist (ptr_ *); +static void changeelement (ptr_ *, long); +static void err (long); +static void tabrule (long, long); +static void dul (long *); +static void pushl (ptr_ *); //pushl probably means local push +static char des (ptr_); +static void nextl (); +static key_type_as_int valc (ptr_); +static bool el (key_type_as_int); +static void bltn (long, long *); +static void operator_ (ptr_ *); +static void instruc (ptr_ *); +static void expr (ptr_ *, bool); +static void rule (ptr_ *); +static void pict (ptr_ *, long *, long *); a m1[150], etalon[150]; -/* massiwy, postoqnnye dlq poddervki - prikreplennyh cepo~ek w prostranstwah */ + long varn_desks; filespecification curfile_name; -a currulename; /* adres w sp2 imeni teku{ego prawila */ -ptr_ l; /* pojnter dlq whodnogo spiska ~ekera w sp1 */ -ptr_ r; /* ob{ego nazna~eniq pojntery */ -long errmuch; /* ~islo o{ibok */ - -boolean bspi; /* we are within v' or S' */ -a ass_1; /* special variable $ */ -a saveladr; /* sohranqemyj dlq el/val adres */ -keyint saveelkey; /* sohraneqemyj nomer. kl. slowa el/val */ +a currulename; +ptr_ l; +ptr_ r; +long errmuch; + +bool bspi; // we are within v' or S' +a ass_1; // special variable $ +a saveladr; +key_type_as_int saveelkey; a tabv[rulemaxnum], tabn[rulemaxnum], tabflags[rulemaxnum]; aa tabfiles[rulemaxnum]; word tabcord[rulemaxnum]; -/* tablica adresow spiskow peremennyh, imen prawil i flagow dlq nee */ +error_rec_type error_rec_ch; +aa error_rec_ch_adr; // renew by incfile +string80 error_rec_ch_mainstr;// constant +bool er; + +a ttt, tt1; +filespecification name; + +char pch[101]; +int i; +FILE *sour, *lstn; + +error_rec_type erm; +string80 stt; -/* source list */ -/* result code */ +int +main (int argc, char *argv[]) +{ -extern Void che11 PP((long chein, long *rezche, Char *main_name, - error_rec_type *error_rec_rw,int an_argc,char *an_argv[])); + printf("RC argc=%d\n",argc); + printf("RC arg[0]=%s\n",argv[0]); + printf("RC arg[1]=%s\n",argv[1]); + printf("RC arg[2]=%s\n",argv[2]); -/* ukazatelx |l-ta spiska */ -/* nowyj |l-t */ -extern Void push PP((ptr_ *pp, long adr)); + if (argc > 1) set_string( name, argv[1] ); + else *name = '\0'; -/* dobawlqet |lement k spisku */ -extern Void newlist PP((ptr_ *pp)); + if (*name == '\0') + { + printf (" Rigal Checker and Compiler v.%s\n", rigal_version); + printf (" rc filename [-c] [-D] [-P options ]\n"); + printf (" filename must be without extension, .rig is appended\n"); + close_and_exit_rc( out, sour, lstn ); -/* nowyj ukazatelx spiska */ -/* sozdaet nowyj spisok */ -/* ukazatelx spiska */ -/* imq */ -extern Void namelist PP((ptr_ pp, long name)); + } -/* priswaiwaet imq spisku */ -/* gde izmenitx */ -/* na ~to */ -extern Void changeelement PP((ptr_ *pp, long adr)); + init_dinform (); // defpage + opena (); + opens (); + lstn = NULL; + sour = NULL; + out = NULL; + out = fopen ("check_tmp.out", "w"); + if (out == NULL) _EscIO (FileNotFound); -error_rec_type error_rec_ch; -aa error_rec_ch_adr; /* renew by incfile */ -string80 error_rec_ch_mainstr; /* constant */ -boolean er; - - -/* transported in oll big procedures - as last, var- paramerter */ -extern Void err PP((long err_num)); - -/* wydaet soob{eniq ob o{ibkah rigal-teksta */ -extern Void tabrule PP((long av, long ar)); - -/* sozdaet nowoe imq peremennoj av prawila ar w - tablice prawil w sp2 , adresa iz sp2 */ -extern Void dul PP((long *ad)); - -/* beret l.cel iz sp1 i dubliruet w ad w sp2 */ -extern Void pushl PP((ptr_ *m)); - -/* kak push(m,l.cel) ,no iz sp1 w sp2 */ -extern char des PP((ptr_ g)); - -extern Void nextl PV(); - -extern keyint valc PP((ptr_ pp)); - -extern boolean el PP((keyint ii)); - -extern Void bltn PP((long rname, long *rnum)); - - -extern Void operator_ PP((ptr_ *m)); - -extern Void instruc PP((ptr_ *m)); - -extern Void expr PP((ptr_ *p, boolean bigexpr)); - -extern Void chepro PV(); - -extern Void chepil PP((ptr_ *v)); - -extern Void rule PP((ptr_ *d)); - -extern Void pict PP((ptr_ *m, long *siz, long *act)); - - -#define let_sign 1 -#define d_colon 2 -#define more_eq 3 -#define less_more 4 -#define lpar_point 5 -#define rpar_point 6 -#define less_eq 7 -#define minus_more 8 -#define lpar_star 9 -#define rpar_star 10 -#define lpar_plus 11 -#define rpar_plus 12 -#define d_cross 13 -#define d_semic 14 -#define d_excl 15 -#define d_plus 16 -#define excl_point 17 -#define less_point 18 -#define more_point 19 -#define less_star 20 -#define more_star 21 -#define lpar_colon 22 /* ---- */ -#define d_less 22 -#define rpar_colon 23 /* ---- */ -#define d_more 23 -#define if_key 24 -#define fi_key 25 -#define in_key 26 /* ---- */ -#define do_key 27 -#define od_key 28 -#define or_key 29 -#define plus 30 -#define excl_sign 31 -#define lpar 32 -#define rpar 33 -#define minus 34 -#define eq_sign 35 -#define star 36 -#define point 37 -#define more_sign 38 -#define less_sign 39 -#define lbrac 40 -#define rbrac 41 - -#define and_key 42 -#define mod_key 43 -#define div_key 44 -#define not_key 45 -#define save_key 46 -#define load_key 47 -#define fail_key 48 -#define copy_key 49 -#define elsif_key 50 -#define onfail_key 51 -#define print_key 52 -#define report_key 52 /* ---- */ -#define forall_key 53 -#define open_key 54 -#define outtext_key 54 /* ---- */ -#define slash 55 -#define semic 56 -#define return_key 57 -#define last_key 58 -#define null_key 59 -#define colon_sign 60 -#define comma_sign 61 -#define close_key 62 -#define break_key 63 -#define end_key 64 -#define loop_key 65 -#define d_sun 66 /* ------ */ -#define less_rbrac 67 /* ------ */ -#define s_apost 68 /* ------ */ -#define v_apost 69 /* ------ */ -#define reserv5_key 70 /* ------ */ -#define selectors_key 71 -#define branches_key 72 - -#define maxkey 72 - - -Void chepil(v) -ptr_ *v; + out_screen = false; + max_printlevel = max_printconst; + *erm.message = '\0'; + + set_string( name, argv[1] ); + char name_rig[86]; + sprintf (name_rig, "%s.rig", name); + if (!existfile (name_rig)) + { + printf ("Error : file %s.rig not found \n", name); + close_and_exit_rc( out, sour, lstn ); + } + + printf ("Rigal Checker/Compiler V.%s, 1996,LU Riga ", rigal_version); + + //run the lexer + ley (name_rig, &ttt, false, &erm); + + if (*erm.message == '\0')//no error => run the checker + { + che11 (ttt, &tt1, name, &erm, argc, argv); + if (!er) + { + strncat (name, ".rsc",4); + savesn (name, &tt1); + } + else er = true; + } + else er = true; + + if (!er) + { + printf ("No errors found\n"); + for (i = 1; i < argc; i++) + { + set_string( stt, argv[i] ); + if (!strcmp (stt, "-c")) + { + printf ("Starting xd\n"); + system ("/bin/csh -f ./xd"); + break; + } + } + } + else process_error(); + + close_and_exit_rc( out, sour, lstn ); + +} + +static void close_and_exit_rc(FILE *out, FILE* sour, FILE *lstn ) +{ + if (out != NULL) fclose (out ); + if (sour != NULL) fclose (sour); + if (lstn != NULL) fclose (lstn); + exit (0); +} + + +static void process_error() +{ + char STR1[256]; + if (erm.filename[strlen (erm.filename) - 1] != 'g') + { + sprintf (STR1, "%.*s", (int) (strlen (erm.filename) - 1L), erm.filename); + strcpy (erm.filename, STR1); + } + printf (" Error in file %s\n", erm.filename); + printf (" Line = %12d\n", erm.address / 80); + printf (" Message = %s\n", erm.message); + printf (" Column = %12d\n", erm.address % 80); +} + + +static void +chepil (ptr_ * v) { mpd x, x1; a p1, aar, ruleadr; longint varcoun; long nb, i, j; - /*array[1..80] of char*/ bl80 str80; p1 = v->UU.U1.mainadr; - first(p1, v); - - while (v->nel != 0) /*while*/ - { /*1*/ - ruleadr = v->cel; - pointr(ruleadr, &x1.sa); - nb = 1; - aar = x1.srd->name; - while (aar != tabn[nb - 1] && nb < rulemaxnum) - nb++; - if (nb == rulemaxnum) { - err(523L); - goto _L77; - } - /* ==== tabflag[nb]:=tabflag[nb]+1;==== */ - p1 = tabv[nb - 1]; - if (p1 == 0) /* if/else/ p1 */ - varcoun = 1; - else { /*2*/ - pointr(p1, &x.sa); - if (x.smld->dtype != listmain) { - err(522L); - goto _L77; - } - varcoun = x.smld->totalelnum; - if (varcoun == 0) - varcoun = 1; - } - /*2*/ - next(v); - p1 = v->cel; - points(p1, &x1.sa); - if (x1.snd->dtype != number) { - err(524L); - goto _L77; + first (p1, v); + + while (v->nel != 0) + { + /*1 */ + ruleadr = v->cel; + assert_and_assign_real_pointer (ruleadr, &x1.sa); + nb = 1; + aar = x1.srd->name; + while (aar != tabn[nb - 1] && nb < rulemaxnum) + nb++; + if (nb == rulemaxnum) + { + err (523L); + goto _L77; + } + /* ==== tabflag[nb]:=tabflag[nb]+1;==== */ + p1 = tabv[nb - 1]; + if (p1 == 0) /* if/else/ p1 */ + varcoun = 1; + else + { /*2 */ + assert_and_assign_real_pointer (p1, &x.sa); + if (x.smld->dtype != listmain) + { + err (522L); + goto _L77; + } + varcoun = x.smld->totalelnum; + if (varcoun == 0) + varcoun = 1; + } + /*2 */ + next (v); + p1 = v->cel; + assert_and_assign_real_pointer (p1, &x1.sa); + if (x1.snd->dtype != number) + { + err (524L); + goto _L77; + } + x1.snd->val = -1; + next (v); + p1 = v->cel; + + assert_and_assign_real_pointer (p1, &x1.sa); + if (x1.snd->dtype != number) + { + err (525L); + goto _L77; + } + x1.snd->val = varcoun; + + + while (v->cel != 0 && v->nel != 0) + next (v); + next (v); } - x1.snd->val = -1; - next(v); - p1 = v->cel; + /*1 */ - points(p1, &x1.sa); - if (x1.snd->dtype != number) { - err(525L); - goto _L77; + nb = 1; + while (tabn[nb - 1] != 0 && nb != rulemaxnum) + { /*1 */ + if (tabflags[nb - 1] == 0) + { /*2 */ + strcpy (error_rec_ch.message, + "406 THIS RULE WAS NOT DEFINED IN PROGRAM"); + if (tabfiles[nb - 1] == 0) + strcpy (error_rec_ch.filename, error_rec_ch_mainstr); + else + { + get_data_from_pointa (tabfiles[nb - 1], str80, &j); + *error_rec_ch.filename = '\0'; + for (i = 0; i < j; i++) + sprintf (error_rec_ch.filename + + strlen (error_rec_ch.filename), "%c", str80[i]); + } + error_rec_ch.address = tabcord[nb - 1]; + er = true; + goto _L77; + } + /*2 */ + nb++; } - x1.snd->val = varcoun; + /*1 */ +_L77:; +}//chepil - while (v->cel != 0 && v->nel != 0) - next(v); - next(v); - } - /*1*/ - /* prowerka na nali~ie w tablice neopredelennyh prawil */ - nb = 1; - while (tabn[nb - 1] != 0 && nb != rulemaxnum) /*while*/ - { /*1*/ - if (tabflags[nb - 1] == 0) /* if */ - { /*2*/ - strcpy(error_rec_ch.message, "406 THIS RULE WAS NOT DEFINED IN PROGRAM"); - if (tabfiles[nb - 1] == 0) - strcpy(error_rec_ch.filename, error_rec_ch_mainstr); - else { - pointa(tabfiles[nb - 1], str80, &j); - *error_rec_ch.filename = '\0'; - for (i = 0; i < j; i++) - sprintf(error_rec_ch.filename + strlen(error_rec_ch.filename), "%c", - str80[i]); - } - error_rec_ch.address = tabcord[nb - 1]; - er = true; - goto _L77; - } - /*2*/ - nb++; - } - /*1*/ -_L77: ; -} /*chepil*/ - - -typedef union bufrectype { - Char lexbuf[bufmaxlen]; - Char b1; - Char b2[2]; - Char b3[3]; - Char b4[4]; - Char b5[5]; - Char b6[6]; - Char b7[7]; - Char b8[8]; - Char b9[9]; - Char b10[10]; -} bufrectype; - - -/* Local variables for chepro: */ -struct LOC_chepro { - bufrectype bufrec; -} ; - -Local Void makekey(ki, LINK) -keyint ki; -struct LOC_chepro *LINK; +bufrectype bufrec; + + + +static void +makekey (key_type_as_int ki, bufrectype bufrec) { - /* nomer k-ty */ - /* sozdaet w sp1 konstantu, berq ee iz bufrec */ - long q; + int q; a a1, aadr; mpd x; - long l1len; + int l1len; - for (q = 1; q <= 10; q++) { - if (LINK->bufrec.b10[q - 1] != ' ') - l1len = q; - } - putatm(LINK->bufrec.b10, l1len, &aadr); - if (ki <= 75) { - gets1(&a1, &x.sa); - x.sad->dtype = keyword; - x.sad->name = aadr; - } else { - gets2(&a1, &x.sa); - x.srd->dtype = rulename; - x.srd->name = aadr; - x.srd->fragmadr = 0; - x.srd->nomintab = 0; - } + for (q = 1; q <= 10; q++) + { + if (bufrec.b10[q - 1] != ' ') + l1len = q; + } + putatm (bufrec.b10, l1len, &aadr); + if (ki <= 75) + { + gets1 (&a1, &x.sa); + x.sad->dtype = keyword; + x.sad->name = aadr; + } + else + { + gets2 (&a1, &x.sa); + x.srd->dtype = rulename; + x.srd->name = aadr; + x.srd->fragmadr = 0; + x.srd->nomintab = 0; + } for (q = 0; q <= 9; q++) - LINK->bufrec.b10[q] = ' '; - m1[(int)ki] = a1; /* zakreplqet adres */ - etalon[(int)ki] = aadr; /* zakreplqet a-adres */ - /*==$ifdef harddebug*/ - /* if bb7 then - writeln('razm. ', str80[1], str80[2], str80[3], ki: 3, - 'A1(S)=', a1, ' AADR(A)=', aadr);*/ - /*==$endif*/ -} + bufrec.b10[q] = ' '; + + m1[(int) ki] = a1; + etalon[(int) ki] = aadr; +} -Void chepro() -{ /* inicializaciq peremennyh */ - struct LOC_chepro V; - Char onechar_array[12]; +void +chepro () +{ + char onechar_array[12]; c2 twochar_symbols[29]; long i; - /* a1: a;*/ - ptr_ f1; + ptr_ f1; + errmuch = 0; + memset (&bufrec, ' ', sizeof (bufrectype)); - errmuch = 0; /* ~islo o{ibok */ - /* nomera prostranstw i konstanty */ - for (i = 0; i <= 149; i++) /* o~istka */ + for (i = 0; i <= 149; i++) m1[i] = 0; - for (i = 0; i < rulemaxnum; i++) /* o~istka */ + for (i = 0; i < rulemaxnum; i++) tabv[i] = 0; - memcpy(tabn, tabv, rulemaxnum * sizeof(long)); - memcpy(tabflags, tabv, rulemaxnum * sizeof(long)); - memcpy(twochar_symbols[0], ":=", sizeof(c2)); - memcpy(twochar_symbols[1], "::", sizeof(c2)); - memcpy(twochar_symbols[2], ">=", sizeof(c2)); - memcpy(twochar_symbols[3], "<>", sizeof(c2)); - memcpy(twochar_symbols[4], "(.", sizeof(c2)); - memcpy(twochar_symbols[5], ".)", sizeof(c2)); - memcpy(twochar_symbols[6], "<=", sizeof(c2)); - memcpy(twochar_symbols[7], "->", sizeof(c2)); - memcpy(twochar_symbols[8], "(*", sizeof(c2)); - memcpy(twochar_symbols[9], "*)", sizeof(c2)); - memcpy(twochar_symbols[10], "(+", sizeof(c2)); - memcpy(twochar_symbols[11], "+)", sizeof(c2)); - memcpy(twochar_symbols[12], "##", sizeof(c2)); - memcpy(twochar_symbols[13], ";;", sizeof(c2)); - memcpy(twochar_symbols[14], "!!", sizeof(c2)); - memcpy(twochar_symbols[15], "++", sizeof(c2)); - memcpy(twochar_symbols[16], "!.", sizeof(c2)); - memcpy(twochar_symbols[17], "<.", sizeof(c2)); - memcpy(twochar_symbols[18], ".>", sizeof(c2)); - memcpy(twochar_symbols[19], "<*", sizeof(c2)); - memcpy(twochar_symbols[20], "*>", sizeof(c2)); - memcpy(twochar_symbols[21], "<<", sizeof(c2)); - memcpy(twochar_symbols[22], ">>", sizeof(c2)); - memcpy(twochar_symbols[23], "IF", sizeof(c2)); - memcpy(twochar_symbols[24], "FI", sizeof(c2)); - memcpy(twochar_symbols[25], "IN", sizeof(c2)); - memcpy(twochar_symbols[26], "DO", sizeof(c2)); - memcpy(twochar_symbols[27], "OD", sizeof(c2)); - memcpy(twochar_symbols[28], "OR", sizeof(c2)); - memcpy(V.bufrec.b10, " ", 10L); - for (i = 1; i <= 29; i++) { - V.bufrec.b2[0] = twochar_symbols[i - 1][0]; - V.bufrec.b2[1] = twochar_symbols[i - 1][1]; - makekey((int)i, &V); - } - memcpy(onechar_array, "+!()-=*.><[]", 12L); - for (i = 1; i <= 12; i++) { - V.bufrec.b1 = onechar_array[i - 1]; - makekey((int)(i + 29), &V); - } - memcpy(V.bufrec.b3, "AND", 3L); - makekey(42, &V); - memcpy(V.bufrec.b3, "MOD", 3L); - makekey(43, &V); - memcpy(V.bufrec.b3, "DIV", 3L); - makekey(44, &V); - memcpy(V.bufrec.b3, "NOT", 3L); - makekey(45, &V); - memcpy(V.bufrec.b4, "SAVE", 4L); - makekey(46, &V); - memcpy(V.bufrec.b4, "LOAD", 4L); - makekey(47, &V); - memcpy(V.bufrec.b4, "FAIL", 4L); - makekey(48, &V); - memcpy(V.bufrec.b4, "COPY", 4L); - makekey(49, &V); - memcpy(V.bufrec.b5, "ELSIF", 5L); - makekey(50, &V); - memcpy(V.bufrec.b6, "ONFAIL", 6L); - makekey(51, &V); - memcpy(V.bufrec.b5, "PRINT", 5L); - makekey(52, &V); - memcpy(V.bufrec.b6, "FORALL", 6L); - makekey(53, &V); - memcpy(V.bufrec.b4, "OPEN", 4L); - makekey(54, &V); - V.bufrec.b1 = '/'; - makekey(55, &V); - V.bufrec.b1 = ';'; - makekey(56, &V); - memcpy(V.bufrec.b6, "RETURN", 6L); - makekey(57, &V); - memcpy(V.bufrec.b4, "LAST", 4L); - makekey(58, &V); - memcpy(V.bufrec.b4, "NULL", 4L); - makekey(59, &V); - V.bufrec.b1 = ':'; - makekey(60, &V); - V.bufrec.b1 = ','; - makekey(61, &V); - memcpy(V.bufrec.b5, "CLOSE", 5L); - makekey(62, &V); - memcpy(V.bufrec.b5, "BREAK", 5L); - makekey(63, &V); - memcpy(V.bufrec.b3, "END", 3L); - makekey(64, &V); - memcpy(V.bufrec.b4, "LOOP", 4L); - makekey(65, &V); - memcpy(V.bufrec.b2, "$$", 2L); - makekey(66, &V); - memcpy(V.bufrec.b2, "<]", 2L); - makekey(67, &V); - memcpy(V.bufrec.b2, "S'", 2L); - makekey(68, &V); - memcpy(V.bufrec.b2, "V'", 2L); - makekey(69, &V); - V.bufrec.b1 = '@'; - makekey(70, &V); - memcpy(V.bufrec.b9, "SELECTORS", 9L); - makekey(71, &V); - memcpy(V.bufrec.b8, "BRANCHES", 8L); - makekey(72, &V); - V.bufrec.b1 = '_'; - makekey(73, &V); + memmove (tabn, tabv, rulemaxnum * sizeof (long)); + memmove (tabflags, tabv, rulemaxnum * sizeof (long)); + memmove (twochar_symbols[0], ":=", sizeof (c2)); + memmove (twochar_symbols[1], "::", sizeof (c2)); + memmove (twochar_symbols[2], ">=", sizeof (c2)); + memmove (twochar_symbols[3], "<>", sizeof (c2)); + memmove (twochar_symbols[4], "(.", sizeof (c2)); + memmove (twochar_symbols[5], ".)", sizeof (c2)); + memmove (twochar_symbols[6], "<=", sizeof (c2)); + memmove (twochar_symbols[7], "->", sizeof (c2)); + memmove (twochar_symbols[8], "(*", sizeof (c2)); + memmove (twochar_symbols[9], "*)", sizeof (c2)); + memmove (twochar_symbols[10], "(+", sizeof (c2)); + memmove (twochar_symbols[11], "+)", sizeof (c2)); + memmove (twochar_symbols[12], "##", sizeof (c2)); + memmove (twochar_symbols[13], ";;", sizeof (c2)); + memmove (twochar_symbols[14], "!!", sizeof (c2)); + memmove (twochar_symbols[15], "++", sizeof (c2)); + memmove (twochar_symbols[16], "!.", sizeof (c2)); + memmove (twochar_symbols[17], "<.", sizeof (c2)); + memmove (twochar_symbols[18], ".>", sizeof (c2)); + memmove (twochar_symbols[19], "<*", sizeof (c2)); + memmove (twochar_symbols[20], "*>", sizeof (c2)); + memmove (twochar_symbols[21], "<<", sizeof (c2)); + memmove (twochar_symbols[22], ">>", sizeof (c2)); + memmove (twochar_symbols[23], "IF", sizeof (c2)); + memmove (twochar_symbols[24], "FI", sizeof (c2)); + memmove (twochar_symbols[25], "IN", sizeof (c2)); + memmove (twochar_symbols[26], "DO", sizeof (c2)); + memmove (twochar_symbols[27], "OD", sizeof (c2)); + memmove (twochar_symbols[28], "OR", sizeof (c2)); + memmove (bufrec.b10, " ", 10L); + for (i = 1; i <= 29; i++) + { + bufrec.b2[0] = twochar_symbols[i - 1][0]; + bufrec.b2[1] = twochar_symbols[i - 1][1]; + makekey ((int) i, bufrec); + memmove (bufrec.b10, " ", 10L); + } + memmove (bufrec.b10, " ", 10L); + memmove (onechar_array, "+!()-=*.><[]", 12L); + for (i = 1; i <= 12; i++) + { + bufrec.b1 = onechar_array[i - 1]; + makekey ((int) (i + 29), bufrec); + memmove (bufrec.b10, " ", 10L); + } + memmove (bufrec.b3, "AND", 3L); + makekey (42, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b3, "MOD", 3L); + makekey (43, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b3, "DIV", 3L); + makekey (44, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b3, "NOT", 3L); + makekey (45, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "SAVE", 4L); + makekey (46, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "LOAD", 4L); + makekey (47, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "FAIL", 4L); + makekey (48, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "COPY", 4L); + makekey (49, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b5, "ELSIF", 5L); + makekey (50, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b6, "ONFAIL", 6L); + makekey (51, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b5, "PRINT", 5L); + makekey (52, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b6, "FORALL", 6L); + makekey (53, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "OPEN", 4L); + makekey (54, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = '/'; + makekey (55, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = ';'; + makekey (56, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b6, "RETURN", 6L); + makekey (57, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "LAST", 4L); + makekey (58, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "NULL", 4L); + makekey (59, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = ':'; + makekey (60, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = ','; + makekey (61, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b5, "CLOSE", 5L); + makekey (62, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b5, "BREAK", 5L); + makekey (63, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b3, "END", 3L); + makekey (64, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b4, "LOOP", 4L); + makekey (65, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b2, "$$", 2L); + makekey (66, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b2, "<]", 2L); + makekey (67, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b2, "S'", 2L); + makekey (68, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b2, "V'", 2L); + makekey (69, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = '@'; + makekey (70, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b9, "SELECTORS", 9L); + makekey (71, bufrec); + memmove (bufrec.b10, " ", 10L); + memmove (bufrec.b8, "BRANCHES", 8L); + makekey (72, bufrec); + memmove (bufrec.b10, " ", 10L); + bufrec.b1 = '_'; + makekey (73, bufrec); + memmove (bufrec.b10, " ", 10L); ass_1 = etalon[73]; - /* this is used after maxkey and necessary for - $ - variable name is '_' */ - /* na~inaq s nomera 76 - |talony imen wstroennyh prawil */ - /* nomer prawila wy~islqetsq w programme bltn : i-75 */ - memcpy(V.bufrec.b7, "IMPLODE", 7L); - makekey(76, &V); /* 1 */ - memcpy(V.bufrec.b7, "EXPLODE", 7L); - makekey(77, &V); /* 2 */ - memcpy(V.bufrec.b4, "ATOM", 4L); - makekey(78, &V); /* 3 */ - memcpy(V.bufrec.b6, "NUMBER", 6L); - makekey(79, &V); /* 4 */ - memcpy(V.bufrec.b5, "IDENT", 5L); - makekey(80, &V); /* 5 */ - memcpy(V.bufrec.b4, "LIST", 4L); - makekey(81, &V); /* 6 */ - memcpy(V.bufrec.b4, "TREE", 4L); - makekey(82, &V); /* 7 */ - memcpy(V.bufrec.b5, "TATOM", 5L); - makekey(83, &V); /* 8 */ - memcpy(V.bufrec.b5, "FATOM", 5L); - makekey(84, &V); /* 9 */ - memcpy(V.bufrec.b8, "_KEYWORD", 8L); - makekey(85, &V); /* 10 */ - memcpy(V.bufrec.b9, "_SPECDESC", 9L); - makekey(86, &V); /* 11 */ - memcpy(V.bufrec.b3, "LEN", 3L); - makekey(87, &V); /* 12 */ - memcpy(V.bufrec.b9, "_SPECATOM", 9L); - makekey(88, &V); /* 13 */ - memcpy(V.bufrec.b9, "_RULENAME", 9L); - makekey(89, &V); /* 14 */ - memcpy(V.bufrec.b8, "_VARNAME", 8L); - makekey(90, &V); /* 15 */ - memcpy(V.bufrec.b10, "_RULETOATM", 10L); - makekey(91, &V); /* 16 */ - memcpy(V.bufrec.b10, "_VARNTOATM", 10L); - makekey(92, &V); /* 17 */ - memcpy(V.bufrec.b10, "_VARDESLOC", 10L); - makekey(93, &V); /* 18 */ - memcpy(V.bufrec.b5, "DEBUG", 5L); - makekey(94, &V); /* 19 */ - memcpy(V.bufrec.b10, "_SPECTODSC", 10L); - makekey(95, &V); /* 20 */ - memcpy(V.bufrec.b9, "_CONTENT2", 9L); - makekey(96, &V); /* 21 */ - memcpy(V.bufrec.b3, "CHR", 3L); - makekey(97, &V); /* 22 */ - memcpy(V.bufrec.b4, "PARM", 4L); - makekey(98, &V); /* 23 */ - memcpy(V.bufrec.b8, "_TOTATOM", 8L); - makekey(99, &V); /* 24 */ - memcpy(V.bufrec.b3, "ORD", 3L); - makekey(100, &V); /* 25 */ - memcpy(V.bufrec.b8, "CALL_PAS", 8L); - makekey(101, &V); /* 26 */ - for (i = 102; i <= 149; i++) - etalon[i] = 0; - /* ..... */ - /* b3 := '...' ; makekey(99); 24 */ - /* ee kakie-to inicializacii */ - varn_desks = (1L << ((long)variable)) | (1L << ((long)idvariable)) | - (1L << ((long)fvariable)) | (1L << ((long)nvariable)); - newlist(&f1); - /* nowyj spisok - dlq tablicy prawil */ - /*m2[1] := f1.mainadr;*/ - push(&f1, 0L); - bspi = false; /* dlq $$ w s' */ - saveladr = 512; /* any impossible address */ - /* with */ + // this is used after maxkey and necessary for + // $ - variable name is '_' + memmove (bufrec.b7, "IMPLODE", 7L); + makekey (76, bufrec); + memmove (bufrec.b10, " ", 10L); // 1 + memmove (bufrec.b7, "EXPLODE", 7L); + makekey (77, bufrec); + memmove (bufrec.b10, " ", 10L); // 2 + memmove (bufrec.b4, "ATOM", 4L); + makekey (78, bufrec); + memmove (bufrec.b10, " ", 10L); // 3 + memmove (bufrec.b6, "NUMBER", 6L); + makekey (79, bufrec); + memmove (bufrec.b10, " ", 10L); // 4 + memmove (bufrec.b5, "IDENT", 5L); + makekey (80, bufrec); + memmove (bufrec.b10, " ", 10L); // 5 + memmove (bufrec.b4, "LIST", 4L); + makekey (81, bufrec); + memmove (bufrec.b10, " ", 10L); // 6 + memmove (bufrec.b4, "TREE", 4L); + makekey (82, bufrec); + memmove (bufrec.b10, " ", 10L); // 7 + memmove (bufrec.b5, "TATOM", 5L); + makekey (83, bufrec); + memmove (bufrec.b10, " ", 10L); // 8 + memmove (bufrec.b5, "FATOM", 5L); + makekey (84, bufrec); + memmove (bufrec.b10, " ", 10L); // 9 + memmove (bufrec.b8, "_KEYWORD", 8L); + makekey (85, bufrec); + memmove (bufrec.b10, " ", 10L); // 10 + memmove (bufrec.b9, "_SPECDESC", 9L); + makekey (86, bufrec); + memmove (bufrec.b10, " ", 10L); // 11 + memmove (bufrec.b3, "LEN", 3L); + makekey (87, bufrec); + memmove (bufrec.b10, " ", 10L); // 12 + memmove (bufrec.b9, "_SPECATOM", 9L); + makekey (88, bufrec); + memmove (bufrec.b10, " ", 10L); // 13 + memmove (bufrec.b9, "_RULENAME", 9L); + makekey (89, bufrec); + memmove (bufrec.b10, " ", 10L); // 14 + memmove (bufrec.b8, "_VARNAME", 8L); + makekey (90, bufrec); + memmove (bufrec.b10, " ", 10L); // 15 + memmove (bufrec.b10, "_RULETOATM", 10L); + makekey (91, bufrec); + memmove (bufrec.b10, " ", 10L); // 16 + memmove (bufrec.b10, "_VARNTOATM", 10L); + makekey (92, bufrec); + memmove (bufrec.b10, " ", 10L); // 17 + memmove (bufrec.b10, "_VARDESLOC", 10L); + makekey (93, bufrec); + memmove (bufrec.b10, " ", 10L); // 18 + memmove (bufrec.b5, "DEBUG", 5L); + makekey (94, bufrec); + memmove (bufrec.b10, " ", 10L); // 19 + memmove (bufrec.b10, "_SPECTODSC", 10L); + makekey (95, bufrec); + memmove (bufrec.b10, " ", 10L); // 20 + memmove (bufrec.b9, "_CONTENT2", 9L); + makekey (96, bufrec); + memmove (bufrec.b10, " ", 10L); // 21 + memmove (bufrec.b3, "CHR", 3L); + makekey (97, bufrec); + memmove (bufrec.b10, " ", 10L); // 22 + memmove (bufrec.b4, "PARM", 4L); + makekey (98, bufrec); + memmove (bufrec.b10, " ", 10L); // 23 + memmove (bufrec.b8, "_TOTATOM", 8L); + makekey (99, bufrec); + memmove (bufrec.b10, " ", 10L); // 24 + memmove (bufrec.b3, "ORD", 3L); + makekey (100, bufrec); + memmove (bufrec.b10, " ", 10L); // 25 + memmove (bufrec.b8, "CALL_PAS", 8L); + makekey (101, bufrec); + memmove (bufrec.b10, " ", 10L); // 26 + memset (&(etalon[102]), 0, 48); + + varn_desks = (1L << ((long) variable)) | (1L << ((long) idvariable)) | + (1L << ((long) fvariable)) | (1L << ((long) nvariable)); + newlist (&f1); + + //m2[1] := f1.mainadr; + push (&f1, 0L); + bspi = false; // dlq $$ w s' + saveladr = 512; // any impossible address + } -/* Local variables for che11: */ -struct LOC_che11 { - mpd x; - a a1; - FILE *batfile; - long icc; -} ; -Local Void incfile(LINK) -struct LOC_che11 *LINK; +static void +incfile (struct LOC_che11 *LINK) { /* processing file name description */ - Char STR1[256]; + char STR1[256]; - pointr(l.cel, &LINK->x.sa); + assert_and_assign_real_pointer (l.cel, &LINK->x.sa); LINK->a1 = LINK->x.sad->name; - aa_str(curfile_name, LINK->a1); + + aa_str (curfile_name, LINK->a1); + error_rec_ch_adr = LINK->a1; - strcpy(error_rec_ch.filename, curfile_name); - - if (curfile_name[strlen(curfile_name) - 1] == 'I') { - sprintf(STR1, "%.*s", (int)(strlen(curfile_name) - 5L), curfile_name); - strcpy(curfile_name, STR1); - printf("%s:\n", curfile_name); - /* we delete extension ".rig" in curfile_name */ - fprintf(LINK->batfile, "%s\n", curfile_name); /* ==> rigcomp.tmp */ - LINK->icc++; - } - next(&l); + + strcpy (error_rec_ch.filename, curfile_name); + + if (curfile_name[strlen (curfile_name) - 1] == 'I') + { + sprintf (STR1, "%.*s", (int) (strlen (curfile_name) - 5L), + curfile_name); + strcpy (curfile_name, STR1); + printf ("%s:\n", curfile_name); + /* we delete extension ".rig" in curfile_name */ + fprintf (LINK->batfile, "%s\n", curfile_name); /* ==> rigcomp.tmp */ + LINK->icc++; + } + next (&l); } -Void che11(chein, rezche, main_name_, error_rec_rw, an_argc, an_argv) -long chein, *rezche; -Char *main_name_; -error_rec_type *error_rec_rw; -int an_argc; -char *an_argv[]; +static void +che11 (chein, rezche, main_name_, error_rec_rw, an_argc, an_argv) + long chein, *rezche; + char *main_name_; + error_rec_type *error_rec_rw; + int an_argc; + char *an_argv[]; { /* source list */ /* result code */ struct LOC_che11 V; string80 main_name; - ptr_ rrr; /* pointer moves along input list */ + ptr_ rrr; /* pointer moves along input list */ long ii, ri, i; string80 stt; long FORLIM; - strcpy(main_name, main_name_); + strcpy (main_name, main_name_); V.batfile = NULL; m1[0] = chein; V.icc = 0; er = false; *error_rec_ch.message = '\0'; - memset( error_rec_ch.filename,0,80); - memmove(error_rec_ch.filename,main_name,75); - memmove(&(error_rec_ch.filename[(int)strlen(error_rec_ch.filename)]),".rig",4); - //sprintf(error_rec_ch.filename, "%s.rig", main_name); + sprintf (error_rec_ch.filename, "%s.rig", main_name); error_rec_ch_adr = 0; - memset( error_rec_ch_mainstr,0,80); - memmove(error_rec_ch_mainstr,main_name,75); - memmove(&(error_rec_ch_mainstr[(int)strlen(error_rec_ch_mainstr)]),".rig",4); - //sprintf(error_rec_ch_mainstr, "%s.rig", main_name); + sprintf (error_rec_ch_mainstr, "%s.rig", main_name); - chepro(); /* prolog of checker , makes deskriptrs */ + chepro (); /* prolog of checker , makes deskriptrs */ if (V.batfile != NULL) - V.batfile = freopen("RIGCOMP.TMP", "w", V.batfile); + V.batfile = freopen ("RIGCOMP.TMP", "w", V.batfile); else - V.batfile = fopen("RIGCOMP.TMP", "w"); + V.batfile = fopen ("RIGCOMP.TMP", "w"); if (V.batfile == NULL) - _EscIO(FileNotFound); - fprintf(V.batfile, "%s\n", main_name); + _EscIO (FileNotFound); + fprintf (V.batfile, "%s\n", main_name); - newlist(&rrr); + newlist (&rrr); - first(chein, &l); + first (chein, &l); - if (des(l) != rulename) { - err(21L); - goto _L77; - } - pushl(&rrr); - bltn(l.cel, &V.a1); - if (V.a1 != 0) { - err(23L); - goto _L77; - } + if (des (l) != rulename) + { + err (21L); + goto _L77; + } + pushl (&rrr); + bltn (l.cel, &V.a1); + if (V.a1 != 0) + { + err (23L); + goto _L77; + } /* main rule is not built_in */ - tabrule(512L, rrr.cel); + tabrule (512L, rrr.cel); if (er) goto _L77; currulename = rrr.cel; - for (ii = 1; ii <= 2; ii++) { - gets1(&V.a1, &V.x.sa); - push(&rrr, V.a1); - V.x.snd->dtype = number; - V.x.snd->val = 0; - } - nextl(); + for (ii = 1; ii <= 2; ii++) + { + gets1 (&V.a1, &V.x.sa); + push (&rrr, V.a1); + V.x.snd->dtype = number; + V.x.snd->val = 0; + } + nextl (); - instruc(&rrr); + instruc (&rrr); if (er) goto _L77; - if (!el(d_cross)) { - err(22L); - goto _L77; - } - next(&l); - push(&rrr, 0L); /* razdelitelx */ + if (!el (d_cross)) + { + err (22L); + goto _L77; + } + next (&l); + push (&rrr, 0L); /* razdelitelx */ /* write('Rule 1:'); - pointr(currulename,x.sa); - writeln('#',aa_str(x.srd^.name));*/ + assert_and_assign_real_pointer (currulename,x.sa); + writeln('#',aa_str(x.srd^.name)); */ /*clreol; - gotoxy(1,wherey); + gotoxy(1,wherey); */ ri = 2; - while (l.nel != 0) { - while (true) { - if (l.cel == 0 || l.nel == 0) - goto _L69; - if (des(l) != tatom) - goto _L12; - incfile(&V); - } - -_L12: - if (l.cel != 0 && l.nel != 0) { - if (des(l) != rulename) { - err(3L); - goto _L77; - } /* if rulename */ - /* write('Rule ', ri,':'); - pointr(l.cel,x.sa); writeln('#',aa_str(x.srd^.name));*/ - /* clreol; - gotoxy(1,wherey); */ - rule(&rrr); - if (er) - goto _L77; - push(&rrr, (long)null_); - ri++; - if (!el(d_cross)) { - err(25L); - goto _L77; - } - next(&l); - } - - while (true) { - if (l.cel == 0 || l.nel == 0) - goto _L69; - if (des(l) != tatom) - goto _L13; - incfile(&V); - } - - - -_L13: ; - } /* l.nel = 0 */ + while (l.nel != 0) + { + while (true) + { + if (l.cel == 0 || l.nel == 0) + goto _L69; + if (des (l) != tatom) + goto _L12; + incfile (&V); + } + + _L12: + if (l.cel != 0 && l.nel != 0) + { + if (des (l) != rulename) + { + err (3L); + goto _L77; + } /* if rulename */ + /* write('Rule ', ri,':'); + assert_and_assign_real_pointer (l.cel,x.sa); writeln('#',aa_str(x.srd^.name)); */ + /* clreol; + gotoxy(1,wherey); */ + rule (&rrr); + if (er) + goto _L77; + push (&rrr, (long) null_); + ri++; + if (!el (d_cross)) + { + err (25L); + goto _L77; + } + next (&l); + } + + while (true) + { + if (l.cel == 0 || l.nel == 0) + goto _L69; + if (des (l) != tatom) + goto _L13; + incfile (&V); + } + + + + _L13:; + } /* l.nel = 0 */ _L69: - chepil(&rrr); + chepil (&rrr); if (er) goto _L77; _L77: *rezche = rrr.UU.U1.mainadr; *error_rec_rw = error_rec_ch; - /*different places of rec=rw and chefun*/ + /*different places of rec=rw and chefun */ if (!er) - printf("Saving code ...\n"); - - if (!er) { - if (V.batfile != NULL) - fclose(V.batfile); - V.batfile = NULL; /* ==> rigcomp.tmp */ - if (V.batfile != NULL) - V.batfile = freopen("xd", "w", V.batfile); - else - V.batfile = fopen("xd", "w"); - if (V.batfile == NULL) - _EscIO(FileNotFound); - fprintf(V.batfile, "#!/bin/csh -f\n"); - - char *binpath = realpath(an_argv[0], NULL); - fprintf(stderr,"BINPATH = %s\n",binpath); - if (binpath == NULL) binpath = strdup(getenv("_")); - fprintf(V.batfile, "set rig=`dirname %s`\n", binpath); - fprintf(V.batfile, "echo $rig\n"); - free(binpath); - binpath = NULL; - - fprintf(V.batfile, "$rig/anrig -p N.TMP\n"); - fprintf(V.batfile, "$rig/genrigd S -p N.TMP\n"); - fprintf(V.batfile, " cc -g -w -m32 "); - for (i = 1; i < an_argc; i++) { - strcpy(stt,an_argv[i]); - brt(stt); - if (!strcmp(stt, "-P")) { - if (i <= an_argc - 2) { - strcpy(stt,an_argv[i+1]); - fprintf(V.batfile, " %s", stt); - } - } - } - fprintf(V.batfile, " -I../include -I. xcrg.c xcrg_0.c\\\n"); - FORLIM = V.icc; - for (i = 1; i <= FORLIM; i++) - fprintf(V.batfile, "xcrg_%ld.c\\\n", i); - fprintf(V.batfile, "-o %s\\\n", main_name); - //fprintf(V.batfile, "../lib/riglib.a -lm\n"); - fprintf(V.batfile, "../lib/riglib.a -lm \n"); - for (i = 1; i < an_argc; i++) { - strcpy(stt,an_argv[i]); - brt(stt); - if (!strcmp(stt, "-D")) - goto _L99; - } + printf ("Saving code ...\n"); - FORLIM = V.icc; - for (i = 0; i <= FORLIM; i++) - fprintf(V.batfile, "rm -f xcrg_%ld.c xcrg_%ld.o \n", i, i); - fprintf(V.batfile, "rm -f xcrg.c xcrg.o xcrga.h xcrg.h\n"); - fprintf(V.batfile, "rm -f *.RC2 *.RC4 RIGCOMP.TMP N.TMP\n"); - fprintf(V.batfile, "rm -f check_tmp.out $0\n"); -_L99: - /* -writeln(batfile,'echo Terminated successfully, result is ',main_name);*/ - if (V.batfile != NULL) - fclose(V.batfile); - V.batfile = NULL; + if (!er) + { + if (V.batfile != NULL) + fclose (V.batfile); + V.batfile = NULL; /* ==> rigcomp.tmp */ + if (V.batfile != NULL) + V.batfile = freopen ("xd", "w", V.batfile); + else + V.batfile = fopen ("xd", "w"); + if (V.batfile == NULL) + _EscIO (FileNotFound); + fprintf (V.batfile, "#!/bin/csh -f\n"); + + char *binpath = realpath (an_argv[0], NULL); + fprintf (stderr, "BINPATH = %s\n", binpath); + if (binpath == NULL) + binpath = strdup (getenv ("_")); + fprintf (V.batfile, "set rig=`dirname %s`\n", binpath); + fprintf (V.batfile, "echo $rig\n"); + free (binpath); + binpath = NULL; + + fprintf (V.batfile, "$rig/anrig -p N.TMP\n"); + fprintf (V.batfile, "$rig/genrigd S -p N.TMP\n"); + fprintf (V.batfile, " cc -g -w -m32 "); + for (i = 1; i < an_argc; i++) + { + strcpy (stt, an_argv[i]); + keep_string_up_to_first_space (stt); + if (!strcmp (stt, "-P")) + { + if (i <= an_argc - 2) + { + strcpy (stt, an_argv[i + 1]); + fprintf (V.batfile, " %s", stt); + } + } + } + fprintf (V.batfile, " -I../include -I. xcrg.c xcrg_0.c\\\n"); + FORLIM = V.icc; + for (i = 1; i <= FORLIM; i++) + fprintf (V.batfile, "xcrg_%ld.c\\\n", i); + fprintf (V.batfile, "-o %s\\\n", main_name); + //fprintf(V.batfile, "../lib/riglib.a -lm\n"); + fprintf (V.batfile, "../lib/riglib.a -lm \n"); + for (i = 1; i < an_argc; i++) + { + strcpy (stt, an_argv[i]); + keep_string_up_to_first_space (stt); + if (!strcmp (stt, "-D")) + goto _L99; + } + + FORLIM = V.icc; + for (i = 0; i <= FORLIM; i++) + fprintf (V.batfile, "rm -f xcrg_%ld.c xcrg_%ld.o \n", i, i); + fprintf (V.batfile, "rm -f xcrg.c xcrg.o xcrga.h xcrg.h\n"); + fprintf (V.batfile, "rm -f *.RC2 *.RC4 RIGCOMP.TMP N.TMP\n"); + fprintf (V.batfile, "rm -f check_tmp.out $0\n"); + _L99: + /* + writeln(batfile,'echo Terminated successfully, result is ',main_name); */ + if (V.batfile != NULL) + fclose (V.batfile); + V.batfile = NULL; - } + } if (V.batfile != NULL) - fclose(V.batfile); + fclose (V.batfile); } -/* Local variables for expr: */ -struct LOC_expr { - boolean bigexpr; -} ; +/* static variables for expr: */ +struct LOC_expr +{ + bool bigexpr; +}; -Local Void expr1(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; +static void +expr1 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { a a1; mpd x; @@ -803,1390 +846,1509 @@ struct LOC_expr *LINK; /* wyraveniq samogo nizkogo urownq */ - TEMP = des(l); - if (((1L << ((long)TEMP)) & ((1L << ((long)idatom)) | (1L << ((long)atom)) | - (1L << ((long)number)) | (1L << ((long)fatom)))) != 0) { - pushl(p); - nextl(); - goto _L99; - } - - TEMP = des(l); - if (((1L << ((long)TEMP)) & varn_desks) != 0) { - pushl(p); - tabrule(p->cel, currulename); - nextl(); - goto _L99; - } - - if (des(l) == rulename) { - bltn(l.cel, &a1); - if (a1 == 0) { /* pome{{aetsq nomer prawila */ - pushl(p); - tabrule(0L, p->cel); - } else /* wyzow wstroennoj f-ii */ - push(p, a1); - nextl(); - if (el(lpar)) { - /* " #.... ( ... ) " - konstruktor */ - nextl(); - push(p, 13312L); - while (!el(rpar)) { - expr(p, true); - if (er) - goto _L99; - push(p, 14336L); - } - if (p->cel == 14336) /* poslednij */ - changeelement(p, 13824L); - else - push(p, 13824L); - nextl(); - if (a1 == 0) /* priznak tipa prawila */ - push(p, 17920L); - else - push(p, 27136L); - goto _L99; - } else { - err(325L); + TEMP = des (l); + if (((1L << ((long) TEMP)) & + ((1L << ((long) idatom)) | (1L << ((long) atom)) | + (1L << ((long) number)) | (1L << ((long) fatom)))) != 0) + { + pushl (p); + nextl (); goto _L99; } - } - if (des(l) == spec) { - if (LINK->bigexpr) { - pushl(p); - nextl(); - } else - err(324L); - goto _L99; - } + TEMP = des (l); + if (((1L << ((long) TEMP)) & varn_desks) != 0) + { + pushl (p); + tabrule (p->cel, currulename); + nextl (); + goto _L99; + } - if (des(l) == keyword) { /* ob'ekt neizwestnogo tipa w wyravenii */ - switch (valc(l)) { - - case lpar_point: /* "(." - konstruktor */ - nextl(); - push(p, 13312L); - while (!el(rpar_point)) { - expr(p, true); - if (er) - goto _L99; - push(p, 14336L); - } - if (p->cel == 14336) /* poslednij */ - changeelement(p, 13824L); + if (des (l) == rulename) + { + bltn (l.cel, &a1); + if (a1 == 0) + { /* pome{{aetsq nomer prawila */ + pushl (p); + tabrule (0L, p->cel); + } + else /* wyzow wstroennoj f-ii */ + push (p, a1); + nextl (); + if (el (lpar)) + { + /* " #.... ( ... ) " - konstruktor */ + nextl (); + push (p, 13312L); + while (!el (rpar)) + { + expr (p, true); + if (er) + goto _L99; + push (p, 14336L); + } + if (p->cel == 14336) /* poslednij */ + changeelement (p, 13824L); + else + push (p, 13824L); + nextl (); + if (a1 == 0) /* priznak tipa prawila */ + push (p, 17920L); + else + push (p, 27136L); + goto _L99; + } else - push(p, 13824L); - nextl(); - break; - - case less_point: /* <. - konstruktor */ - nextl(); - push(p, 14848L); - if (!el(more_point)) { - do { - expr(p, true); - if (er) - goto _L99; - /* imq wetwi derewa - wyravenie */ - if (el(colon_sign)) - nextl(); - else - err(329L); - /* net : w opisanii wetwi derewa */ - push(p, 30720L); - expr(p, true); /* sodervanie wetwi */ - if (er) - goto _L99; - if (!el(more_point)) { - if (!el(comma_sign)) { - err(330L); - goto _L99; - } - push(p, 15872L); - nextl(); - if (el(more_point)) { - err(331L); - goto _L99; - } - } - } while (!el(more_point)); - } - push(p, 15360L); - nextl(); - break; - - case lpar: - nextl(); - expr(p, true); - if (er) - goto _L99; - if (!el(rpar)) { - err(301L); - goto _L99; - } - /* oby~nye skobki */ - nextl(); - break; - - case last_key: - nextl(); /* last-wyravenie */ - if (des(l) != rulename) { - err(302L); - goto _L99; - } - bltn(l.cel, &a1); - if (a1 != 0) { - err(304L); - goto _L99; - } - pushl(p); - a1 = p->cel; - nextl(); - TEMP = des(l); - if (!(((1L << ((long)TEMP)) & varn_desks) != 0)) { - err(303L); - goto _L99; - } - pushl(p); - tabrule(p->cel, a1); - nextl(); - push(p, 17408L); - break; - - case copy_key: - nextl(); - if (!el(lpar)) { - err(313L); - goto _L99; - } - nextl(); - expr(p, true); - if (er) - goto _L99; - if (!el(rpar)) { - err(314L); - goto _L99; - } - nextl(); - push(p, 29696L); - break; - - case d_sun: - nextl(); - push(p, 0L); - push(p, 512L); - pointr(currulename, &x.sa); - if (x.srd->name == tabn[0]) { - err(409L); - goto _L99; - } - /* $$ not allowed in the main rule */ - break; - /* if not(bspi) then err(307);*/ - /* commented 30-aug-89 */ - /* tolxko w s'..*/ - + { + err (325L); + goto _L99; + } + } + if (des (l) == spec) + { + if (LINK->bigexpr) + { + pushl (p); + nextl (); + } + else + err (324L); + goto _L99; + } - default: - err(323L); - nextl(); - goto _L99; /* else */ - /* neovidannyj keyword wnutri wyraveniq */ - break; - }/*case*/ - } /* if/keyword */ + if (des (l) == keyword) + { /* ob'ekt neizwestnogo tipa w wyravenii */ + switch (valc (l)) + { + + case lpar_point: /* "(." - konstruktor */ + nextl (); + push (p, 13312L); + while (!el (rpar_point)) + { + expr (p, true); + if (er) + goto _L99; + push (p, 14336L); + } + if (p->cel == 14336) /* poslednij */ + changeelement (p, 13824L); + else + push (p, 13824L); + nextl (); + break; + + case less_point: /* <. - konstruktor */ + nextl (); + push (p, 14848L); + if (!el (more_point)) + { + do + { + expr (p, true); + if (er) + goto _L99; + /* imq wetwi derewa - wyravenie */ + if (el (colon_sign)) + nextl (); + else + err (329L); + /* net : w opisanii wetwi derewa */ + push (p, 30720L); + expr (p, true); /* sodervanie wetwi */ + if (er) + goto _L99; + if (!el (more_point)) + { + if (!el (comma_sign)) + { + err (330L); + goto _L99; + } + push (p, 15872L); + nextl (); + if (el (more_point)) + { + err (331L); + goto _L99; + } + } + } + while (!el (more_point)); + } + push (p, 15360L); + nextl (); + break; + + case lpar: + nextl (); + expr (p, true); + if (er) + goto _L99; + if (!el (rpar)) + { + err (301L); + goto _L99; + } + /* oby~nye skobki */ + nextl (); + break; + + case last_key: + nextl (); /* last-wyravenie */ + if (des (l) != rulename) + { + err (302L); + goto _L99; + } + bltn (l.cel, &a1); + if (a1 != 0) + { + err (304L); + goto _L99; + } + pushl (p); + a1 = p->cel; + nextl (); + TEMP = des (l); + if (!(((1L << ((long) TEMP)) & varn_desks) != 0)) + { + err (303L); + goto _L99; + } + pushl (p); + tabrule (p->cel, a1); + nextl (); + push (p, 17408L); + break; + + case copy_key: + nextl (); + if (!el (lpar)) + { + err (313L); + goto _L99; + } + nextl (); + expr (p, true); + if (er) + goto _L99; + if (!el (rpar)) + { + err (314L); + goto _L99; + } + nextl (); + push (p, 29696L); + break; + + case d_sun: + nextl (); + push (p, 0L); + push (p, 512L); + assert_and_assign_real_pointer (currulename, &x.sa); + if (x.srd->name == tabn[0]) + { + err (409L); + goto _L99; + } + /* $$ not allowed in the main rule */ + break; + /* if not(bspi) then err(307); */ + /* commented 30-aug-89 */ + /* tolxko w s'.. */ + + + + default: + err (323L); + nextl (); + goto _L99; /* else */ + /* neovidannyj keyword wnutri wyraveniq */ + break; + } /*case */ + } /* if/keyword */ else - err(327L); -_L99: ; + err (327L); +_L99:; -} /* expr1 */ +} /* expr1 */ -Local Void expr3(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; +static void +expr3 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { - expr1(p, LINK); + expr1 (p, LINK); if (er) goto _L1; - do { - switch (valc(l)) { - - case point: - nextl(); - expr1(p, LINK); - push(p, 18432L); - break; + do + { + switch (valc (l)) + { + + case point: + nextl (); + expr1 (p, LINK); + push (p, 18432L); + break; + + case d_colon: + nextl (); + expr1 (p, LINK); + push (p, 19456L); + break; + + case lbrac: + nextl (); + expr (p, true); + if (er) + goto _L1; + if (!el (rbrac)) + { + err (321L); + goto _L1; + } + nextl (); + push (p, 18944L); + break; + + + + default: + goto _L1; + break; + } /* case */ + } + while (true); +_L1:; +} /* expr3 */ + +static void +expr4 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; +{ + switch (valc (l)) + { - case d_colon: - nextl(); - expr1(p, LINK); - push(p, 19456L); + case not_key: + nextl (); + expr3 (p, LINK); + push (p, 16384L); break; - case lbrac: - nextl(); - expr(p, true); - if (er) - goto _L1; - if (!el(rbrac)) { - err(321L); - goto _L1; - } - nextl(); - push(p, 18944L); + case minus: + nextl (); + expr3 (p, LINK); + push (p, 16896L); break; + /* plus: begin nextl; expr3(p); push(p,. .); end; */ default: - goto _L1; + expr3 (p, LINK); break; - }/* case */ - } while (true); -_L1: ; -} /* expr3 */ + } /* case */ +} /* expr4 */ -Local Void expr4(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; +static void +expr5 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { - switch (valc(l)) { - - case not_key: - nextl(); - expr3(p, LINK); - push(p, 16384L); - break; - - case minus: - nextl(); - expr3(p, LINK); - push(p, 16896L); - break; - - /* plus: begin nextl; expr3(p); push(p,. .); end; */ - - - default: - expr3(p, LINK); - break; - }/* case */ -} /* expr4 */ - -Local Void expr5(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; -{ - expr4(p, LINK); + expr4 (p, LINK); if (er) goto _L1; - do { - switch (valc(l)) { - - case star: - nextl(); - expr4(p, LINK); - push(p, 19968L); - break; - - case div_key: - nextl(); - expr4(p, LINK); - push(p, 20480L); - break; - - case mod_key: - nextl(); - expr4(p, LINK); - push(p, 20992L); - break; - - - default: - goto _L1; - break; - }/*case */ - if (er) - goto _L1; - } while (true); -_L1: ; -} /* expr5 */ - -Local Void expr6(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; + do + { + switch (valc (l)) + { + + case star: + nextl (); + expr4 (p, LINK); + push (p, 19968L); + break; + + case div_key: + nextl (); + expr4 (p, LINK); + push (p, 20480L); + break; + + case mod_key: + nextl (); + expr4 (p, LINK); + push (p, 20992L); + break; + + + default: + goto _L1; + break; + } /*case */ + if (er) + goto _L1; + } + while (true); +_L1:; +} /* expr5 */ + +static void +expr6 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { - expr5(p, LINK); + expr5 (p, LINK); if (er) goto _L1; - do { - switch (valc(l)) { - - case d_excl: - nextl(); - expr5(p, LINK); - push(p, 21504L); - break; - - case excl_point: - nextl(); - expr5(p, LINK); - push(p, 22016L); - break; - - case d_plus: - nextl(); - expr5(p, LINK); - push(p, 22528L); - break; - - case plus: - nextl(); - expr5(p, LINK); - push(p, 23040L); - break; - - case minus: - nextl(); - expr5(p, LINK); - push(p, 23552L); - break; - - - default: - goto _L1; - break; - }/* case */ - if (er) - goto _L1; - } while (true); -_L1: ; -} /* expr6 */ - -Local Void expr7(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; + do + { + switch (valc (l)) + { + + case d_excl: + nextl (); + expr5 (p, LINK); + push (p, 21504L); + break; + + case excl_point: + nextl (); + expr5 (p, LINK); + push (p, 22016L); + break; + + case d_plus: + nextl (); + expr5 (p, LINK); + push (p, 22528L); + break; + + case plus: + nextl (); + expr5 (p, LINK); + push (p, 23040L); + break; + + case minus: + nextl (); + expr5 (p, LINK); + push (p, 23552L); + break; + + + default: + goto _L1; + break; + } /* case */ + if (er) + goto _L1; + } + while (true); +_L1:; +} /* expr6 */ + +static void +expr7 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { - expr6(p, LINK); + expr6 (p, LINK); if (er) goto _L1; - do { - switch (valc(l)) { - - case eq_sign: - nextl(); - expr6(p, LINK); - push(p, 24064L); - break; - - case less_more: - nextl(); - expr6(p, LINK); - push(p, 24576L); - break; - - case more_sign: - nextl(); - expr6(p, LINK); - push(p, 25088L); - break; - - case less_sign: - nextl(); - expr6(p, LINK); - push(p, 25600L); - break; - - case more_eq: - nextl(); - expr6(p, LINK); - push(p, 26112L); - break; - - case less_eq: - nextl(); - expr6(p, LINK); - push(p, 26624L); - break; - - - - default: - goto _L1; - break; - }/* case */ - if (er) - goto _L1; - } while (true); -_L1: ; -} /* expr7 */ - -Local Void expr8(p, LINK) -ptr_ *p; -struct LOC_expr *LINK; + do + { + switch (valc (l)) + { + + case eq_sign: + nextl (); + expr6 (p, LINK); + push (p, 24064L); + break; + + case less_more: + nextl (); + expr6 (p, LINK); + push (p, 24576L); + break; + + case more_sign: + nextl (); + expr6 (p, LINK); + push (p, 25088L); + break; + + case less_sign: + nextl (); + expr6 (p, LINK); + push (p, 25600L); + break; + + case more_eq: + nextl (); + expr6 (p, LINK); + push (p, 26112L); + break; + + case less_eq: + nextl (); + expr6 (p, LINK); + push (p, 26624L); + break; + + + + default: + goto _L1; + break; + } /* case */ + if (er) + goto _L1; + } + while (true); +_L1:; +} /* expr7 */ + +static void +expr8 (p, LINK) + ptr_ *p; + struct LOC_expr *LINK; { - expr7(p, LINK); + expr7 (p, LINK); if (er) goto _L1; - while (el(and_key)) { - nextl(); - expr7(p, LINK); - if (er) - goto _L1; - push(p, 27648L); - } -_L1: ; + while (el (and_key)) + { + nextl (); + expr7 (p, LINK); + if (er) + goto _L1; + push (p, 27648L); + } +_L1:; } -Void expr(p, bigexpr_) -ptr_ *p; -boolean bigexpr_; +static void expr (ptr_ *p,bool bigexpr_) { struct LOC_expr V; /* telo samoj proc. expr */ V.bigexpr = bigexpr_; /*-$ifdef harddebug*/ - /* if bb3 then writeln('*EXPR*', valc(l));*/ + /* if bb3 then writeln('*EXPR*', valc(l)); */ /*-$endif*/ - if (V.bigexpr) { /* esli nastoq{ee wyravenie */ - expr8(p, &V); - if (er) - goto _L1; - while (el(or_key)) { - nextl(); - expr8(p, &V); + if (V.bigexpr) + { /* esli nastoq{ee wyravenie */ + expr8 (p, &V); if (er) - goto _L1; - push(p, 28160L); + goto _L1; + while (el (or_key)) + { + nextl (); + expr8 (p, &V); + if (er) + goto _L1; + push (p, 28160L); + } } - } else /* esli odin obxekt */ - expr3(p, &V); + else /* esli odin obxekt */ + expr3 (p, &V); /*-$ifdef harddebug*/ - /* if bb3 then writeln('**EXPR/END *');*/ + /* if bb3 then writeln('**EXPR/END *'); */ /*-$endif*/ -_L1: ; +_L1:; } -Void err(err_num) -long err_num; +void +err (err_num) + long err_num; { ptr_ listp; long cint; char m[256]; - boolean found, var_mes; + bool found, var_mes; mpd x; string80 STR1; - memset(m,0,256); + memset (m, 0, 256); listp = l; /* writeln; - writeln('RIGAL SYNTAX ERROR NO.',err_num);*/ - switch (err_num) { + writeln('RIGAL SYNTAX ERROR NO.',err_num); */ + switch (err_num) + { + + case 2: + strcpy (m, "SYMBOL '##' NOT FOUND AFTER THE MAIN RULE"); + break; + + case 3: + strcpy (m, "RULE NAME '#...' NOT FOUND IN THE BEGINNING OF THE RULE"); + break; - case 2: - strcpy(m, "SYMBOL '##' NOT FOUND AFTER THE MAIN RULE"); - break; + case 5: + strcpy (m, "SYMBOL '##' NOT FOUND AFTER THE RULE"); + break; - case 3: - strcpy(m, "RULE NAME '#...' NOT FOUND IN THE BEGINNING OF THE RULE"); - break; + case 21: + strcpy (m, + "RULE NAME '#...' NOT FOUND IN THE BEGINNING OF THE MAIN RULE"); + break; - case 5: - strcpy(m, "SYMBOL '##' NOT FOUND AFTER THE RULE"); - break; + case 22: + strcpy (m, "SYMBOL '##' NOT FOUND AFTER THE MAIN RULE"); + break; - case 21: - strcpy(m, "RULE NAME '#...' NOT FOUND IN THE BEGINNING OF THE MAIN RULE"); - break; + case 23: + strcpy (m, "MAIN RULE NAME IS BUILT-IN RULE NAME"); + break; - case 22: - strcpy(m, "SYMBOL '##' NOT FOUND AFTER THE MAIN RULE"); - break; + case 30: + strcpy (m, "ENDING '/' NOT FOUND AFTER LIST OF STATEMENTS"); + break; - case 23: - strcpy(m, "MAIN RULE NAME IS BUILT-IN RULE NAME"); - break; + case 31: + strcpy (m, "SYMBOL '.)' MATCHING '(.' WAS NOT FOUND"); + break; - case 30: - strcpy(m, "ENDING '/' NOT FOUND AFTER LIST OF STATEMENTS"); - break; + case 37: + strcpy (m, "UNEXPECTED ELEMENT IN PATTERN"); + break; - case 31: - strcpy(m, "SYMBOL '.)' MATCHING '(.' WAS NOT FOUND"); - break; + case 38: + strcpy (m, "UNEXPECTED KEYWORD OR SYMBOL IN PATTERN"); + break; - case 37: - strcpy(m, "UNEXPECTED ELEMENT IN PATTERN"); - break; + case 40: + strcpy (m, + "UNEXPECTED BRANCH FOUND IN TREE PATTERN AFTER VARIABLE $A:..."); + break; - case 38: - strcpy(m, "UNEXPECTED KEYWORD OR SYMBOL IN PATTERN"); - break; + case 41: + strcpy (m, "VARIABLES NOT ALLOWED IN TREE PATTERN <. $A : ..."); + break; - case 40: - strcpy(m, - "UNEXPECTED BRANCH FOUND IN TREE PATTERN AFTER VARIABLE $A:..."); - break; - - case 41: - strcpy(m, "VARIABLES NOT ALLOWED IN TREE PATTERN <. $A : ..."); - break; - - case 42: - strcpy(m, "VARIABLES NOT ALLOWED IN TREE PATTERN <. ... [ $A : ..]"); - break; - - case 43: - strcpy(m, - "ONLY VARIABLES AND IDENTIFIERS ALLOWED AS BRANCH NAME IN TREE PATTERN"); - break; + case 42: + strcpy (m, "VARIABLES NOT ALLOWED IN TREE PATTERN <. ... [ $A : ..]"); + break; - case 44: - strcpy(m, "SYMBOL ':' NOT FOUND IN TREE PATTERN"); - break; + case 43: + strcpy (m, + "ONLY VARIABLES AND IDENTIFIERS ALLOWED AS BRANCH NAME IN TREE PATTERN"); + break; - case 45: - strcpy(m, "ONLY ONE PATTERN AS BRANCH VALUE IN TREE PATTERN ALLOWED"); - break; + case 44: + strcpy (m, "SYMBOL ':' NOT FOUND IN TREE PATTERN"); + break; - case 46: - strcpy(m, "SYMBOL ']' MATCHING ']' NOT FOUND IN TREE PATTERN"); - break; + case 45: + strcpy (m, "ONLY ONE PATTERN AS BRANCH VALUE IN TREE PATTERN ALLOWED"); + break; - case 47: - strcpy(m, "SYMBOL '.>', '*>' OR ',' MUST BE AFTER BRANCH PATTERN"); - break; + case 46: + strcpy (m, "SYMBOL ']' MATCHING ']' NOT FOUND IN TREE PATTERN"); + break; - case 48: - strcpy(m, "PATTERN <* ... .> NOT ALLOWED"); - break; + case 47: + strcpy (m, "SYMBOL '.>', '*>' OR ',' MUST BE AFTER BRANCH PATTERN"); + break; - case 49: - strcpy(m, "PATTERN <. ... *> NOT ALLOWED"); - break; + case 48: + strcpy (m, "PATTERN <* ... .> NOT ALLOWED"); + break; + + case 49: + strcpy (m, "PATTERN <. ... *> NOT ALLOWED"); + break; - case 50: - strcpy(m, "A VARIABLE NOT FIND IN THE LAST BRANCH OF <* ... *>"); - break; + case 50: + strcpy (m, "A VARIABLE NOT FIND IN THE LAST BRANCH OF <* ... *>"); + break; - case 51: - strcpy(m, "NO MORE THAN 5 BRANCHES IN <* ... *> ALLOWED"); - break; + case 51: + strcpy (m, "NO MORE THAN 5 BRANCHES IN <* ... *> ALLOWED"); + break; - case 52: - strcpy(m, "SYMBOL '::' NOT ALLOWED BEFORE RULE NAME"); - break; + case 52: + strcpy (m, "SYMBOL '::' NOT ALLOWED BEFORE RULE NAME"); + break; - case 53: - strcpy(m, "SYMBOL '::' NOT ALLOWED BEFORE '('"); - break; + case 53: + strcpy (m, "SYMBOL '::' NOT ALLOWED BEFORE '('"); + break; - case 54: - strcpy(m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN (* *)"); - break; + case 54: + strcpy (m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN (* *)"); + break; - case 55: - strcpy(m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN (+ +)"); - break; + case 55: + strcpy (m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN (+ +)"); + break; - case 56: - strcpy(m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN [ ]"); - break; + case 56: + strcpy (m, "MUST BE AT LEAST ONE PATTERN OR ACTION WITHIN [ ]"); + break; - case 57: - strcpy(m, "EMPTY TREE PATTERN IS NOT ALLOWED"); - break; + case 57: + strcpy (m, "EMPTY TREE PATTERN IS NOT ALLOWED"); + break; - case 58: - strcpy(m, "SYMBOL '::' IS NOT ALLOWED IN THIS POSITION"); - break; + case 58: + strcpy (m, "SYMBOL '::' IS NOT ALLOWED IN THIS POSITION"); + break; - case 59: - strcpy(m, "EMPTY ALTERNATIVE IN (..!..) OR EMPTY () ARE NOT ALLOWED"); - break; + case 59: + strcpy (m, "EMPTY ALTERNATIVE IN (..!..) OR EMPTY () ARE NOT ALLOWED"); + break; - case 61: - strcpy(m, "SYMBOL ';;' OR '##' EXPECTED"); - break; + case 61: + strcpy (m, "SYMBOL ';;' OR '##' EXPECTED"); + break; - case 63: - strcpy(m, "RULE NAME #... NOT FOUND IN THE BEGINNING OF THE RULE"); - break; + case 63: + strcpy (m, "RULE NAME #... NOT FOUND IN THE BEGINNING OF THE RULE"); + break; - case 64: - strcpy(m, "SYMBOL ';;' OR '##' EXPECTED"); - break; + case 64: + strcpy (m, "SYMBOL ';;' OR '##' EXPECTED"); + break; - case 65: - strcpy(m, "THIS RULE NAME IS BUILT-IN RULE NAME"); - break; + case 65: + strcpy (m, "THIS RULE NAME IS BUILT-IN RULE NAME"); + break; - case 66: - strcpy(m, "SYMBOL ';;' OR '##' EXPECTED"); - break; + case 66: + strcpy (m, "SYMBOL ';;' OR '##' EXPECTED"); + break; - case 71: - strcpy(m, "WRONG DELIMITER IN (*...* .. ) PATTERN"); - break; + case 71: + strcpy (m, "WRONG DELIMITER IN (*...* .. ) PATTERN"); + break; - case 72: - strcpy(m, "SYMBOL ')' EXPECTED IN (*...* .. ) PATTERN"); - break; + case 72: + strcpy (m, "SYMBOL ')' EXPECTED IN (*...* .. ) PATTERN"); + break; - case 73: - strcpy(m, "SYMBOL '*)' MATCHING '(*' NOT FOUND"); - break; + case 73: + strcpy (m, "SYMBOL '*)' MATCHING '(*' NOT FOUND"); + break; - case 74: - strcpy(m, "WRONG DELIMITER IN (+...+ .. )"); - break; + case 74: + strcpy (m, "WRONG DELIMITER IN (+...+ .. )"); + break; - case 75: - strcpy(m, "SYMBOL ')' EXPECTED IN (+...+ .. ) PATTERN"); - break; + case 75: + strcpy (m, "SYMBOL ')' EXPECTED IN (+...+ .. ) PATTERN"); + break; - case 76: - strcpy(m, "SYMBOL '+)' MATCHING '(+' NOT FOUND"); - break; + case 76: + strcpy (m, "SYMBOL '+)' MATCHING '(+' NOT FOUND"); + break; - case 77: - strcpy(m, "SYMBOL ']' MATCHING '[' NOT FOUND"); - break; + case 77: + strcpy (m, "SYMBOL ']' MATCHING '[' NOT FOUND"); + break; - case 81: - strcpy(m, "ONLY ONE ELEMENT MIGHT BE IN EVERY PART OF (..!..!..!..)"); - break; + case 81: + strcpy (m, "ONLY ONE ELEMENT MIGHT BE IN EVERY PART OF (..!..!..!..)"); + break; - case 82: - strcpy(m, "ONLY ONE ELEMENT MIGHT BE IN THE LAST PART OF (..!..!..!..)"); - break; + case 82: + strcpy (m, + "ONLY ONE ELEMENT MIGHT BE IN THE LAST PART OF (..!..!..!..)"); + break; - case 83: - strcpy(m, "UNEXPECTED SYMBOL IN PATTERN (..!..!..!..)"); - break; + case 83: + strcpy (m, "UNEXPECTED SYMBOL IN PATTERN (..!..!..!..)"); + break; - case 84: - strcpy(m, "UNEXPECTED '!' FOUND IN PATTERN (..!..!..!..)"); - break; + case 84: + strcpy (m, "UNEXPECTED '!' FOUND IN PATTERN (..!..!..!..)"); + break; - case 86: - strcpy(m, "SYMBOL '(' EXPECTED AFTER S' OR V'"); - break; + case 86: + strcpy (m, "SYMBOL '(' EXPECTED AFTER S' OR V'"); + break; - case 87: - strcpy(m, "SYMBOL ')' EXPECTED AFTER S'(... OR V'(..."); - break; + case 87: + strcpy (m, "SYMBOL ')' EXPECTED AFTER S'(... OR V'(..."); + break; - case 91: - strcpy(m, "ASSIGNMENT SYMBOL ':=' EXPECTED AFTER '!!', '!.', '++' OR '+'"); - break; + case 91: + strcpy (m, + "ASSIGNMENT SYMBOL ':=' EXPECTED AFTER '!!', '!.', '++' OR '+'"); + break; - case 101: - strcpy(m, "INTERNAL ERROR :MAINADR<>LISTMAIN"); - break; + case 101: + strcpy (m, "INTERNAL ERROR :MAINADR<>LISTMAIN"); + break; - case 102: - strcpy(m, "INTERNAL ERROR : PUSH FOR TREES"); - break; + case 102: + strcpy (m, "INTERNAL ERROR : PUSH FOR TREES"); + break; - case 201: - strcpy(m, "SYMBOL 'FI','OD', '/', '##' OR ';;' EXPECTED"); - break; + case 201: + strcpy (m, "SYMBOL 'FI','OD', '/', '##' OR ';;' EXPECTED"); + break; - case 202: - strcpy(m, "SYMBOL '->' AFTER 'IF' EXPECTED"); - break; + case 202: + strcpy (m, "SYMBOL '->' AFTER 'IF' EXPECTED"); + break; - case 203: - strcpy(m, "SYMBOL 'FI' AFTER 'IF...->' EXPECTED"); - break; + case 203: + strcpy (m, "SYMBOL 'FI' AFTER 'IF...->' EXPECTED"); + break; - case 205: - strcpy(m, "SYMBOL '->' AFTER 'ELSIF' EXPECTED"); - break; + case 205: + strcpy (m, "SYMBOL '->' AFTER 'ELSIF' EXPECTED"); + break; - case 206: - strcpy(m, "SYMBOL 'FI' AFTER 'ELSIF...->' EXPECTED"); - break; + case 206: + strcpy (m, "SYMBOL 'FI' AFTER 'ELSIF...->' EXPECTED"); + break; - case 207: - strcpy(m, "STATEMENT EXPECTED AFTER 'ELSIF..->'"); - break; + case 207: + strcpy (m, "STATEMENT EXPECTED AFTER 'ELSIF..->'"); + break; - case 208: - strcpy(m, "SYMBOL 'END' MATCHING 'LOOP' NO FOUND"); - break; + case 208: + strcpy (m, "SYMBOL 'END' MATCHING 'LOOP' NO FOUND"); + break; - case 209: - strcpy(m, "STATEMENT EXPECTED AFTER 'IF..->'"); - break; + case 209: + strcpy (m, "STATEMENT EXPECTED AFTER 'IF..->'"); + break; - case 210: - strcpy(m, "VARIABLE NAME OR \"BRANCHES\" OR \"SELECTORS\" EXPECTED"); - break; + case 210: + strcpy (m, "VARIABLE NAME OR \"BRANCHES\" OR \"SELECTORS\" EXPECTED"); + break; - case 211: - strcpy(m, "SYMBOL 'IN' AFTER 'FORALL' EXPECTED"); - break; + case 211: + strcpy (m, "SYMBOL 'IN' AFTER 'FORALL' EXPECTED"); + break; - case 212: - strcpy(m, "SYMBOL 'DO' AFTER 'FORALL...IN' EXPECTED"); - break; + case 212: + strcpy (m, "SYMBOL 'DO' AFTER 'FORALL...IN' EXPECTED"); + break; - case 213: - strcpy(m, "SYMBOL 'OD' OR ';' EXPECTED AFTER FORALL..DO..."); - break; + case 213: + strcpy (m, "SYMBOL 'OD' OR ';' EXPECTED AFTER FORALL..DO..."); + break; - case 215: - strcpy(m, "SYMBOL ':=' EXPECTED AFTER THIS OBJECT"); - break; + case 215: + strcpy (m, "SYMBOL ':=' EXPECTED AFTER THIS OBJECT"); + break; - case 216: - strcpy(m, "ASSIGNMENT SYMBOL ':=' EXPECTED AFTER '!!','!.','+' OR '++'"); - break; + case 216: + strcpy (m, + "ASSIGNMENT SYMBOL ':=' EXPECTED AFTER '!!','!.','+' OR '++'"); + break; - case 217: - strcpy(m, "VARIABLE EXPECTED AFTER \"SELECTORS\" "); - break; + case 217: + strcpy (m, "VARIABLE EXPECTED AFTER \"SELECTORS\" "); + break; - case 218: - strcpy(m, "VARIABLE EXPECTED AFTER \"BRANCHES\" "); - break; + case 218: + strcpy (m, "VARIABLE EXPECTED AFTER \"BRANCHES\" "); + break; - case 220: - strcpy(m, "VARIABLE EXPECTED AFTER 'LOAD'"); - break; + case 220: + strcpy (m, "VARIABLE EXPECTED AFTER 'LOAD'"); + break; - case 221: - strcpy(m, "VARIABLE EXPECTED AFTER 'SAVE'"); - break; + case 221: + strcpy (m, "VARIABLE EXPECTED AFTER 'SAVE'"); + break; - case 222: - strcpy(m, "FILE IDENTIFIER EXPECTED AFTER 'OPEN'"); - break; + case 222: + strcpy (m, "FILE IDENTIFIER EXPECTED AFTER 'OPEN'"); + break; - case 223: - strcpy(m, "FILE IDENTIFIER EXPECTED AFTER 'CLOSE'"); - break; + case 223: + strcpy (m, "FILE IDENTIFIER EXPECTED AFTER 'CLOSE'"); + break; - case 224: - strcpy(m, "WRONG BEGINNING OF THE STATEMENT"); - break; + case 224: + strcpy (m, "WRONG BEGINNING OF THE STATEMENT"); + break; - case 225: - strcpy(m, "UNEXPECTED SYMBOL AFTER RULE CALL #..(..)"); - break; + case 225: + strcpy (m, "UNEXPECTED SYMBOL AFTER RULE CALL #..(..)"); + break; - case 301: - strcpy(m, "SYMBOL ')' EXPECTED"); - break; + case 301: + strcpy (m, "SYMBOL ')' EXPECTED"); + break; - case 302: - strcpy(m, "RULE NAME #... EXPECTED AFTER 'LAST'"); - break; + case 302: + strcpy (m, "RULE NAME #... EXPECTED AFTER 'LAST'"); + break; - case 303: - strcpy(m, "VARIABLE NAME $... EXPECTED AFTER 'LAST #...'"); - break; + case 303: + strcpy (m, "VARIABLE NAME $... EXPECTED AFTER 'LAST #...'"); + break; - case 304: - strcpy(m, "BUILT-IN RULE NOT ALLOWED IN 'LAST'"); - break; + case 304: + strcpy (m, "BUILT-IN RULE NOT ALLOWED IN 'LAST'"); + break; - case 307: - strcpy(m, "SYMBOL '$$' ALLOWED ONLY INSIDE S' PATTERN"); - break; + case 307: + strcpy (m, "SYMBOL '$$' ALLOWED ONLY INSIDE S' PATTERN"); + break; - case 313: - strcpy(m, "SYMBOL '(' EXPECTED AFTER 'COPY'"); - break; + case 313: + strcpy (m, "SYMBOL '(' EXPECTED AFTER 'COPY'"); + break; - case 314: - strcpy(m, "SYMBOL ')' EXPECTED AFTER 'COPY (...'"); - break; + case 314: + strcpy (m, "SYMBOL ')' EXPECTED AFTER 'COPY (...'"); + break; - case 321: - strcpy(m, "SYMBOL ']' MATCHING '[' NOT FOUND IN EXPRESSION"); - break; + case 321: + strcpy (m, "SYMBOL ']' MATCHING '[' NOT FOUND IN EXPRESSION"); + break; - case 323: - strcpy(m, "UNEXPECTED SYMBOL (END OF '<<'-STATEMENT NOT FOUND)"); - break; + case 323: + strcpy (m, "UNEXPECTED SYMBOL (END OF '<<'-STATEMENT NOT FOUND)"); + break; - case 324: - strcpy(m, "NULL OR A'... NOT ALLOWED IN THE LEFT SIDE OF THE ASSIGNMENT"); - break; + case 324: + strcpy (m, + "NULL OR A'... NOT ALLOWED IN THE LEFT SIDE OF THE ASSIGNMENT"); + break; - case 325: - strcpy(m, "SYMBOL '(' EXPECTED AFTER RULE CALL IN EXPRESSION"); - break; + case 325: + strcpy (m, "SYMBOL '(' EXPECTED AFTER RULE CALL IN EXPRESSION"); + break; - case 327: - strcpy(m, "WRONG OBJECT OR SYMBOL IN EXPRESSION"); - break; + case 327: + strcpy (m, "WRONG OBJECT OR SYMBOL IN EXPRESSION"); + break; - case 329: - strcpy(m, "SYMBOL ':' EXPECTED IN <. ... .> CONSTRUCTOR"); - break; + case 329: + strcpy (m, "SYMBOL ':' EXPECTED IN <. ... .> CONSTRUCTOR"); + break; - case 330: - strcpy(m, "SYMBOL ',' OR '.>' EXPECTED IN <. ... .> CONSTRUCTOR"); - break; + case 330: + strcpy (m, "SYMBOL ',' OR '.>' EXPECTED IN <. ... .> CONSTRUCTOR"); + break; - case 331: - strcpy(m, "SYMBOL ',' IS UNEXPECTED"); - break; + case 331: + strcpy (m, "SYMBOL ',' IS UNEXPECTED"); + break; - case 405: - strcpy(m, "RULE WAS DEFINED TWO TIMES (THIS IS THE SECOND) "); - break; + case 405: + strcpy (m, "RULE WAS DEFINED TWO TIMES (THIS IS THE SECOND) "); + break; - case 406: - strcpy(m, "RULE WAS NOT DEFINED IN PROGRAM "); - break; + case 406: + strcpy (m, "RULE WAS NOT DEFINED IN PROGRAM "); + break; - case 407: - strcpy(m, "CALL OF THE MAIN RULE NOT ALLOWED "); - break; + case 407: + strcpy (m, "CALL OF THE MAIN RULE NOT ALLOWED "); + break; - case 408: - strcpy(m, "VARIABLE $ NOT ALLOWED IN THE MAIN RULE"); - break; + case 408: + strcpy (m, "VARIABLE $ NOT ALLOWED IN THE MAIN RULE"); + break; - case 409: - strcpy(m, "VARIABLE $$ NOT ALLOWED IN THE MAIN RULE"); - break; + case 409: + strcpy (m, "VARIABLE $$ NOT ALLOWED IN THE MAIN RULE"); + break; - /* this message is formed in tabr */ - case 501: - strcpy(m, "INTERNAL ERROR : 1ST PARM - NOT RULE NAME"); - break; + /* this message is formed in tabr */ + case 501: + strcpy (m, "INTERNAL ERROR : 1ST PARM - NOT RULE NAME"); + break; - case 503: - strcpy(m, "INTERNAL ERROR : 2ND PARM - NOT VARIABLE"); - break; + case 503: + strcpy (m, "INTERNAL ERROR : 2ND PARM - NOT VARIABLE"); + break; - case 504: - strcpy(m, "MORE THAN 255 VARIABLES IN RULE"); - break; + case 504: + strcpy (m, "MORE THAN 255 VARIABLES IN RULE"); + break; - case 505: - strcpy(m, "MORE THAN 400 RULES IN PROGRAM"); - break; + case 505: + strcpy (m, "MORE THAN 400 RULES IN PROGRAM"); + break; - case 521: - strcpy(m, "no RULENAME in V-list"); - break; + case 521: + strcpy (m, "no RULENAME in V-list"); + break; - case 522: - strcpy(m, "no LISTMAIN in R-list variable list"); - break; + case 522: + strcpy (m, "no LISTMAIN in R-list variable list"); + break; - case 523: - strcpy(m, "INTERNAL ERROR : THIS RULE NOT FOUND"); - break; + case 523: + strcpy (m, "INTERNAL ERROR : THIS RULE NOT FOUND"); + break; - case 524: - strcpy(m, "no num in V-list 1-st parm"); - break; + case 524: + strcpy (m, "no num in V-list 1-st parm"); + break; - case 525: - strcpy(m, "no num in V-list 2-nd parm"); - break; + case 525: + strcpy (m, "no num in V-list 2-nd parm"); + break; - case 526: - snprintf(m, 256, "RULE %s WAS NOT DEFINED IN PROGRAM", error_rec_ch.message); - break; + case 526: + snprintf (m, 256, "RULE %s WAS NOT DEFINED IN PROGRAM", + error_rec_ch.message); + break; - case 527: - snprintf(m, 256,"RULE %s WAS DEFINED TWO TIMES", error_rec_ch.message); - break; + case 527: + snprintf (m, 256, "RULE %s WAS DEFINED TWO TIMES", + error_rec_ch.message); + break; - case 528: - strcpy(m, "INTERNAL ERROR : wrong type in BLTIN rule table"); - break; + case 528: + strcpy (m, "INTERNAL ERROR : wrong type in BLTIN rule table"); + break; - case 699: - strcpy(m, "UNEXPECTED END OF PROGRAM"); - break; + case 699: + strcpy (m, "UNEXPECTED END OF PROGRAM"); + break; - default: - strcpy(m, "UNKNOWN ERROR"); - break; - } - /* writeln(m);*/ - /* write(' BEFORE THIS TEXT:');*/ + default: + strcpy (m, "UNKNOWN ERROR"); + break; + } + /* writeln(m); */ + /* write(' BEFORE THIS TEXT:'); */ cint = 1; found = false; var_mes = true; - sprintf(error_rec_ch.message, "%s ", long_to_str(STR1, err_num)); + sprintf (error_rec_ch.message, "%s ", long_to_str (STR1, err_num)); error_rec_ch.address = 0; - if (err_num < 500) { - while (listp.nel != 0 && cint < 50 && !found) { - pointr(listp.cel, &x.sa); - switch (x.sad->dtype) { - - case atom: - case idatom: - case keyword: - case tatom: - case fatom: - error_rec_ch.address = x.sad->cord; - found = true; - break; - - case rulename: - error_rec_ch.address = x.srd->cord; - found = true; - break; - - case number: - error_rec_ch.address = x.snd->cord; - found = true; - break; - - case variable: - case idvariable: - case fvariable: - case nvariable: /* allows only for first variable to move to message*/ - if (var_mes) { - sprintf(error_rec_ch.message + strlen(error_rec_ch.message), "$%s ", - aa_str(STR1, x.svd->name)); - var_mes = false; - } - next(&listp); - break; - - default: - next(&listp); - break; - }/*case*/ - } /* while */ - } + if (err_num < 500) + { + while (listp.nel != 0 && cint < 50 && !found) + { + assert_and_assign_real_pointer (listp.cel, &x.sa); + switch (x.sad->dtype) + { + + case atom: + case idatom: + case keyword: + case tatom: + case fatom: + error_rec_ch.address = x.sad->cord; + found = true; + break; + + case rulename: + error_rec_ch.address = x.srd->cord; + found = true; + break; + + case number: + error_rec_ch.address = x.snd->cord; + found = true; + break; + + case variable: + case idvariable: + case fvariable: + case nvariable: /* allows only for first variable to move to message */ + if (var_mes) + { + sprintf (error_rec_ch.message + + strlen (error_rec_ch.message), "$%s ", + aa_str (STR1, x.svd->name)); + var_mes = false; + } + next (&listp); + break; + + default: + next (&listp); + break; + } /*case */ + } /* while */ + } /* writeln; - writeln('Press Enter to see file'); - readln; */ + writeln('Press Enter to see file'); + readln; */ er = true; - strcat(error_rec_ch.message, m); /* with */ + strcat (error_rec_ch.message, m); /* with */ -} /* err */ +} /* err */ -Void instruc(m) -ptr_ *m; +void +instruc (m) + ptr_ *m; { - keyint TEMP, TEMP1; - - while (!(TEMP = valc(l), - TEMP == d_semic || TEMP == d_cross || TEMP == slash)) { - operator_(m); - if (er) - goto _L1; - if (el(semic)) - nextl(); - else { - TEMP1 = valc(l); - if (!(TEMP1 == d_semic || TEMP1 == d_cross || TEMP1 == slash)) { - err(201L); - goto _L1; - } + key_type_as_int TEMP, TEMP1; + + while (!(TEMP = valc (l), + TEMP == d_semic || TEMP == d_cross || TEMP == slash)) + { + operator_ (m); + if (er) + goto _L1; + if (el (semic)) + nextl (); + else + { + TEMP1 = valc (l); + if (!(TEMP1 == d_semic || TEMP1 == d_cross || TEMP1 == slash)) + { + err (201L); + goto _L1; + } + } } - } -_L1: ; +_L1:; } -/* Local variables for operator_: */ -struct LOC_operator_ { +/* static variables for operator_: */ +struct LOC_operator_ +{ ptr_ *m, p; -} ; +}; -Local Void oplist(opcode, LINK) -long opcode; -struct LOC_operator_ *LINK; +static void +oplist (opcode, LINK) + long opcode; + struct LOC_operator_ *LINK; { - nextl(); - newlist(&LINK->p); - push(LINK->m, LINK->p.UU.U1.mainadr); - namelist(LINK->p, opcode); + nextl (); + newlist (&LINK->p); + push (LINK->m, LINK->p.UU.U1.mainadr); + namelist (LINK->p, opcode); } -Void operator_(m_) -ptr_ *m_; +void +operator_ (m_) + ptr_ *m_; { struct LOC_operator_ V; a a1; - boolean selectors_flag; - keyint TEMP1, TEMP2; + bool selectors_flag; + key_type_as_int TEMP1, TEMP2; char TEMP3; V.m = m_; if (er) goto _L1; - switch (valc(l)) { - - case if_key: - oplist(8704L, &V); - expr(&V.p, true); - if (er) - goto _L1; - if (!el(minus_more)) { - err(202L); - goto _L1; - } - nextl(); - push(&V.p, 30208L); - TEMP1 = valc(l); - if (TEMP1 == elsif_key || TEMP1 == fi_key) { - err(209L); - goto _L1; - } - while (!(TEMP1 = valc(l), TEMP1 == elsif_key || TEMP1 == fi_key)) { - operator_(&V.p); - if (er) - goto _L1; - if (el(semic)) - nextl(); - else { - TEMP2 = valc(l); - if (!(TEMP2 == elsif_key || TEMP2 == fi_key || TEMP2 == semic)) { - err(203L); - goto _L1; - } - } - } - while (el(elsif_key)) { - nextl(); - push(&V.p, 9216L); + switch (valc (l)) + { - expr(&V.p, true); - if (er) - goto _L1; - if (el(minus_more)) - nextl(); - else - err(205L); - push(&V.p, 30208L); - TEMP1 = valc(l); - if (TEMP1 == elsif_key || TEMP1 == fi_key) { - err(208L); - goto _L1; - } - while (!(TEMP1 = valc(l), TEMP1 == elsif_key || TEMP1 == fi_key)) { - operator_(&V.p); - if (er) - goto _L1; - if (el(semic)) - nextl(); - else { - TEMP2 = valc(l); - if (!(TEMP2 == elsif_key || TEMP2 == fi_key || TEMP2 == semic)) { - err(206L); - goto _L1; - } - } - } /* while / valc */ - } /* while / el */ - if (!el(fi_key)) { - err(207L); - goto _L1; - } - nextl(); - break; - - case load_key: - oplist(9728L, &V); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & varn_desks) != 0)) { - err(220L); - goto _L1; - } - pushl(&V.p); - tabrule(V.p.cel, currulename); - nextl(); - expr(&V.p, true); - break; - - case save_key: - oplist(10240L, &V); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & varn_desks) != 0)) { - err(221L); - goto _L1; - } - pushl(&V.p); - tabrule(V.p.cel, currulename); - nextl(); - expr(&V.p, true); - break; - /* oformleniq spiskow dlq razn. tipow operatora */ - - case open_key: - oplist(10752L, &V); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & - ((1L << ((long)atom)) | (1L << ((long)idatom)))) != 0)) { - err(222L); - goto _L1; - } - pushl(&V.p); - nextl(); - expr(&V.p, true); - break; - - case close_key: - oplist(31744L, &V); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & - ((1L << ((long)atom)) | (1L << ((long)idatom)))) != 0)) { - err(223L); - goto _L1; - } - pushl(&V.p); - nextl(); - break; - - case break_key: - nextl(); - push(V.m, 16384L); - break; - - case return_key: - oplist(11776L, &V); - expr(&V.p, true); - break; - - case loop_key: - oplist(28160L, &V); - while (!el(end_key)) { /* while */ - operator_(&V.p); + case if_key: + oplist (8704L, &V); + expr (&V.p, true); if (er) - goto _L1; - if (!el(semic)) { - if (el(end_key)) - break; - err(208L); - goto _L1; - } - /* net end posle loop */ - nextl(); - } - nextl(); /* 'END' - konec operatora */ - break; - /* loop - key */ - - case print_key: - oplist(32256L, &V); - expr(&V.p, true); - break; - - case fail_key: - nextl(); - push(V.m, 12288L); - break; - - case forall_key: /* wyzow prawila,priswaiwanie ili wywod*/ - oplist(12800L, &V); /* operator cikla */ - if (el(selectors_key)) { - nextl(); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & varn_desks) != 0)) { - err(217L); - goto _L1; - } - /* variable exp. after selectors */ - } - TEMP3 = des(l); - selectors_flag = (((1L << ((long)TEMP3)) & varn_desks) != 0); - if (selectors_flag) { - pushl(&V.p); /* 1st position */ - tabrule(V.p.cel, currulename); - nextl(); - } else - push(&V.p, 0L); /* 1st position */ - if (el(branches_key)) { /*b*/ - nextl(); - TEMP3 = des(l); - if (!(((1L << ((long)TEMP3)) & varn_desks) != 0)) { - err(218L); - goto _L1; - } - /* variable expected after branches */ - pushl(&V.p); /* 2nd position */ - tabrule(V.p.cel, currulename); - nextl(); - } /*b*/ - else { /* no b */ - push(&V.p, 0L); /* 2nd position */ - if (!selectors_flag) { - err(210L); - goto _L1; - } - /* variable name or selector or branches expected */ - } /* no b */ + goto _L1; + if (!el (minus_more)) + { + err (202L); + goto _L1; + } + nextl (); + push (&V.p, 30208L); + TEMP1 = valc (l); + if (TEMP1 == elsif_key || TEMP1 == fi_key) + { + err (209L); + goto _L1; + } + while (!(TEMP1 = valc (l), TEMP1 == elsif_key || TEMP1 == fi_key)) + { + operator_ (&V.p); + if (er) + goto _L1; + if (el (semic)) + nextl (); + else + { + TEMP2 = valc (l); + if (!(TEMP2 == elsif_key || TEMP2 == fi_key || TEMP2 == semic)) + { + err (203L); + goto _L1; + } + } + } + while (el (elsif_key)) + { + nextl (); + push (&V.p, 9216L); + + expr (&V.p, true); + if (er) + goto _L1; + if (el (minus_more)) + nextl (); + else + err (205L); + push (&V.p, 30208L); + TEMP1 = valc (l); + if (TEMP1 == elsif_key || TEMP1 == fi_key) + { + err (208L); + goto _L1; + } + while (!(TEMP1 = valc (l), TEMP1 == elsif_key || TEMP1 == fi_key)) + { + operator_ (&V.p); + if (er) + goto _L1; + if (el (semic)) + nextl (); + else + { + TEMP2 = valc (l); + if (! + (TEMP2 == elsif_key || TEMP2 == fi_key + || TEMP2 == semic)) + { + err (206L); + goto _L1; + } + } + } /* while / valc */ + } /* while / el */ + if (!el (fi_key)) + { + err (207L); + goto _L1; + } + nextl (); + break; - if (!el(in_key)) { - err(211L); - goto _L1; - } - nextl(); - expr(&V.p, true); /* wyravenie */ - if (er) - goto _L1; - if (!el(do_key)) { - err(212L); - goto _L1; - } - nextl(); - push(&V.p, 30208L); - while (!el(od_key)) { /* while */ - operator_(&V.p); /* telo cikla */ - if (er) - goto _L1; - TEMP1 = valc(l); - if (!(TEMP1 == od_key || TEMP1 == semic)) { - err(213L); - goto _L1; - } - if (el(semic)) - nextl(); - } - nextl(); /* od - konec */ + case load_key: + oplist (9728L, &V); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & varn_desks) != 0)) + { + err (220L); + goto _L1; + } + pushl (&V.p); + tabrule (V.p.cel, currulename); + nextl (); + expr (&V.p, true); + break; + + case save_key: + oplist (10240L, &V); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & varn_desks) != 0)) + { + err (221L); + goto _L1; + } + pushl (&V.p); + tabrule (V.p.cel, currulename); + nextl (); + expr (&V.p, true); + break; + /* oformleniq spiskow dlq razn. tipow operatora */ + + case open_key: + oplist (10752L, &V); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & + ((1L << ((long) atom)) | (1L << ((long) idatom)))) != 0)) + { + err (222L); + goto _L1; + } + pushl (&V.p); + nextl (); + expr (&V.p, true); + break; + + case close_key: + oplist (31744L, &V); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & + ((1L << ((long) atom)) | (1L << ((long) idatom)))) != 0)) + { + err (223L); + goto _L1; + } + pushl (&V.p); + nextl (); + break; - break; - /* forall - key */ + case break_key: + nextl (); + push (V.m, 16384L); + break; + + case return_key: + oplist (11776L, &V); + expr (&V.p, true); + break; + case loop_key: + oplist (28160L, &V); + while (!el (end_key)) + { /* while */ + operator_ (&V.p); + if (er) + goto _L1; + if (!el (semic)) + { + if (el (end_key)) + break; + err (208L); + goto _L1; + } + /* net end posle loop */ + nextl (); + } + nextl (); /* 'END' - konec operatora */ + break; + /* loop - key */ + case print_key: + oplist (32256L, &V); + expr (&V.p, true); + break; - /* otherwise */ + case fail_key: + nextl (); + push (V.m, 12288L); + break; - default: /* otherw. */ - if (des(l) == rulename) { - newlist(&V.p); - push(V.m, V.p.UU.U1.mainadr); - expr(&V.p, false); + case forall_key: /* wyzow prawila,priswaiwanie ili wywod */ + oplist (12800L, &V); /* operator cikla */ + if (el (selectors_key)) + { + nextl (); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & varn_desks) != 0)) + { + err (217L); + goto _L1; + } + /* variable exp. after selectors */ + } + TEMP3 = des (l); + selectors_flag = (((1L << ((long) TEMP3)) & varn_desks) != 0); + if (selectors_flag) + { + pushl (&V.p); /* 1st position */ + tabrule (V.p.cel, currulename); + nextl (); + } + else + push (&V.p, 0L); /* 1st position */ + if (el (branches_key)) + { /*b */ + nextl (); + TEMP3 = des (l); + if (!(((1L << ((long) TEMP3)) & varn_desks) != 0)) + { + err (218L); + goto _L1; + } + /* variable expected after branches */ + pushl (&V.p); /* 2nd position */ + tabrule (V.p.cel, currulename); + nextl (); + } /*b */ + else + { /* no b */ + push (&V.p, 0L); /* 2nd position */ + if (!selectors_flag) + { + err (210L); + goto _L1; + } + /* variable name or selector or branches expected */ + } /* no b */ + + if (!el (in_key)) + { + err (211L); + goto _L1; + } + nextl (); + expr (&V.p, true); /* wyravenie */ if (er) - goto _L1; - if (V.p.cel != 17920 && V.p.cel != 27136) { - err(225L); - goto _L1; - } - /* li{nie simwoly posle operatora-wyzowa prawila */ - namelist(V.p, V.p.cel); - } else { - TEMP3 = des(l); - if (((1L << ((long)TEMP3)) & - ((1L << ((long)idatom)) | (1L << ((long)atom)))) != 0) { - /* wywod w fajl */ - newlist(&V.p); - push(V.m, V.p.UU.U1.mainadr); - pushl(&V.p); - nextl(); - if (!(el(d_less) | el(less_rbrac))) { - err(224L); - goto _L1; - } - if (el(d_less)) - namelist(V.p, 11264L); - else - namelist(V.p, 18432L); - nextl(); - push(&V.p, 13312L); - while (!(TEMP1 = valc(l), TEMP1 == od_key || TEMP1 == elsif_key || - TEMP1 == end_key || TEMP1 == d_semic || - TEMP1 == d_cross || TEMP1 == slash || - TEMP1 == fi_key || TEMP1 == semic)) { - if (el(reserv5_key)) { - push(&V.p, 1024L); - nextl(); - } else - expr(&V.p, true); - if (er) - goto _L1; - push(&V.p, 14336L); - } - - if (V.p.cel == 14336) - changeelement(&V.p, 13824L); - else - changeelement(&V.p, 0L); - } else { /* priswaiwanie */ - newlist(&V.p); - push(V.m, V.p.UU.U1.mainadr); - expr(&V.p, false); /* lewaq ~astx prisw. */ - if (er) - goto _L1; - push(&V.p, 5632L); - switch (valc(l)) { - - case plus: - a1 = 6656; - nextl(); - break; - - case d_plus: - a1 = 7168; - nextl(); - break; - - case d_excl: - a1 = 7680; - nextl(); - break; - - case excl_point: - a1 = 8192; - nextl(); - break; - - case let_sign: - a1 = 6144; - break; - - - default: - err(215L); - goto _L1; - break; - }/* case/valc */ - if (!el(let_sign)) { - err(216L); - goto _L1; - } - nextl(); /* propuskaem znak ":=" */ - namelist(V.p, a1); /* tip priswaiwaniq -> w imq */ - expr(&V.p, true); /* prawaq ~astx prisw. */ - } /* priswaiwanie */ - } - break; - }/* bolxoj case/valc */ -_L1: ; + goto _L1; + if (!el (do_key)) + { + err (212L); + goto _L1; + } + nextl (); + push (&V.p, 30208L); + while (!el (od_key)) + { /* while */ + operator_ (&V.p); /* telo cikla */ + if (er) + goto _L1; + TEMP1 = valc (l); + if (!(TEMP1 == od_key || TEMP1 == semic)) + { + err (213L); + goto _L1; + } + if (el (semic)) + nextl (); + } + nextl (); /* od - konec */ + + break; + /* forall - key */ + + + + /* otherwise */ + + default: /* otherw. */ + if (des (l) == rulename) + { + newlist (&V.p); + push (V.m, V.p.UU.U1.mainadr); + expr (&V.p, false); + if (er) + goto _L1; + if (V.p.cel != 17920 && V.p.cel != 27136) + { + err (225L); + goto _L1; + } + /* li{nie simwoly posle operatora-wyzowa prawila */ + namelist (V.p, V.p.cel); + } + else + { + TEMP3 = des (l); + if (((1L << ((long) TEMP3)) & + ((1L << ((long) idatom)) | (1L << ((long) atom)))) != 0) + { + /* wywod w fajl */ + newlist (&V.p); + push (V.m, V.p.UU.U1.mainadr); + pushl (&V.p); + nextl (); + if (!(el (d_less) | el (less_rbrac))) + { + err (224L); + goto _L1; + } + if (el (d_less)) + namelist (V.p, 11264L); + else + namelist (V.p, 18432L); + nextl (); + push (&V.p, 13312L); + while (! + (TEMP1 = valc (l), TEMP1 == od_key || TEMP1 == elsif_key + || TEMP1 == end_key || TEMP1 == d_semic + || TEMP1 == d_cross || TEMP1 == slash || TEMP1 == fi_key + || TEMP1 == semic)) + { + if (el (reserv5_key)) + { + push (&V.p, 1024L); + nextl (); + } + else + expr (&V.p, true); + if (er) + goto _L1; + push (&V.p, 14336L); + } + + if (V.p.cel == 14336) + changeelement (&V.p, 13824L); + else + changeelement (&V.p, 0L); + } + else + { /* priswaiwanie */ + newlist (&V.p); + push (V.m, V.p.UU.U1.mainadr); + expr (&V.p, false); /* lewaq ~astx prisw. */ + if (er) + goto _L1; + push (&V.p, 5632L); + switch (valc (l)) + { + + case plus: + a1 = 6656; + nextl (); + break; + + case d_plus: + a1 = 7168; + nextl (); + break; + + case d_excl: + a1 = 7680; + nextl (); + break; + + case excl_point: + a1 = 8192; + nextl (); + break; + + case let_sign: + a1 = 6144; + break; + + + default: + err (215L); + goto _L1; + break; + } /* case/valc */ + if (!el (let_sign)) + { + err (216L); + goto _L1; + } + nextl (); /* propuskaem znak ":=" */ + namelist (V.p, a1); /* tip priswaiwaniq -> w imq */ + expr (&V.p, true); /* prawaq ~astx prisw. */ + } /* priswaiwanie */ + } + break; + } /* bolxoj case/valc */ +_L1:; -} /*operator*/ +} /*operator */ -Local Void bltnvar(rname, rnum) -long rname, *rnum; +static void +bltnvar (rname, rnum) + long rname, *rnum; { long ii; @@ -2194,708 +2356,790 @@ long rname, *rnum; *rnum = 0; - pointr(rname, &x1.sa); /* access to tested name */ - for (ii = 76; ii <= 99; ii++) { - if (m1[ii] != 0) { - pointr(m1[ii], &x.sa); /* access to "etalon" name */ - if (x.srd->dtype == x1.srd->dtype) { /* esli tipy ne rawny*/ - if (x.srd->name == x1.srd->name) { - /* return specaddress with number - (n+10)*512 , where n- function's number */ - *rnum = (ii - 65) * 512; - goto _L1; - } /*if =name*/ - } /*if =dtype*/ - else - err(528L); - } /* if m1[ii]>0 */ - } -_L1: ; + assert_and_assign_real_pointer (rname, &x1.sa); /* access to tested name */ + for (ii = 76; ii <= 99; ii++) + { + if (m1[ii] != 0) + { + assert_and_assign_real_pointer (m1[ii], &x.sa); /* access to "etalon" name */ + if (x.srd->dtype == x1.srd->dtype) + { /* esli tipy ne rawny */ + if (x.srd->name == x1.srd->name) + { + /* return specaddress with number + (n+10)*512 , where n- function's number */ + *rnum = (ii - 65) * 512; + goto _L1; + } /*if =name */ + } /*if =dtype */ + else + err (528L); + } /* if m1[ii]>0 */ + } +_L1:; } /* 2-jul-91 some comments inserted and some pretty-printed */ /* 23-jan-92 additional limitations and un-limitations added: errors no. 52-59 */ -Void pict(m, siz, act) -ptr_ *m; -long *siz, *act; +void +pict (m, siz, act) + ptr_ *m; + long *siz, *act; { /* processes sequence of pattersn, puts code to list "m", count of patterns is "siz", count of action pieces is "act" */ - long s1, ac1, arcnumber; /* number of arc patterns*/ + long s1, ac1, arcnumber; /* number of arc patterns */ ptr_ z, z1, l1, l3; a spopcode, a_title, a_arcvar, a_varname, limiter, a_bltnvar; - boolean specoperator, agregname, lastarcflag, treestarflag, treebracflag, - alternflag; + bool specoperator, agregname, lastarcflag, treestarflag, treebracflag, + alternflag; char TEMP; - keyint TEMP1; + key_type_as_int TEMP1; char TEMP2; - *siz = 0; /* counter of patterns */ - *act = 0; /* counter of non-empty actions */ - specoperator = false; /* net operatora */ - agregname = false; /* net agregata */ + *siz = 0; /* counter of patterns */ + *act = 0; /* counter of non-empty actions */ + specoperator = false; /* net operatora */ + agregname = false; /* net agregata */ - do { + do + { /******************************************* / actions / ******/ - if (el(slash)) { /* the slash "/" switches */ - nextl(); - push(m, 28672L); - if (!el(slash)) - (*act)++; - instruc(m); - if (er) /*operatory wnutri spiska */ - goto _L1; - push(m, 28672L); - if (!el(slash)) { - err(30L); - goto _L1; - } - nextl(); - } else { - /* enters one pattern */ - (*siz)++; + if (el (slash)) + { /* the slash "/" switches */ + nextl (); + push (m, 28672L); + if (!el (slash)) + (*act)++; + instruc (m); + if (er) /*operatory wnutri spiska */ + goto _L1; + push (m, 28672L); + if (!el (slash)) + { + err (30L); + goto _L1; + } + nextl (); + } + else + { + /* enters one pattern */ + (*siz)++; /******************************************** (* interation *) ****/ - if (el(lpar_star)) { - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); - namelist(z, (long)se); /* se - standart */ - push(&z, 5120L); /* net ograni~itelq w "( *"-konstr. */ - z1 = z; /* movet-budet */ - pict(&z, &s1, &ac1); /* rekursiwno wyzow posledowatelxnosti */ - if (er) - goto _L1; - - if (s1 + ac1 == 0) { - err(54L); - goto _L1; - } - - if (el(star)) { - nextl(); - TEMP = des(l); - if (!(((1L << ((long)TEMP)) & ((1L << ((long)idatom)) | - (1L << ((long)atom)) | (1L << ((long)rulename)) | - (1L << ((long)number)) | (1L << ((long)spec)))) != 0)) - { /* added */ - err(71L); - goto _L1; - } - /* estx ograni~itelx */ - dul(&limiter); /* l.cel -> w sp2 po adresu limitera*/ - if (des(l) == rulename) { - bltnvar(l.cel, &a_bltnvar); - if (a_bltnvar != 0) - limiter = a_bltnvar; - else - tabrule(0L, limiter); - } - if (er) - goto _L1; - changeelement(&z1, limiter); - /* perewod w sp2 w mesto z1 iz l-spiska */ - nextl(); - /* skobka posle ograni~itelq */ - if (!el(rpar)) { - err(72L); - goto _L1; - } - nextl(); - } else if (el(rpar_star)) - nextl(); - else { - err(73L); - goto _L1; - } - goto _L99; - } + if (el (lpar_star)) + { + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); + namelist (z, (long) se); /* se - standart */ + push (&z, 5120L); /* net ograni~itelq w "( *"-konstr. */ + z1 = z; /* movet-budet */ + pict (&z, &s1, &ac1); /* rekursiwno wyzow posledowatelxnosti */ + if (er) + goto _L1; + + if (s1 + ac1 == 0) + { + err (54L); + goto _L1; + } + + if (el (star)) + { + nextl (); + TEMP = des (l); + if (!(((1L << ((long) TEMP)) & ((1L << ((long) idatom)) | + (1L << ((long) atom)) | (1L + << + ((long) rulename)) | (1L << ((long) number)) | (1L << ((long) spec)))) != 0)) + { /* added */ + err (71L); + goto _L1; + } + /* estx ograni~itelx */ + dul (&limiter); /* l.cel -> w sp2 po adresu limitera */ + if (des (l) == rulename) + { + bltnvar (l.cel, &a_bltnvar); + if (a_bltnvar != 0) + limiter = a_bltnvar; + else + tabrule (0L, limiter); + } + if (er) + goto _L1; + changeelement (&z1, limiter); + /* perewod w sp2 w mesto z1 iz l-spiska */ + nextl (); + /* skobka posle ograni~itelq */ + if (!el (rpar)) + { + err (72L); + goto _L1; + } + nextl (); + } + else if (el (rpar_star)) + nextl (); + else + { + err (73L); + goto _L1; + } + goto _L99; + } /******************************************** (+ interation +) ****/ - if (el(lpar_plus)) { - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); - namelist(z, (long)ps); /* ps - standart */ - push(&z, 5120L); /* net ograni~itelq w "(+"-konstr. */ - z1 = z; /* movet-budet */ - pict(&z, &s1, &ac1); /* rekursiwno wyzow posledowatelxnosti */ - if (er) - goto _L1; - - if (s1 + ac1 == 0) { - err(55L); - goto _L1; - } - - if (el(plus)) { - nextl(); - TEMP = des(l); - if (!(((1L << ((long)TEMP)) & ((1L << ((long)idatom)) | - (1L << ((long)atom)) | (1L << ((long)rulename)) | - (1L << ((long)number)) | (1L << ((long)spec)))) != 0)) - { /* added */ - err(74L); - goto _L1; - } - /* estx ograni~itelx */ - dul(&limiter); /* perewod w sp2 w mesto z1 iz l-spiska*/ - if (des(l) == rulename) { - bltnvar(l.cel, &a_bltnvar); - if (a_bltnvar != 0) - limiter = a_bltnvar; - else - tabrule(0L, limiter); - } - if (er) - goto _L1; - changeelement(&z1, limiter); - nextl(); - /* skobka posle ograni~itelq */ - if (!el(rpar)) { - err(75L); - goto _L1; - } - nextl(); - } else if (el(rpar_plus)) - nextl(); - else { - err(76L); - goto _L1; - } - goto _L99; - } + if (el (lpar_plus)) + { + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); + namelist (z, (long) ps); /* ps - standart */ + push (&z, 5120L); /* net ograni~itelq w "(+"-konstr. */ + z1 = z; /* movet-budet */ + pict (&z, &s1, &ac1); /* rekursiwno wyzow posledowatelxnosti */ + if (er) + goto _L1; + + if (s1 + ac1 == 0) + { + err (55L); + goto _L1; + } + + if (el (plus)) + { + nextl (); + TEMP = des (l); + if (!(((1L << ((long) TEMP)) & ((1L << ((long) idatom)) | + (1L << ((long) atom)) | (1L + << + ((long) rulename)) | (1L << ((long) number)) | (1L << ((long) spec)))) != 0)) + { /* added */ + err (74L); + goto _L1; + } + /* estx ograni~itelx */ + dul (&limiter); /* perewod w sp2 w mesto z1 iz l-spiska */ + if (des (l) == rulename) + { + bltnvar (l.cel, &a_bltnvar); + if (a_bltnvar != 0) + limiter = a_bltnvar; + else + tabrule (0L, limiter); + } + if (er) + goto _L1; + changeelement (&z1, limiter); + nextl (); + /* skobka posle ograni~itelq */ + if (!el (rpar)) + { + err (75L); + goto _L1; + } + nextl (); + } + else if (el (rpar_plus)) + nextl (); + else + { + err (76L); + goto _L1; + } + goto _L99; + } /******************************************** [ optional ] ****/ - if (el(lbrac)) { - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); - namelist(z, (long)fa); /* fakulxtatiw - standart */ - pict(&z, &s1, &ac1); - if (er) - goto _L1; - if (s1 + ac1 == 0) { - err(56L); - goto _L1; - } - if (!el(rbrac)) { - err(77L); - goto _L1; - } - nextl(); - goto _L99; - } - - specoperator = false; - /* estx li dop. - operator - priswaiwaniq */ - agregname = false; - /* ukazano li imq - agregata */ - - - TEMP = des(l); + if (el (lbrac)) + { + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); + namelist (z, (long) fa); /* fakulxtatiw - standart */ + pict (&z, &s1, &ac1); + if (er) + goto _L1; + if (s1 + ac1 == 0) + { + err (56L); + goto _L1; + } + if (!el (rbrac)) + { + err (77L); + goto _L1; + } + nextl (); + goto _L99; + } + + specoperator = false; + /* estx li dop. + operator + priswaiwaniq */ + agregname = false; + /* ukazano li imq + agregata */ + + + TEMP = des (l); /****************************** assign variable $x:= ****/ - if (((1L << ((long)TEMP)) & varn_desks) != 0) { - dul(&a_varname); /* zdesx imq peremennoj*/ - tabrule(a_varname, currulename); - if (er) - goto _L1; - l1 = l; /* sohranim na slu~aj, esli dalee ne operator */ - nextl(); - /* added 17-jan-1990 for (+ $e $r + tt ) difference from - $r + := tt */ - if (valc(l) == plus) { - nextl(); - nextl(); - if (valc(l) == rpar) { - l = l1; - goto _L55; - } - l = l1; - nextl(); - } - - TEMP1 = valc(l); - if ((unsigned)TEMP1 < 32 && - ((1L << TEMP1) & ((1L << plus) | (1L << d_plus) | (1L << d_excl) | - (1L << excl_point))) != 0) - { /* backtracking : no assignment symbols */ - /* esli posle perem. +,++,!!,!. i :=, to dop. operator */ - l3 = l; /* l3 - zdesx znak tipa priswaiwaniq */ - nextl(); - if (!el(let_sign)) - err(91L); - if (er) - goto _L1; - nextl(); /* propuskaetsq znak := */ - switch (valc(l3)) { - - /* generiruetsq kod specoperatora */ - case plus: - spopcode = 6656; - break; - - case d_plus: - spopcode = 7168; - break; - - case d_excl: - spopcode = 7680; - break; - - case excl_point: - spopcode = 8192; - break; - }/* case */ - specoperator = true; - } /* if/in */ - else { /* movet bytx operator priswaiwaniq */ - if (el(let_sign)) { /* esli $a:= ... */ - push(m, 29184L); /* null -> $a */ - push(m, a_varname); - nextl(); /* propusk ego ":=" */ - spopcode = 6144; /* kod oby~nogo prisw. */ - specoperator = true; - } /* if ":=" */ - else /* woobshe ne operator */ - l = l1; - } - } /* if variable */ - - -_L55: + if (((1L << ((long) TEMP)) & varn_desks) != 0) + { + dul (&a_varname); /* zdesx imq peremennoj */ + tabrule (a_varname, currulename); + if (er) + goto _L1; + l1 = l; /* sohranim na slu~aj, esli dalee ne operator */ + nextl (); + /* added 17-jan-1990 for (+ $e $r + tt ) difference from + $r + := tt */ + if (valc (l) == plus) + { + nextl (); + nextl (); + if (valc (l) == rpar) + { + l = l1; + goto _L55; + } + l = l1; + nextl (); + } + + TEMP1 = valc (l); + if ((unsigned) TEMP1 < 32 && + ((1L << TEMP1) & + ((1L << plus) | (1L << d_plus) | (1L << d_excl) | + (1L << excl_point))) != 0) + { /* backtracking : no assignment symbols */ + /* esli posle perem. +,++,!!,!. i :=, to dop. operator */ + l3 = l; /* l3 - zdesx znak tipa priswaiwaniq */ + nextl (); + if (!el (let_sign)) + err (91L); + if (er) + goto _L1; + nextl (); /* propuskaetsq znak := */ + switch (valc (l3)) + { + + /* generiruetsq kod specoperatora */ + case plus: + spopcode = 6656; + break; + + case d_plus: + spopcode = 7168; + break; + + case d_excl: + spopcode = 7680; + break; + + case excl_point: + spopcode = 8192; + break; + } /* case */ + specoperator = true; + } /* if/in */ + else + { /* movet bytx operator priswaiwaniq */ + if (el (let_sign)) + { /* esli $a:= ... */ + push (m, 29184L); /* null -> $a */ + push (m, a_varname); + nextl (); /* propusk ego ":=" */ + spopcode = 6144; /* kod oby~nogo prisw. */ + specoperator = true; + } /* if ":=" */ + else /* woobshe ne operator */ + l = l1; + } + } /* if variable */ + + + _L55: /***************** position after assignment ( main position ) ****/ - TEMP = des(l); + TEMP = des (l); /**************** $x :: or aa :: ********/ - if (((1L << ((long)TEMP)) & (varn_desks | (1L << ((long)atom)) | - (1L << ((long)idatom)) | (1L << ((long)number)) | - (1L << ((long)fatom)) | (1L << ((long)spec)))) != 0) { - dul(&a_title); - TEMP2 = des(l); - if (((1L << ((long)TEMP2)) & varn_desks) != 0) { - tabrule(a_title, currulename); - if (er) - goto _L1; - if (specoperator) - nextl(); - else { /* ne nado powtorno pe~atatx imq perem.*/ - next(&l); - if (l.nel == 0) - err(699L); - if (er) - goto _L1; - } - } else - nextl(); - - - if (!el(d_colon)) { /* ******** no :: **** */ - /* esli dalee ne "::", to |to prosto */ - /* peremennaq ili atom */ - push(m, a_title); - goto _L99; - } - nextl(); - agregname = true; - } /* if/in */ + if (((1L << ((long) TEMP)) & (varn_desks | (1L << ((long) atom)) | + (1L << ((long) idatom)) | (1L << + ((long) + number)) | + (1L << ((long) fatom)) | (1L << + ((long) + spec)))) != + 0) + { + dul (&a_title); + TEMP2 = des (l); + if (((1L << ((long) TEMP2)) & varn_desks) != 0) + { + tabrule (a_title, currulename); + if (er) + goto _L1; + if (specoperator) + nextl (); + else + { /* ne nado powtorno pe~atatx imq perem. */ + next (&l); + if (l.nel == 0) + err (699L); + if (er) + goto _L1; + } + } + else + nextl (); + + + if (!el (d_colon)) + { /* ******** no :: **** */ + /* esli dalee ne "::", to |to prosto */ + /* peremennaq ili atom */ + push (m, a_title); + goto _L99; + } + nextl (); + agregname = true; + } /* if/in */ /******************************************** (. list .) ****/ - if (el(lpar_point)) { - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); /* spisok opisaniq ego */ - namelist(z, (long)li); /* standart */ - if (agregname) { /* net imeni */ - agregname = false; - /* wstawlqem imq spiska */ - push(&z, a_title); - } else - push(&z, 5120L); - pict(&z, &s1, &ac1); /* sam spisok*/ - if (er) - goto _L1; - if (el(rpar_point)) - nextl(); - else - err(31L); - if (er) - goto _L1; - goto _L99; - } + if (el (lpar_point)) + { + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); /* spisok opisaniq ego */ + namelist (z, (long) li); /* standart */ + if (agregname) + { /* net imeni */ + agregname = false; + /* wstawlqem imq spiska */ + push (&z, a_title); + } + else + push (&z, 5120L); + pict (&z, &s1, &ac1); /* sam spisok */ + if (er) + goto _L1; + if (el (rpar_point)) + nextl (); + else + err (31L); + if (er) + goto _L1; + goto _L99; + } /****************************** ( alternative or group ) ****/ - if (el(lpar)) { /* "(" */ - if (agregname) { - err(53L); - goto _L1; - } - alternflag = false; /* ovidaetsq, ~to net '!' */ - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); - namelist(z, (long)al); /* alxternatiwa-standart */ - do { - pict(&z, &s1, &ac1); - if (er) - goto _L1; - if (s1 + ac1 == 0) { - err(59L); - goto _L1; - } - if (!(el(excl_sign) | el(rpar))) { - err(83L); /* newernyj simwol w */ - if (er) /* (..!..!..) */ - goto _L1; - nextl(); - } - if ((s1 <= 1) & el(excl_sign)) { - /* |to nastoqshaq alxternatiwa */ - push(&z, 4608L); /* razdelitelx alxternatiw */ - alternflag = true; /* wse ve estx '!'*/ - nextl(); - if (el(rpar)) - err(84L); - if (er) /* ')' posle '!' */ - goto _L1; - } - if ((s1 > 1) & el(excl_sign)) - err(81L); - if (er) - goto _L1; - } while (!el(rpar)); /* do prawoj skobki */ - if (s1 > 1 && alternflag) - err(82L); - if (er) - goto _L1; - nextl(); - goto _L99; - } + if (el (lpar)) + { /* "(" */ + if (agregname) + { + err (53L); + goto _L1; + } + alternflag = false; /* ovidaetsq, ~to net '!' */ + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); + namelist (z, (long) al); /* alxternatiwa-standart */ + do + { + pict (&z, &s1, &ac1); + if (er) + goto _L1; + if (s1 + ac1 == 0) + { + err (59L); + goto _L1; + } + if (!(el (excl_sign) | el (rpar))) + { + err (83L); /* newernyj simwol w */ + if (er) /* (..!..!..) */ + goto _L1; + nextl (); + } + if ((s1 <= 1) & el (excl_sign)) + { + /* |to nastoqshaq alxternatiwa */ + push (&z, 4608L); /* razdelitelx alxternatiw */ + alternflag = true; /* wse ve estx '!' */ + nextl (); + if (el (rpar)) + err (84L); + if (er) /* ')' posle '!' */ + goto _L1; + } + if ((s1 > 1) & el (excl_sign)) + err (81L); + if (er) + goto _L1; + } + while (!el (rpar)); /* do prawoj skobki */ + if (s1 > 1 && alternflag) + err (82L); + if (er) + goto _L1; + nextl (); + goto _L99; + } /****************************** #xxx ****/ - if (des(l) == rulename) { /* imq prawila */ - if (agregname) { - err(52L); - goto _L1; - } - bltn(l.cel, &a_bltnvar); - if (a_bltnvar == 0) { - pushl(m); - tabrule(0L, m->cel); - if (er) - goto _L1; - } else { - push(m, 27136L); - push(m, a_bltnvar); - } - nextl(); - goto _L99; - } - - TEMP1 = valc(l); + if (des (l) == rulename) + { /* imq prawila */ + if (agregname) + { + err (52L); + goto _L1; + } + bltn (l.cel, &a_bltnvar); + if (a_bltnvar == 0) + { + pushl (m); + tabrule (0L, m->cel); + if (er) + goto _L1; + } + else + { + push (m, 27136L); + push (m, a_bltnvar); + } + nextl (); + goto _L99; + } + + TEMP1 = valc (l); /****************************** <* tree iteration *> <. tree .> ****/ - if ((unsigned)TEMP1 < 32 && - ((1L << TEMP1) & ((1L << less_point) | (1L << less_star))) != 0) { - treestarflag = (valc(l) == less_star); - nextl(); - newlist(&z); - push(m, z.UU.U1.mainadr); - if (treestarflag) - namelist(z, 3584L); - else - namelist(z, 512L); - /* tip shablona <* ili <. */ - if (agregname) { - agregname = false; /* esli bylo imq derewa */ - push(&z, a_title); - } else - push(&z, 5120L); - lastarcflag = false; /* poslednqq li wetwx */ - if (el(more_star) | el(more_point)) { - err(57L); - goto _L1; - } - /* empty tree is not allowed */ - arcnumber = 0; - while (!(el(more_star) | el(more_point))) { - arcnumber++; /* pods~et wetwej */ - if (lastarcflag) - err(40L); - if (er) - goto _L1; - /* ne dolvno bytx wetwej za $a:... */ - if (el(lbrac)) { - push(&z, 31232L); - nextl(); - treebracflag = true; /* estx [...] */ - } else { - push(&z, 0L); - z1 = z; /* sohranqem ~toby potom */ - /* w poslednij raz menqtx 0 na 30208 */ - treebracflag = false; - } - TEMP = des(l); - if (((1L << ((long)TEMP)) & (1L << ((long)idatom))) != 0) { - /*atom,*/ - /* atom - imq wetwi derewa */ - pushl(&z); - nextl(); - } else { - TEMP2 = des(l); - if (((1L << ((long)TEMP2)) & varn_desks) != 0) { - lastarcflag = true; /* tut poslednqq wetwx */ - if (!treestarflag) - err(41L); - if (er) - goto _L1; - /* zapretna peremennaq w <. $a : ... .> */ - if (treebracflag) - err(42L); - if (er) - goto _L1; - /* zapretna peremennaq w [ $a : ... ] */ - changeelement(&z1, 30208L); /* zamenqem 0 dlq priznaka */ - dul(&a_arcvar); - tabrule(a_arcvar, currulename); - if (er) - goto _L1; - push(&z, a_arcvar); /* peremennaq -imq wetwi */ - nextl(); - } else - err(43L); - } - /*, fatom, number */ - if (er) /* ne peremennaq i ne atom */ - goto _L1; - - /* ****************************** : ***** */ - if (el(colon_sign)) - nextl(); - else - err(44L); - if (er) /* net : */ - goto _L1; - pict(&z, &s1, &ac1); - if (er) - goto _L1; - if (s1 != 1) - err(45L); - if (er) /* ne odin shablon */ - goto _L1; - if (treebracflag) { - if (el(rbrac)) - nextl(); - else - err(46L); - } - if (er) - goto _L1; - /* net ] posle [... : ... */ - if (el(comma_sign)) { - push(&z, 4096L); - nextl(); - if (el(more_point) | el(more_star)) - err(331L); - } else if (!(el(more_point) | el(more_star))) - err(47L); - if (er) - goto _L1; - } /* while , cikl po wetwqm derewa */ - - if (treestarflag & el(more_point)) - err(48L); - if (er) /* <* .> */ - goto _L1; - if ((!treestarflag) & el(more_star)) - err(49L); - if (er) /* <. *> */ - goto _L1; - if (treestarflag && !lastarcflag) - err(50L); - if (er) /* netu <* ..,...,$e:...*> */ - goto _L1; - if (treestarflag && arcnumber > 5) - err(51L); - if (er) - goto _L1; - /* bolee 5 wetwej zapreseny */ - nextl(); - goto _L99; - } - - - if (agregname) { - err(58L); - goto _L1; - } - - /* ********************* v'() S'() *********** */ - - - - if (el(v_apost) | el(s_apost)) { - newlist(&z); - bspi = true; - if (el(s_apost)) - namelist(z, 6656L); - else - namelist(z, 6144L); - nextl(); - if (!el(lpar)) - err(86L); - if (er) - goto _L1; - nextl(); - push(m, z.UU.U1.mainadr); - expr(&z, true); - if (er) - goto _L1; - if (!el(rpar)) - err(87L); - if (er) - goto _L1; - nextl(); - bspi = false; - goto _L99; - } + if ((unsigned) TEMP1 < 32 && + ((1L << TEMP1) & ((1L << less_point) | (1L << less_star))) != 0) + { + treestarflag = (valc (l) == less_star); + nextl (); + newlist (&z); + push (m, z.UU.U1.mainadr); + if (treestarflag) + namelist (z, 3584L); + else + namelist (z, 512L); + /* tip shablona <* ili <. */ + if (agregname) + { + agregname = false; /* esli bylo imq derewa */ + push (&z, a_title); + } + else + push (&z, 5120L); + lastarcflag = false; /* poslednqq li wetwx */ + if (el (more_star) | el (more_point)) + { + err (57L); + goto _L1; + } + /* empty tree is not allowed */ + arcnumber = 0; + while (!(el (more_star) | el (more_point))) + { + arcnumber++; /* pods~et wetwej */ + if (lastarcflag) + err (40L); + if (er) + goto _L1; + /* ne dolvno bytx wetwej za $a:... */ + if (el (lbrac)) + { + push (&z, 31232L); + nextl (); + treebracflag = true; /* estx [...] */ + } + else + { + push (&z, 0L); + z1 = z; /* sohranqem ~toby potom */ + /* w poslednij raz menqtx 0 na 30208 */ + treebracflag = false; + } + TEMP = des (l); + if (((1L << ((long) TEMP)) & (1L << ((long) idatom))) != 0) + { + /*atom, */ + /* atom - imq wetwi derewa */ + pushl (&z); + nextl (); + } + else + { + TEMP2 = des (l); + if (((1L << ((long) TEMP2)) & varn_desks) != 0) + { + lastarcflag = true; /* tut poslednqq wetwx */ + if (!treestarflag) + err (41L); + if (er) + goto _L1; + /* zapretna peremennaq w <. $a : ... .> */ + if (treebracflag) + err (42L); + if (er) + goto _L1; + /* zapretna peremennaq w [ $a : ... ] */ + changeelement (&z1, 30208L); /* zamenqem 0 dlq priznaka */ + dul (&a_arcvar); + tabrule (a_arcvar, currulename); + if (er) + goto _L1; + push (&z, a_arcvar); /* peremennaq -imq wetwi */ + nextl (); + } + else + err (43L); + } + /*, fatom, number */ + if (er) /* ne peremennaq i ne atom */ + goto _L1; + + /* ****************************** : ***** */ + if (el (colon_sign)) + nextl (); + else + err (44L); + if (er) /* net : */ + goto _L1; + pict (&z, &s1, &ac1); + if (er) + goto _L1; + if (s1 != 1) + err (45L); + if (er) /* ne odin shablon */ + goto _L1; + if (treebracflag) + { + if (el (rbrac)) + nextl (); + else + err (46L); + } + if (er) + goto _L1; + /* net ] posle [... : ... */ + if (el (comma_sign)) + { + push (&z, 4096L); + nextl (); + if (el (more_point) | el (more_star)) + err (331L); + } + else if (!(el (more_point) | el (more_star))) + err (47L); + if (er) + goto _L1; + } /* while , cikl po wetwqm derewa */ + + if (treestarflag & el (more_point)) + err (48L); + if (er) /* <* .> */ + goto _L1; + if ((!treestarflag) & el (more_star)) + err (49L); + if (er) /* <. *> */ + goto _L1; + if (treestarflag && !lastarcflag) + err (50L); + if (er) /* netu <* ..,...,$e:...*> */ + goto _L1; + if (treestarflag && arcnumber > 5) + err (51L); + if (er) + goto _L1; + /* bolee 5 wetwej zapreseny */ + nextl (); + goto _L99; + } + + + if (agregname) + { + err (58L); + goto _L1; + } + + /* ********************* v'() S'() *********** */ + + + + if (el (v_apost) | el (s_apost)) + { + newlist (&z); + bspi = true; + if (el (s_apost)) + namelist (z, 6656L); + else + namelist (z, 6144L); + nextl (); + if (!el (lpar)) + err (86L); + if (er) + goto _L1; + nextl (); + push (m, z.UU.U1.mainadr); + expr (&z, true); + if (er) + goto _L1; + if (!el (rpar)) + err (87L); + if (er) + goto _L1; + nextl (); + bspi = false; + goto _L99; + } + + (*siz)--; + /* it was not a pattern element, but + pattern close symbol */ + /* ******************************* errors ********** */ + if (des (l) == keyword) + { + TEMP1 = valc (l); + if (!(TEMP1 == comma_sign || TEMP1 == more_point || + TEMP1 == more_star || TEMP1 == rpar_plus || + TEMP1 == rpar_point || TEMP1 == excl_sign || TEMP1 == rpar + || TEMP1 == rbrac || TEMP1 == plus || TEMP1 == onfail_key + || TEMP1 == d_cross || TEMP1 == d_semic + || TEMP1 == rpar_star || TEMP1 == star)) + { /* slash ? */ + err (38L); + if (er) + goto _L1; + nextl (); + } /* neovidannoe kl. slowo w shablone */ + } + else + err (37L); + if (er) + goto _L1; + /* neovidannyj simwol w + shablone */ + + _L99: + if (specoperator) + { + specoperator = false; + push (m, spopcode); + /* stawitsq imq peremennoj w specoperatore */ + push (m, a_varname); + } + } /* if/pattern */ - (*siz)--; - /* it was not a pattern element, but - pattern close symbol */ - /* ******************************* errors ********** */ - if (des(l) == keyword) { - TEMP1 = valc(l); - if (!(TEMP1 == comma_sign || TEMP1 == more_point || - TEMP1 == more_star || TEMP1 == rpar_plus || - TEMP1 == rpar_point || TEMP1 == excl_sign || TEMP1 == rpar || - TEMP1 == rbrac || TEMP1 == plus || TEMP1 == onfail_key || - TEMP1 == d_cross || TEMP1 == d_semic || TEMP1 == rpar_star || - TEMP1 == star)) - { /* slash ? */ - err(38L); - if (er) - goto _L1; - nextl(); - } /* neovidannoe kl. slowo w shablone */ - } else - err(37L); if (er) - goto _L1; - /* neovidannyj simwol w - shablone */ - -_L99: - if (specoperator) { - specoperator = false; - push(m, spopcode); - /* stawitsq imq peremennoj w specoperatore */ - push(m, a_varname); - } - } /* if/pattern */ - - if (er) - goto _L1; - /* - slash ? */ - } while (!(TEMP1 = valc(l), TEMP1 == comma_sign || TEMP1 == more_point || - TEMP1 == more_star || TEMP1 == rpar_plus || - TEMP1 == rpar_point || TEMP1 == excl_sign || - TEMP1 == rpar || TEMP1 == rbrac || - TEMP1 == plus || TEMP1 == onfail_key || - TEMP1 == d_cross || TEMP1 == d_semic || - TEMP1 == rpar_star || TEMP1 == star)); -_L1: ; + goto _L1; + /* + slash ? */ + } + while (!(TEMP1 = valc (l), TEMP1 == comma_sign || TEMP1 == more_point || + TEMP1 == more_star || TEMP1 == rpar_plus || + TEMP1 == rpar_point || TEMP1 == excl_sign || + TEMP1 == rpar || TEMP1 == rbrac || + TEMP1 == plus || TEMP1 == onfail_key || + TEMP1 == d_cross || TEMP1 == d_semic || + TEMP1 == rpar_star || TEMP1 == star)); +_L1:; /* |to imq agregata */ -} /* pict */ +} /* pict */ -Void push(pp, adr) -ptr_ *pp; -long adr; +void +push (pp, adr) + ptr_ *pp; + long adr; { mpd x, x1; a a1; - /* dobawlqet po pojnteru spiska nowyj |lement k spisku*/ + /* dobawlqet po pojnteru spiska nowyj |lement k spisku */ /* i sdwigaet pojnter pp */ - if (pp->ptrtype != ptrlist) { - printf("Rigal internal error Push-102\n"); - return; - } /* if/then */ - points(pp->UU.U1.mainadr, &x.sa); + if (pp->ptrtype != ptrlist) + { + printf ("Rigal internal error Push-102\n"); + return; + } /* if/then */ + assert_and_assign_real_pointer (pp->UU.U1.mainadr, &x.sa); if (x.smld->dtype == listmain) x.smld->totalelnum++; else - printf("Rigal internal error Push-101\n"); - points(pp->UU.U1.curfragment, &x.sa); - if ( - ( - (x.smld->dtype == listmain ) && - (pp->nel == mainlistelnum ) )|| - ( - (x.sfld->dtype == listfragm ) && - (pp->nel == fragmlistelnum ) ) - ) - { - /* w slu~ae dostiveniq konca fragmenta spiska */ - gets5(&a1, &x1.sa); - if (x.smld->dtype == listmain) /* podceplenie */ - x.smld->next = a1; - else - x.sfld->next = a1; - /* obrazuem i zapolnqem nowyj */ - x1.sfld->dtype = listfragm; - x1.sfld->elnum = 1; - x1.sfld->elt[0] = adr; - points(pp->UU.U1.mainadr, &x.sa); - x.smld->lastfragm = a1; - /* sdwig pojntera */ - pp->nel = 1; - pp->cel = adr; - pp->UU.U1.curfragment = a1; - return; - } /* then */ + printf ("Rigal internal error Push-101\n"); + assert_and_assign_real_pointer (pp->UU.U1.curfragment, &x.sa); + if (((x.smld->dtype == listmain) && + (pp->nel == mainlistelnum)) || + ((x.sfld->dtype == listfragm) && (pp->nel == fragmlistelnum))) + { + /* w slu~ae dostiveniq konca fragmenta spiska */ + gets5 (&a1, &x1.sa); + if (x.smld->dtype == listmain) /* podceplenie */ + x.smld->next = a1; + else + x.sfld->next = a1; + /* obrazuem i zapolnqem nowyj */ + x1.sfld->dtype = listfragm; + x1.sfld->elnum = 1; + x1.sfld->elt[0] = adr; + assert_and_assign_real_pointer (pp->UU.U1.mainadr, &x.sa); + x.smld->lastfragm = a1; + /* sdwig pojntera */ + pp->nel = 1; + pp->cel = adr; + pp->UU.U1.curfragment = a1; + return; + } /* then */ /* ob{ij clu~aj dobawleniq |lementa wnutri fragmenta */ - switch (x.smld->dtype) { - - case listmain: - x.smld->elnum++; - x.smld->elt[pp->nel] = adr; - break; - - case listfragm: - x.sfld->elnum++; - x.sfld->elt[pp->nel] = adr; - break; - }/* case */ + switch (x.smld->dtype) + { + + case listmain: + x.smld->elnum++; + x.smld->elt[pp->nel] = adr; + break; + + case listfragm: + x.sfld->elnum++; + x.sfld->elt[pp->nel] = adr; + break; + } /* case */ pp->nel++; pp->cel = adr; /* else */ -} /* push */ +} /* push */ -Void newlist(pp) -ptr_ *pp; +static void +newlist (pp) + ptr_ *pp; { /* nowyj ukazatelx spiska */ /* sozdaet nowyj spisok */ @@ -2903,7 +3147,7 @@ ptr_ *pp; a a1; - gets5(&a1, &x.sa); + gets5 (&a1, &x.sa); x.smld->dtype = listmain; x.smld->lastfragm = a1; pp->ptrtype = ptrlist; @@ -2914,9 +3158,10 @@ ptr_ *pp; } -Void namelist(pp, name) -ptr_ pp; -long name; +static void +namelist (pp, name) + ptr_ pp; + long name; { /* ukazatelx spiska */ /* imq */ @@ -2925,14 +3170,15 @@ long name; a a1; a1 = pp.UU.U1.mainadr; - points(a1, &x.sa); + assert_and_assign_real_pointer (a1, &x.sa); x.smld->name = name; } -Void changeelement(pp, adr) -ptr_ *pp; -long adr; +void +changeelement (pp, adr) + ptr_ *pp; + long adr; { /* gde izmenitx */ /* na ~to */ @@ -2941,7 +3187,7 @@ long adr; a a1; a1 = pp->UU.U1.curfragment; - points(a1, &x.sa); + assert_and_assign_real_pointer (a1, &x.sa); if (x.sfld->dtype == listfragm) x.sfld->elt[pp->nel - 1] = adr; else @@ -2951,8 +3197,9 @@ long adr; /*=================================*/ -Void bltn(rname, rnum) -long rname, *rnum; +void +bltn (rname, rnum) + long rname, *rnum; { a a1; long ii; @@ -2960,227 +3207,251 @@ long rname, *rnum; *rnum = 0; - pointr(rname, &x1.sa); /* dostup k prowerqemomu imeni */ - for (ii = 76; ii <= 111; ii++) { /* 111-76=35 funkcij */ - if (etalon[ii] != 0) { - if (rulename == x1.srd->dtype) { /* esli tipy ne rawny */ - if (x1.srd->name == etalon[ii]) - { /* zapolnqetsq deskriptor s nomerom */ - gets1(&a1, &x.sa); - x.snd->dtype = number; - x.snd->val = ii - 75; - *rnum = a1; - goto _L1; - } /*if =name*/ - } /*if =dtype*/ - else - err(528L); - } /* if m1[ii]>0 */ - } -_L1: ; + assert_and_assign_real_pointer (rname, &x1.sa); /* dostup k prowerqemomu imeni */ + for (ii = 76; ii <= 111; ii++) + { /* 111-76=35 funkcij */ + if (etalon[ii] != 0) + { + if (rulename == x1.srd->dtype) + { /* esli tipy ne rawny */ + if (x1.srd->name == etalon[ii]) + { /* zapolnqetsq deskriptor s nomerom */ + gets1 (&a1, &x.sa); + x.snd->dtype = number; + x.snd->val = ii - 75; + *rnum = a1; + goto _L1; + } /*if =name */ + } /*if =dtype */ + else + err (528L); + } /* if m1[ii]>0 */ + } +_L1:; } -Void dul(ad) -long *ad; +void +dul (ad) + long *ad; { a a1, a2; mpd x1, x; - a2 = 12; /* fikciq */ + a2 = 12; /* fikciq */ a1 = l.cel; - pointr(a1, &x.sa); - switch (x.sad->dtype) { - - case listfragm: - case listmain: - case treefragm: - case treemain: - gets5(&a2, &x1.sa); - *x1.sfld = *x.sfld; - break; - - case rulename: - gets2(&a2, &x1.sa); - *x1.srd = *x.srd; - break; - - - default: - gets1(&a2, &x1.sa); - *x1.sc8 = *x.sc8; - break; - }/* case */ + assert_and_assign_real_pointer (a1, &x.sa); + switch (x.sad->dtype) + { + + case listfragm: + case listmain: + case treefragm: + case treemain: + gets5 (&a2, &x1.sa); + *x1.sfld = *x.sfld; + break; + + case rulename: + gets2 (&a2, &x1.sa); + *x1.srd = *x.srd; + break; + + + default: + gets1 (&a2, &x1.sa); + *x1.sc8 = *x.sc8; + break; + } /* case */ *ad = a2; } -Void pushl(m) -ptr_ *m; +void +pushl (m) + ptr_ *m; { /* kak push(m,l.cel) ,no iz sp1 w sp2 */ a a1; - dul(&a1); - push(m, a1); + dul (&a1); + push (m, a1); } -char des(g) -ptr_ g; +char +des (g) + ptr_ g; { a a1; mpd x; a1 = g.cel; - if (a1 == null_) { - err(699L); - return dummy; - } else { - pointr(a1, &x.sa); - return (x.sad->dtype); - } + if (a1 == null_) + { + err (699L); + return dummy; + } + else + { + assert_and_assign_real_pointer (a1, &x.sa); + return (x.sad->dtype); + } } -Void nextl() +void +nextl () { - next(&l); + next (&l); if (l.nel == 0) - err(699L); + err (699L); } -keyint valc(pp) -ptr_ pp; +key_type_as_int +valc (ptr_ pp) { - /* type keyint=0..127 */ + /* type key_type_as_int=0..127 */ long ii; - keyint vv; + key_type_as_int vv; mpd x; a a1; - vv = 127; /* not key-valcue */ + vv = 127; /* not key-valcue */ if (pp.nel == 0) return vv; - else { /* this branch is added 15-jul-91 */ - if (pp.cel == saveladr) - return saveelkey; - else { - if (des(pp) == keyword) { - a1 = pp.cel; - pointr(a1, &x.sa); - a1 = x.sad->name; - for (ii = 1; ii <= 75; ii++) { /*maxkey*/ - if (a1 == etalon[ii]) { - vv = ii; - goto _L1; - } - } - } -_L1: - saveladr = pp.cel; - saveelkey = vv; - return vv; - } + else + { /* this branch is added 15-jul-91 */ + if (pp.cel == saveladr) + return saveelkey; + else + { + if (des (pp) == keyword) + { + a1 = pp.cel; + assert_and_assign_real_pointer (a1, &x.sa); + a1 = x.sad->name; + for (ii = 1; ii <= 75; ii++) + { /*maxkey */ + if (a1 == etalon[ii]) + { + vv = ii; + goto _L1; + } + } + } + _L1: + saveladr = pp.cel; + saveelkey = vv; + return vv; + } - } + } } -boolean el(ii) -keyint ii; +static bool el (key_type_as_int ii) { /* predikat na keyword-y */ - return (valc(l) == ii); + return (valc (l) == ii); } /***********/ -Local Void simplerule(d) -ptr_ *d; +static void +simplerule (d) + ptr_ *d; { long s1, ac1; ptr_ t, t1, k; - newlist(&t); - push(d, t.UU.U1.mainadr); - push(&t, (long)null_); + newlist (&t); + push (d, t.UU.U1.mainadr); + push (&t, (long) null_); t1 = t; - pict(&t, &s1, &ac1); + pict (&t, &s1, &ac1); if (er) goto _L16; - if (el(onfail_key)) { - newlist(&k); - changeelement(&t1, k.UU.U1.mainadr); - nextl(); - instruc(&k); - if (er) - goto _L16; - } - if (!(el(d_cross) | el(d_semic))) - err(61L); -_L16: ; -} /* simplerule */ + if (el (onfail_key)) + { + newlist (&k); + changeelement (&t1, k.UU.U1.mainadr); + nextl (); + instruc (&k); + if (er) + goto _L16; + } + if (!(el (d_cross) | el (d_semic))) + err (61L); +_L16:; +} /* simplerule */ -Void rule(d) -ptr_ *d; +void +rule (d) + ptr_ *d; { mpd x; a a1; - boolean end_bran; + bool end_bran; long ii; /* ************************ */ - if (des(l) == rulename) { - bltn(l.cel, &a1); - if (a1 != 0) - err(65L); - if (er) - goto _L15; - pushl(d); - } else - err(63L); + if (des (l) == rulename) + { + bltn (l.cel, &a1); + if (a1 != 0) + err (65L); + if (er) + goto _L15; + pushl (d); + } + else + err (63L); /* pohove na push(d,l.cel) , no nado */ /* perestawitx atom iz sp1 w sp2 */ if (er) goto _L15; - tabrule(512L, d->cel); /* 512=registration of declaration */ + tabrule (512L, d->cel); /* 512=registration of declaration */ if (er) goto _L15; /* formirowanie prawila w tabl. */ currulename = d->cel; - for (ii = 1; ii <= 2; ii++) { - gets2(&a1, &x.sa); - x.snd->dtype = number; - x.snd->val = 0; - push(d, a1); - } - nextl(); - do { - simplerule(d); - if (er) - goto _L15; - - if (!(el(d_semic) | el(d_cross))) { - err(64L); + for (ii = 1; ii <= 2; ii++) + { + gets2 (&a1, &x.sa); + x.snd->dtype = number; + x.snd->val = 0; + push (d, a1); + } + nextl (); + do + { + simplerule (d); if (er) - goto _L15; - nextl(); + goto _L15; + + if (!(el (d_semic) | el (d_cross))) + { + err (64L); + if (er) + goto _L15; + nextl (); + } + end_bran = el (d_semic); + if (end_bran) + nextl (); } - end_bran = el(d_semic); - if (end_bran) - nextl(); - } while (end_bran); - if (!el(d_cross)) /* message=64 */ - err(66L); -_L15: ; + while (end_bran); + if (!el (d_cross)) /* message=64 */ + err (66L); +_L15:; } @@ -3189,339 +3460,158 @@ _L15: ; and in the descriptors; - checks context conditions */ -Void tabrule(av, ar) -long av, ar; +void +tabrule (av, ar) + long av, ar; { /* s-address of varaible - or 0 == call of rule - or 512 == declaration of rule - */ + or 0 == call of rule + or 512 == declaration of rule + */ /* s-address of rule */ /* tabv - array of lists of s-addresses of variable names */ /* tabn - array of a-addresses of rule names */ /* list is 0 */ /* or 0 var var var ... */ /* program chepil also checks context conditions using this table */ - ptr_ f2, f5; /* pointers for traversing the table */ - long vnum, nb, rn; /* counters */ - boolean bb2; /*local flags */ - mpd x, x1; /* deskriptors */ + ptr_ f2, f5; /* pointers for traversing the table */ + long vnum, nb, rn; /* counters */ + bool bb2; /*local flags */ + mpd x, x1; /* deskriptors */ a p1, aar; /* finds or adds rule in table */ - pointr(ar, &x.sa); + assert_and_assign_real_pointer (ar, &x.sa); aar = x.srd->name; nb = 1; while (aar != tabn[nb - 1] && nb < rulemaxnum && tabn[nb - 1] != 0) nb++; - if (nb == rulemaxnum) { - err(505L); - goto _L77; - } + if (nb == rulemaxnum) + { + err (505L); + goto _L77; + } /* too many rules */ - if (tabn[nb - 1] == 0) { - tabn[nb - 1] = aar; /* append new rule */ - tabfiles[nb - 1] = error_rec_ch_adr; - /* a-address of current file name or 0 if main*/ - tabcord[nb - 1] = x.srd->cord; - } + if (tabn[nb - 1] == 0) + { + tabn[nb - 1] = aar; /* append new rule */ + tabfiles[nb - 1] = error_rec_ch_adr; + /* a-address of current file name or 0 if main */ + tabcord[nb - 1] = x.srd->cord; + } rn = nb; /* checks declaration twice */ - if (av == 512) { - /* registration of the declaration */ - tabflags[nb - 1]++; - if (tabflags[nb - 1] == 2) { - err(405L); - goto _L77; + if (av == 512) + { + /* registration of the declaration */ + tabflags[nb - 1]++; + if (tabflags[nb - 1] == 2) + { + err (405L); + goto _L77; + } + av = 0; } - av = 0; - } else { - if (av == 0) { - if (nb == 1) { - err(407L); - goto _L77; - } - /* call of the main rule is not allowed */ + else + { + if (av == 0) + { + if (nb == 1) + { + err (407L); + goto _L77; + } + /* call of the main rule is not allowed */ + } } - } - if (av != 0) { - points(av, &x1.sa); /* access to variable name */ - if (x1.svd->name != null_ && x1.svd->name != ass_1) { - if (tabv[rn - 1] == 0) { - /* create variable list */ - newlist(&f2); - tabv[rn - 1] = f2.UU.U1.mainadr; /* push it to table */ - push(&f2, 0L); /* first is null always */ - } - /* updates variable list */ - /* nb: variable $$ is not processed here */ - - p1 = tabv[rn - 1]; - first(p1, &f2); /* f2 - at first element */ - f5 = f2; /* save */ - bb2 = false; /* variable not found */ - vnum = 1; /* counter along variable list */ - next(&f2); /* f2 at second element */ - - while (f2.nel != 0) { /* poka ne kon~ilsq spisok peremennyh ... */ - vnum++; - /* cikl wdolx spiska peremennyh */ - p1 = f2.cel; - points(p1, &x.sa); /* dostup k mestu peremennoj w tablice */ - points(av, &x1.sa); /* dostup k nastoq{emu opis. peremennoj */ - if (((1L << ((long)x1.svd->dtype)) & varn_desks) == 0) { - err(503L); - goto _L77; - } /* o{ibka w ~ekere */ - if (x1.svd->name == x.svd->name) { - bb2 = true; /* peremennaq najdena */ - x1.svd->location = vnum; /* ustanowka ee nomera */ - x.svd->location = vnum; /* to ve */ - } - f5 = f2; /* posledn. zanqtyj |l-t */ - next(&f2); /* sdwig na sled. opisanie peremennoj */ - } /* while */ - if (!bb2) { /* peremennaq ne najdena */ - gets1(&p1, &x.sa); - push(&f5, p1); /* |l-t - nowaq peremennaq */ - points(p1, &x.sa); - /* dostup k nowomu mestu dlq peremennoj w - tabl.*/ - points(av, &x1.sa); /* dostup k nastoq{emu opis. peremennoj */ - x1.svd->location = vnum + 1; /* ustanowim nomer peremennoj */ - if (vnum >= 255) { - err(504L); - goto _L77; - } - *x.svd = *x1.svd; /* zapolneno mesto */ - } /* if/bb2 */ - } /* if/ ,null,ord(' ')*/ - else { - /* variable $ is registered with number 1 */ - if (x1.svd->name == ass_1) { - x1.svd->location = 1; - if (rn == 1) - err(408L); - /* $ in main rule not allowed */ - } - } + if (av != 0) + { + assert_and_assign_real_pointer (av, &x1.sa); /* access to variable name */ + if (x1.svd->name != null_ && x1.svd->name != ass_1) + { + if (tabv[rn - 1] == 0) + { + /* create variable list */ + newlist (&f2); + tabv[rn - 1] = f2.UU.U1.mainadr; /* push it to table */ + push (&f2, 0L); /* first is null always */ + } + /* updates variable list */ + /* nb: variable $$ is not processed here */ + + p1 = tabv[rn - 1]; + first (p1, &f2); /* f2 - at first element */ + f5 = f2; /* save */ + bb2 = false; /* variable not found */ + vnum = 1; /* counter along variable list */ + next (&f2); /* f2 at second element */ + + while (f2.nel != 0) + { /* poka ne kon~ilsq spisok peremennyh ... */ + vnum++; + /* cikl wdolx spiska peremennyh */ + p1 = f2.cel; + assert_and_assign_real_pointer (p1, &x.sa); /* dostup k mestu peremennoj w tablice */ + assert_and_assign_real_pointer (av, &x1.sa); /* dostup k nastoq{emu opis. peremennoj */ + if (((1L << ((long) x1.svd->dtype)) & varn_desks) == 0) + { + err (503L); + goto _L77; + } /* o{ibka w ~ekere */ + if (x1.svd->name == x.svd->name) + { + bb2 = true; /* peremennaq najdena */ + x1.svd->location = vnum; /* ustanowka ee nomera */ + x.svd->location = vnum; /* to ve */ + } + f5 = f2; /* posledn. zanqtyj |l-t */ + next (&f2); /* sdwig na sled. opisanie peremennoj */ + } /* while */ + if (!bb2) + { /* peremennaq ne najdena */ + gets1 (&p1, &x.sa); + push (&f5, p1); /* |l-t - nowaq peremennaq */ + assert_and_assign_real_pointer (p1, &x.sa); + /* dostup k nowomu mestu dlq peremennoj w + tabl. */ + assert_and_assign_real_pointer (av, &x1.sa); /* dostup k nastoq{emu opis. peremennoj */ + x1.svd->location = vnum + 1; /* ustanowim nomer peremennoj */ + if (vnum >= 255) + { + err (504L); + goto _L77; + } + *x.svd = *x1.svd; /* zapolneno mesto */ + } /* if/bb2 */ + } /* if/ ,null,ord(' ') */ + else + { + /* variable $ is registered with number 1 */ + if (x1.svd->name == ass_1) + { + x1.svd->location = 1; + if (rn == 1) + err (408L); + /* $ in main rule not allowed */ + } + } - } /* if/ av<>0 */ + } /* if/ av<>0 */ -_L77: ; +_L77:; /* check call of the main rule */ -} /* tabrule */ - - - - - - - - - - - - - - - - - - - - - - - +} /* tabrule */ -#define tempo "_CH_RIG.TMP" -a ttt, tt1; -filespecification name; - -Char pch[101]; -long i; -FILE *sour, *lstn; - -error_rec_type erm; -string80 str_val, stt; -Char zzz[256]; -Char zzz2[256]; - -/* -Static Void copy_line() -{ - char *TEMP; - Char STR1[256]; - - fgets(str_val, 81, sour); - TEMP = strchr(str_val, '\n'); - if (TEMP != NULL) - *TEMP = 0; - sprintf(STR1, "%.3s", str_val); - if (strcmp(STR1, "--:")) - fprintf(lstn, "%s\n", str_val); -} -*/ - -int main(int argc,char *argv[]) -{ - - Char STR1[256]; - Char STR2[86]; - -/* printf("argc=%d\n",argc); - printf("arg[0]=%s\n",argv[0]); - printf("arg[1]=%s\n",argv[1]); - printf("arg[2]=%s\n",argv[2]); -*/ -/* p2c: rc_.z: Note: Array of files files should be initialized [257] */ - lstn = NULL; - sour = NULL; - out = NULL; - if (argc > 1) { - strcpy(name,argv[1]); - brt(name); - } else - *name = '\0'; - /*****************************/ - /* strcpy(name,"a"); */ - if (*name == '\0') { - printf(" Rigal Checker and Compiler v.%s\n", rigal_version); - printf(" rc filename [-c] [-D] [-P options ]\n"); - printf(" filename must be without extension, .rig is appended\n"); - goto _L99; - - } - - - printf("Rigal Checker/Compiler V.%s, 1996,LU Riga ", rigal_version); - if (out != NULL) - out = freopen("check_tmp.out", "w", out); - else - out = fopen("check_tmp.out", "w"); - if (out == NULL) - _EscIO(FileNotFound); - out_screen = false; - max_printlevel = max_printconst; - *erm.message = '\0'; - strcpy(name,argv[1]); - brt(name); - - sprintf(STR2, "%s.rig", name); - if (!existfile(STR2)) { - printf("Error : file %s.rig not found \n", name); - goto _L99; - } - printf("%s.rig\n", name); - - init_dinform(); /* defpage */ - opena(); - opens('@'); - sprintf(STR2, "%s.rig", name); - - ley(STR2, &ttt, false, &erm); /*ley*/ - if (*erm.message == '\0') { - che11(ttt, &tt1, name, &erm,argc,argv); - if (!er) { - strcat(name, ".rsc"); - savesn(name, &tt1); - } - } else - er = true; - - - closes(); - closea(); - /* -reset(sour,erm.filename); -rewrite(lstn,tempo); -if er then -writeln(lstn,'--:** See error message in line ',erm.address div 80); -if not er then - begin - while not(eof(sour)) do copy_line; - - end -else - begin - for i:=1 to erm.address div 80 do begin - if not(eof(sour)) then copy_line; - end; - end; - -if er then begin - write(lstn,'--:'); - for i:=5 to erm.address mod 80 do write(lstn,'-'); - writeln(lstn,'^'); - writeln(lstn,'--:** ',erm.message); - writeln(lstn,'--:** **************************************************'); - writeln(lstn,'--:** **************************************************'); - while not(eof(sour)) do copy_line; -end; - -close(lstn); -close(sour); - - - */ - if (out != NULL) - fclose(out); - out = NULL; - if (er) { - if (erm.filename[strlen(erm.filename) - 1] != 'g') { - sprintf(STR1, "%.*s", (int)(strlen(erm.filename) - 1L), erm.filename); - strcpy(erm.filename, STR1); - } - printf(" Error in file %s\n", erm.filename); - printf(" Line=%12d\n", erm.address / 80); - printf(" Message=%s\n", erm.message); - - printf(" Column = %12d\n", erm.address % 80); - /* for i:=2 to erm.address mod 80 do write(' '); - writeln('^');*/ - goto _L99; - } else { - printf("No errors found\n"); - for (i = 1; i < argc; i++) { - strcpy(stt,argv[i]); - brt(stt); - if (!strcmp(stt, "-c")) - goto _L98; - } - goto _L99; - } -_L98: - strcpy(zzz, "/bin/csh -f ./xd"); - zzz[16] = '\0'; - /* zzz:='xd'; - zzz[3]:=chr(0); */ - printf("Starts xd\n"); - /* execl(zzz,zzz,nil);*/ - system(zzz); - -_L99: - - if (out != NULL) - fclose(out); - if (sour != NULL) - fclose(sour); - if (lstn != NULL) - fclose(lstn); - exit(0); -} /* End. */ - - diff --git a/RIGAL/rigsc.446/src/s_scan.c b/RIGAL/rigsc.446/src/s_scan.c index 8b00e1e72dc83f9821b036e2c3ea15577ccf3c9a..7bd2c7497e1df67a7c4fdda89df042ad2ea455cd 100644 --- a/RIGAL/rigsc.446/src/s_scan.c +++ b/RIGAL/rigsc.446/src/s_scan.c @@ -3,8 +3,8 @@ #include "defpage.h" #include "scan.h" #include "nef2.h" -typedef Char bigstring[128]; -#define new_line_code '\015' /* chr(0 is allowed too */ +typedef char bigstring[128]; +#define new_line_code '\015' /* chr(0 is allowed too */ #define endfile_code '\032' @@ -18,21 +18,21 @@ typedef Char bigstring[128]; #define is_first_of_two 7 -typedef Char pair[2]; +typedef char pair[2]; -a a1; /* global variable for only local use */ +a a1; /* global variable for only local use */ /*aa1 : aa ;*/ /* --"-- */ -mpd x; /* --"-- */ +mpd x; /* --"-- */ bl80 bl801; /* -- " -- */ /* array[1..80] of char*/ -long k, kk; /* -"- */ -Char c1; +long k, kk; /* -"- */ +char c1; -word saved_coord; /* where current token began */ -word coord_mark; /* what was set by coordinate marker */ +word saved_coord; /* where current token began */ +word coord_mark; /* what was set by coordinate marker */ word line_byte_number; /* number of totally read bytes till beginning of current line */ @@ -44,64 +44,69 @@ word last_mark_byte_number; word old_line_length; char dt; /* type of last read token or control character */ -a aadr; /* a-space address of last read token */ -longint linenumber; /* current line number */ -longint tokennumber; /* current token number */ -a errlist; /* list of numbers of errors */ -long read_mode; /* 1,2,3 */ -ptr_ ptr1; /* list pointer when read from list of atoms */ +a aadr; /* a-space address of last read token */ +longint linenumber; /* current line number */ +longint tokennumber; /* current token number */ +a errlist; /* list of numbers of errors */ +long read_mode; /* 1,2,3 */ +ptr_ ptr1; /* list pointer when read from list of atoms */ FILE *inpfile; -boolean c_lexics, pascal_lexics, row80_coord, byte_coord, mark_byte_coord, - mark_only_coord, string_coord, char_coord, token_coord, - collect_errors, screen_errors, to_uppercase, pascal_comment, - c_comment, ada_comment, pascal_string, modula_string; -bigstring s, s_for_val; /* added 17-feb-92 */ +bool c_lexics, pascal_lexics, row80_coord, byte_coord, mark_byte_coord, + mark_only_coord, string_coord, char_coord, token_coord, + collect_errors, screen_errors, to_uppercase, pascal_comment, + c_comment, ada_comment, pascal_string, modula_string; +bigstring s, s_for_val; /* added 17-feb-92 */ long i; char as[256]; char isa; -Char upcase_tab[256]; +char upcase_tab[256]; char set_of_second_of_two[9]; long two_char_symbols_num; pair two_char_symbols[30]; -union { - Char b1; - Char b2[2]; - Char b3[3]; +union +{ + char b1; + char b2[2]; + char b3[3]; } b123; -boolean in_comment, in_string, is_2quote; +bool in_comment, in_string, is_2quote; /* if in_string then it is possible */ longint str_constlen; -string80 str_const; /* array of char is allowed too */ +string80 str_const; /* array of char is allowed too */ /*===== sun version ===*/ -Static Void jnc(xxx) -long *xxx; +static void +jnc (xxx) + long *xxx; { (*xxx)++; } -Static Void jnc2(xxx, yyy) -long *xxx, yyy; +static void +jnc2 (xxx, yyy) + long *xxx, yyy; { *xxx += yyy; } -Static Void jncx(xxx) -long *xxx; +static void +jncx (xxx) + long *xxx; { (*xxx)++; } -Static Void jnc2x(xxx, yyy) -long *xxx, yyy; +static void +jnc2x (xxx, yyy) + long *xxx, yyy; { *xxx += yyy; } @@ -109,45 +114,45 @@ long *xxx, yyy; /*=====*/ -Static char cont_char_to_dt PP((Char c)); +static char cont_char_to_dt PP ((char c)); -Static word getcoord PV(); +static word getcoord PV (); -Static Void er_lex PP((long er_number)); +static void er_lex PP ((long er_number)); /*procedure initialize_scan_variables;forward;*/ -Static Void read_file PP((long *read_file_rez)); +static void read_file PP ((long *read_file_rez)); -Static long read_item PV(); +static long read_item PV (); -Static Void readline PV(); +static void readline PV (); -Static Void putatom PP((long j)); +static void putatom PP ((long j)); -Static Void putit PP((Char dd, long j)); +static void putit PP ((char dd, long j)); -Static Void putident PP((long j)); +static void putident PP ((long j)); -Static Void putfloat PP((long j)); +static void putfloat PP ((long j)); -Static Void putnumber PV(); +static void putnumber PV (); -Static Void putstr PV(); +static void putstr PV (); -Static Void putstr2 PV(); +static void putstr2 PV (); /*procedure scaner;forward;*/ -Static Void setlexics PV(); +static void setlexics PV (); -Static Void stradd PP((Char c)); +static void stradd PP ((char c)); -Static Void strbegin PV(); +static void strbegin PV (); -Static Void token PV(); +static void token PV (); -Static long take_digits PP((long *jj)); +static long take_digits PP ((long *jj)); -Static long take_letters PV(); +static long take_letters PV (); @@ -163,7 +168,7 @@ Static long take_letters PV(); -> lconc.nef er_lex -> setoptions gets1.defpage -> first.nef token - -> assign.system pointr.defpage + -> assign.system assert_and_assign_real_pointer .defpage -> reset.system lconc.nef -> readline @@ -182,105 +187,121 @@ Static long take_letters PV(); -Static char cont_char_to_dt(c) -Char c; +static char +cont_char_to_dt (c) + char c; { /************************************************/ - return ((char)c); + return ((char) c); } -Static word getcoord() +static word +getcoord () { /*************************/ if (row80_coord) return (i + linenumber * 80); - else { - if (mark_only_coord) - return coord_mark; - else { - if (mark_byte_coord) - return (coord_mark + line_byte_number + i - last_mark_byte_number); - else { - if (byte_coord) - return (line_byte_number + i); - else { - if (string_coord) - return linenumber; - else { - if (token_coord) - return tokennumber; - else - return 0; - } + else + { + if (mark_only_coord) + return coord_mark; + else + { + if (mark_byte_coord) + return (coord_mark + line_byte_number + i - + last_mark_byte_number); + else + { + if (byte_coord) + return (line_byte_number + i); + else + { + if (string_coord) + return linenumber; + else + { + if (token_coord) + return tokennumber; + else + return 0; + } + } + } } - } } - } } -Static Void er_lex(er_number) -long er_number; +static void +er_lex (er_number) + long er_number; { /*************************************/ a er_atom; word co; numberdescriptor *WITH; - co = getcoord(); - if (collect_errors) { - gets1(&er_atom, &x.sa); - WITH = x.snd; /*global*/ - WITH->dtype = number; - WITH->cord = co; - WITH->val = er_number; - lconc(&errlist, er_atom); - } + co = getcoord (); + if (collect_errors) + { + gets1 (&er_atom, &x.sa); + WITH = x.snd; /*global */ + WITH->dtype = number; + WITH->cord = co; + WITH->val = er_number; + lconc (&errlist, er_atom); + } if (screen_errors) - printf("Lexical error (%12ld) line=%12d column=%12d\n", - er_number, co / 80, co % 80); + printf ("Lexical error (%12ld) line=%12d column=%12d\n", + er_number, co / 80, co % 80); } -Void initialize_scan_variables() +void +initialize_scan_variables () { /*************************************/ - Char c; + char c; short TEMP; - for (TEMP = '\0'; TEMP <= 255; TEMP++) { - c = TEMP; - upcase_tab[c] = c; - } - for (c = 'a'; c <= 'z'; c++) /*ascii*/ - upcase_tab[c] = c - 32; - for (TEMP = 160; TEMP <= 175; TEMP++) { - c = TEMP; + for (TEMP = '\0'; TEMP <= 255; TEMP++) + { + c = TEMP; + upcase_tab[c] = c; + } + for (c = 'a'; c <= 'z'; c++) /*ascii */ upcase_tab[c] = c - 32; - } - /*russian*/ - for (TEMP = 224; TEMP <= 239; TEMP++) { - c = TEMP; - upcase_tab[c] = c - 60; - } - /*russian*/ + for (TEMP = 160; TEMP <= 175; TEMP++) + { + c = TEMP; + upcase_tab[c] = c - 32; + } + /*russian */ + for (TEMP = 224; TEMP <= 239; TEMP++) + { + c = TEMP; + upcase_tab[c] = c - 60; + } + /*russian */ for (c = '\0'; c <= '\037'; c++) as[c] = is_control; - for (TEMP = 128; TEMP <= 255; TEMP++) { - c = TEMP; - as[c] = is_letter; - } + for (TEMP = 128; TEMP <= 255; TEMP++) + { + c = TEMP; + as[c] = is_letter; + } /* russian and pseudographics */ - for (TEMP = ' '; TEMP <= '\177'; TEMP++) { - c = TEMP; - /* not used actually */ + for (TEMP = ' '; TEMP <= '\177'; TEMP++) + { + c = TEMP; + /* not used actually */ - as[c] = is_printable; - } + as[c] = is_printable; + } as[new_line_code] = is_control; as[' '] = is_space; @@ -306,28 +327,33 @@ Void initialize_scan_variables() -Static Void read_file(read_file_rez) -long *read_file_rez; +static void +read_file (read_file_rez) + long *read_file_rez; { /********************************/ /* reads whole input, produces list of items */ *read_file_rez = null_; - do { - a1 = read_item(); - if (dt == start_tree || dt == end_tree || dt == start_list || - dt == end_list || dt == name_obj) { - er_lex(6L); - goto _L99; + do + { + a1 = read_item (); + if (dt == start_tree || dt == end_tree || dt == start_list || + dt == end_list || dt == name_obj) + { + er_lex (6L); + goto _L99; + } + if (dt != eof_desk) + lconc (read_file_rez, a1); } - if (dt != eof_desk) - lconc(read_file_rez, a1); - } while (dt != eof_desk); -_L99: ; + while (dt != eof_desk); +_L99:; } -Static long read_item() +static long +read_item () { /**********************/ long Result; @@ -335,204 +361,238 @@ Static long read_item() atomdescriptor *WITH; numberdescriptor *WITH1; - Result = null_; /* default value for exits with errors */ + Result = null_; /* default value for exits with errors */ result = null_; - token(); - - /*writeln('DT=',dt,ord(dt));*/ - - switch (dt) { - - case atom: - case idatom: - case tatom: - case fatom: - case keyword: - gets1(&result, &x.sa); - WITH = x.sad; - WITH->dtype = dt; - WITH->cord = saved_coord; - WITH->name = aadr; - break; - - case number: - gets1(&result, &x.sa); - WITH1 = x.snd; - WITH1->dtype = dt; - WITH1->cord = saved_coord; - WITH1->val = aadr; /* is set in token .. is_digit */ - break; - - case start_tree: - result = null_; - do { - token(); - aadr1 = aadr; /* to save */ - if (dt == idatom || dt == atom || dt == tatom || dt == keyword) { - /* what is allowed selector in scaner input ? - normally - idatom only, but here - atom is allowed too - for experiment purposes */ - a1 = read_item(); - if (dt == end_list) { - er_lex(6L); - goto _L99; + token (); + + /*writeln('DT=',dt,ord(dt)); */ + + switch (dt) + { + + case atom: + case idatom: + case tatom: + case fatom: + case keyword: + gets1 (&result, &x.sa); + WITH = x.sad; + WITH->dtype = dt; + WITH->cord = saved_coord; + WITH->name = aadr; + break; + + case number: + gets1 (&result, &x.sa); + WITH1 = x.snd; + WITH1->dtype = dt; + WITH1->cord = saved_coord; + WITH1->val = aadr; /* is set in token .. is_digit */ + break; + + case start_tree: + result = null_; + do + { + token (); + aadr1 = aadr; /* to save */ + if (dt == idatom || dt == atom || dt == tatom || dt == keyword) + { + /* what is allowed selector in scaner input ? + normally - idatom only, but here + atom is allowed too - for experiment purposes */ + a1 = read_item (); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (1L); + goto _L99; + } + addel3 (&result, aadr1, a1); + } + else if (dt != end_tree) + { + er_lex (2L); + goto _L99; + } } - if (dt == eof_desk) { - er_lex(1L); + while (dt != end_tree && dt != eof_desk); + if (dt == eof_desk) + { + er_lex (3L); goto _L99; } - addel3(&result, aadr1, a1); - } else if (dt != end_tree) { - er_lex(2L); - goto _L99; - } - } while (dt != end_tree && dt != eof_desk); - if (dt == eof_desk) { - er_lex(3L); - goto _L99; - } - dt = complex_desk; - /* to ignore analysis in upper level of - recursion */ - break; - - case start_list: - result = null_; - do { - a1 = read_item(); - if (dt == eof_desk) { - er_lex(4L); - goto _L99; - } - if (dt != end_list) - lconc(&result, a1); - } while (dt != end_list); - dt = complex_desk; - break; - - case end_tree: - er_lex(5L); - goto _L99; - break; - - case end_list: - break; - /*immodiately returns to the upper level*/ - - case name_obj: - temp_res = read_item(); - if (dt == end_list) { - er_lex(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex(7L); - goto _L99; - } - result = read_item(); - if (dt == end_list) { - er_lex(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex(8L); + dt = complex_desk; + /* to ignore analysis in upper level of + recursion */ + break; + + case start_list: + result = null_; + do + { + a1 = read_item (); + if (dt == eof_desk) + { + er_lex (4L); + goto _L99; + } + if (dt != end_list) + lconc (&result, a1); + } + while (dt != end_list); + dt = complex_desk; + break; + + case end_tree: + er_lex (5L); goto _L99; - } - if (result != null_) { - points(result, &x.sa); - if (x.smld->dtype == listmain || x.smtd->dtype == treemain) - x.smtd->name = temp_res; - } - dt = complex_desk; - break; + break; - case eof_desk: - break; - /* returns to the upper level */ + case end_list: + break; + /*immodiately returns to the upper level */ + case name_obj: + temp_res = read_item (); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (7L); + goto _L99; + } + result = read_item (); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (8L); + goto _L99; + } + if (result != null_) + { + assert_and_assign_real_pointer (result, &x.sa); + if (x.smld->dtype == listmain || x.smtd->dtype == treemain) + x.smtd->name = temp_res; + } + dt = complex_desk; + break; + + case eof_desk: + break; + /* returns to the upper level */ - default: - er_lex(9L); - goto _L99; /* impossible value */ - break; - }/* case */ + + default: + er_lex (9L); + goto _L99; /* impossible value */ + break; + } /* case */ Result = result; _L99: return Result; -} /* read_item */ +} /* read_item */ -Static Void readline() +static void +readline () { /*****************************/ /* sets new values for "s" and "i" global variables */ - Char c; + char c; long rline; atomdescriptor *WITH; long FORLIM; int fff; i = 1; /* in any case, so; only here it is initialized. - it is column number. - variable "s" is string only for speed purposes; - it plays exactly as packed array of char, - never used as whole and the length byte is never used */ + it is column number. + variable "s" is string only for speed purposes; + it plays exactly as packed array of char, + never used as whole and the length byte is never used */ linenumber++; line_byte_number += old_line_length; - if (read_mode == 1) { - - if (feof(inpfile)) - s[0] = endfile_code; - else { - /*readln(inpfile,s);*/ - - fgets(s,145,inpfile); - if (s[strlen(s)-1]=='\n') - { s[strlen(s)-1]=0; - fff=fgetc(inpfile); - if (fff!=10) - { ungetc(fff,inpfile);} - else - linenumber++; - } - - s[strlen(s)] = new_line_code; - old_line_length = strlen(s); - } - } else { - if (read_mode == 2) { - if (ptr1.nel == 0) { + if (read_mode == 1) + { + + if (feof (inpfile)) s[0] = endfile_code; - goto _L99; - } - if (ptr1.cel == 0) { - s[0] = new_line_code; - old_line_length = 0; - } else { - pointr(ptr1.cel, &x.sa); - WITH = x.sad; /* with */ - if (WITH->dtype == atom || WITH->dtype == idatom || - WITH->dtype == fatom || WITH->dtype == tatom || - WITH->dtype == keyword) { - pointa(WITH->name, bl801, &k); - FORLIM = k; - for (kk = 1; kk <= FORLIM; kk++) - s[kk - 1] = bl801[kk - 1]; - old_line_length = k; - s[k] = new_line_code; - } else { - s[0] = new_line_code; /* other objects are ignored */ - old_line_length = 0; + else + { + /*readln(inpfile,s); */ + + fgets (s, 145, inpfile); + if (s[strlen (s) - 1] == '\n') + { + s[strlen (s) - 1] = 0; + fff = fgetc (inpfile); + if (fff != 10) + { + ungetc (fff, inpfile); + } + else + linenumber++; + } + + s[strlen (s)] = new_line_code; + old_line_length = strlen (s); } - } /* <>0 */ - next(&ptr1); + } + else + { + if (read_mode == 2) + { + if (ptr1.nel == 0) + { + s[0] = endfile_code; + goto _L99; + } + if (ptr1.cel == 0) + { + s[0] = new_line_code; + old_line_length = 0; + } + else + { + assert_and_assign_real_pointer (ptr1.cel, &x.sa); + WITH = x.sad; /* with */ + if (WITH->dtype == atom || WITH->dtype == idatom || + WITH->dtype == fatom || WITH->dtype == tatom || + WITH->dtype == keyword) + { + pointa (WITH->name, bl801, &k); + FORLIM = k; + for (kk = 1; kk <= FORLIM; kk++) + s[kk - 1] = bl801[kk - 1]; + old_line_length = k; + s[k] = new_line_code; + } + else + { + s[0] = new_line_code; /* other objects are ignored */ + old_line_length = 0; + } + } /* <>0 */ + next (&ptr1); - } /*=2*/ - } -_L99: ; + } + /*=2*/ + } +_L99:; } @@ -541,107 +601,117 @@ _L99: ; -Static Void putatom(j) -long j; +static void +putatom (j) + long j; { /*************************/ - putit(atom, j); + putit (atom, j); } -Static Void putit(dd, j) -Char dd; -long j; +static void +putit (dd, j) + char dd; + long j; { /*************************/ - putatm(&s[i - 1], j, &aadr); + putatm (&s[i - 1], j, &aadr); dt = dd; - saved_coord = getcoord(); + saved_coord = getcoord (); tokennumber++; } -Static Void putident(j) -long j; +static void +putident (j) + long j; { /*************************/ - putit(idatom, j); + putit (idatom, j); } -Static Void putfloat(j) -long j; -{ /*ignored*/ +static void +putfloat (j) + long j; +{ /*ignored */ /*************************/ double rea_val; long ii, kk; real_char reac; - Char STR1[256]; + char STR1[256]; - sprintf(STR1, "%.*s", (int)j, s + i - 1); - val2(STR1, &rea_val, &ii); - ii = sizeof(double); + sprintf (STR1, "%.*s", (int) j, s + i - 1); + val2 (STR1, &rea_val, &ii); + ii = sizeof (double); for (kk = 0; kk < ii; kk++) - reac[kk] = ((Char *)(&rea_val))[kk]; + reac[kk] = ((char *) (&rea_val))[kk]; - putatm(reac, ii, &aadr); + putatm (reac, ii, &aadr); dt = fatom; - saved_coord = getcoord(); - jnc(&tokennumber); + saved_coord = getcoord (); + jnc (&tokennumber); } -Static Void putnumber() +static void +putnumber () { /*************************/ dt = number; - saved_coord = getcoord(); - jnc(&tokennumber); + saved_coord = getcoord (); + jnc (&tokennumber); } -Static Void putstr() +static void +putstr () { /*************************/ - putatm(str_const, str_constlen, &aadr); + putatm (str_const, str_constlen, &aadr); dt = tatom; in_string = false; tokennumber++; } -Static Void putstr2() +static void +putstr2 () { /*************************/ - putatm(str_const, str_constlen, &aadr); + putatm (str_const, str_constlen, &aadr); dt = keyword; in_string = false; tokennumber++; } -/* Local variables for scaner: */ -struct LOC_scaner { +/* static variables for scaner: */ +struct LOC_scaner +{ string80 options_str; -} ; +}; /*inner function*/ -Local boolean setop(c, LINK) -Char c; -struct LOC_scaner *LINK; +static bool +setop (c, LINK) + char c; + struct LOC_scaner *LINK; { - boolean Result; - char * tmp; + bool Result; + char *tmp; Result = false; - tmp=strchr(LINK->options_str,c); + tmp = strchr (LINK->options_str, c); - if ( tmp ) { - if (tmp[1] != '-') /* Check next position */ - return true; - } + if (tmp) + { + if (tmp[1] != '-') /* Check next position */ + return true; + } return Result; } @@ -657,14 +727,15 @@ struct LOC_scaner *LINK; -Void scaner(mode_parm, filename_, options_str_, rez, erlist_parm, strlist, - segm, ofs) -long mode_parm; -Char *filename_, *options_str_; -long *rez, *erlist_parm, strlist, segm, ofs; +void +scaner (mode_parm, filename_, options_str_, rez, erlist_parm, strlist, + segm, ofs) + long mode_parm; + char *filename_, *options_str_; + long *rez, *erlist_parm, strlist, segm, ofs; { /*******************************************/ - /*1=from file,2=list of strings,3=absulute address*/ + /*1=from file,2=list of strings,3=absulute address */ /* result; set to null if input is absent */ /* error number list; set to null if no error */ /* list of atoms */ @@ -673,50 +744,50 @@ long *rez, *erlist_parm, strlist, segm, ofs; string80 filename; - strcpy(filename, filename_); - strcpy(V.options_str, options_str_); - read_mode = mode_parm; /* save for global use */ + strcpy (filename, filename_); + strcpy (V.options_str, options_str_); + read_mode = mode_parm; /* save for global use */ *rez = null_; *erlist_parm = null_; - errlist = null_; /* global */ + errlist = null_; /* global */ /* initializes all options */ /* defaults */ - strcat(V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); + strcat (V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); /* to every option su,me default value should be given, otherwise the flag remains uninitialized */ - /*errors*/ - screen_errors = setop('S', &V); - collect_errors = setop('O', &V); + /*errors */ + screen_errors = setop ('S', &V); + collect_errors = setop ('O', &V); - /*comments*/ - ada_comment = setop('D', &V); - c_comment = setop('C', &V); - pascal_comment = setop('P', &V); + /*comments */ + ada_comment = setop ('D', &V); + c_comment = setop ('C', &V); + pascal_comment = setop ('P', &V); - /*string constants*/ - pascal_string = setop('p', &V); - modula_string = setop('m', &V); - to_uppercase = setop('U', &V); + /*string constants */ + pascal_string = setop ('p', &V); + modula_string = setop ('m', &V); + to_uppercase = setop ('U', &V); - /*coordinate*/ - string_coord = setop('s', &V); - token_coord = setop('t', &V); - row80_coord = setop('R', &V); - byte_coord = setop('Y', &V); - mark_byte_coord = setop('B', &V); - mark_only_coord = setop('N', &V); + /*coordinate */ + string_coord = setop ('s', &V); + token_coord = setop ('t', &V); + row80_coord = setop ('R', &V); + byte_coord = setop ('Y', &V); + mark_byte_coord = setop ('B', &V); + mark_only_coord = setop ('N', &V); - /*language_specific lexics*/ - c_lexics = setop('L', &V); - pascal_lexics = setop('A', &V); + /*language_specific lexics */ + c_lexics = setop ('L', &V); + pascal_lexics = setop ('A', &V); /* initializes language-specific settings */ - setlexics(); + setlexics (); - /* initializes "session" flags (alf order)*/ + /* initializes "session" flags (alf order) */ coord_mark = 0; in_comment = false; in_string = false; @@ -730,103 +801,113 @@ long *rez, *erlist_parm, strlist, segm, ofs; /* initializes physical level reading */ - if (read_mode == 1) { /* read from file */ - if (!existfile(filename)) { - *rez = 0; - goto _L1; - } + if (read_mode == 1) + { /* read from file */ + if (!existfile (filename)) + { + *rez = 0; + goto _L1; + } - inpfile = fopen(filename, "r"); - if (inpfile == NULL) - _EscIO(FileNotFound); + inpfile = fopen (filename, "r"); + if (inpfile == NULL) + _EscIO (FileNotFound); - readline(); /* reads first line of file */ - } else { - if (read_mode == 2) { /* read from list */ - if (strlist == null_) { - *rez = 0; - goto _L99; - } - first(strlist, &ptr1); /* sets global list-pointer ptr1 */ - if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) { - *rez = 0; - goto _L99; - } - readline(); /* reads line from current list-pointer position */ - /* read from ms-dos ram memory */ + readline (); /* reads first line of file */ + } + else + { + if (read_mode == 2) + { /* read from list */ + if (strlist == null_) + { + *rez = 0; + goto _L99; + } + first (strlist, &ptr1); /* sets global list-pointer ptr1 */ + if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) + { + *rez = 0; + goto _L99; + } + readline (); /* reads line from current list-pointer position */ + /* read from ms-dos ram memory */ + } } - } - read_file(rez); /* main call ... */ + read_file (rez); /* main call ... */ - *erlist_parm = errlist; /*global*/ + *erlist_parm = errlist; /*global */ _L1: -_L99: ; -} /* scaner */ +_L99:; +} /* scaner */ -Static Void setlexics() +static void +setlexics () { /*************************/ long j, FORLIM; - if (pascal_lexics) { - /* changes in standard, necessary for pascal*/ - as['{'] = is_special; - as['#'] = is_special; - as['$'] = is_special; - as['%'] = is_special; - as['\''] = is_special; - as['('] = is_special; - memcpy(two_char_symbols[0], ":=", sizeof(pair)); - memcpy(two_char_symbols[1], "<=", sizeof(pair)); - memcpy(two_char_symbols[2], ">=", sizeof(pair)); - memcpy(two_char_symbols[3], "**", sizeof(pair)); - memcpy(two_char_symbols[4], "..", sizeof(pair)); - memcpy(two_char_symbols[5], "<>", sizeof(pair)); - two_char_symbols_num = 6; - strcpy(set_of_second_of_two,"=*.>"); - FORLIM = two_char_symbols_num; - for (j = 0; j < FORLIM; j++) - as[two_char_symbols[j][0]] = is_first_of_two; - if (modula_string) { - as['"'] = is_special; - as['{'] = is_printable; + if (pascal_lexics) + { + /* changes in standard, necessary for pascal */ + as['{'] = is_special; + as['#'] = is_special; + as['$'] = is_special; + as['%'] = is_special; + as['\''] = is_special; + as['('] = is_special; + memcpy (two_char_symbols[0], ":=", sizeof (pair)); + memcpy (two_char_symbols[1], "<=", sizeof (pair)); + memcpy (two_char_symbols[2], ">=", sizeof (pair)); + memcpy (two_char_symbols[3], "**", sizeof (pair)); + memcpy (two_char_symbols[4], "..", sizeof (pair)); + memcpy (two_char_symbols[5], "<>", sizeof (pair)); + two_char_symbols_num = 6; + strcpy (set_of_second_of_two, "=*.>"); + FORLIM = two_char_symbols_num; + for (j = 0; j < FORLIM; j++) + as[two_char_symbols[j][0]] = is_first_of_two; + if (modula_string) + { + as['"'] = is_special; + as['{'] = is_printable; + } + return; } - return; - } if (!c_lexics) return; as['_'] = is_letter; as['$'] = is_letter; - memcpy(two_char_symbols[0], "->", sizeof(pair)); - memcpy(two_char_symbols[1], "++", sizeof(pair)); - memcpy(two_char_symbols[2], "--", sizeof(pair)); - memcpy(two_char_symbols[3], ">>", sizeof(pair)); - memcpy(two_char_symbols[4], "<<", sizeof(pair)); - memcpy(two_char_symbols[5], "==", sizeof(pair)); - memcpy(two_char_symbols[6], "+=", sizeof(pair)); - memcpy(two_char_symbols[7], "*=", sizeof(pair)); - memcpy(two_char_symbols[8], "-=", sizeof(pair)); - memcpy(two_char_symbols[9], "/=", sizeof(pair)); - memcpy(two_char_symbols[10], "%=", sizeof(pair)); - memcpy(two_char_symbols[11], "&=", sizeof(pair)); - memcpy(two_char_symbols[12], "^=", sizeof(pair)); - memcpy(two_char_symbols[13], "|=", sizeof(pair)); - memcpy(two_char_symbols[14], "!=", sizeof(pair)); + memcpy (two_char_symbols[0], "->", sizeof (pair)); + memcpy (two_char_symbols[1], "++", sizeof (pair)); + memcpy (two_char_symbols[2], "--", sizeof (pair)); + memcpy (two_char_symbols[3], ">>", sizeof (pair)); + memcpy (two_char_symbols[4], "<<", sizeof (pair)); + memcpy (two_char_symbols[5], "==", sizeof (pair)); + memcpy (two_char_symbols[6], "+=", sizeof (pair)); + memcpy (two_char_symbols[7], "*=", sizeof (pair)); + memcpy (two_char_symbols[8], "-=", sizeof (pair)); + memcpy (two_char_symbols[9], "/=", sizeof (pair)); + memcpy (two_char_symbols[10], "%=", sizeof (pair)); + memcpy (two_char_symbols[11], "&=", sizeof (pair)); + memcpy (two_char_symbols[12], "^=", sizeof (pair)); + memcpy (two_char_symbols[13], "|=", sizeof (pair)); + memcpy (two_char_symbols[14], "!=", sizeof (pair)); two_char_symbols_num = 15; - strcpy(set_of_second_of_two,">+-<="); + strcpy (set_of_second_of_two, ">+-<="); FORLIM = two_char_symbols_num; for (j = 0; j < FORLIM; j++) as[two_char_symbols[j][0]] = is_first_of_two; - as['<'] = is_special; /* used to process <<= */ - as['>'] = is_special; /* used to process >>= */ - as['/'] = is_special; /* used to process / * */ + as['<'] = is_special; /* used to process <<= */ + as['>'] = is_special; /* used to process >>= */ + as['/'] = is_special; /* used to process / * */ /* otherwise isa:=is_first_of_two is assigned ! */ as['\''] = is_special; @@ -837,23 +918,25 @@ Static Void setlexics() -Static Void stradd(c) -Char c; +static void +stradd (c) + char c; { /*************************/ - if (str_constlen > 80) /* string is truncated */ - er_lex(10L); + if (str_constlen > 80) /* string is truncated */ + er_lex (10L); else - jnc(&str_constlen); + jnc (&str_constlen); str_const[str_constlen - 1] = c; } -Static Void strbegin() +static void +strbegin () { /********************/ - saved_coord = getcoord(); - /* it will be used when putstr works and token exits - in read_item*/ + saved_coord = getcoord (); + /* it will be used when putstr works and token exits - in read_item */ in_string = true; str_constlen = 0; } @@ -862,166 +945,197 @@ Static Void strbegin() -Static Void token() -{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ +static void +token () +{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ /**********************/ - long j, i_saved; /* positions */ + long j, i_saved; /* positions */ long FORLIM; /* at beginning time "i" - is already set to character in string "s"; array "as" is already initialized; coordinate mode "coord_mode" is already known; - */ + */ -_L1: /* we return to this label if token is not ready still */ +_L1: /* we return to this label if token is not ready still */ b123.b1 = s[i - 1]; - isa = as[b123.b1]; /* type of this character */ - - - - if (isa == is_control) { /*1*/ - if (b123.b1 == new_line_code) { - readline(); /* skips to next line, sets new "s" and "i" */ - if (in_string) { - er_lex(11L); - putstr(); - goto _L99; - } - /* error= end of line appears in string constant */ - goto _L1; - } else { - if (b123.b1 == endfile_code) { - if (in_comment) - er_lex(12L); - /* error = end of file appears in comment */ - dt = eof_desk; - goto _L99; - } else { /*2*/ - if (in_comment) { - er_lex(13L); - in_comment = false; - } - /* error = control char in comment */ - if (in_string) { - er_lex(14L); - putstr(); - goto _L99; - /* will take control character next time */ + isa = as[b123.b1]; /* type of this character */ + + + + if (isa == is_control) + { /*1 */ + if (b123.b1 == new_line_code) + { + readline (); /* skips to next line, sets new "s" and "i" */ + if (in_string) + { + er_lex (11L); + putstr (); + goto _L99; + } + /* error= end of line appears in string constant */ + goto _L1; } - /* error = control char in string */ - dt = cont_char_to_dt(b123.b1); - i++; - if (dt == set_coord && as[s[i - 1]] == is_digit) { - /* this control character sets coordinate to value given in input */ - coord_mark = take_digits(&j); - last_mark_byte_number = line_byte_number + i; - i += j; - goto _L1; /* does not returns ! */ - + else + { + if (b123.b1 == endfile_code) + { + if (in_comment) + er_lex (12L); + /* error = end of file appears in comment */ + dt = eof_desk; + goto _L99; + } + else + { /*2 */ + if (in_comment) + { + er_lex (13L); + in_comment = false; + } + /* error = control char in comment */ + if (in_string) + { + er_lex (14L); + putstr (); + goto _L99; + /* will take control character next time */ + } + /* error = control char in string */ + dt = cont_char_to_dt (b123.b1); + i++; + if (dt == set_coord && as[s[i - 1]] == is_digit) + { + /* this control character sets coordinate to value given in input */ + coord_mark = take_digits (&j); + last_mark_byte_number = line_byte_number + i; + i += j; + goto _L1; /* does not returns ! */ + + } + goto _L99; + } /*2 */ } - goto _L99; - } /*2*/ - } - /*never here*/ - } /*1*/ + /*never here */ + } /*1 */ /* all the following executes after check of is_control */ - /*b3[1]:=s[i];*/ + /*b3[1]:=s[i]; */ /* this character */ - b123.b3[1] = s[i]; /* next */ - b123.b3[2] = s[i + 1]; /* next */ - - if (in_comment) /* check for end of comment */ - { /*1*/ - /* we are in comment; - here only comments that have some special end mark are processed */ - if (pascal_comment) { /*2*/ - if (b123.b1 == '}') { - jncx(&i); - in_comment = false; - goto _L1; - } - - - - if (!strncmp(b123.b2, "*)", 2)) { - jnc2x(&i, 2L); - in_comment = false; - goto _L1; - } - - - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp(b123.b2, "*/", 2)) { - jnc2x(&i, 2L); - in_comment = false; - goto _L1; + b123.b3[1] = s[i]; /* next */ + b123.b3[2] = s[i + 1]; /* next */ + + if (in_comment) /* check for end of comment */ + { /*1 */ + /* we are in comment; + here only comments that have some special end mark are processed */ + if (pascal_comment) + { /*2 */ + if (b123.b1 == '}') + { + jncx (&i); + in_comment = false; + goto _L1; + } + + + + if (!strncmp (b123.b2, "*)", 2)) + { + jnc2x (&i, 2L); + in_comment = false; + goto _L1; + } + + + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp (b123.b2, "*/", 2)) + { + jnc2x (&i, 2L); + in_comment = false; + goto _L1; + } + } /*2 */ } - } /*2*/ - } - jncx(&i); - goto _L1; - } /*1*/ - - - - - if (in_string) { /*1*/ - if (pascal_string) { /*2*/ - if (b123.b1 == '\'') { /*3*/ - if (b123.b2[1] == '\'') { - stradd('\''); - jnc2x(&i, 2L); - goto _L1; - } else { - putstr(); - jncx(&i); - goto _L99; - } - /* this allow to save '''' as '' */ - - - } /*3*/ - else { /*3*/ - stradd(b123.b1); - jncx(&i); - goto _L1; - } /*3*/ - - } /*2*/ - if (modula_string) { /*2*/ - if (is_2quote && b123.b1 == '"') { - putstr(); - jncx(&i); - goto _L99; - } - if (!is_2quote && b123.b1 == '\'') { - putstr2(); - jncx(&i); - goto _L99; - } else { /*3*/ - if (b123.b1 == '\\') { - stradd(b123.b1); - stradd(b123.b2[1]); - /* this allows to save \? as ? even if \" appears" */ - jnc2x(&i, 2L); - goto _L1; - } - - stradd(b123.b1); - jncx(&i); - goto _L1; - } /*3*/ - } /*2*/ - } /*1*/ + jncx (&i); + goto _L1; + } /*1 */ + + + + + if (in_string) + { /*1 */ + if (pascal_string) + { /*2 */ + if (b123.b1 == '\'') + { /*3 */ + if (b123.b2[1] == '\'') + { + stradd ('\''); + jnc2x (&i, 2L); + goto _L1; + } + else + { + putstr (); + jncx (&i); + goto _L99; + } + /* this allow to save '''' as '' */ + + + } /*3 */ + else + { /*3 */ + stradd (b123.b1); + jncx (&i); + goto _L1; + } /*3 */ + + } /*2 */ + if (modula_string) + { /*2 */ + if (is_2quote && b123.b1 == '"') + { + putstr (); + jncx (&i); + goto _L99; + } + if (!is_2quote && b123.b1 == '\'') + { + putstr2 (); + jncx (&i); + goto _L99; + } + else + { /*3 */ + if (b123.b1 == '\\') + { + stradd (b123.b1); + stradd (b123.b2[1]); + /* this allows to save \? as ? even if \" appears" */ + jnc2x (&i, 2L); + goto _L1; + } + + stradd (b123.b1); + jncx (&i); + goto _L1; + } /*3 */ + } /*2 */ + } /*1 */ /* check for end of string or something special in string */ @@ -1029,182 +1143,219 @@ _L1: /* we return to this label if token is not ready still */ /* all the following executes after check for in_string & in_comment */ - if (isa == is_special) { /*1*/ - if (pascal_comment) { /*2*/ - if (!strncmp(b123.b2, "(*", 2)) { - in_comment = true; - jnc2x(&i, 2L); - goto _L1; - } - if (b123.b1 == '{' && b123.b2[1] != '$') { - in_comment = true; - jncx(&i); - goto _L1; - } - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp(b123.b2, "/*", 2)) { - in_comment = true; - jnc2x(&i, 2L); - goto _L1; + if (isa == is_special) + { /*1 */ + if (pascal_comment) + { /*2 */ + if (!strncmp (b123.b2, "(*", 2)) + { + in_comment = true; + jnc2x (&i, 2L); + goto _L1; + } + if (b123.b1 == '{' && b123.b2[1] != '$') + { + in_comment = true; + jncx (&i); + goto _L1; + } + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp (b123.b2, "/*", 2)) + { + in_comment = true; + jnc2x (&i, 2L); + goto _L1; + } + } /*2 */ + else + { + if (ada_comment) + { /*2 */ + if (!strncmp (b123.b2, "--", 2)) + { + readline (); + goto _L1; + } + } /*2 */ + } } - } /*2*/ - else { - if (ada_comment) { /*2*/ - if (!strncmp(b123.b2, "--", 2)) { - readline(); - goto _L1; - } - } /*2*/ - } - } - if (pascal_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin(); - is_2quote = false; - jncx(&i); - goto _L1; - } - } /*2*/ - else { - if (modula_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin(); - is_2quote = false; - jncx(&i); - goto _L1; + if (pascal_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin (); + is_2quote = false; + jncx (&i); + goto _L1; + } + } /*2 */ + else + { + if (modula_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin (); + is_2quote = false; + jncx (&i); + goto _L1; + } + if (b123.b1 == '"') + { + strbegin (); + is_2quote = true; + jncx (&i); + goto _L1; + } + } /*2 */ } - if (b123.b1 == '"') { - strbegin(); - is_2quote = true; - jncx(&i); - goto _L1; - } - } /*2*/ - } - if (pascal_lexics) { /*2*/ - /* specially takes turbo pascal directive-comments */ - if (!strncmp(b123.b2, "{$", 2)) { /*3*/ - j = 0; - do { - jncx(&j); - } while (s[i + j - 1] != '}' && as[s[i + j - 1]] != is_control); - if (s[i + j - 1] == '}') - jncx(&j); - putatom(j); - jnc2x(&i, j); - goto _L99; - } /*3*/ - - /* additional symbols */ - if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') { /*3*/ - jncx(&i); - j = take_letters(); /* starts from i-th position */ - i--; - putatom(j + 1); /* takes token from i-th position */ - jnc2x(&i, j + 1); - goto _L99; - } /*3*/ - - } /*2*/ - else { - if (c_lexics) { /*2*/ - if (!strncmp(b123.b3, "<<=", 3) || !strncmp(b123.b3, ">>=", 3)) { - putatom(3L); - jnc2x(&i, 3L); - goto _L99; + if (pascal_lexics) + { /*2 */ + /* specially takes turbo pascal directive-comments */ + if (!strncmp (b123.b2, "{$", 2)) + { /*3 */ + j = 0; + do + { + jncx (&j); + } + while (s[i + j - 1] != '}' && as[s[i + j - 1]] != is_control); + if (s[i + j - 1] == '}') + jncx (&j); + putatom (j); + jnc2x (&i, j); + goto _L99; + } /*3 */ + + /* additional symbols */ + if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') + { /*3 */ + jncx (&i); + j = take_letters (); /* starts from i-th position */ + i--; + putatom (j + 1); /* takes token from i-th position */ + jnc2x (&i, j + 1); + goto _L99; + } /*3 */ + + } /*2 */ + else + { + if (c_lexics) + { /*2 */ + if (!strncmp (b123.b3, "<<=", 3) + || !strncmp (b123.b3, ">>=", 3)) + { + putatom (3L); + jnc2x (&i, 3L); + goto _L99; + } + isa = is_first_of_two; + /* !! in c case <<, >>, >=, <= will be tested further + in two_char_symbols section, hence we go to there + using assignment to "isa" */ + + } /*2 */ + /* symbols= > < */ + /* special cases for c language */ + } - isa = is_first_of_two; - /* !! in c case <<, >>, >=, <= will be tested further - in two_char_symbols section, hence we go to there - using assignment to "isa" */ - } /*2*/ - /* symbols= > < */ - /* special cases for c language */ + } /*1 */ + + if (isa == is_space) + { + jncx (&i); + goto _L1; } - } /*1*/ - - - if (isa == is_space) { - jncx(&i); - goto _L1; - } - - if (isa == is_letter) { - j = take_letters(); - putident(j); - i += j; - goto _L99; - } - - - if (isa == is_digit) { /*1*/ - if (c_lexics) { /*2*/ - /* additional symbols; here hex and octal numbers are saved as - normal atoms */ - if (b123.b1 == '0') { /*3*/ - jncx(&i); - j = take_letters(); /* starts from i-th position */ - i--; - putatom(j + 1); /* takes token from i-th position */ - jnc2x(&i, j + 1); - goto _L99; - } /*3*/ - } /*2*/ - - - i_saved = i; /* remember starting position */ - aadr = take_digits(&j); - - if (j < 10 && - (s[i + j - 1] == '.' && s[i + j] == '.' || - s[i + j - 1] != '.' && s[i + j - 1] != 'E' && s[i + j - 1] != 'e')) { - putnumber(); - jnc2x(&i, j); + if (isa == is_letter) + { + j = take_letters (); + putident (j); + i += j; goto _L99; } - jnc2x(&i, j); - if (s[i - 1] == '.') { - jncx(&i); - aadr = take_digits(&j); - jnc2x(&i, j); - } - if (s[i - 1] == 'E' || s[i - 1] == 'e') { - jncx(&i); - if (s[i - 1] == '-' || s[i - 1] == '+') - jncx(&i); - aadr = take_digits(&j); - jnc2x(&i, j); - } - j = i - i_saved; - i = i_saved; /* to set "i" to starting position */ - putfloat(j); - jnc2x(&i, j); - goto _L99; - } /*1*/ - - if (isa == is_first_of_two) { /*1*/ - if (strchr(set_of_second_of_two,(int)b123.b2[1])) { - FORLIM = two_char_symbols_num; - for (j = 0; j < FORLIM; j++) { - if (b123.b2[0] == two_char_symbols[j][0] && - b123.b2[1] == two_char_symbols[j][1]) { - putatom(2L); - i += 2; + + + if (isa == is_digit) + { /*1 */ + if (c_lexics) + { /*2 */ + /* additional symbols; here hex and octal numbers are saved as + normal atoms */ + if (b123.b1 == '0') + { /*3 */ + jncx (&i); + j = take_letters (); /* starts from i-th position */ + i--; + putatom (j + 1); /* takes token from i-th position */ + jnc2x (&i, j + 1); + goto _L99; + } /*3 */ + } /*2 */ + + + i_saved = i; /* remember starting position */ + aadr = take_digits (&j); + + if (j < 10 && + (s[i + j - 1] == '.' && s[i + j] == '.' || + s[i + j - 1] != '.' && s[i + j - 1] != 'E' && s[i + j - 1] != 'e')) + { + putnumber (); + jnc2x (&i, j); goto _L99; } - } - } - } /*1*/ + jnc2x (&i, j); + if (s[i - 1] == '.') + { + jncx (&i); + aadr = take_digits (&j); + jnc2x (&i, j); + } + if (s[i - 1] == 'E' || s[i - 1] == 'e') + { + jncx (&i); + if (s[i - 1] == '-' || s[i - 1] == '+') + jncx (&i); + aadr = take_digits (&j); + jnc2x (&i, j); + } + j = i - i_saved; + i = i_saved; /* to set "i" to starting position */ + putfloat (j); + jnc2x (&i, j); + goto _L99; + } /*1 */ + + if (isa == is_first_of_two) + { /*1 */ + if (strchr (set_of_second_of_two, (int) b123.b2[1])) + { + FORLIM = two_char_symbols_num; + for (j = 0; j < FORLIM; j++) + { + if (b123.b2[0] == two_char_symbols[j][0] && + b123.b2[1] == two_char_symbols[j][1]) + { + putatom (2L); + i += 2; + goto _L99; + } + } + } + } /*1 */ - putatom(1L); - jncx(&i); /* with*/ -_L99: ; + putatom (1L); + jncx (&i); /* with */ +_L99:; @@ -1215,7 +1366,8 @@ _L99: ; -Static long take_letters() +static long +take_letters () { /****************************************/ long Result; @@ -1223,20 +1375,22 @@ Static long take_letters() returns number of characters read */ long jj; - Char c; + char c; jj = 0; - while (true) { - c = s[i + jj - 1]; - isa = as[c]; - if (isa != is_letter && isa != is_digit && isa != is_underscore) { - Result = jj; - goto _L99; + while (true) + { + c = s[i + jj - 1]; + isa = as[c]; + if (isa != is_letter && isa != is_digit && isa != is_underscore) + { + Result = jj; + goto _L99; + } + if (to_uppercase) + s[i + jj - 1] = upcase_tab[c]; + jncx (&jj); } - if (to_uppercase) - s[i + jj - 1] = upcase_tab[c]; - jncx(&jj); - } _L99: return Result; } @@ -1244,25 +1398,28 @@ _L99: -Static long take_digits(jj) -long *jj; +static long +take_digits (jj) + long *jj; { /**************************************************/ long Result; longint summator; - Char c; + char c; *jj = 0; summator = 0; - while (true) { - c = s[i + *jj - 1]; - if (as[c] != is_digit) { - Result = summator; - goto _L99; + while (true) + { + c = s[i + *jj - 1]; + if (as[c] != is_digit) + { + Result = summator; + goto _L99; + } + summator = summator * 10 + c - '0'; + jncx (jj); } - summator = summator * 10 + c - '0'; - jncx(jj); - } _L99: return Result; } diff --git a/RIGAL/rigsc.446/src/scan.c b/RIGAL/rigsc.446/src/scan.c index 799d84f6e3d026198b31e45d9f15b1a0131f81ed..418166245b33dd57ddd9dbf399eb0e3f048ac72d 100644 --- a/RIGAL/rigsc.446/src/scan.c +++ b/RIGAL/rigsc.446/src/scan.c @@ -3,7 +3,7 @@ #include "defpage.h" #include "scan.h" #include "nef2.h" - /*4-jul-93 invented maxline as length of input line*/ + /*4-jul-93 invented maxline as length of input line */ #define maxline 255 @@ -20,7 +20,7 @@ typedef unsigned char bigstring[maxline + 1]; may-93 now tex scaner is available. t+ defines latex lexical rules - and value of new "tex_lexics" boolean variable + and value of new "tex_lexics" bool variable @+ defines (additionaly to t+) .sty - file mode of latex, when @ characters are allowed in command names @@ -34,7 +34,7 @@ typedef unsigned char bigstring[maxline + 1]; */ -#define new_line_code '\015' /* chr(0 is allowed too */ +#define new_line_code '\015' /* chr(0 is allowed too */ #define endfile_code '\032' #define is_control 0 @@ -50,88 +50,92 @@ typedef unsigned char bigstring[maxline + 1]; typedef unsigned char pair[2]; - a a1; /* global variable for only local use */ +a a1; /* global variable for only local use */ /*aa1 : aa ;*/ /* --"-- */ - mpd x; /* --"-- */ - bl80 bl801; +mpd x; /* --"-- */ +bl80 bl801; /* -- " -- */ /* array[1..80] of char*/ - long k, kk; /* -"- */ - unsigned char c1; +long k, kk; /* -"- */ +unsigned char c1; - word saved_coord; /* where current token began */ - word coord_mark; /* what was set by coordinate marker */ - word line_byte_number; +word saved_coord; /* where current token began */ +word coord_mark; /* what was set by coordinate marker */ +word line_byte_number; /* number of totally read bytes till beginning of current line */ - word last_mark_byte_number; +word last_mark_byte_number; /* number of totally read bytes till last coordinate marker */ /* length of the current line, used only for incrementation of "lyne_byte_number"*/ - word old_line_length; - unsigned char dt; +word old_line_length; +unsigned char dt; /* type of last read token or control character */ - a aadr; /* a-space address of last read token */ - longint linenumber; /* current line number */ - longint tokennumber; /* current token number */ - a errlist; /* list of numbers of errors */ - long read_mode; /* 1,2,3 */ - ptr_ ptr1; /* list pointer when read from list of atoms */ - - FILE *inpfile; - boolean c_lexics, pascal_lexics, sty_lexics, tex_lexics, row80_coord, - byte_coord, mark_byte_coord, mark_only_coord, string_coord, - char_coord, token_coord, collect_errors, screen_errors, - to_uppercase, pascal_comment, c_comment, ada_comment, - pascal_string, modula_string; - bigstring s, s_for_val; /* added 17-feb-92 */ - long i; - unsigned char as[256]; - unsigned char isa; - unsigned Char upcase_tab[256]; - unsigned char set_of_second_of_two[9]; /* long -> char */ - long two_char_symbols_num; - pair two_char_symbols[30]; - - union { - unsigned Char b1; - unsigned Char b2[2]; - unsigned Char b3[3]; +a aadr; /* a-space address of last read token */ +longint linenumber; /* current line number */ +longint tokennumber; /* current token number */ +a errlist; /* list of numbers of errors */ +long read_mode; /* 1,2,3 */ +ptr_ ptr1; /* list pointer when read from list of atoms */ + +FILE *inpfile; +bool c_lexics, pascal_lexics, sty_lexics, tex_lexics, row80_coord, + byte_coord, mark_byte_coord, mark_only_coord, string_coord, + char_coord, token_coord, collect_errors, screen_errors, + to_uppercase, pascal_comment, c_comment, ada_comment, + pascal_string, modula_string; +bigstring s, s_for_val; /* added 17-feb-92 */ +long i; +unsigned char as[256]; +unsigned char isa; +unsigned char upcase_tab[256]; +unsigned char set_of_second_of_two[9]; /* long -> char */ +long two_char_symbols_num; +pair two_char_symbols[30]; + +union +{ + unsigned char b1; + unsigned char b2[2]; + unsigned char b3[3]; } b123; - boolean in_comment, in_string, is_2quote; +bool in_comment, in_string, is_2quote; /* if in_string then it is possible */ - longint str_constlen; - string80 str_const; /* array of char is allowed too */ +longint str_constlen; +string80 str_const; /* array of char is allowed too */ /*===== sun version ===*/ -Static Void jnc(xxx) -long *xxx; +static void +jnc (xxx) + long *xxx; { (*xxx)++; } /* -Static Void jnc2(xxx, yyy) +static void jnc2(xxx, yyy) long *xxx, yyy; { *xxx += yyy; } */ -Static Void jncx(xxx) -long *xxx; +static void +jncx (xxx) + long *xxx; { (*xxx)++; } -Static Void jnc2x(xxx, yyy) -long *xxx, yyy; +static void +jnc2x (xxx, yyy) + long *xxx, yyy; { *xxx += yyy; } @@ -139,43 +143,43 @@ long *xxx, yyy; /*=====*/ -Static unsigned Char cont_char_to_dt PP((int c)); +static unsigned char cont_char_to_dt PP ((int c)); -Static word getcoord PV(); +static word getcoord PV (); -Static Void er_lex PP((long er_number)); +static void er_lex PP ((long er_number)); /*procedure initialize_scan_variables;forward;*/ -Static Void read_file PP((long *read_file_rez)); +static void read_file PP ((long *read_file_rez)); -Static long read_item PP((long *pghead)); +static long read_item PP ((long *pghead)); -Static Void readline PV(); +static void readline PV (); -Static Void putatom PP((long j)); +static void putatom PP ((long j)); -Static Void putit PP((unsigned Char dd, long j)); +static void putit PP ((unsigned char dd, long j)); -Static Void putident PP((long j)); +static void putident PP ((long j)); -Static Void putfloat PP((long j)); +static void putfloat PP ((long j)); -Static Void putnumber PV(); +static void putnumber PV (); -Static Void putstr PP((unsigned Char dd)); +static void putstr PP ((unsigned char dd)); /*procedure scaner;forward;*/ -Static Void setlexics PV(); +static void setlexics PV (); -Static Void stradd PP((int c)); +static void stradd PP ((int c)); -Static Void strbegin PV(); +static void strbegin PV (); -Static Void token PV(); +static void token PV (); -Static long take_digits PP((long *jj)); +static long take_digits PP ((long *jj)); -Static long take_letters PV(); +static long take_letters PV (); @@ -191,7 +195,7 @@ Static long take_letters PV(); -> lconc.nef er_lex -> setoptions gets1.defpage -> first.nef token - -> assign.system pointr.defpage + -> assign.system assert_and_assign_real_pointer .defpage -> reset.system lconc.nef -> readline @@ -210,113 +214,129 @@ Static long take_letters PV(); -Static unsigned Char cont_char_to_dt(c) -unsigned Char c; +static unsigned char +cont_char_to_dt (c) + unsigned char c; { /************************************************/ - return ((unsigned Char)c); + return ((unsigned char) c); } -Static word getcoord() +static word +getcoord () { /*************************/ if (row80_coord) return (i + linenumber * 80); - else { - if (mark_only_coord) - return coord_mark; - else { - if (mark_byte_coord) - return (coord_mark + line_byte_number + i - last_mark_byte_number); - else { - if (byte_coord) - return (line_byte_number + i); - else { - if (string_coord) - return linenumber; - else { - if (token_coord) - return tokennumber; - else - return 0; - } + else + { + if (mark_only_coord) + return coord_mark; + else + { + if (mark_byte_coord) + return (coord_mark + line_byte_number + i - + last_mark_byte_number); + else + { + if (byte_coord) + return (line_byte_number + i); + else + { + if (string_coord) + return linenumber; + else + { + if (token_coord) + return tokennumber; + else + return 0; + } + } + } } - } } - } } -Static Void er_lex(er_number) -long er_number; +static void +er_lex (er_number) + long er_number; { /*************************************/ a er_atom; word co; numberdescriptor *WITH; - co = getcoord(); - if (collect_errors) { - gets1(&er_atom, &x.sa); - WITH = x.snd; /*global*/ - WITH->dtype = number; - WITH->cord = co; - WITH->val = er_number; - lconc(&errlist, er_atom); - } + co = getcoord (); + if (collect_errors) + { + gets1 (&er_atom, &x.sa); + WITH = x.snd; /*global */ + WITH->dtype = number; + WITH->cord = co; + WITH->val = er_number; + lconc (&errlist, er_atom); + } if (screen_errors) - printf("Lexical error (%12ld) line=%12d column=%12d\n", - er_number, co / 80, co % 80); + printf ("Lexical error (%12ld) line=%12d column=%12d\n", + er_number, co / 80, co % 80); } -Void initialize_scan_variables() +void +initialize_scan_variables () { /*************************************/ - unsigned Char c; + unsigned char c; short TEMP; - for (TEMP = '\0'; TEMP <= 255; TEMP++) { - c = TEMP; - upcase_tab[c] = c; - } - for (c = 'a'; c <= 'z'; c++) /*ascii*/ + for (TEMP = '\0'; TEMP <= 255; TEMP++) + { + c = TEMP; + upcase_tab[c] = c; + } + for (c = 'a'; c <= 'z'; c++) /*ascii */ upcase_tab[c] = c - 32; #ifdef russian - for (TEMP = 160; TEMP <= 175; TEMP++) { - c = TEMP; - upcase_tab[c] = c - 32; - } - /*russian*/ - for (TEMP = 224; TEMP <= 239; TEMP++) { - c = TEMP; - upcase_tab[c] = c - 60; - } - /*russian*/ + for (TEMP = 160; TEMP <= 175; TEMP++) + { + c = TEMP; + upcase_tab[c] = c - 32; + } + /*russian */ + for (TEMP = 224; TEMP <= 239; TEMP++) + { + c = TEMP; + upcase_tab[c] = c - 60; + } + /*russian */ #endif for (c = '\0'; c <= '\037'; c++) as[c] = is_control; - for (TEMP = 128; TEMP <= 255; TEMP++) { - c = TEMP; - as[c] = is_letter; - } + for (TEMP = 128; TEMP <= 255; TEMP++) + { + c = TEMP; + as[c] = is_letter; + } /* russian and pseudographics */ - for (TEMP = ' '; TEMP <= '\177'; TEMP++) { - c = TEMP; - /* not used actually */ + for (TEMP = ' '; TEMP <= '\177'; TEMP++) + { + c = TEMP; + /* not used actually */ - as[c] = is_printable; - } + as[c] = is_printable; + } as[new_line_code] = is_control; as[' '] = is_space; @@ -342,34 +362,40 @@ Void initialize_scan_variables() -Static Void read_file(read_file_rez) -long *read_file_rez; +static void +read_file (read_file_rez) + long *read_file_rez; { /********************************/ /* reads whole input, produces list of items */ a head; *read_file_rez = null_; - do { - a1 = read_item(&head); - if (dt == start_tree || dt == end_tree || dt == start_list || - dt == end_list || dt == name_obj) { - er_lex(6L); - goto _L99; - } - if (dt != eof_desk) { - if (head != null_) - lconc(read_file_rez, head); - lconc(read_file_rez, a1); + do + { + a1 = read_item (&head); + if (dt == start_tree || dt == end_tree || dt == start_list || + dt == end_list || dt == name_obj) + { + er_lex (6L); + goto _L99; + } + if (dt != eof_desk) + { + if (head != null_) + lconc (read_file_rez, head); + lconc (read_file_rez, a1); + } } - } while (dt != eof_desk); -_L99: ; + while (dt != eof_desk); +_L99:; } -Static long read_item(pghead) -long *pghead; +static long +read_item (pghead) + long *pghead; { /**********************/ long Result; @@ -377,144 +403,162 @@ long *pghead; atomdescriptor *WITH; numberdescriptor *WITH1; - Result = null_; /* default value for exits with errors */ + Result = null_; /* default value for exits with errors */ *pghead = null_; result = null_; - token(); - - /*writeln('DT=',dt,ord(dt));*/ - - switch (dt) { - - case atom: - case idatom: - case tatom: - case fatom: - case keyword: - gets1(&result, &x.sa); - WITH = x.sad; - WITH->dtype = dt; - WITH->cord = saved_coord; - WITH->name = aadr; - break; - - case number: - gets1(&result, &x.sa); - WITH1 = x.snd; - WITH1->dtype = dt; - WITH1->cord = saved_coord; - WITH1->val = aadr; /* is set in token .. is_digit */ - break; - - case dummy: - result = null_; - break; - - case start_tree: - result = null_; - do { - token(); - aadr1 = aadr; /* to save */ - if (dt == idatom || dt == atom || dt == tatom || dt == keyword) { - /* what is allowed selector in scaner input ? - normally - idatom only, but here - atom is allowed too - for experiment purposes */ - a1 = read_item(&dum); - if (dt == end_list) { - er_lex(6L); - goto _L99; + token (); + + /*writeln('DT=',dt,ord(dt)); */ + + switch (dt) + { + + case atom: + case idatom: + case tatom: + case fatom: + case keyword: + gets1 (&result, &x.sa); + WITH = x.sad; + WITH->dtype = dt; + WITH->cord = saved_coord; + WITH->name = aadr; + break; + + case number: + gets1 (&result, &x.sa); + WITH1 = x.snd; + WITH1->dtype = dt; + WITH1->cord = saved_coord; + WITH1->val = aadr; /* is set in token .. is_digit */ + break; + + case dummy: + result = null_; + break; + + case start_tree: + result = null_; + do + { + token (); + aadr1 = aadr; /* to save */ + if (dt == idatom || dt == atom || dt == tatom || dt == keyword) + { + /* what is allowed selector in scaner input ? + normally - idatom only, but here + atom is allowed too - for experiment purposes */ + a1 = read_item (&dum); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (1L); + goto _L99; + } + addel3 (&result, aadr1, a1); + } + else if (dt != end_tree) + { + er_lex (2L); + goto _L99; + } } - if (dt == eof_desk) { - er_lex(1L); + while (dt != end_tree && dt != eof_desk); + if (dt == eof_desk) + { + er_lex (3L); goto _L99; } - addel3(&result, aadr1, a1); - } else if (dt != end_tree) { - er_lex(2L); - goto _L99; - } - } while (dt != end_tree && dt != eof_desk); - if (dt == eof_desk) { - er_lex(3L); - goto _L99; - } - dt = complex_desk; - /* to ignore analysis in upper level of - recursion */ - break; - - case start_list: - result = null_; - - do { - a1 = read_item(&dum); - if (dt == eof_desk) { - er_lex(4L); - goto _L99; - } - if (dt != end_list) - lconc(&result, a1); - } while (dt != end_list); - - dt = complex_desk; - break; - - case end_tree: - er_lex(5L); - goto _L99; - break; - - case end_list: - break; - /*immodiately returns to the upper level*/ - - case name_obj: - temp_res = read_item(&dum); - if (dt == end_list) { - er_lex(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex(7L); - goto _L99; - } - result = read_item(&dum); - if (dt == end_list) { - er_lex(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex(8L); + dt = complex_desk; + /* to ignore analysis in upper level of + recursion */ + break; + + case start_list: + result = null_; + + do + { + a1 = read_item (&dum); + if (dt == eof_desk) + { + er_lex (4L); + goto _L99; + } + if (dt != end_list) + lconc (&result, a1); + } + while (dt != end_list); + + dt = complex_desk; + break; + + case end_tree: + er_lex (5L); goto _L99; - } - if (result != null_) { - points(result, &x.sa); - if (x.smld->dtype == listmain || x.smtd->dtype == treemain) - x.smtd->name = temp_res; - } - dt = complex_desk; - break; + break; - case eof_desk: - break; - /* returns to the upper level */ + case end_list: + break; + /*immodiately returns to the upper level */ + case name_obj: + temp_res = read_item (&dum); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (7L); + goto _L99; + } + result = read_item (&dum); + if (dt == end_list) + { + er_lex (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex (8L); + goto _L99; + } + if (result != null_) + { + assert_and_assign_real_pointer (result, &x.sa); + if (x.smld->dtype == listmain || x.smtd->dtype == treemain) + x.smtd->name = temp_res; + } + dt = complex_desk; + break; + + case eof_desk: + break; + /* returns to the upper level */ - default: - er_lex(9L); - goto _L99; /* impossible value */ - break; - }/* case */ + + default: + er_lex (9L); + goto _L99; /* impossible value */ + break; + } /* case */ Result = result; _L99: return Result; -} /* read_item */ +} /* read_item */ -Static Void readline() +static void +readline () { /*****************************/ /* sets new values for "s" and "i" global variables */ @@ -523,66 +567,88 @@ Static Void readline() int len; i = 1; /* in any case, so; only here it is initialized. - it is column number. - variable "s" is string only for speed purposes; - it plays exactly as packed array of char, - never used as whole and the length byte is never used */ + it is column number. + variable "s" is string only for speed purposes; + it plays exactly as packed array of char, + never used as whole and the length byte is never used */ linenumber++; line_byte_number += old_line_length; - if (read_mode == 1) { - if (feof(inpfile)) - s[0] = endfile_code; - else { - /*readln(inpfile,s);*/ - /* Here we want to obtain C string with - new_line_code at the end if there is end of line */ - if ( fgets((char*)s, maxline-1 ,inpfile) ) - { len=strlen((char*) s); - if (len >= maxline - 2) - printf(" FATAL ERROR: Line %12ld too long !\n", linenumber); - /*printf("\n Input=<%s> \n",s); */ - - /* This place have been corrected in version 4.46 - in order to handle last line of the file with - \n missing */ - if (s[len-1]=='\n') { s[len-1] = new_line_code;} - else { s[len] = new_line_code; s[len+1]='\0';} - old_line_length = len; - } - else s[0] = endfile_code; - - } - } else { - if (read_mode == 2) { - if (ptr1.nel == 0) { + if (read_mode == 1) + { + if (feof (inpfile)) s[0] = endfile_code; - goto _L99; - } - if (ptr1.cel == 0) { - s[0] = new_line_code; - old_line_length = 0; - } else { - pointr(ptr1.cel, &x.sa); - WITH = x.sad; /* with */ - if (WITH->dtype == atom || WITH->dtype == idatom || - WITH->dtype == fatom || - WITH->dtype == tatom || WITH->dtype == keyword) { - pointa(WITH->name, bl801, &k); - FORLIM = k; - for (kk = 1; kk <= FORLIM; kk++) - s[kk - 1] = bl801[kk - 1]; - old_line_length = k; - s[k] = new_line_code; - } else { - s[0] = new_line_code; /* other objects are ignored */ - old_line_length = 0; + else + { + /*readln(inpfile,s); */ + /* Here we want to obtain C string with + new_line_code at the end if there is end of line */ + if (fgets ((char *) s, maxline - 1, inpfile)) + { + len = strlen ((char *) s); + if (len >= maxline - 2) + printf (" FATAL ERROR: Line %12ld too long !\n", linenumber); + /*printf("\n Input=<%s> \n",s); */ + + /* This place have been corrected in version 4.46 + in order to handle last line of the file with + \n missing */ + if (s[len - 1] == '\n') + { + s[len - 1] = new_line_code; + } + else + { + s[len] = new_line_code; + s[len + 1] = '\0'; + } + old_line_length = len; + } + else + s[0] = endfile_code; + } - } /* <>0 */ - next(&ptr1); + } + else + { + if (read_mode == 2) + { + if (ptr1.nel == 0) + { + s[0] = endfile_code; + goto _L99; + } + if (ptr1.cel == 0) + { + s[0] = new_line_code; + old_line_length = 0; + } + else + { + assert_and_assign_real_pointer (ptr1.cel, &x.sa); + WITH = x.sad; /* with */ + if (WITH->dtype == atom || WITH->dtype == idatom || + WITH->dtype == fatom || + WITH->dtype == tatom || WITH->dtype == keyword) + { + get_data_from_pointa (WITH->name, bl801, &k); + FORLIM = k; + for (kk = 1; kk <= FORLIM; kk++) + s[kk - 1] = bl801[kk - 1]; + old_line_length = k; + s[k] = new_line_code; + } + else + { + s[0] = new_line_code; /* other objects are ignored */ + old_line_length = 0; + } + } /* <>0 */ + next (&ptr1); - } /*=2*/ - } -_L99: ; + } + /*=2*/ + } +_L99:; } @@ -591,43 +657,49 @@ _L99: ; -Static Void putatom(j) -long j; +static void +putatom (j) + long j; { /*************************/ - putit(atom, j); + putit (atom, j); } -Static Void putit(dd, j) -unsigned Char dd; -long j; +static void +putit (dd, j) + unsigned char dd; + long j; { /*************************/ - if (j > 80) { - dt = keyword; - er_lex(10L); - j = 80; - } else + if (j > 80) + { + dt = keyword; + er_lex (10L); + j = 80; + } + else dt = dd; - putatm(&s[i - 1], j, &aadr); + putatm (&s[i - 1], j, &aadr); dt = dd; - saved_coord = getcoord(); + saved_coord = getcoord (); tokennumber++; } -Static Void putident(j) -long j; +static void +putident (j) + long j; { /*************************/ - putit(idatom, j); + putit (idatom, j); } -Static Void putfloat(j) -long j; -{ /*ignored*/ +static void +putfloat (j) + long j; +{ /*ignored */ /* This function takes "j" characters, starting from the current position s[i-1] and converts them to "sizeof(double)" character @@ -638,51 +710,55 @@ long j; double rea_val; long ii, kk; real_char reac; - Char STR1[256]; + char STR1[256]; - sprintf(STR1, "%.*s", (int)j, s + i - 1); + sprintf (STR1, "%.*s", (int) j, s + i - 1); /* STR1 - 0-terminated string */ - val2(STR1, &rea_val, &ii); + val2 (STR1, &rea_val, &ii); /* rea_val - double value. We ignore ii here because we already checked - syntax correctness earlier */ + syntax correctness earlier */ - ii = sizeof(double); + ii = sizeof (double); for (kk = 0; kk < ii; kk++) - reac[kk] = ((Char *)(&rea_val))[kk]; + reac[kk] = ((char *) (&rea_val))[kk]; /* Copy the sizeof(double) characters to the "reac" string */ - putatm(reac, ii, &aadr); + putatm (reac, ii, &aadr); /* Store "reac" into the A-memory */ - + dt = fatom; - saved_coord = getcoord(); - jnc(&tokennumber); + saved_coord = getcoord (); + jnc (&tokennumber); } -Static Void putnumber() +static void +putnumber () { /*************************/ dt = number; - saved_coord = getcoord(); - jnc(&tokennumber); + saved_coord = getcoord (); + jnc (&tokennumber); } -Static Void putstr(dd) -Char dd; +static void +putstr (dd) + char dd; { /*************************/ - if (str_constlen > 80) { - str_constlen = 80; - dt = keyword; /* too long string constant */ - er_lex(10L); - } else + if (str_constlen > 80) + { + str_constlen = 80; + dt = keyword; /* too long string constant */ + er_lex (10L); + } + else dt = dd; - putatm(str_const, str_constlen, &aadr); + putatm (str_const, str_constlen, &aadr); in_string = false; tokennumber++; @@ -691,27 +767,30 @@ Char dd; } -/* Local variables for scaner: */ -struct LOC_scaner { +/* static variables for scaner: */ +struct LOC_scaner +{ string80 options_str; -} ; +}; /*inner function*/ -Local boolean setop(c, LINK) -Char c; -struct LOC_scaner *LINK; +static bool +setop (c, LINK) + char c; + struct LOC_scaner *LINK; { - boolean Result; - char * tmp; + bool Result; + char *tmp; Result = false; - tmp=strchr(LINK->options_str,c); + tmp = strchr (LINK->options_str, c); - if ( tmp ) { - if (tmp[1] != '-') /* Check next position */ - return true; - } + if (tmp) + { + if (tmp[1] != '-') /* Check next position */ + return true; + } - return Result; + return Result; } @@ -726,15 +805,16 @@ struct LOC_scaner *LINK; -Void scaner(mode_parm, filename_, options_str_, rez, erlist_parm, strlist, - segm, ofs) -long mode_parm; -Char *filename_, *options_str_; -long *rez, *erlist_parm, strlist, segm, ofs; +void +scaner (mode_parm, filename_, options_str_, rez, erlist_parm, strlist, + segm, ofs) + long mode_parm; + char *filename_, *options_str_; + long *rez, *erlist_parm, strlist, segm, ofs; { /*******************************************/ - /*1=from file,2=list of strings,3=absulute address*/ + /*1=from file,2=list of strings,3=absulute address */ /* result; set to null if input is absent */ /* error number list; set to null if no error */ /* list of atoms */ @@ -743,51 +823,51 @@ long *rez, *erlist_parm, strlist, segm, ofs; string80 filename; - strcpy(filename, filename_); - strcpy(V.options_str, options_str_); - read_mode = mode_parm; /* save for global use */ + strcpy (filename, filename_); + strcpy (V.options_str, options_str_); + read_mode = mode_parm; /* save for global use */ *rez = null_; *erlist_parm = null_; - errlist = null_; /* global */ + errlist = null_; /* global */ /* initializes all options */ /* defaults */ - strcat(V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); + strcat (V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); /* to every option su,me default value should be given, otherwise the flag remains uninitialized */ - /*errors*/ - screen_errors = setop('S', &V); - collect_errors = setop('O', &V); - - /*comments*/ - ada_comment = setop('D', &V); - c_comment = setop('C', &V); - pascal_comment = setop('P', &V); - - /*string constants*/ - pascal_string = setop('p', &V); - modula_string = setop('m', &V); - to_uppercase = setop('U', &V); - - /*coordinate*/ - string_coord = setop('s', &V); - token_coord = setop('t', &V); - row80_coord = setop('R', &V); - byte_coord = setop('Y', &V); - mark_byte_coord = setop('B', &V); - mark_only_coord = setop('N', &V); - - /*language_specific lexics*/ - c_lexics = setop('L', &V); - pascal_lexics = setop('A', &V); - tex_lexics = setop('T', &V); - sty_lexics = setop('@', &V); + /*errors */ + screen_errors = setop ('S', &V); + collect_errors = setop ('O', &V); + + /*comments */ + ada_comment = setop ('D', &V); + c_comment = setop ('C', &V); + pascal_comment = setop ('P', &V); + + /*string constants */ + pascal_string = setop ('p', &V); + modula_string = setop ('m', &V); + to_uppercase = setop ('U', &V); + + /*coordinate */ + string_coord = setop ('s', &V); + token_coord = setop ('t', &V); + row80_coord = setop ('R', &V); + byte_coord = setop ('Y', &V); + mark_byte_coord = setop ('B', &V); + mark_only_coord = setop ('N', &V); + + /*language_specific lexics */ + c_lexics = setop ('L', &V); + pascal_lexics = setop ('A', &V); + tex_lexics = setop ('T', &V); + sty_lexics = setop ('@', &V); /* initializes language-specific settings */ - setlexics(); + setlexics (); - /* initializes "session" flags (alf order)*/ + /* initializes "session" flags (alf order) */ coord_mark = 0; in_comment = false; in_string = false; @@ -801,108 +881,121 @@ long *rez, *erlist_parm, strlist, segm, ofs; /* initializes physical level reading */ - if (read_mode == 1) { /* read from file */ - if (!existfile(filename)) { - *rez = 0; - goto _L1; - } + if (read_mode == 1) + { /* read from file */ + if (!existfile (filename)) + { + *rez = 0; + goto _L1; + } - inpfile = fopen(filename, "r"); - if (inpfile == NULL) - _EscIO(FileNotFound); + inpfile = fopen (filename, "r"); + if (inpfile == NULL) + _EscIO (FileNotFound); - readline(); /* reads first line of file */ - } else { - if (read_mode == 2) { /* read from list */ - if (strlist == null_) { - *rez = 0; - goto _L99; - } - first(strlist, &ptr1); /* sets global list-pointer ptr1 */ - if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) { - *rez = 0; - goto _L99; - } - readline(); /* reads line from current list-pointer position */ - /* read from ms-dos ram memory */ + readline (); /* reads first line of file */ + } + else + { + if (read_mode == 2) + { /* read from list */ + if (strlist == null_) + { + *rez = 0; + goto _L99; + } + first (strlist, &ptr1); /* sets global list-pointer ptr1 */ + if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) + { + *rez = 0; + goto _L99; + } + readline (); /* reads line from current list-pointer position */ + /* read from ms-dos ram memory */ + } } - } - read_file(rez); /* main call ... */ + read_file (rez); /* main call ... */ - *erlist_parm = errlist; /*global*/ + *erlist_parm = errlist; /*global */ _L1: -_L99: ; -} /* scaner */ +_L99:; +} /* scaner */ -Static Void setlexics() +static void +setlexics () { /*************************/ long j, FORLIM; - if (pascal_lexics) { - /* changes in standard, necessary for pascal*/ - as['{'] = is_special; - as['#'] = is_special; - as['$'] = is_special; - as['%'] = is_special; - as['\''] = is_special; - as['('] = is_special; - memcpy(two_char_symbols[0], ":=", sizeof(pair)); - memcpy(two_char_symbols[1], "<=", sizeof(pair)); - memcpy(two_char_symbols[2], ">=", sizeof(pair)); - memcpy(two_char_symbols[3], "**", sizeof(pair)); - memcpy(two_char_symbols[4], "..", sizeof(pair)); - memcpy(two_char_symbols[5], "<>", sizeof(pair)); - two_char_symbols_num = 6; - strcpy((char*)set_of_second_of_two,"=*.>"); - FORLIM = two_char_symbols_num; - for (j = 0; j < FORLIM; j++) - as[two_char_symbols[j][0]] = is_first_of_two; - if (modula_string) { - as['"'] = is_special; - as['{'] = is_printable; - } - } else { - if (c_lexics) { - as['_'] = is_letter; - as['$'] = is_letter; - memcpy(two_char_symbols[0], "->", sizeof(pair)); - memcpy(two_char_symbols[1], "++", sizeof(pair)); - memcpy(two_char_symbols[2], "--", sizeof(pair)); - memcpy(two_char_symbols[3], ">>", sizeof(pair)); - memcpy(two_char_symbols[4], "<<", sizeof(pair)); - memcpy(two_char_symbols[5], "==", sizeof(pair)); - memcpy(two_char_symbols[6], "+=", sizeof(pair)); - memcpy(two_char_symbols[7], "*=", sizeof(pair)); - memcpy(two_char_symbols[8], "-=", sizeof(pair)); - memcpy(two_char_symbols[9], "/=", sizeof(pair)); - memcpy(two_char_symbols[10], "%=", sizeof(pair)); - memcpy(two_char_symbols[11], "&=", sizeof(pair)); - memcpy(two_char_symbols[12], "^=", sizeof(pair)); - memcpy(two_char_symbols[13], "|=", sizeof(pair)); - memcpy(two_char_symbols[14], "!=", sizeof(pair)); - two_char_symbols_num = 15; - strcpy((char*)set_of_second_of_two,">+-<="); + if (pascal_lexics) + { + /* changes in standard, necessary for pascal */ + as['{'] = is_special; + as['#'] = is_special; + as['$'] = is_special; + as['%'] = is_special; + as['\''] = is_special; + as['('] = is_special; + memcpy (two_char_symbols[0], ":=", sizeof (pair)); + memcpy (two_char_symbols[1], "<=", sizeof (pair)); + memcpy (two_char_symbols[2], ">=", sizeof (pair)); + memcpy (two_char_symbols[3], "**", sizeof (pair)); + memcpy (two_char_symbols[4], "..", sizeof (pair)); + memcpy (two_char_symbols[5], "<>", sizeof (pair)); + two_char_symbols_num = 6; + strcpy ((char *) set_of_second_of_two, "=*.>"); FORLIM = two_char_symbols_num; for (j = 0; j < FORLIM; j++) as[two_char_symbols[j][0]] = is_first_of_two; - as['<'] = is_special; /* used to process <<= */ - as['>'] = is_special; /* used to process >>= */ - as['/'] = is_special; /* used to process / * */ - /* otherwise isa:=is_first_of_two - is assigned ! */ - as['\''] = is_special; - as['"'] = is_special; + if (modula_string) + { + as['"'] = is_special; + as['{'] = is_printable; + } + } + else + { + if (c_lexics) + { + as['_'] = is_letter; + as['$'] = is_letter; + memcpy (two_char_symbols[0], "->", sizeof (pair)); + memcpy (two_char_symbols[1], "++", sizeof (pair)); + memcpy (two_char_symbols[2], "--", sizeof (pair)); + memcpy (two_char_symbols[3], ">>", sizeof (pair)); + memcpy (two_char_symbols[4], "<<", sizeof (pair)); + memcpy (two_char_symbols[5], "==", sizeof (pair)); + memcpy (two_char_symbols[6], "+=", sizeof (pair)); + memcpy (two_char_symbols[7], "*=", sizeof (pair)); + memcpy (two_char_symbols[8], "-=", sizeof (pair)); + memcpy (two_char_symbols[9], "/=", sizeof (pair)); + memcpy (two_char_symbols[10], "%=", sizeof (pair)); + memcpy (two_char_symbols[11], "&=", sizeof (pair)); + memcpy (two_char_symbols[12], "^=", sizeof (pair)); + memcpy (two_char_symbols[13], "|=", sizeof (pair)); + memcpy (two_char_symbols[14], "!=", sizeof (pair)); + two_char_symbols_num = 15; + strcpy ((char *) set_of_second_of_two, ">+-<="); + FORLIM = two_char_symbols_num; + for (j = 0; j < FORLIM; j++) + as[two_char_symbols[j][0]] = is_first_of_two; + as['<'] = is_special; /* used to process <<= */ + as['>'] = is_special; /* used to process >>= */ + as['/'] = is_special; /* used to process / * */ + /* otherwise isa:=is_first_of_two + is assigned ! */ + as['\''] = is_special; + as['"'] = is_special; + } } - } if (!tex_lexics) return; @@ -937,7 +1030,7 @@ Static Void setlexics() as['-'] = is_special; as['_'] = is_special; as['\''] = is_special; - if (sty_lexics) /*it is the only place where sty_lexics is used*/ + if (sty_lexics) /*it is the only place where sty_lexics is used */ as['@'] = is_letter; else as['@'] = is_special; @@ -948,23 +1041,25 @@ Static Void setlexics() -Static Void stradd(c) -unsigned Char c; +static void +stradd (c) + unsigned char c; { /*************************/ - if (str_constlen > 80) /* string is truncated */ - er_lex(10L); + if (str_constlen > 80) /* string is truncated */ + er_lex (10L); else - jnc(&str_constlen); + jnc (&str_constlen); str_const[str_constlen - 1] = c; } -Static Void strbegin() +static void +strbegin () { /********************/ - saved_coord = getcoord(); - /* it will be used when putstr works and token exits - in read_item*/ + saved_coord = getcoord (); + /* it will be used when putstr works and token exits - in read_item */ in_string = true; str_constlen = 0; } @@ -973,180 +1068,215 @@ Static Void strbegin() -Static Void token() -{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ +static void +token () +{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ /**********************/ - long j, i_saved; /* positions */ + long j, i_saved; /* positions */ long FORLIM; /* at beginning time "i" - is already set to character in string "s"; array "as" is already initialized; coordinate mode "coord_mode" is already known; - */ + */ -_L1: /* we return to this label if token is not ready still */ +_L1: /* we return to this label if token is not ready still */ b123.b1 = s[i - 1]; - isa = as[b123.b1]; /* type of this character */ + isa = as[b123.b1]; /* type of this character */ - if (isa == is_control) { /*1*/ - if (b123.b1 == new_line_code) { - readline(); /* skips to next line, sets new "s" and "i" */ + if (isa == is_control) + { /*1 */ + if (b123.b1 == new_line_code) + { + readline (); /* skips to next line, sets new "s" and "i" */ - if (tex_lexics) { - dt = dummy; - goto _L99; - } /*null is returned at the end of line*/ + if (tex_lexics) + { + dt = dummy; + goto _L99; + } /*null is returned at the end of line */ - if (in_string) { - er_lex(11L); - putstr(keyword); - goto _L99; - } - /* error= end of line appears in string constant */ - goto _L1; - } else { - if (b123.b1 == endfile_code) { - if (in_comment) - er_lex(12L); - /* error = end of file appears in comment */ - dt = eof_desk; - goto _L99; - } else { /*2*/ - if (in_comment) { - er_lex(13L); - in_comment = false; + if (in_string) + { + er_lex (11L); + putstr (keyword); + goto _L99; + } + /* error= end of line appears in string constant */ + goto _L1; } - /* error = control char in comment */ - if (in_string) { - er_lex(14L); - putstr(keyword); - goto _L99; - /* will take control character next time */ + else + { + if (b123.b1 == endfile_code) + { + if (in_comment) + er_lex (12L); + /* error = end of file appears in comment */ + dt = eof_desk; + goto _L99; + } + else + { /*2 */ + if (in_comment) + { + er_lex (13L); + in_comment = false; + } + /* error = control char in comment */ + if (in_string) + { + er_lex (14L); + putstr (keyword); + goto _L99; + /* will take control character next time */ + } + /* error = control char in string */ + dt = cont_char_to_dt (b123.b1); + i++; + if (dt == set_coord && as[s[i - 1]] == is_digit) + { + /* this control character sets coordinate to value given in input */ + coord_mark = take_digits (&j); + last_mark_byte_number = line_byte_number + i; + i += j; + goto _L1; /* does not returns ! */ + + } + goto _L99; + } /*2 */ } - /* error = control char in string */ - dt = cont_char_to_dt(b123.b1); - i++; - if (dt == set_coord && as[s[i - 1]] == is_digit) { - /* this control character sets coordinate to value given in input */ - coord_mark = take_digits(&j); - last_mark_byte_number = line_byte_number + i; - i += j; - goto _L1; /* does not returns ! */ - - } - goto _L99; - } /*2*/ - } - /*never here*/ - } /*1*/ + /*never here */ + } /*1 */ /* all the following executes after check of is_control */ - /*b3[1]:=s[i];*/ + /*b3[1]:=s[i]; */ /* this character */ - b123.b3[1] = s[i]; /* next */ - b123.b3[2] = s[i + 1]; /* next */ - - if (in_comment) /* check for end of comment */ - { /*1*/ - /* we are in comment; - here only comments that have some special end mark are processed */ - if (pascal_comment) { /*2*/ - if (b123.b1 == '}') { - jncx(&i); - in_comment = false; - goto _L1; - } - - - - if (!strncmp((char*)b123.b2, "*)", 2)) { - jnc2x(&i, 2L); - in_comment = false; - goto _L1; - } - - - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp((char*)b123.b2, "*/", 2)) { - jnc2x(&i, 2L); - in_comment = false; - goto _L1; + b123.b3[1] = s[i]; /* next */ + b123.b3[2] = s[i + 1]; /* next */ + + if (in_comment) /* check for end of comment */ + { /*1 */ + /* we are in comment; + here only comments that have some special end mark are processed */ + if (pascal_comment) + { /*2 */ + if (b123.b1 == '}') + { + jncx (&i); + in_comment = false; + goto _L1; + } + + + + if (!strncmp ((char *) b123.b2, "*)", 2)) + { + jnc2x (&i, 2L); + in_comment = false; + goto _L1; + } + + + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp ((char *) b123.b2, "*/", 2)) + { + jnc2x (&i, 2L); + in_comment = false; + goto _L1; + } + } /*2 */ } - } /*2*/ - } - jncx(&i); - goto _L1; - } /*1*/ - /*this part never appears in mif input, since there is no in_comment status*/ - - - - - - if (in_string) { /*1*/ - if (pascal_string) { /*2*/ - if (b123.b1 == '\'') { /*3*/ - if (b123.b2[1] == '\'') { - stradd('\''); - jnc2x(&i, 2L); - goto _L1; - } else { - putstr(tatom); - jncx(&i); - goto _L99; - } - /* this allow to save '''' as '' */ - - - } /*3*/ - else { /*3*/ - stradd(b123.b1); - jncx(&i); - goto _L1; - } /*3*/ - - } /*2*/ - if (modula_string) { /*2*/ - if (is_2quote && b123.b1 == '"') { - if (b123.b2[1] == '"') { - stradd('"'); - jnc2x(&i, 2L); - goto _L1; - } else { - putstr(tatom); - jncx(&i); - goto _L99; - } - } - if (!is_2quote && b123.b1 == '\'') { - putstr(keyword); - jncx(&i); - goto _L99; - } else { /*3*/ - if (b123.b1 == '\\') { - stradd(b123.b1); - stradd(b123.b2[1]); - /* this allows to save \? as ? even if \" appears" */ - jnc2x(&i, 2L); - goto _L1; - } - - stradd(b123.b1); - jncx(&i); - goto _L1; - } /*3*/ - } /*2*/ - } /*1*/ + jncx (&i); + goto _L1; + } /*1 */ + /*this part never appears in mif input, since there is no in_comment status */ + + + + + + if (in_string) + { /*1 */ + if (pascal_string) + { /*2 */ + if (b123.b1 == '\'') + { /*3 */ + if (b123.b2[1] == '\'') + { + stradd ('\''); + jnc2x (&i, 2L); + goto _L1; + } + else + { + putstr (tatom); + jncx (&i); + goto _L99; + } + /* this allow to save '''' as '' */ + + + } /*3 */ + else + { /*3 */ + stradd (b123.b1); + jncx (&i); + goto _L1; + } /*3 */ + + } /*2 */ + if (modula_string) + { /*2 */ + if (is_2quote && b123.b1 == '"') + { + if (b123.b2[1] == '"') + { + stradd ('"'); + jnc2x (&i, 2L); + goto _L1; + } + else + { + putstr (tatom); + jncx (&i); + goto _L99; + } + } + if (!is_2quote && b123.b1 == '\'') + { + putstr (keyword); + jncx (&i); + goto _L99; + } + else + { /*3 */ + if (b123.b1 == '\\') + { + stradd (b123.b1); + stradd (b123.b2[1]); + /* this allows to save \? as ? even if \" appears" */ + jnc2x (&i, 2L); + goto _L1; + } + + stradd (b123.b1); + jncx (&i); + goto _L1; + } /*3 */ + } /*2 */ + } /*1 */ /* check for end of string or something special in string */ @@ -1154,172 +1284,205 @@ _L1: /* we return to this label if token is not ready still */ /* all the following executes after check for in_string & in_comment */ - if (isa == is_special) { /*1*/ - if (pascal_comment) { /*2*/ - if (!strncmp((char*)b123.b2, "(*", 2)) { - in_comment = true; - jnc2x(&i, 2L); - goto _L1; - } - if (b123.b1 == '{' && b123.b2[1] != '$') { - in_comment = true; - jncx(&i); - goto _L1; - } - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp((char*)b123.b2, "/*", 2)) { - in_comment = true; - jnc2x(&i, 2L); - goto _L1; + if (isa == is_special) + { /*1 */ + if (pascal_comment) + { /*2 */ + if (!strncmp ((char *) b123.b2, "(*", 2)) + { + in_comment = true; + jnc2x (&i, 2L); + goto _L1; + } + if (b123.b1 == '{' && b123.b2[1] != '$') + { + in_comment = true; + jncx (&i); + goto _L1; + } + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp ((char *) b123.b2, "/*", 2)) + { + in_comment = true; + jnc2x (&i, 2L); + goto _L1; + } + } /*2 */ + else + { + if (ada_comment) + { /*2 */ + if (!strncmp ((char *) b123.b2, "--", 2)) + { + readline (); + goto _L1; + } + } /*2 */ + } } - } /*2*/ - else { - if (ada_comment) { /*2*/ - if (!strncmp((char*)b123.b2, "--", 2)) { - readline(); - goto _L1; - } - } /*2*/ - } - } - if (pascal_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin(); - is_2quote = false; - jncx(&i); - goto _L1; - } - } /*2*/ - else { - if (modula_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin(); - is_2quote = false; - jncx(&i); - goto _L1; + if (pascal_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin (); + is_2quote = false; + jncx (&i); + goto _L1; + } + } /*2 */ + else + { + if (modula_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin (); + is_2quote = false; + jncx (&i); + goto _L1; + } + if (b123.b1 == '"') + { + strbegin (); + is_2quote = true; + jncx (&i); + goto _L1; + } + } /*2 */ } - if (b123.b1 == '"') { - strbegin(); - is_2quote = true; - jncx(&i); - goto _L1; + if (pascal_lexics) + { /*2 */ + /* specially takes turbo pascal directive-comments */ + if (!strncmp ((char *) b123.b2, "{$", 2)) + { /*3 */ + j = 0; + do + { + jncx (&j); + } + while (s[i + j - 1] != '}' && as[s[i + j - 1]] != is_control); + if (s[i + j - 1] == '}') + jncx (&j); + putatom (j); + jnc2x (&i, j); + goto _L99; + } /*3 */ + + /* additional symbols */ + if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') + { /*3 */ + jncx (&i); + j = take_letters (); /* starts from i-th position */ + i--; + putatom (j + 1); /* takes token from i-th position */ + jnc2x (&i, j + 1); + goto _L99; + } /*3 */ + + } /*2 */ + else + { + if (c_lexics) + { /*2 */ + if (!strncmp ((char *) b123.b3, "<<=", 3) + || !strncmp ((char *) b123.b3, ">>=", 3)) + { + putatom (3L); + jnc2x (&i, 3L); + goto _L99; + } + isa = is_first_of_two; + /* !! in c case <<, >>, >=, <= will be tested further + in two_char_symbols section, hence we go to there + using assignment to "isa" */ + + } /*2 */ + /* symbols= > < */ + /* special cases for c language */ + } - } /*2*/ - } - if (pascal_lexics) { /*2*/ - /* specially takes turbo pascal directive-comments */ - if (!strncmp((char*)b123.b2, "{$", 2)) { /*3*/ - j = 0; - do { - jncx(&j); - } while (s[i + j - 1] != '}' && as[s[i + j - 1]] != is_control); - if (s[i + j - 1] == '}') - jncx(&j); - putatom(j); - jnc2x(&i, j); - goto _L99; - } /*3*/ - - /* additional symbols */ - if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') { /*3*/ - jncx(&i); - j = take_letters(); /* starts from i-th position */ - i--; - putatom(j + 1); /* takes token from i-th position */ - jnc2x(&i, j + 1); - goto _L99; - } /*3*/ - - } /*2*/ - else { - if (c_lexics) { /*2*/ - if (!strncmp((char*)b123.b3, "<<=", 3) || !strncmp((char*)b123.b3, ">>=", 3)) { - putatom(3L); - jnc2x(&i, 3L); + + } /*1 */ + /*this part never appears in mif input, since there is no is_special */ + + + + + if (tex_lexics) + { /*1 */ + if (b123.b1 == '\\') + { /*2 */ + if (as[b123.b2[1]] == is_letter) + { + /* command like \def, or \d@f \@ in sty_lexics */ + j = 1; + while (as[s[i + j - 1]] == is_letter) + jncx (&j); + /* non-loop condition: s[last_element]=' ', it is not a is_letter + character */ + putit (idatom, j); + jnc2x (&i, j); + goto _L99; + } + else + { + if (b123.b2[1] == new_line_code) + { + /* THIS ADDITIONAL IF IS ADDED 4/5/1995 (!) */ + putit (keyword, 1L); + jnc2x (&i, 1L); + goto _L99; + } + else + { + /*commands like \% \$ and so on; \@ if not sty_lexics */ + putit (keyword, 2L); + jnc2x (&i, 2L); + goto _L99; + } + } + } /*2 */ + + /*my comment: \ is included in is_special, but it makes + no any difference */ + + if (isa == is_special) + { + putit (keyword, 1L); + jncx (&i); goto _L99; } - isa = is_first_of_two; - /* !! in c case <<, >>, >=, <= will be tested further - in two_char_symbols section, hence we go to there - using assignment to "isa" */ + /*separate character like $ ( ) etc. */ - } /*2*/ - /* symbols= > < */ - /* special cases for c language */ - - } + if (b123.b1 == ' ') + { + putit (atom, 1L); + jncx (&i); + goto _L99; + } - } /*1*/ - /*this part never appears in mif input, since there is no is_special*/ - - - - - if (tex_lexics) { /*1*/ - if (b123.b1 == '\\') { /*2*/ - if (as[b123.b2[1]] == is_letter) { - /* command like \def, or \d@f \@ in sty_lexics */ - j = 1; - while (as[s[i + j - 1]] == is_letter) - jncx(&j); - /* non-loop condition: s[last_element]=' ', it is not a is_letter - character */ - putit(idatom, j); - jnc2x(&i, j); - goto _L99; - } else { - if (b123.b2[1]==new_line_code) - { - /* THIS ADDITIONAL IF IS ADDED 4/5/1995 (!) */ - putit(keyword, 1L); - jnc2x(&i, 1L); - goto _L99; - } - else - { - /*commands like \% \$ and so on; \@ if not sty_lexics */ - putit(keyword, 2L); - jnc2x(&i, 2L); - goto _L99; - } - } - } /*2*/ - - /*my comment: \ is included in is_special, but it makes - no any difference*/ - - if (isa == is_special) { - putit(keyword, 1L); - jncx(&i); - goto _L99; - } - /*separate character like $ ( ) etc. */ + /*all other characters */ + /*all other characters simply form 80-byte atoms; + end of line and end of file cannot be included to it; + tabulators are changed to spaces. */ + j = 0; + while (as[s[i + j - 1]] != is_special && j < 80 && + s[i + j - 1] != new_line_code && s[i + j - 1] != endfile_code) + { + if (s[i + j - 1] == '\t') + s[i + j - 1] = ' '; + jncx (&j); + } - if (b123.b1 == ' ') { - putit(atom, 1L); - jncx(&i); + putit (atom, j); + jnc2x (&i, j); goto _L99; - } - - /*all other characters*/ - /*all other characters simply form 80-byte atoms; - end of line and end of file cannot be included to it; - tabulators are changed to spaces.*/ - j = 0; - while (as[s[i + j - 1]] != is_special && j < 80 && - s[i + j - 1] != new_line_code && s[i + j - 1] != endfile_code) { - if (s[i + j - 1] == '\t') - s[i + j - 1] = ' '; - jncx(&j); - } - - putit(atom, j); - jnc2x(&i, j); - goto _L99; - } /*1*/ + } /*1 */ /********* description of tex lexics ********* end_of_line,(but not end_of_file) are null atom \letters is command , where letters are a-z,a-z. @@ -1351,97 +1514,100 @@ _L1: /* we return to this label if token is not ready still */ - if (isa == is_space) { - jncx(&i); - goto _L1; - } - - if (isa == is_letter) { - j = take_letters(); - putident(j); - i += j; - goto _L99; - } - - - if (isa == is_digit) { /*1*/ - if (c_lexics) { /*2*/ - /* additional symbols; here hex and octal numbers are saved as - normal atoms */ - if ((b123.b1 == '0') - && - ( - (as[b123.b2[1]] == is_letter)|| - (as[b123.b2[1]] == is_digit) || - (as[b123.b2[1]] == is_underscore) - ) - ) - - { /*3*/ - jncx(&i); - j = take_letters(); /* starts from i-th position */ - i--; - putatom(j + 1); /* takes token from i-th position */ - jnc2x(&i, j + 1); - goto _L99; - } /*3*/ - } /*2*/ - - - i_saved = i; /* remember starting position */ - aadr = take_digits(&j); - - if ( j < 10 && - ( - ( (s[i + j - 1] == '.') && - (s[i + j ] == '.') ) || - ( (s[i + j - 1] != '.') && - (s[i + j - 1] != 'E') && - (s[i + j - 1] != 'e') ) - ) - ) - { - putnumber(); - jnc2x(&i, j); - goto _L99; - } - jnc2x(&i, j); - if (s[i - 1] == '.') { - jncx(&i); - aadr = take_digits(&j); - jnc2x(&i, j); + if (isa == is_space) + { + jncx (&i); + goto _L1; } - if (s[i - 1] == 'E' || s[i - 1] == 'e') { - jncx(&i); - if (s[i - 1] == '-' || s[i - 1] == '+') - jncx(&i); - aadr = take_digits(&j); - jnc2x(&i, j); + + if (isa == is_letter) + { + j = take_letters (); + putident (j); + i += j; + goto _L99; } - j = i - i_saved; - i = i_saved; /* to set "i" to starting position */ - putfloat(j); - jnc2x(&i, j); - goto _L99; - } /*1*/ - - if (isa == is_first_of_two) { /*1*/ - if (strchr((char*)set_of_second_of_two,(int)b123.b2[1])) { - FORLIM = two_char_symbols_num; - for (j = 0; j < FORLIM; j++) { - if (b123.b2[0] == two_char_symbols[j][0] && - b123.b2[1] == two_char_symbols[j][1]) { - putatom(2L); - i += 2; + + + if (isa == is_digit) + { /*1 */ + if (c_lexics) + { /*2 */ + /* additional symbols; here hex and octal numbers are saved as + normal atoms */ + if ((b123.b1 == '0') + && + ((as[b123.b2[1]] == is_letter) || + (as[b123.b2[1]] == is_digit) || + (as[b123.b2[1]] == is_underscore))) + + { /*3 */ + jncx (&i); + j = take_letters (); /* starts from i-th position */ + i--; + putatom (j + 1); /* takes token from i-th position */ + jnc2x (&i, j + 1); + goto _L99; + } /*3 */ + } /*2 */ + + + i_saved = i; /* remember starting position */ + aadr = take_digits (&j); + + if (j < 10 && + (((s[i + j - 1] == '.') && + (s[i + j] == '.')) || + ((s[i + j - 1] != '.') && + (s[i + j - 1] != 'E') && (s[i + j - 1] != 'e')))) + { + putnumber (); + jnc2x (&i, j); goto _L99; } - } - } - } /*1*/ + jnc2x (&i, j); + if (s[i - 1] == '.') + { + jncx (&i); + aadr = take_digits (&j); + jnc2x (&i, j); + } + if (s[i - 1] == 'E' || s[i - 1] == 'e') + { + jncx (&i); + if (s[i - 1] == '-' || s[i - 1] == '+') + jncx (&i); + aadr = take_digits (&j); + jnc2x (&i, j); + } + j = i - i_saved; + i = i_saved; /* to set "i" to starting position */ + putfloat (j); + jnc2x (&i, j); + goto _L99; + } /*1 */ + + if (isa == is_first_of_two) + { /*1 */ + if (strchr ((char *) set_of_second_of_two, (int) b123.b2[1])) + { + FORLIM = two_char_symbols_num; + for (j = 0; j < FORLIM; j++) + { + if (b123.b2[0] == two_char_symbols[j][0] && + b123.b2[1] == two_char_symbols[j][1]) + { + putatom (2L); + i += 2; + goto _L99; + } + } + } + } /*1 */ - putatom(1L); - jncx(&i); /* with*/ -_L99: ; + putatom (1L); + jncx (&i); /* with */ +_L99:; @@ -1453,7 +1619,8 @@ _L99: ; -Static long take_letters() +static long +take_letters () { /****************************************/ long Result; @@ -1464,17 +1631,19 @@ Static long take_letters() unsigned char c; jj = 0; - while (true) { - c = s[i + jj - 1]; - isa = as[c]; - if (isa != is_letter && isa != is_digit && isa != is_underscore) { - Result = jj; - goto _L99; + while (true) + { + c = s[i + jj - 1]; + isa = as[c]; + if (isa != is_letter && isa != is_digit && isa != is_underscore) + { + Result = jj; + goto _L99; + } + if (to_uppercase) + s[i + jj - 1] = upcase_tab[c]; + jncx (&jj); } - if (to_uppercase) - s[i + jj - 1] = upcase_tab[c]; - jncx(&jj); - } _L99: return Result; } @@ -1482,8 +1651,9 @@ _L99: -Static long take_digits(jj) -long *jj; +static long +take_digits (jj) + long *jj; { /**************************************************/ long Result; @@ -1492,15 +1662,17 @@ long *jj; *jj = 0; summator = 0; - while (true) { - c = s[i + *jj - 1]; - if (as[c] != is_digit) { - Result = summator; - goto _L99; + while (true) + { + c = s[i + *jj - 1]; + if (as[c] != is_digit) + { + Result = summator; + goto _L99; + } + summator = summator * 10 + c - '0'; + jncx (jj); } - summator = summator * 10 + c - '0'; - jncx(jj); - } _L99: return Result; } @@ -1515,4 +1687,3 @@ _L99: /* End. */ - diff --git a/RIGAL/rigsc.446/src/scanmif.c b/RIGAL/rigsc.446/src/scanmif.c index f4df8c3c053f1b4dce66e36cdb9f0cfc788b4af7..51d4e6e20421edfb3f3127b0420ba9bbb3f4dde4 100644 --- a/RIGAL/rigsc.446/src/scanmif.c +++ b/RIGAL/rigsc.446/src/scanmif.c @@ -4,14 +4,14 @@ #include "scan.h" #include "nef2.h" - /*4-jul-93 invented maxline as length of input line*/ + /*4-jul-93 invented maxline as length of input line */ /* 6-dec-93: user can set on or off definition "bbs" */ /* University of New Mexico: #define bbs - Other places where bbs filter is not used: - / * #define bbs * / + Other places where bbs filter is not used: + / * #define bbs * / - september-95 (release rig444c) + september-95 (release rig444c) Added processing for cases when a newline appears within FrameMaker string constants. @@ -24,10 +24,10 @@ #define maxline 255 -typedef Char bigstring[maxline + 1]; +typedef char bigstring[maxline + 1]; -#define new_line_code '\015' /* chr(0 is allowed too */ +#define new_line_code '\015' /* chr(0 is allowed too */ #define endfile_code '\032' #define is_control 0 @@ -40,91 +40,94 @@ typedef Char bigstring[maxline + 1]; #define is_first_of_two 7 -typedef Char pair[2]; +typedef char pair[2]; - a a1; /* global variable for only local use */ +a a1; /* global variable for only local use */ /*aa1 : aa ;*/ /* --"-- */ - mpd x; /* --"-- */ - bl80 bl801; +mpd x; /* --"-- */ +bl80 bl801; /* -- " -- */ /* array[1..80] of char*/ - long k, kk; /* -"- */ - Char c1; +long k, kk; /* -"- */ +char c1; - word saved_coord; /* where current token_ began */ - word coord_mark; /* what was set by coordinate marker */ - word line_byte_number; +word saved_coord; /* where current token_ began */ +word coord_mark; /* what was set by coordinate marker */ +word line_byte_number; /* number of totally read bytes till beginning of current line */ - word last_mark_byte_number; +word last_mark_byte_number; /* number of totally read bytes till last coordinate marker */ /* length of the current line, used only for incrementation of "lyne_byte_number"*/ - word old_line_length; - Char dt; +word old_line_length; +char dt; /* type of last read token_ or control character */ - a aadr; /* a-space address of last read token_ */ - longint linenumber; /* current line number */ - longint tokennumber; /* current token_ number */ - a errlist; /* list of numbers of errors */ - long read_mode; /* 1,2,3 */ - ptr_ ptr1; /* list pointer when read from list of atoms */ - - FILE *inpfile; - boolean c_lexics, pascal_lexics, row80_coord, byte_coord, - mark_byte_coord, mark_only_coord, string_coord, char_coord, - token_coord, collect_errors, screen_errors, to_uppercase, - pascal_comment, c_comment, ada_comment, pascal_string, - modula_string; - bigstring s, s_for_val; /* added 17-feb-92 */ - long i; - char as[256]; - char isa; - Char upcase_tab[256]; - char set_of_second_of_two[9]; - long two_char_symbols_num; - pair two_char_symbols[30]; - - union { - Char b1; - Char b2[2]; - Char b3[3]; +a aadr; /* a-space address of last read token_ */ +longint linenumber; /* current line number */ +longint tokennumber; /* current token_ number */ +a errlist; /* list of numbers of errors */ +long read_mode; /* 1,2,3 */ +ptr_ ptr1; /* list pointer when read from list of atoms */ + +FILE *inpfile; +bool c_lexics, pascal_lexics, row80_coord, byte_coord, + mark_byte_coord, mark_only_coord, string_coord, char_coord, + token_coord, collect_errors, screen_errors, to_uppercase, + pascal_comment, c_comment, ada_comment, pascal_string, modula_string; +bigstring s, s_for_val; /* added 17-feb-92 */ +long i; +char as[256]; +char isa; +char upcase_tab[256]; +char set_of_second_of_two[9]; +long two_char_symbols_num; +pair two_char_symbols[30]; + +union +{ + char b1; + char b2[2]; + char b3[3]; } b123; - boolean in_comment, in_string, is_2quote; +bool in_comment, in_string, is_2quote; /* if in_string then it is possible */ - longint str_constlen; - string80 str_const; /* array of char is allowed too */ +longint str_constlen; +string80 str_const; /* array of char is allowed too */ /*===== sun version ===*/ -Static Void jnc_(xxx) -long *xxx; +static void +jnc_ (xxx) + long *xxx; { (*xxx)++; } /* -Static Void jnc2_(xxx, yyy) +static void jnc2_(xxx, yyy) long *xxx, yyy; { *xxx += yyy; } */ -Static Void jncx_(xxx) -long *xxx; +static void +jncx_ (xxx) + long *xxx; { (*xxx)++; } -Static Void jnc2x_(xxx, yyy) -long *xxx, yyy; +static void +jnc2x_ (xxx, yyy) + long *xxx, yyy; { *xxx += yyy; } @@ -132,43 +135,43 @@ long *xxx, yyy; /*=====*/ -Static Char cont_char_to_dt_ PP((int c)); +static char cont_char_to_dt_ PP ((int c)); -Static word getcoord_ PV(); +static word getcoord_ PV (); -Static Void er_lex_ PP((long er_number)); +static void er_lex_ PP ((long er_number)); /*procedure initialize_scan_variables;forward;*/ -Static Void read_file_ PP((long *read_file_rez)); +static void read_file_ PP ((long *read_file_rez)); -Static long read_item_ PP((long *pghead)); +static long read_item_ PP ((long *pghead)); -Static Void readline_ PV(); +static void readline_ PV (); -Static Void putatom_ PP((long j)); +static void putatom_ PP ((long j)); -Static Void putit_ PP((Char dd, long j)); +static void putit_ PP ((char dd, long j)); -Static Void putident_ PP((long j)); +static void putident_ PP ((long j)); -Static Void putfloat_ PP((long j)); +static void putfloat_ PP ((long j)); -Static Void putnumber_ PV(); +static void putnumber_ PV (); -Static Void putstr_ PP((Char dd)); +static void putstr_ PP ((char dd)); /*procedure scaner;forward;*/ -Static Void setlexics_ PV(); +static void setlexics_ PV (); -Static Void stradd_ PP((int c)); +static void stradd_ PP ((int c)); -Static Void strbegin_ PV(); +static void strbegin_ PV (); -Static Void token_ PV(); +static void token_ PV (); -Static long take_digits_ PP((long *jj)); +static long take_digits_ PP ((long *jj)); -Static long take_letters_ PV(); +static long take_letters_ PV (); @@ -184,7 +187,7 @@ Static long take_letters_ PV(); -> lconc.nef er_lex_ -> setoptions gets1.defpage -> first.nef token_ - -> assign.system pointr.defpage + -> assign.system assert_and_assign_real_pointer .defpage -> reset.system lconc.nef -> readline_ @@ -203,13 +206,14 @@ Static long take_letters_ PV(); -Static Char cont_char_to_dt_(c) -Char c; +static char +cont_char_to_dt_ (c) + char c; { /************************************************/ - Char Result; + char Result; - Result = (Char)c; + Result = (char) c; if (c == '<') Result = start_list; @@ -220,110 +224,125 @@ Char c; } -Static word getcoord_() +static word +getcoord_ () { /*************************/ if (row80_coord) return (i + linenumber * 80); - else { - if (mark_only_coord) - return coord_mark; - else { - if (mark_byte_coord) - return (coord_mark + line_byte_number + i - last_mark_byte_number); - else { - if (byte_coord) - return (line_byte_number + i); - else { - if (string_coord) - return linenumber; - else { - if (token_coord) - return tokennumber; - else - return 0; - } + else + { + if (mark_only_coord) + return coord_mark; + else + { + if (mark_byte_coord) + return (coord_mark + line_byte_number + i - + last_mark_byte_number); + else + { + if (byte_coord) + return (line_byte_number + i); + else + { + if (string_coord) + return linenumber; + else + { + if (token_coord) + return tokennumber; + else + return 0; + } + } + } } - } } - } } -Static Void er_lex_(er_number) -long er_number; +static void +er_lex_ (er_number) + long er_number; { /*************************************/ a er_atom; word co; numberdescriptor *WITH; - co = getcoord_(); - if (collect_errors) { - gets1(&er_atom, &x.sa); - WITH = x.snd; /*global*/ - WITH->dtype = number; - WITH->cord = co; - WITH->val = er_number; - lconc(&errlist, er_atom); - } + co = getcoord_ (); + if (collect_errors) + { + gets1 (&er_atom, &x.sa); + WITH = x.snd; /*global */ + WITH->dtype = number; + WITH->cord = co; + WITH->val = er_number; + lconc (&errlist, er_atom); + } if (screen_errors) - printf("Lexical error (%12ld) line=%12d column=%12d\n", - er_number, co / 80, co % 80); + printf ("Lexical error (%12ld) line=%12d column=%12d\n", + er_number, co / 80, co % 80); } -Void initialize_scan_variables_mif() +void +initialize_scan_variables_mif () { /*************************************/ - Char c; + char c; short TEMP; - for (TEMP = '\0'; TEMP <= 255; TEMP++) { - c = TEMP; - upcase_tab[(int) c] = c; - } - for (c = 'a'; c <= 'z'; c++) /*ascii*/ - upcase_tab[(int) c] = c - 32; - for (TEMP = 160; TEMP <= 175; TEMP++) { - c = TEMP; + for (TEMP = '\0'; TEMP <= 255; TEMP++) + { + c = TEMP; + upcase_tab[(int) c] = c; + } + for (c = 'a'; c <= 'z'; c++) /*ascii */ upcase_tab[(int) c] = c - 32; - } - /*russian*/ - for (TEMP = 224; TEMP <= 239; TEMP++) { - c = TEMP; - upcase_tab[(int) c] = c - 60; - } - /*russian*/ + for (TEMP = 160; TEMP <= 175; TEMP++) + { + c = TEMP; + upcase_tab[(int) c] = c - 32; + } + /*russian */ + for (TEMP = 224; TEMP <= 239; TEMP++) + { + c = TEMP; + upcase_tab[(int) c] = c - 60; + } + /*russian */ for (c = '\0'; c <= '\037'; c++) as[(int) c] = is_control; - for (TEMP = 128; TEMP <= 255; TEMP++) { - c = TEMP; - as[(int) c] = is_letter; - } + for (TEMP = 128; TEMP <= 255; TEMP++) + { + c = TEMP; + as[(int) c] = is_letter; + } /* russian and pseudographics */ - for (TEMP = ' '; TEMP <= '\177'; TEMP++) { - c = TEMP; - /* not used actually */ + for (TEMP = ' '; TEMP <= '\177'; TEMP++) + { + c = TEMP; + /* not used actually */ - as[(int) c] = is_printable; - } + as[(int) c] = is_printable; + } as[new_line_code] = is_control; as[' '] = is_space; as['\t'] = is_space; /* these are allowed to be first letter of identifiers */ for (c = 'A'; c <= 'Z'; c++) - as[(int)c] = is_letter; + as[(int) c] = is_letter; for (c = 'a'; c <= 'z'; c++) - as[(int)c] = is_letter; + as[(int) c] = is_letter; for (c = '0'; c <= '9'; c++) - as[(int)c] = is_digit; + as[(int) c] = is_digit; /* allowed to be non-first letter of odentifier */ as['_'] = is_underscore; @@ -338,34 +357,40 @@ Void initialize_scan_variables_mif() -Static Void read_file_(read_file_rez) -long *read_file_rez; +static void +read_file_ (read_file_rez) + long *read_file_rez; { /********************************/ /* reads whole input, produces list of items */ a head; *read_file_rez = null_; - do { - a1 = read_item_(&head); - if (dt == start_tree || dt == end_tree || dt == start_list || - dt == end_list || dt == name_obj) { - er_lex_(6L); - goto _L99; - } - if (dt != eof_desk) { - if (head != null_) - lconc(read_file_rez, head); - lconc(read_file_rez, a1); + do + { + a1 = read_item_ (&head); + if (dt == start_tree || dt == end_tree || dt == start_list || + dt == end_list || dt == name_obj) + { + er_lex_ (6L); + goto _L99; + } + if (dt != eof_desk) + { + if (head != null_) + lconc (read_file_rez, head); + lconc (read_file_rez, a1); + } } - } while (dt != eof_desk); -_L99: ; + while (dt != eof_desk); +_L99:; } -Static long read_item_(pghead) -long *pghead; +static long +read_item_ (pghead) + long *pghead; { /**********************/ long Result; @@ -373,149 +398,168 @@ long *pghead; atomdescriptor *WITH; numberdescriptor *WITH1; - Result = null_; /* default value for exits with errors */ + Result = null_; /* default value for exits with errors */ *pghead = null_; result = null_; - token_(); - - /*writeln('DT=',dt,ord(dt));*/ - - switch (dt) { - - case atom: - case idatom: - case tatom: - case fatom: - case keyword: - gets1(&result, &x.sa); - WITH = x.sad; - WITH->dtype = dt; - WITH->cord = saved_coord; - WITH->name = aadr; - break; - - case number: - gets1(&result, &x.sa); - WITH1 = x.snd; - WITH1->dtype = dt; - WITH1->cord = saved_coord; - WITH1->val = aadr; /* is set in token_ .. is_digit */ - break; - - case dummy: - result = null_; - break; - - case start_tree: - result = null_; - do { - token_(); - aadr1 = aadr; /* to save */ - if (dt == idatom || dt == atom || dt == tatom || dt == keyword) { - /* what is allowed selector in scaner input ? - normally - idatom only, but here - atom is allowed too - for experiment purposes */ - a1 = read_item_(&dum); - if (dt == end_list) { - er_lex_(6L); - goto _L99; + token_ (); + + /*writeln('DT=',dt,ord(dt)); */ + + switch (dt) + { + + case atom: + case idatom: + case tatom: + case fatom: + case keyword: + gets1 (&result, &x.sa); + WITH = x.sad; + WITH->dtype = dt; + WITH->cord = saved_coord; + WITH->name = aadr; + break; + + case number: + gets1 (&result, &x.sa); + WITH1 = x.snd; + WITH1->dtype = dt; + WITH1->cord = saved_coord; + WITH1->val = aadr; /* is set in token_ .. is_digit */ + break; + + case dummy: + result = null_; + break; + + case start_tree: + result = null_; + do + { + token_ (); + aadr1 = aadr; /* to save */ + if (dt == idatom || dt == atom || dt == tatom || dt == keyword) + { + /* what is allowed selector in scaner input ? + normally - idatom only, but here + atom is allowed too - for experiment purposes */ + a1 = read_item_ (&dum); + if (dt == end_list) + { + er_lex_ (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex_ (1L); + goto _L99; + } + addel3 (&result, aadr1, a1); + } + else if (dt != end_tree) + { + er_lex_ (2L); + goto _L99; + } } - if (dt == eof_desk) { - er_lex_(1L); + while (dt != end_tree && dt != eof_desk); + if (dt == eof_desk) + { + er_lex_ (3L); goto _L99; } - addel3(&result, aadr1, a1); - } else if (dt != end_tree) { - er_lex_(2L); - goto _L99; - } - } while (dt != end_tree && dt != eof_desk); - if (dt == eof_desk) { - er_lex_(3L); - goto _L99; - } - dt = complex_desk; - /* to ignore analysis in upper level of - recursion */ - break; - - case start_list: - result = null_; - - *pghead = read_item_(&dum); - do { - a1 = read_item_(&head); - if (dt == eof_desk) { - er_lex_(4L); - goto _L99; - } - if (dt != end_list) { - if (head != null_) - lconc(&result, head); - lconc(&result, a1); - } - } while (dt != end_list); - - - dt = complex_desk; - break; - - case end_tree: - er_lex_(5L); - goto _L99; - break; - - case end_list: - break; - /*immodiately returns to the upper level*/ - - case name_obj: - temp_res = read_item_(&dum); - if (dt == end_list) { - er_lex_(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex_(7L); - goto _L99; - } - result = read_item_(&dum); - if (dt == end_list) { - er_lex_(6L); - goto _L99; - } - if (dt == eof_desk) { - er_lex_(8L); + dt = complex_desk; + /* to ignore analysis in upper level of + recursion */ + break; + + case start_list: + result = null_; + + *pghead = read_item_ (&dum); + do + { + a1 = read_item_ (&head); + if (dt == eof_desk) + { + er_lex_ (4L); + goto _L99; + } + if (dt != end_list) + { + if (head != null_) + lconc (&result, head); + lconc (&result, a1); + } + } + while (dt != end_list); + + + dt = complex_desk; + break; + + case end_tree: + er_lex_ (5L); goto _L99; - } - if (result != null_) { - points(result, &x.sa); - if (x.smld->dtype == listmain || x.smtd->dtype == treemain) - x.smtd->name = temp_res; - } - dt = complex_desk; - break; + break; - case eof_desk: - break; - /* returns to the upper level */ + case end_list: + break; + /*immodiately returns to the upper level */ + case name_obj: + temp_res = read_item_ (&dum); + if (dt == end_list) + { + er_lex_ (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex_ (7L); + goto _L99; + } + result = read_item_ (&dum); + if (dt == end_list) + { + er_lex_ (6L); + goto _L99; + } + if (dt == eof_desk) + { + er_lex_ (8L); + goto _L99; + } + if (result != null_) + { + assert_and_assign_real_pointer (result, &x.sa); + if (x.smld->dtype == listmain || x.smtd->dtype == treemain) + x.smtd->name = temp_res; + } + dt = complex_desk; + break; + case eof_desk: + break; + /* returns to the upper level */ - default: - er_lex_(9L); - goto _L99; /* impossible value */ - break; - }/* case */ + + + default: + er_lex_ (9L); + goto _L99; /* impossible value */ + break; + } /* case */ Result = result; _L99: return Result; -} /* read_item_ */ +} /* read_item_ */ -Static Void readline_() +static void +readline_ () { /*****************************/ /* sets new values for "s" and "i" global variables */ @@ -524,58 +568,73 @@ Static Void readline_() i = 1; /* in any case, so; only here it is initialized. - it is column number. - variable "s" is string only for speed purposes; - it plays exactly as packed array of char, - never used as whole and the length byte is never used */ + it is column number. + variable "s" is string only for speed purposes; + it plays exactly as packed array of char, + never used as whole and the length byte is never used */ linenumber++; line_byte_number += old_line_length; - if (read_mode == 1) { - if (feof(inpfile)) - s[0] = endfile_code; - else { - /*readln(inpfile,s);*/ - if ( fgets(s, maxline-1 ,inpfile) ) - { if (strlen(s) >= maxline - 2) - printf(" FATAL ERROR: Line %12ld too long !\n", linenumber); - /* printf("\n Input=<%s> \n",s); */ - s[strlen(s)-1] = new_line_code; - old_line_length = strlen(s); - } - else s[0] = endfile_code; - - } - } else { - if (read_mode == 2) { - if (ptr1.nel == 0) { + if (read_mode == 1) + { + if (feof (inpfile)) s[0] = endfile_code; - goto _L99; - } - if (ptr1.cel == 0) { - s[0] = new_line_code; - old_line_length = 0; - } else { - pointr(ptr1.cel, &x.sa); - WITH = x.sad; /* with */ - if (WITH->dtype == atom || WITH->dtype == idatom || - WITH->dtype == fatom || - WITH->dtype == tatom || WITH->dtype == keyword) { - pointa(WITH->name, bl801, &k); - FORLIM = k; - for (kk = 1; kk <= FORLIM; kk++) - s[kk - 1] = bl801[kk - 1]; - old_line_length = k; - s[k] = new_line_code; - } else { - s[0] = new_line_code; /* other objects are ignored */ - old_line_length = 0; + else + { + /*readln(inpfile,s); */ + if (fgets (s, maxline - 1, inpfile)) + { + if (strlen (s) >= maxline - 2) + printf (" FATAL ERROR: Line %12ld too long !\n", linenumber); + /* printf("\n Input=<%s> \n",s); */ + s[strlen (s) - 1] = new_line_code; + old_line_length = strlen (s); + } + else + s[0] = endfile_code; + } - } /* <>0 */ - next(&ptr1); + } + else + { + if (read_mode == 2) + { + if (ptr1.nel == 0) + { + s[0] = endfile_code; + goto _L99; + } + if (ptr1.cel == 0) + { + s[0] = new_line_code; + old_line_length = 0; + } + else + { + assert_and_assign_real_pointer (ptr1.cel, &x.sa); + WITH = x.sad; /* with */ + if (WITH->dtype == atom || WITH->dtype == idatom || + WITH->dtype == fatom || + WITH->dtype == tatom || WITH->dtype == keyword) + { + get_data_from_pointa (WITH->name, bl801, &k); + FORLIM = k; + for (kk = 1; kk <= FORLIM; kk++) + s[kk - 1] = bl801[kk - 1]; + old_line_length = k; + s[k] = new_line_code; + } + else + { + s[0] = new_line_code; /* other objects are ignored */ + old_line_length = 0; + } + } /* <>0 */ + next (&ptr1); - } /*=2*/ - } -_L99: ; + } + /*=2*/ + } +_L99:; } @@ -584,111 +643,122 @@ _L99: ; -Static Void putatom_(j) -long j; +static void +putatom_ (j) + long j; { /*************************/ - putit_(atom, j); + putit_ (atom, j); } -Static Void putit_(dd, j) -Char dd; -long j; +static void +putit_ (dd, j) + char dd; + long j; { /*************************/ - putatm(&s[i - 1], j, &aadr); + putatm (&s[i - 1], j, &aadr); dt = dd; - saved_coord = getcoord_(); + saved_coord = getcoord_ (); tokennumber++; } -Static Void putident_(j) -long j; +static void +putident_ (j) + long j; { /*************************/ - putit_(idatom, j); + putit_ (idatom, j); } -Static Void putfloat_(j) -long j; -{ /*ignored*/ +static void +putfloat_ (j) + long j; +{ /*ignored */ /*************************/ double rea_val; long ii, kk; real_char reac; - Char STR1[256]; + char STR1[256]; - sprintf(STR1, "%.*s", (int)j, s + i - 1); - val2(STR1, &rea_val, &ii); - ii = sizeof(double); + sprintf (STR1, "%.*s", (int) j, s + i - 1); + val2 (STR1, &rea_val, &ii); + ii = sizeof (double); for (kk = 0; kk < ii; kk++) - reac[kk] = ((Char *)(&rea_val))[kk]; + reac[kk] = ((char *) (&rea_val))[kk]; - putatm(reac, ii, &aadr); + putatm (reac, ii, &aadr); dt = fatom; - saved_coord = getcoord_(); - jnc_(&tokennumber); + saved_coord = getcoord_ (); + jnc_ (&tokennumber); } -Static Void putnumber_() +static void +putnumber_ () { /*************************/ dt = number; - saved_coord = getcoord_(); - jnc_(&tokennumber); + saved_coord = getcoord_ (); + jnc_ (&tokennumber); } -Static Void putstr_(dd) -Char dd; +static void +putstr_ (dd) + char dd; { /*************************/ - if (str_constlen > 80) { - str_constlen = 80; - dt = keyword; /* too long string constant */ - er_lex_(10L); - } else + if (str_constlen > 80) + { + str_constlen = 80; + dt = keyword; /* too long string constant */ + er_lex_ (10L); + } + else dt = dd; - putatm(str_const, str_constlen, &aadr); + putatm (str_const, str_constlen, &aadr); in_string = false; tokennumber++; if (str_constlen == 0) dt = dummy; - /* string constants of 0 length are converted to null*/ + /* string constants of 0 length are converted to null */ } -/* Local variables for scaner_mif: */ -struct LOC_scaner_mif { +/* static variables for scaner_mif: */ +struct LOC_scaner_mif +{ string80 options_str; -} ; +}; /*inner function*/ -Local boolean setop(c, LINK) -Char c; -struct LOC_scaner_mif *LINK; +static bool +setop (c, LINK) + char c; + struct LOC_scaner_mif *LINK; { - boolean Result; - char * tmp; + bool Result; + char *tmp; Result = false; - tmp=strchr(LINK->options_str,c); + tmp = strchr (LINK->options_str, c); - if ( tmp ) { - if (tmp[1] != '-') /* Check next position */ - return true; - } + if (tmp) + { + if (tmp[1] != '-') /* Check next position */ + return true; + } - return Result; + return Result; } @@ -703,15 +773,16 @@ struct LOC_scaner_mif *LINK; -Void scaner_mif(mode_parm, filename_, options_str_, rez, erlist_parm, strlist, - segm, ofs) -long mode_parm; -Char *filename_, *options_str_; -long *rez, *erlist_parm, strlist, segm, ofs; +void +scaner_mif (mode_parm, filename_, options_str_, rez, erlist_parm, strlist, + segm, ofs) + long mode_parm; + char *filename_, *options_str_; + long *rez, *erlist_parm, strlist, segm, ofs; { /*******************************************/ - /*1=from file,2=list of strings,3=absulute address*/ + /*1=from file,2=list of strings,3=absulute address */ /* result; set to null if input is absent */ /* error number list; set to null if no error */ /* list of atoms */ @@ -720,50 +791,50 @@ long *rez, *erlist_parm, strlist, segm, ofs; string80 filename; - strcpy(filename, filename_); - strcpy(V.options_str, options_str_); - read_mode = mode_parm; /* save for global use */ + strcpy (filename, filename_); + strcpy (V.options_str, options_str_); + read_mode = mode_parm; /* save for global use */ *rez = null_; *erlist_parm = null_; - errlist = null_; /* global */ + errlist = null_; /* global */ /* initializes all options */ /* defaults */ - strcat(V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); + strcat (V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-"); /* to every option su,me default value should be given, otherwise the flag remains uninitialized */ - /*errors*/ - screen_errors = setop('S', &V); - collect_errors = setop('O', &V); + /*errors */ + screen_errors = setop ('S', &V); + collect_errors = setop ('O', &V); - /*comments*/ - ada_comment = setop('D', &V); - c_comment = setop('C', &V); - pascal_comment = setop('P', &V); + /*comments */ + ada_comment = setop ('D', &V); + c_comment = setop ('C', &V); + pascal_comment = setop ('P', &V); - /*string constants*/ - pascal_string = setop('p', &V); - modula_string = setop('m', &V); - to_uppercase = setop('U', &V); + /*string constants */ + pascal_string = setop ('p', &V); + modula_string = setop ('m', &V); + to_uppercase = setop ('U', &V); - /*coordinate*/ - string_coord = setop('s', &V); - token_coord = setop('t', &V); - row80_coord = setop('R', &V); - byte_coord = setop('Y', &V); - mark_byte_coord = setop('B', &V); - mark_only_coord = setop('N', &V); + /*coordinate */ + string_coord = setop ('s', &V); + token_coord = setop ('t', &V); + row80_coord = setop ('R', &V); + byte_coord = setop ('Y', &V); + mark_byte_coord = setop ('B', &V); + mark_only_coord = setop ('N', &V); - /*language_specific lexics*/ - c_lexics = setop('L', &V); - pascal_lexics = setop('A', &V); + /*language_specific lexics */ + c_lexics = setop ('L', &V); + pascal_lexics = setop ('A', &V); /* initializes language-specific settings */ - setlexics_(); + setlexics_ (); - /* initializes "session" flags (alf order)*/ + /* initializes "session" flags (alf order) */ coord_mark = 0; in_comment = false; in_string = false; @@ -777,45 +848,53 @@ long *rez, *erlist_parm, strlist, segm, ofs; /* initializes physical level reading */ - if (read_mode == 1) { /* read from file */ - if (!existfile(filename)) { - *rez = 0; - goto _L1; - } + if (read_mode == 1) + { /* read from file */ + if (!existfile (filename)) + { + *rez = 0; + goto _L1; + } - inpfile = fopen(filename, "r"); - if (inpfile == NULL) - _EscIO(FileNotFound); - - readline_(); /* reads first line of file */ - } else { - if (read_mode == 2) { /* read from list */ - if (strlist == null_) { - *rez = 0; - goto _L99; - } - first(strlist, &ptr1); /* sets global list-pointer ptr1 */ - if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) { - *rez = 0; - goto _L99; - } - readline_(); /* reads line from current list-pointer position */ - /* read from ms-dos ram memory */ + inpfile = fopen (filename, "r"); + if (inpfile == NULL) + _EscIO (FileNotFound); + + readline_ (); /* reads first line of file */ + } + else + { + if (read_mode == 2) + { /* read from list */ + if (strlist == null_) + { + *rez = 0; + goto _L99; + } + first (strlist, &ptr1); /* sets global list-pointer ptr1 */ + if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) + { + *rez = 0; + goto _L99; + } + readline_ (); /* reads line from current list-pointer position */ + /* read from ms-dos ram memory */ + } } - } - read_file_(rez); /* main call ... */ + read_file_ (rez); /* main call ... */ - *erlist_parm = errlist; /*global*/ + *erlist_parm = errlist; /*global */ _L1: -_L99: ; -} /* scaner */ +_L99:; +} /* scaner */ -Static Void setlexics_() +static void +setlexics_ () { /*************************/ @@ -823,7 +902,7 @@ Static Void setlexics_() as['>'] = is_control; goto _L99; - /* changes in standard, necessary for pascal*/ + /* changes in standard, necessary for pascal */ /* p2c: scanmif.pas: Note: Deleting unreachable code [255] */ /* used to process <<= */ /* used to process >>= */ @@ -831,29 +910,31 @@ Static Void setlexics_() /* otherwise isa:=is_first_of_two is assigned ! */ -_L99: ; +_L99:; } -Static Void stradd_(c) -Char c; +static void +stradd_ (c) + char c; { /*************************/ - if (str_constlen > 80) /* string is truncated */ - er_lex_(10L); + if (str_constlen > 80) /* string is truncated */ + er_lex_ (10L); else - jnc_(&str_constlen); + jnc_ (&str_constlen); str_const[str_constlen - 1] = c; } -Static Void strbegin_() +static void +strbegin_ () { /********************/ - saved_coord = getcoord_(); - /* it will be used when putstr_ works and token_ exits - in read_item_*/ + saved_coord = getcoord_ (); + /* it will be used when putstr_ works and token_ exits - in read_item_ */ in_string = true; str_constlen = 0; } @@ -862,145 +943,164 @@ Static Void strbegin_() -Static Void token_() -{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ +static void +token_ () +{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */ /**********************/ - long j, i_saved; /* positions */ + long j, i_saved; /* positions */ long FORLIM; /* at beginning time "i" - is already set to character in string "s"; array "as" is already initialized; coordinate mode "coord_mode" is already known; - */ + */ -_L1: /* we return to this label if token_ is not ready still */ +_L1: /* we return to this label if token_ is not ready still */ b123.b1 = s[i - 1]; - isa = as[(int) b123.b1]; /* type of this character */ - - - if (isa == is_control) { /*1*/ - if (b123.b1 == new_line_code) { - readline_(); /* skips to next line, sets new "s" and "i" */ - if (in_string) { - /* This place modified 13/9/95 */ - if (str_constlen == 81) /*An atom just have been produced last time and buffer is empty */ - {str_constlen = 0; - goto _L1; - } - else - { - putstr_(atom); /* newline serves as end of atom*/ - strbegin_(); /*initializes buffer */ - is_2quote = false; - goto _L99; /*next time we contiue to read from the string*/ - } - } - - /* End of modified place */ - goto _L1; - } - /*never here*/ - if (b123.b1 == endfile_code) { - if (in_comment) - er_lex_(12L); - /* error = end of file appears in comment */ - dt = eof_desk; - goto _L99; - } - /* others are control characters; */ - /* they set "dt" field and then form rigal list/tree structure */ - - if (!in_string) { /*2*/ - if (in_comment) { - er_lex_(13L); - in_comment = false; - } - /* error = control char in comment */ - if (in_string) { - er_lex_(14L); - putstr_(keyword); - goto _L99; - /* will take control character next time */ - } - /* error = control char in string */ - dt = cont_char_to_dt_(b123.b1); - i++; - if (dt == set_coord && as[(int) s[i - 1]] == is_digit) { - /* this control character sets coordinate to value given in input */ - coord_mark = take_digits_(&j); - last_mark_byte_number = line_byte_number + i; - i += j; - goto _L1; /* does not returns ! */ - - } - goto _L99; - } /*2*/ + isa = as[(int) b123.b1]; /* type of this character */ + + + if (isa == is_control) + { /*1 */ + if (b123.b1 == new_line_code) + { + readline_ (); /* skips to next line, sets new "s" and "i" */ + if (in_string) + { + /* This place modified 13/9/95 */ + if (str_constlen == 81) /*An atom just have been produced last time and buffer is empty */ + { + str_constlen = 0; + goto _L1; + } + else + { + putstr_ (atom); /* newline serves as end of atom */ + strbegin_ (); /*initializes buffer */ + is_2quote = false; + goto _L99; /*next time we contiue to read from the string */ + } + } + + /* End of modified place */ + goto _L1; + } + /*never here */ + if (b123.b1 == endfile_code) + { + if (in_comment) + er_lex_ (12L); + /* error = end of file appears in comment */ + dt = eof_desk; + goto _L99; + } + /* others are control characters; */ + /* they set "dt" field and then form rigal list/tree structure */ + + if (!in_string) + { /*2 */ + if (in_comment) + { + er_lex_ (13L); + in_comment = false; + } + /* error = control char in comment */ + if (in_string) + { + er_lex_ (14L); + putstr_ (keyword); + goto _L99; + /* will take control character next time */ + } + /* error = control char in string */ + dt = cont_char_to_dt_ (b123.b1); + i++; + if (dt == set_coord && as[(int) s[i - 1]] == is_digit) + { + /* this control character sets coordinate to value given in input */ + coord_mark = take_digits_ (&j); + last_mark_byte_number = line_byte_number + i; + i += j; + goto _L1; /* does not returns ! */ + + } + goto _L99; + } /*2 */ - } /*1*/ + } /*1 */ /* all the following executes after check of is_control */ - /*b3[1]:=s[i];*/ + /*b3[1]:=s[i]; */ /* this character */ - b123.b3[1] = s[i]; /* next */ - b123.b3[2] = s[i + 1]; /* next */ - - if (in_comment) /* check for end of comment */ - { /*1*/ - /* we are in comment; - here only comments that have some special end mark are processed */ - if (pascal_comment) { /*2*/ - if (b123.b1 == '}') { - jncx_(&i); - in_comment = false; - goto _L1; - } - - - - if (!strncmp(b123.b2, "*)", 2)) { - jnc2x_(&i, 2L); - in_comment = false; - goto _L1; - } - - - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp(b123.b2, "*/", 2)) { - jnc2x_(&i, 2L); - in_comment = false; - goto _L1; + b123.b3[1] = s[i]; /* next */ + b123.b3[2] = s[i + 1]; /* next */ + + if (in_comment) /* check for end of comment */ + { /*1 */ + /* we are in comment; + here only comments that have some special end mark are processed */ + if (pascal_comment) + { /*2 */ + if (b123.b1 == '}') + { + jncx_ (&i); + in_comment = false; + goto _L1; + } + + + + if (!strncmp (b123.b2, "*)", 2)) + { + jnc2x_ (&i, 2L); + in_comment = false; + goto _L1; + } + + + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp (b123.b2, "*/", 2)) + { + jnc2x_ (&i, 2L); + in_comment = false; + goto _L1; + } + } /*2 */ } - } /*2*/ - } - jncx_(&i); - goto _L1; - } /*1*/ - /*this part never appears in mif input, since there is no in_comment status*/ + jncx_ (&i); + goto _L1; + } /*1 */ + /*this part never appears in mif input, since there is no in_comment status */ - if (in_string) { /*1*/ - if (b123.b1 == '\'') { - if (str_constlen == 81) { - /*constant ends after special character or in 80 character*/ - strbegin_(); /*sets str_constlen to 0*/ - is_2quote = false; - } + if (in_string) + { /*1 */ + if (b123.b1 == '\'') + { + if (str_constlen == 81) + { + /*constant ends after special character or in 80 character */ + strbegin_ (); /*sets str_constlen to 0 */ + is_2quote = false; + } - putstr_(atom); - jncx_(&i); - goto _L99; - } + putstr_ (atom); + jncx_ (&i); + goto _L99; + } - /*end if mif constant*/ + /*end if mif constant */ /* THIS PIECE WAS INSERTED MANUALLY FOR BBS VERSION ! */ @@ -1016,204 +1116,216 @@ _L1: /* we return to this label if token_ is not ready still */ then new IDENT-atom is created. It contains only 'letters', without \ */ - if (b123.b1 == '\\') { - if (b123.b2[1] == '\\') { - stradd_(b123.b2[1]); - jnc2x_(&i, 2L); - goto _L1; - } - if (b123.b2[1] == '>') { - stradd_(b123.b2[1]); - jnc2x_(&i, 2L); - goto _L1; - } - if (b123.b2[1] == 'x' && b123.b3[2] == 'd' && - (s[i + 2] == '5' || s[i + 2] == '4' || s[i + 2] == '2')) { - switch (s[i + 2]) { - - case '2': - stradd_('"'); - break; - - case '4': /* you can choose symbol here */ - stradd_('`'); - break; - - case '5': - stradd_('\''); - break; + if (b123.b1 == '\\') + { + if (b123.b2[1] == '\\') + { + stradd_ (b123.b2[1]); + jnc2x_ (&i, 2L); + goto _L1; + } + if (b123.b2[1] == '>') + { + stradd_ (b123.b2[1]); + jnc2x_ (&i, 2L); + goto _L1; + } + if (b123.b2[1] == 'x' && b123.b3[2] == 'd' && + (s[i + 2] == '5' || s[i + 2] == '4' || s[i + 2] == '2')) + { + switch (s[i + 2]) + { + + case '2': + stradd_ ('"'); + break; + + case '4': /* you can choose symbol here */ + stradd_ ('`'); + break; + + case '5': + stradd_ ('\''); + break; + } + jnc2x_ (&i, 4L); + goto _L1; + } + /* unregistred control sequence */ + putstr_ (atom); + jncx_ (&i); /* symbol \ is ignored */ + in_string = true; + str_constlen = 82; /* special value, normally impossible */ + goto _L99; } - jnc2x_(&i, 4L); - goto _L1; - } - /* unregistred control sequence */ - putstr_(atom); - jncx_(&i); /* symbol \ is ignored */ - in_string = true; - str_constlen = 82; /* special value, normally impossible */ - goto _L99; - } #else - /* END OF MANUALLY INSERTED CODE */ + /* END OF MANUALLY INSERTED CODE */ - /* latex variant of processing: - if any of control characters appears then a separate idatom with such contents - is created. - if \x(n)(n)(space) then idatom with \x(n)(n) is created; - if \t then idatom t - \b b - \n n - \\ \\ - \> \> - \(another letter) \(another letter) + /* latex variant of processing: + if any of control characters appears then a separate idatom with such contents + is created. + if \x(n)(n)(space) then idatom with \x(n)(n) is created; + if \t then idatom t + \b b + \n n + \\ \\ + \> \> + \(another letter) \(another letter) - empty mif strings are coded as null - after and before idents additional nulls can appear sometimes - */ - if (str_constlen == 83) - { /* special value for taking one character to next idatom */ - strbegin_(); - is_2quote = false; - stradd_(b123.b1); - putstr_(idatom); - jncx_(&i); - in_string = true; - str_constlen = 81; /* go to next part of the constant*/ - goto _L99; - } - if (str_constlen == 84) - { /* special value for taking two characters to next idatom */ - strbegin_(); - is_2quote = false; - stradd_(b123.b1); - stradd_(b123.b2[1]); - putstr_(idatom); - jnc2x_(&i, 2L); - in_string = true; - str_constlen = 81; /* go to next part of the constant*/ - goto _L99; - } + empty mif strings are coded as null + after and before idents additional nulls can appear sometimes + */ + if (str_constlen == 83) + { /* special value for taking one character to next idatom */ + strbegin_ (); + is_2quote = false; + stradd_ (b123.b1); + putstr_ (idatom); + jncx_ (&i); + in_string = true; + str_constlen = 81; /* go to next part of the constant */ + goto _L99; + } + if (str_constlen == 84) + { /* special value for taking two characters to next idatom */ + strbegin_ (); + is_2quote = false; + stradd_ (b123.b1); + stradd_ (b123.b2[1]); + putstr_ (idatom); + jnc2x_ (&i, 2L); + in_string = true; + str_constlen = 81; /* go to next part of the constant */ + goto _L99; + } - if (str_constlen == 85) { - /* special value for taking 4 characters to next idatom, - and ignoring one more after them */ - strbegin_(); - is_2quote = false; - stradd_(b123.b2[0]); - stradd_(b123.b2[1]); - stradd_(b123.b3[2]); - stradd_(s[i + 2]); - putstr_(idatom); - jnc2x_(&i, 5L); - in_string = true; - str_constlen = 81; /* go to next part of the constant*/ - goto _L99; - } + if (str_constlen == 85) + { + /* special value for taking 4 characters to next idatom, + and ignoring one more after them */ + strbegin_ (); + is_2quote = false; + stradd_ (b123.b2[0]); + stradd_ (b123.b2[1]); + stradd_ (b123.b3[2]); + stradd_ (s[i + 2]); + putstr_ (idatom); + jnc2x_ (&i, 5L); + in_string = true; + str_constlen = 81; /* go to next part of the constant */ + goto _L99; + } - if (b123.b1 == '*' || b123.b1 == '-' || b123.b1 == '_' || - b123.b1 == '<' || b123.b1 == '|' || b123.b1 == '>' || - b123.b1 == '~' || b123.b1 == '^' || b123.b1 == '`' || - b123.b1 == ']' || b123.b1 == '[' || b123.b1 == '}' || - b123.b1 == '{' || b123.b1 == '/' || b123.b1 == '&' || - b123.b1 == '%' || b123.b1 == '$' || b123.b1 == '#' || - b123.b1 == '@' || b123.b1 == '"' || b123.b1 == '!' - || b123.b1 == ',' + if (b123.b1 == '*' || b123.b1 == '-' || b123.b1 == '_' || + b123.b1 == '<' || b123.b1 == '|' || b123.b1 == '>' || + b123.b1 == '~' || b123.b1 == '^' || b123.b1 == '`' || + b123.b1 == ']' || b123.b1 == '[' || b123.b1 == '}' || + b123.b1 == '{' || b123.b1 == '/' || b123.b1 == '&' || + b123.b1 == '%' || b123.b1 == '$' || b123.b1 == '#' || + b123.b1 == '@' || b123.b1 == '"' || b123.b1 == '!' || b123.b1 == ',' /* b123.b1 == ',' is added in Pascal code in june-95; here in september-95 */ - ) - - { - if (str_constlen == 81) - dt = dummy; - else - putstr_(atom); - in_string = true; - str_constlen = 83; - /* special value for taking one character to next idatom */ - goto _L99; - } + ) + + { + if (str_constlen == 81) + dt = dummy; + else + putstr_ (atom); + in_string = true; + str_constlen = 83; + /* special value for taking one character to next idatom */ + goto _L99; + } - if (b123.b1 == '\\') { - if (b123.b2[1] == 'x') { - if (str_constlen == 81) - dt = dummy; - else - putstr_(atom); - in_string = true; - str_constlen = 85; /*take 4 chars*/ - goto _L99; - } - if (b123.b2[1] == 'n' || b123.b2[1] == 'b' || b123.b2[1] == 't') { - jncx_(&i); - if (str_constlen == 81) - dt = dummy; - else - putstr_(atom); - in_string = true; - str_constlen = 83; /*take 1 char*/ - goto _L99; - } - if (str_constlen == 81) - dt = dummy; - else - putstr_(atom); - in_string = true; - str_constlen = 84; /*take 2 chars*/ - goto _L99; - } + if (b123.b1 == '\\') + { + if (b123.b2[1] == 'x') + { + if (str_constlen == 81) + dt = dummy; + else + putstr_ (atom); + in_string = true; + str_constlen = 85; /*take 4 chars */ + goto _L99; + } + if (b123.b2[1] == 'n' || b123.b2[1] == 'b' || b123.b2[1] == 't') + { + jncx_ (&i); + if (str_constlen == 81) + dt = dummy; + else + putstr_ (atom); + in_string = true; + str_constlen = 83; /*take 1 char */ + goto _L99; + } + if (str_constlen == 81) + dt = dummy; + else + putstr_ (atom); + in_string = true; + str_constlen = 84; /*take 2 chars */ + goto _L99; + } #endif - /* MANUALLY INSERTED ENDIF ! */ + /* MANUALLY INSERTED ENDIF ! */ - if (str_constlen < 80) { - stradd_(b123.b1); - jncx_(&i); - goto _L1; - } /*normal case*/ - if (str_constlen == 82) { - /* **** - strbegin_;is_2quote:=false; - stradd_(b3[1]);stradd_(b3[2]);stradd_(b3[3]); - putstr_(idatom); - ****/ - j = take_letters_(); - putident_(j); - in_string = true; - str_constlen = 81; /* special value, normally impossible */ - i += j; + if (str_constlen < 80) + { + stradd_ (b123.b1); + jncx_ (&i); + goto _L1; + } /*normal case */ + if (str_constlen == 82) + { + /* **** + strbegin_;is_2quote:=false; + stradd_(b3[1]);stradd_(b3[2]);stradd_(b3[3]); + putstr_(idatom); + *** */ + j = take_letters_ (); + putident_ (j); + in_string = true; + str_constlen = 81; /* special value, normally impossible */ + i += j; - goto _L99; - } + goto _L99; + } - if (str_constlen == 80) { - putstr_(atom); - in_string = true; - jnc_(&str_constlen); - /*becomes 81; no shift in input performed, ends part of constant*/ - goto _L99; - } - if (str_constlen == 81) { - /*immediately afrer previous case; starts next part of constant*/ - strbegin_(); /*sets str_constlen to 0*/ - is_2quote = false; + if (str_constlen == 80) + { + putstr_ (atom); + in_string = true; + jnc_ (&str_constlen); + /*becomes 81; no shift in input performed, ends part of constant */ + goto _L99; + } + if (str_constlen == 81) + { + /*immediately afrer previous case; starts next part of constant */ + strbegin_ (); /*sets str_constlen to 0 */ + is_2quote = false; #ifdef bbs - stradd_(b123.b1); - jncx_(&i); + stradd_ (b123.b1); + jncx_ (&i); #else #endif - goto _L1; - } + goto _L1; + } /************************ else begin @@ -1221,18 +1333,20 @@ _L1: /* we return to this label if token_ is not ready still */ *************************/ - } /*1*/ - if (b123.b1 == '`') { - strbegin_(); - is_2quote = false; - jncx_(&i); - goto _L1; - } - /*starts new mif text constant*/ - if (b123.b1 == '#') { - readline_(); - goto _L1; - } /*mif comment*/ + } /*1 */ + if (b123.b1 == '`') + { + strbegin_ (); + is_2quote = false; + jncx_ (&i); + goto _L1; + } + /*starts new mif text constant */ + if (b123.b1 == '#') + { + readline_ (); + goto _L1; + } /*mif comment */ @@ -1240,198 +1354,227 @@ _L1: /* we return to this label if token_ is not ready still */ /* all the following executes after check for in_string & in_comment */ - if (isa == is_special) { /*1*/ - if (pascal_comment) { /*2*/ - if (!strncmp(b123.b2, "(*", 2)) { - in_comment = true; - jnc2x_(&i, 2L); - goto _L1; - } - if (b123.b1 == '{' && b123.b2[1] != '$') { - in_comment = true; - jncx_(&i); - goto _L1; - } - } /*2*/ - else { - if (c_comment) { /*2*/ - if (!strncmp(b123.b2, "/*", 2)) { - in_comment = true; - jnc2x_(&i, 2L); - goto _L1; + if (isa == is_special) + { /*1 */ + if (pascal_comment) + { /*2 */ + if (!strncmp (b123.b2, "(*", 2)) + { + in_comment = true; + jnc2x_ (&i, 2L); + goto _L1; + } + if (b123.b1 == '{' && b123.b2[1] != '$') + { + in_comment = true; + jncx_ (&i); + goto _L1; + } + } /*2 */ + else + { + if (c_comment) + { /*2 */ + if (!strncmp (b123.b2, "/*", 2)) + { + in_comment = true; + jnc2x_ (&i, 2L); + goto _L1; + } + } /*2 */ + else + { + if (ada_comment) + { /*2 */ + if (!strncmp (b123.b2, "--", 2)) + { + readline_ (); + goto _L1; + } + } /*2 */ + } } - } /*2*/ - else { - if (ada_comment) { /*2*/ - if (!strncmp(b123.b2, "--", 2)) { - readline_(); - goto _L1; - } - } /*2*/ - } - } - if (pascal_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin_(); - is_2quote = false; - jncx_(&i); - goto _L1; - } - } /*2*/ - else { - if (modula_string) { /*2*/ - if (b123.b1 == '\'') { - strbegin_(); - is_2quote = false; - jncx_(&i); - goto _L1; - } - if (b123.b1 == '"') { - strbegin_(); - is_2quote = true; - jncx_(&i); - goto _L1; + if (pascal_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin_ (); + is_2quote = false; + jncx_ (&i); + goto _L1; + } + } /*2 */ + else + { + if (modula_string) + { /*2 */ + if (b123.b1 == '\'') + { + strbegin_ (); + is_2quote = false; + jncx_ (&i); + goto _L1; + } + if (b123.b1 == '"') + { + strbegin_ (); + is_2quote = true; + jncx_ (&i); + goto _L1; + } + } /*2 */ } - } /*2*/ - } - if (pascal_lexics) { /*2*/ - /* specially takes turbo pascal directive-comments */ - if (!strncmp(b123.b2, "{$", 2)) { /*3*/ - j = 0; - do { - jncx_(&j); - } while (s[i + j - 1] != '}' && as[(int) s[i + j - 1]] != is_control); - if (s[i + j - 1] == '}') - jncx_(&j); - putatom_(j); - jnc2x_(&i, j); - goto _L99; - } /*3*/ - - /* additional symbols */ - if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') { /*3*/ - jncx_(&i); - j = take_letters_(); /* starts from i-th position */ - i--; - putatom_(j + 1); /* takes token_ from i-th position */ - jnc2x_(&i, j + 1); - goto _L99; - } /*3*/ - - } /*2*/ - else { - if (c_lexics) { /*2*/ - if (!strncmp(b123.b3, "<<=", 3) || !strncmp(b123.b3, ">>=", 3)) { - putatom_(3L); - jnc2x_(&i, 3L); - goto _L99; + if (pascal_lexics) + { /*2 */ + /* specially takes turbo pascal directive-comments */ + if (!strncmp (b123.b2, "{$", 2)) + { /*3 */ + j = 0; + do + { + jncx_ (&j); + } + while (s[i + j - 1] != '}' + && as[(int) s[i + j - 1]] != is_control); + if (s[i + j - 1] == '}') + jncx_ (&j); + putatom_ (j); + jnc2x_ (&i, j); + goto _L99; + } /*3 */ + + /* additional symbols */ + if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') + { /*3 */ + jncx_ (&i); + j = take_letters_ (); /* starts from i-th position */ + i--; + putatom_ (j + 1); /* takes token_ from i-th position */ + jnc2x_ (&i, j + 1); + goto _L99; + } /*3 */ + + } /*2 */ + else + { + if (c_lexics) + { /*2 */ + if (!strncmp (b123.b3, "<<=", 3) + || !strncmp (b123.b3, ">>=", 3)) + { + putatom_ (3L); + jnc2x_ (&i, 3L); + goto _L99; + } + isa = is_first_of_two; + /* !! in c case <<, >>, >=, <= will be tested further + in two_char_symbols section, hence we go to there + using assignment to "isa" */ + + } /*2 */ + /* symbols= > < */ + /* special cases for c language */ + } - isa = is_first_of_two; - /* !! in c case <<, >>, >=, <= will be tested further - in two_char_symbols section, hence we go to there - using assignment to "isa" */ - } /*2*/ - /* symbols= > < */ - /* special cases for c language */ + } /*1 */ + /*this part never appears in mif input, since there is no is_special */ + + if (isa == is_space) + { + jncx_ (&i); + goto _L1; } - } /*1*/ - /*this part never appears in mif input, since there is no is_special*/ - - - if (isa == is_space) { - jncx_(&i); - goto _L1; - } - - if (isa == is_letter) { - j = take_letters_(); - putident_(j); - i += j; - goto _L99; - } - - - if (isa == is_digit) { /*1*/ - if (c_lexics) { /*2*/ - /* additional symbols; here hex and octal numbers are saved as - normal atoms */ - if ((b123.b1 == '0') - && - ( - (as[(int)b123.b2[1]] == is_letter)|| - (as[(int)b123.b2[1]] == is_digit) || - (as[(int)b123.b2[1]] == is_underscore) - ) - ) - { /*3*/ - jncx_(&i); - j = take_letters_(); /* starts from i-th position */ - i--; - putatom_(j + 1); /* takes token_ from i-th position */ - jnc2x_(&i, j + 1); - goto _L99; - } /*3*/ - } /*2*/ - - - i_saved = i; /* remember starting position */ - aadr = take_digits_(&j); - - if (j < 10 && - ( - ( (s[i + j - 1] == '.') && - (s[i + j ] == '.') )|| - ( (s[i + j - 1] != '.') && - (s[i + j - 1] != 'E') && - (s[i + j - 1] != 'e') ) - ) - ) + if (isa == is_letter) { - putnumber_(); - jnc2x_(&i, j); + j = take_letters_ (); + putident_ (j); + i += j; goto _L99; } - jnc2x_(&i, j); - if (s[i - 1] == '.') { - jncx_(&i); - aadr = take_digits_(&j); - jnc2x_(&i, j); - } - if (s[i - 1] == 'E' || s[i - 1] == 'e') { - jncx_(&i); - if (s[i - 1] == '-' || s[i - 1] == '+') - jncx_(&i); - aadr = take_digits_(&j); - jnc2x_(&i, j); - } - j = i - i_saved; - i = i_saved; /* to set "i" to starting position */ - putfloat_(j); - jnc2x_(&i, j); - goto _L99; - } /*1*/ - - if (isa == is_first_of_two) { /*1*/ - if (strchr(set_of_second_of_two,(int)b123.b2[1])) { - FORLIM = two_char_symbols_num; - for (j = 0; j < FORLIM; j++) { - if (b123.b2[0] == two_char_symbols[j][0] && - b123.b2[1] == two_char_symbols[j][1]) { - putatom_(2L); - i += 2; + + + if (isa == is_digit) + { /*1 */ + if (c_lexics) + { /*2 */ + /* additional symbols; here hex and octal numbers are saved as + normal atoms */ + if ((b123.b1 == '0') + && + ((as[(int) b123.b2[1]] == is_letter) || + (as[(int) b123.b2[1]] == is_digit) || + (as[(int) b123.b2[1]] == is_underscore))) + { /*3 */ + jncx_ (&i); + j = take_letters_ (); /* starts from i-th position */ + i--; + putatom_ (j + 1); /* takes token_ from i-th position */ + jnc2x_ (&i, j + 1); + goto _L99; + } /*3 */ + } /*2 */ + + + i_saved = i; /* remember starting position */ + aadr = take_digits_ (&j); + + if (j < 10 && + (((s[i + j - 1] == '.') && + (s[i + j] == '.')) || + ((s[i + j - 1] != '.') && + (s[i + j - 1] != 'E') && (s[i + j - 1] != 'e')))) + { + putnumber_ (); + jnc2x_ (&i, j); goto _L99; } - } - } - } /*1*/ + jnc2x_ (&i, j); + if (s[i - 1] == '.') + { + jncx_ (&i); + aadr = take_digits_ (&j); + jnc2x_ (&i, j); + } + if (s[i - 1] == 'E' || s[i - 1] == 'e') + { + jncx_ (&i); + if (s[i - 1] == '-' || s[i - 1] == '+') + jncx_ (&i); + aadr = take_digits_ (&j); + jnc2x_ (&i, j); + } + j = i - i_saved; + i = i_saved; /* to set "i" to starting position */ + putfloat_ (j); + jnc2x_ (&i, j); + goto _L99; + } /*1 */ + + if (isa == is_first_of_two) + { /*1 */ + if (strchr (set_of_second_of_two, (int) b123.b2[1])) + { + FORLIM = two_char_symbols_num; + for (j = 0; j < FORLIM; j++) + { + if (b123.b2[0] == two_char_symbols[j][0] && + b123.b2[1] == two_char_symbols[j][1]) + { + putatom_ (2L); + i += 2; + goto _L99; + } + } + } + } /*1 */ - putatom_(1L); - jncx_(&i); /* with*/ -_L99: ; + putatom_ (1L); + jncx_ (&i); /* with */ +_L99:; @@ -1443,7 +1586,8 @@ _L99: ; -Static long take_letters_() +static long +take_letters_ () { /****************************************/ long Result; @@ -1451,20 +1595,22 @@ Static long take_letters_() returns number of characters read */ long jj; - Char c; + char c; jj = 0; - while (true) { - c = s[i + jj - 1]; - isa = as[(int)c]; - if (isa != is_letter && isa != is_digit && isa != is_underscore) { - Result = jj; - goto _L99; + while (true) + { + c = s[i + jj - 1]; + isa = as[(int) c]; + if (isa != is_letter && isa != is_digit && isa != is_underscore) + { + Result = jj; + goto _L99; + } + if (to_uppercase) + s[i + jj - 1] = upcase_tab[(int) c]; + jncx_ (&jj); } - if (to_uppercase) - s[i + jj - 1] = upcase_tab[(int)c]; - jncx_(&jj); - } _L99: return Result; } @@ -1472,25 +1618,28 @@ _L99: -Static long take_digits_(jj) -long *jj; +static long +take_digits_ (jj) + long *jj; { /**************************************************/ long Result; longint summator; - Char c; + char c; *jj = 0; summator = 0; - while (true) { - c = s[i + *jj - 1]; - if (as[(int)c] != is_digit) { - Result = summator; - goto _L99; + while (true) + { + c = s[i + *jj - 1]; + if (as[(int) c] != is_digit) + { + Result = summator; + goto _L99; + } + summator = summator * 10 + c - '0'; + jncx_ (jj); } - summator = summator * 10 + c - '0'; - jncx_(jj); - } _L99: return Result; } @@ -1505,4 +1654,3 @@ _L99: /* End. */ - diff --git a/RIGAL/rigsc.446/src/sevice.c b/RIGAL/rigsc.446/src/sevice.c index 23b64322d247519cabfb965ecb0e45b3d4d86493..c9f3734aa7b323df1dd9ec2b70561158a1a49a11 100644 --- a/RIGAL/rigsc.446/src/sevice.c +++ b/RIGAL/rigsc.446/src/sevice.c @@ -9,14 +9,15 @@ function argc:integer; begin argc:=paramcount+1;end;*/ -long long_to_atom(a_long) -long a_long; +long +long_to_atom (a_long) + long a_long; { a a_rez; mpd x; numberdescriptor *WITH; - gets1(&a_rez, &x.sa); + gets1 (&a_rez, &x.sa); WITH = x.snd; WITH->dtype = number; WITH->cord = 0; @@ -25,149 +26,135 @@ long a_long; } -Char *real_to_string(Result, ar) -Char *Result; -double ar; +char * +real_to_string (Result, ar) + char *Result; + double ar; { - sprintf(Result,"%E",ar); - return Result; + sprintf (Result, "%E", ar); + return Result; } -boolean is_rig_letter(let) -int let; -{ return ( isalpha(let) || (let=='_') - || (let=='~')|| (let=='|')|| (let=='`')|| (let=='{')|| (let=='}') - ); } - -boolean is_rig_symbol(let) -int let; -{ return ( is_rig_letter(let) || isdigit(let) ); } - -char* _OutMem() -{ printf(" **** Out of memory ****"); - exit(0); +bool +is_rig_letter (let) + int let; +{ + return (isalpha (let) || (let == '_') + || (let == '~') || (let == '|') || (let == '`') || (let == '{') + || (let == '}')); } -void _EscIO() -{ printf(" ****** I/O Error *****"); - exit(0); +bool +is_rig_symbol (let) + int let; +{ + return (is_rig_letter (let) || isdigit (let)); } -char *real_to_string_f(char *Result, double ar, long total_num_digits, long num_digits_after_decimal_point) +char * +_OutMem () { - if (total_num_digits > 80) total_num_digits = 80; - - char representation[81]; - memset(representation,0,81); - gcvt(ar,total_num_digits,representation); // provide minimum represtation as a string. - - char *decimal_point = strchr( representation, '.' ); - char *first_null_byte = strchr( representation, '\0'); - char *last_null_byte = &representation[80]; - - if (decimal_point != NULL) - { - int i = num_digits_after_decimal_point - ((int) abs((first_null_byte)-decimal_point-1)); + printf (" **** Out of memory ****"); + exit (0); +} - char *current_byte = first_null_byte; - while ( (current_byte != last_null_byte) && (i>0) ) - { - *current_byte = '0'; - current_byte++; - i--; - } - } - - memset(Result,' ',80); - int len = strlen(representation); - memmove( &Result[(80-len)], representation,len); - - return Result; - } +void +_EscIO (d) + int d; +{ + printf (" ****** I/O Error *****"); + exit (0); +} -/* -Char *real_to_string_f(Result, ar, dignum, afterpoint) -Char *Result; // MANUAL CHANGE char to Char -double ar; - long dignum, afterpoint; +char * +real_to_string_f (Result, ar, dignum, afterpoint) + char *Result; /* MANUAL CHANGE char to char */ + double ar; + long dignum, afterpoint; { - boolean neg; + bool neg; string80 bs, cs; double mult; long i; - Char STR1[82]; - Char STR2[162]; + char STR1[82]; + char STR2[162]; mult = 1.0; for (i = 1; i <= afterpoint; i++) mult *= 10; neg = false; - if (ar < 0) { - ar = -ar; - neg = true; - } - long_to_str(bs, (long)ar); - long_to_str(cs, (long)((ar - (long)ar + 1.0) * mult)); + if (ar < 0) + { + ar = -ar; + neg = true; + } + long_to_str (bs, (long) ar); + long_to_str (cs, (long) ((ar - (long) ar + 1.0) * mult)); cs[0] = '.'; if (afterpoint == 0) *cs = '\0'; if (neg) - sprintf(bs, "-%s%s", strcpy(STR2, bs), cs); + sprintf (bs, "-%s%s", strcpy (STR2, bs), cs); else - strcat(bs, cs); - if (strlen(bs) < dignum) { - while (strlen(bs) != dignum) - sprintf(bs, " %s", strcpy(STR1, bs)); - } - strcpy(Result,bs); // Splitted manually - return Result; - } -*/ + strcat (bs, cs); + if (strlen (bs) < dignum) + { + while (strlen (bs) != dignum) + sprintf (bs, " %s", strcpy (STR1, bs)); + } + strcpy (Result, bs); /* Splitted manually */ + return Result; +} -long str_to_atom(ssr_) -Char *ssr_; + +long +str_to_atom (ssr_) + char *ssr_; { string80 ssr; long l; a rez; - longint intval; + longint intval; - strcpy(ssr, ssr_); + strcpy (ssr, ssr_); rez = null_; - val(ssr, &intval, &l); - if (l == 0) { - rez = long_to_atom(intval); - return rez; - } - else { - rez = str_to_textatom(ssr); - return rez; - } + val (ssr, &intval, &l); + if (l == 0) + { + rez = long_to_atom (intval); + return rez; + } + else + { + rez = str_to_textatom (ssr); + return rez; + } } -long str_to_textatom(ssr_) -Char *ssr_; +long +str_to_textatom (ssr_) + char *ssr_; { string80 ssr; long l; a rez; aa atm; - boolean id; + bool id; long i; mpd x; atomdescriptor *WITH; - strcpy(ssr, ssr_); + strcpy (ssr, ssr_); rez = null_; - l = strlen(ssr); + l = strlen (ssr); if (l == 0) return rez; - id = is_rig_letter(ssr[0]); + id = is_rig_letter (ssr[0]); for (i = 0; i < l; i++) - id &= is_rig_letter (ssr[i]); - putatm(ssr, l, &atm); /* makes a-address */ - gets1(&rez, &x.sa); /* makes s-address */ + id &= is_rig_letter (ssr[i]); + putatm (ssr, l, &atm); /* makes a-address */ + gets1 (&rez, &x.sa); /* makes s-address */ /* fills descriptor */ WITH = x.sad; if (id) @@ -179,17 +166,18 @@ Char *ssr_; } -Char *long_to_str(Result, int_) -Char *Result; -long int_; +char * +long_to_str (Result, int_) + char *Result; + long int_; { - sprintf(Result,"%ld",int_); - return(Result); + sprintf (Result, "%ld", int_); + return (Result); /* ******************* string80 rezstr; - boolean neg; - Char STR1[256]; - Char STR2[82]; + bool neg; + char STR1[256]; + char STR2[82]; neg = false; if (int_ < 0) { @@ -198,7 +186,7 @@ long int_; } *rezstr = '\0'; do { - sprintf(STR1, "%c", (Char)(int_ % 10 + rezstr + '0')); + sprintf(STR1, "%c", (char)(int_ % 10 + rezstr + '0')); strcpy(rezstr, STR1); p2c: defsun3.z, line 541: * Note: Using % for possibly-negative arguments [317] @@ -213,72 +201,80 @@ long int_; } -Char *aa_str(Result, a1) -Char *Result; -long a1; +char * +aa_str (Result, a1) + char *Result; + long a1; { bl80 b80; long len; - Char STR2[256]; + char STR2[256]; - pointa(a1, b80, &len); + get_data_from_pointa (a1, b80, &len); - sprintf(STR2, "%.80s", b80); - sprintf(Result, "%.*s", (int)len, STR2); + sprintf (STR2, "%.80s", b80); + sprintf (Result, "%.*s", (int) len, STR2); return Result; } -Void val(m, intval, rez) -Char *m; -long *intval, *rez; +void +val (m, intval, rez) + char *m; + long *intval, *rez; { /* converts string to longint. returns 0 if normal terminated */ int i; - boolean sign; + bool sign; i = 1; *intval = 0; *rez = 1; sign = false; - if (m[0] == '-') { - sign = true; - i++; - } + if (m[0] == '-') + { + sign = true; + i++; + } if (m[0] == '+') i++; - while ((i <= (int) strlen(m)) && isdigit(m[i - 1])) { - *intval = *intval * 10 + m[i - 1] - '0'; - i++; - } - if (i <= (int) strlen(m)) { - *rez = i; - *intval = 0; - } else + while ((i <= strlen (m)) && isdigit (m[i - 1])) + { + *intval = *intval * 10 + m[i - 1] - '0'; + i++; + } + if (i <= strlen (m)) + { + *rez = i; + *intval = 0; + } + else *rez = 0; if (sign) *intval = -*intval; } -Void val2(st_, r, code) -Char *st_; -double *r; -long *code; +void +val2 (st_, r, code) + char *st_; + double *r; + long *code; { - char * res; /* Help variable , used to analyze the result of "strtod" */ - res=st_; - *r=strtod(st_,&res); - if ((res != st_)&&(res>=st_+strlen(st_))) - *code=0; /* Correct value */ - else *code=1; /* Incorrect value */ - + char *res; /* Help variable , used to analyze the result of "strtod" */ + res = st_; + *r = strtod (st_, &res); + if ((res != st_) && (res >= st_ + strlen (st_))) + *code = 0; /* Correct value */ + else + *code = 1; /* Incorrect value */ + /* string80 st; long i, l; double rx; - boolean sign; + bool sign; long SET[3]; long SET1[9]; @@ -335,46 +331,77 @@ _L1: ; } +// copy the string, then call keep to first space. +void set_string( char *string, char *str_provided ) +{ + assert( string ); + assert( str_provided ); + + char buffer[81]; + memset( buffer,0,81); + + memset ( buffer, 0, 81 ); + memmove( buffer, str_provided, strnlen( str_provided, 80) ); + + keep_string_up_to_first_space( buffer ); + + memset ( string, 0, 81 ); + memmove( string, buffer,strnlen(buffer,80)); + +} -Void brt(p1) -Char *p1; +void keep_string_up_to_first_space (char *p1) { long i; - Char STR1[256]; + char STR1[256]; i = 1; - while (i <= (int) strlen(p1) && p1[i - 1] != ' ') - i++; - /* writeln('i=',i);*/ - sprintf(p1, "%.*s", (int)(i - 1), strcpy(STR1, p1)); + while (i <= strlen (p1) && p1[i - 1] != ' ') i++; + + sprintf (p1, "%.*s", (int) (i - 1), strcpy (STR1, p1)); } +/* +void keep_string_up_to_first_space( char *p1) +{ + int i; + int str_length; + str_length = strlen(p1); + i = 1; + while ( i <= str_length && p1[i - 1] != ' ' ) i++; + + if (i<=str_length) memset( &p1[i-1],0,str_length-i); + +} +*/ FILE *fi; -boolean existfile(fname) -Char *fname; -{ FILE * FF; - /* returns true if it is screen file ('') or existing disk file */ - FF=fopen(fname,"r"); - if (FF!=0) fclose(FF); - return (FF!=0); +bool +existfile (fname) + char *fname; +{ + FILE *FF; + /* returns true if it is screen file ('') or existing disk file */ + FF = fopen (fname, "r"); + if (FF != 0) + fclose (FF); + return (FF != 0); } -/* -boolean rightfile(fname) -Char *fname; + +bool +rightfile (fname) + char *fname; { - // returns true if it is screen or nul (dummy) or valid disk file - // ( former version is erased (!) ) - return true; + /* returns true if it is screen or nul (dummy) or valid disk file + ( former version is erased (!) ) */ + return true; } -*/ - diff --git a/RIGAL/rigsc.446/src/t2.c b/RIGAL/rigsc.446/src/t2.c index 09b96f73981fd5fa25bd51d9d8b6441475e9a150..f6a11a796c7af8a63a28203ab7f4b9b4289fcc36 100644 --- a/RIGAL/rigsc.446/src/t2.c +++ b/RIGAL/rigsc.446/src/t2.c @@ -1,11 +1,11 @@ #include <malloc.h> main () { - int i=0; - while(1) - { printf("Page=%d Adr=%p\n",i++,malloc(10000)); - printf(" memmax=%ld, memavl=%ld\n",_memmax(),_memavl()); - getch(); - } + int i = 0; + while (1) + { + printf ("Page=%d Adr=%p\n", i++, malloc (10000)); + printf (" memmax=%ld, memavl=%ld\n", _memmax (), _memavl ()); + getch (); + } } - diff --git a/RIGAL/rigsc.446/src/usemod.c b/RIGAL/rigsc.446/src/usemod.c index fbb3fa2a618196b435e117f975cec5e528c601c4..3d388fcb34989ae1d89722150a1bf82bd5f64272 100644 --- a/RIGAL/rigsc.446/src/usemod.c +++ b/RIGAL/rigsc.446/src/usemod.c @@ -12,14 +12,15 @@ mpd xx; -Static boolean plstr(p0, strval, lenval, stringflag, stringval) -long p0; -Char *strval; -long *lenval; -boolean stringflag; -Char *stringval; -{ - /* input - s-address*/ +static bool +plstr (p0, strval, lenval, stringflag, stringval) + long p0; + char *strval; + long *lenval; + bool stringflag; + char *stringval; +{ + /* input - s-address */ /* output: array */ /* length of atom */ /* need stringval ? */ @@ -33,25 +34,29 @@ Char *stringval; *stringval = '\0'; if (p0 == null_) return false; - else { - pointr(p0, &xx.sa); /* access to atom in memory */ - if (((1L << ((long)xx.sad->dtype)) & ((1L << ((long)fatom + 1)) - - (1L << ((long)atom))) & (~(1L << ((long)number)))) == 0) - return false; - else { - atm = xx.sad->name; /* access to a-address */ - pointa(atm, strval, lenval); /* reads value to str variable */ - if (stringflag) { - FORLIM = *lenval; - for (i = 0; i < FORLIM; i++) - sprintf(stringval + strlen(stringval), "%c", strval[i]); - /* and to stringval variable */ - } - - return true; + else + { + assert_and_assign_real_pointer (p0, &xx.sa); /* access to atom in memory */ + if (((1L << ((long) xx.sad->dtype)) & ((1L << ((long) fatom + 1)) - + (1L << ((long) atom))) & (~(1L << + ((long) number)))) == 0) + return false; + else + { + atm = xx.sad->name; /* access to a-address */ + get_data_from_pointa (atm, strval, lenval); /* reads value to str variable */ + if (stringflag) + { + FORLIM = *lenval; + for (i = 0; i < FORLIM; i++) + sprintf (stringval + strlen (stringval), "%c", strval[i]); + /* and to stringval variable */ + } + + return true; + } } - } -} /* plstr */ +} /* plstr */ @@ -59,14 +64,15 @@ Char *stringval; static char bc(long a_) { if (a_ >= 10) - return ((Char)(a_ + 55)); + return ((char)(a_ + 55)); else - return ((Char)(a_ + 48)); + return ((char)(a_ + 48)); } */ -Static Void dump(adr, sad) -long adr, sad; +static void +dump (adr, sad) + long adr, sad; { /* physical address */ } @@ -75,147 +81,162 @@ long adr, sad; a a2, atm; long j, l, i1; error_rec_type error_rec_use; -Char dty; +char dty; FILE *workfile; -Char c; -boolean id; +char c; +bool id; string80 sv1, sv2, svar; -bl80 str_; /*for pointa & putatm*/ -bl80 str1_; /*for pointa & putatm*/ +bl80 str_; /*for pointa & putatm */ +bl80 str1_; /*for pointa & putatm */ longint im[5]; - typedef union sa_pointer { +typedef union sa_pointer +{ a pointa; - Char immed[4]; - struct { + char immed[4]; + struct + { word offset; - Char page, pazime; + char page, pazime; } struct_; } sa_pointer; -Void use_42(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_42 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* returns current page (very useful for big algorythms) */ sa_pointer xxx; long i; numberdescriptor *WITH; - gets1(rez, &xx.sa); + gets1 (rez, &xx.sa); WITH = xx.snd; WITH->dtype = number; WITH->cord = 0; xxx.pointa = *rez; - putchar('\n'); + putchar ('\n'); for (i = 0; i <= 3; i++) - printf("%d-", xxx.immed[i]); - putchar('\n'); + printf ("%d-", xxx.immed[i]); + putchar ('\n'); WITH->val = xxx.immed[1]; } -Void use_43(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_43 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* returns #call_pas(42) if current disk in use, - 0 otherwise. */ + 0 otherwise. */ numberdescriptor *WITH; - gets1(rez, &xx.sa); + gets1 (rez, &xx.sa); WITH = xx.snd; WITH->dtype = number; WITH->cord = 0; - vols(im, &im[1], &WITH->val); + vols (im, &im[1], &WITH->val); } -Void use_30(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_30 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = null_; - /*write atom or number*/ - if (plstr(p1, str_, &l, true, sv1)) - fputs(sv1, stdout); - else { - if (plnum(p1, im)) - printf("%12ld", im[0]); - } + /*write atom or number */ + if (plstr (p1, str_, &l, true, sv1)) + fputs (sv1, stdout); + else + { + if (plnum (p1, im)) + printf ("%12ld", im[0]); + } } -Void use_31(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_31 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { long i, FORLIM; - /*write atom or number with adding spaces after it or rupping the end*/ + /*write atom or number with adding spaces after it or rupping the end */ *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) { - if (!plnum(p1, &im[1])) - goto _L1; - long_to_str(sv1, im[1]); - } - if (plnum(p2, im)) { - if (im[0] > (int) strlen(sv1)) { - FORLIM = im[0]; - for (i = strlen(sv1); i < FORLIM; i++) - sv1[i] = ' '; + if (!plstr (p1, str_, &l, true, sv1)) + { + if (!plnum (p1, &im[1])) + goto _L1; + long_to_str (sv1, im[1]); } + if (plnum (p2, im)) + { + if (im[0] > strlen (sv1)) + { + FORLIM = im[0]; + for (i = strlen (sv1); i < FORLIM; i++) + sv1[i] = ' '; + } - printf("%*s", (int)im[0], sv1); - } else - fputs(sv1, stdout); -_L1: ; + printf ("%*s", (int) im[0], sv1); + } + else + fputs (sv1, stdout); +_L1:; } -Void use_1(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_1 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - char *TEMP; /* Char ->char */ + char *TEMP; /* char ->char */ *rez = 0; /* puts an atom (or null) to screen. user's answer (atom, identifier or number ) is returned */ - if (plstr(p1, str_, &l, true, sv1)) - fputs(sv1, stdout); - fgets(svar, 81, stdin); - TEMP = strchr(svar, '\n'); - if (TEMP != NULL) /* enters from screen */ + if (plstr (p1, str_, &l, true, sv1)) + fputs (sv1, stdout); + fgets (svar, 81, stdin); + TEMP = strchr (svar, '\n'); + if (TEMP != NULL) /* enters from screen */ *TEMP = 0; - *rez = str_to_atom(svar); + *rez = str_to_atom (svar); } /*rigal lexical analyser */ -Void use_14(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_14 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = 0; *error_rec_use.message = '\0'; - if (plstr(p1, str_, &l, true, sv1)) - ley(sv1, rez, false, &error_rec_use); + if (plstr (p1, str_, &l, true, sv1)) + ley (sv1, rez, false, &error_rec_use); } -Void use_15(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_15 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = 0; *error_rec_use.message = '\0'; - if (plstr(p1, str_, &l, true, sv1)) - ley(sv1, rez, true, &error_rec_use); + if (plstr (p1, str_, &l, true, sv1)) + ley (sv1, rez, true, &error_rec_use); } -Void use_16(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_16 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { FILE *inpfile; string80 s; @@ -223,43 +244,51 @@ long p1, p2, p3, *rez; inpfile = NULL; *rez = 0; - if (plstr(p1, str_, &l, true, sv1)) { - if (existfile(sv1)) { - inpfile = fopen(sv1, "r"); - if (inpfile == NULL) _EscIO(FileNotFound); - - *rez = null_; - while (!feof(inpfile)) { - - - fgets(s,145,inpfile); - if (s[strlen(s)-1]=='\n') - { s[strlen(s)-1]=0; - fff=fgetc(inpfile); - if (fff!=10) - { ungetc(fff,inpfile);} - } - - - a2 = str_to_textatom(s); - lconc(rez, a2); - } /*while eof*/ - /* readln(inftext,svar); */ + if (plstr (p1, str_, &l, true, sv1)) + { + if (existfile (sv1)) + { + inpfile = fopen (sv1, "r"); + if (inpfile == NULL) + _EscIO (FileNotFound); + + *rez = null_; + while (!feof (inpfile)) + { + + + fgets (s, 145, inpfile); + if (s[strlen (s) - 1] == '\n') + { + s[strlen (s) - 1] = 0; + fff = fgetc (inpfile); + if (fff != 10) + { + ungetc (fff, inpfile); + } + } + + + a2 = str_to_textatom (s); + lconc (rez, a2); + } /*while eof */ + /* readln(inftext,svar); */ + + if (inpfile != NULL) + fclose (inpfile); + inpfile = NULL; + } - if (inpfile != NULL) - fclose(inpfile); - inpfile = NULL; } - - } if (inpfile != NULL) - fclose(inpfile); + fclose (inpfile); } -Void use_4(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_4 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { numberdescriptor *WITH; @@ -267,16 +296,19 @@ long p1, p2, p3, *rez; /* finds coordinate of atom */ if (p1 == 0) return; - pointr(p1, &xx.sa); - if (((1L << ((long)xx.sad->dtype)) & ((1L << ((long)fatom + 1)) - - (1L << ((long)atom))) & (~(1L << ((long)number)))) != 0) + assert_and_assign_real_pointer (p1, &xx.sa); + if (((1L << ((long) xx.sad->dtype)) & ((1L << ((long) fatom + 1)) - + (1L << ((long) atom))) & (~(1L << + ((long) + number)))) + != 0) a2 = xx.sad->cord; else if (xx.snd->dtype == number) a2 = xx.snd->cord; else a2 = 0; /* make numerical atom */ - gets1(rez, &xx.sa); /* fill descriptor */ + gets1 (rez, &xx.sa); /* fill descriptor */ WITH = xx.snd; WITH->dtype = number; WITH->cord = 0; @@ -284,8 +316,9 @@ long p1, p2, p3, *rez; } -Void use_10(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_10 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* dump */ @@ -293,39 +326,44 @@ long p1, p2, p3, *rez; if (p1 == 0) return; a2 = p1; - do { - pointr(a2, &xx.sa); - dump(xx.sa, a2); - printf(" Another address="); - scanf("%ld%*[^\n]", &a2); - getchar(); - } while (a2 != 0); + do + { + assert_and_assign_real_pointer (a2, &xx.sa); + dump (xx.sa, a2); + printf (" Another address="); + scanf ("%ld%*[^\n]", &a2); + getchar (); + } + while (a2 != 0); } -Void use_13(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_13 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* nice print */ *rez = 0; if (p1 != 0) - putchar('\n'); /* dout(p1);*/ + putchar ('\n'); /* dout(p1); */ } -Void use_12(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_12 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = 0; /* nice print */ if (p1 != 0) - fprintf(out, "\n\n"); /*dout2(p1);*/ + fprintf (out, "\n\n"); /*dout2(p1); */ } -Void use_19(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_19 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = 0; @@ -333,92 +371,98 @@ long p1, p2, p3, *rez; } -Void use_20(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_20 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - /*random*/ + /*random */ *rez = 0; } -Void use_21(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_21 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* atom->number, others->null */ *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) + if (!plstr (p1, str_, &l, true, sv1)) return; /* if (sv1[l]='l') or (sv1[l]='L') - then sv1:=substr(sv1,1,l-1);*/ - /*substr*/ - val(sv1, im, &l); + then sv1:=substr(sv1,1,l-1); */ + /*substr */ + val (sv1, im, &l); if (l == 0) - *rez = long_to_atom(im[0]); + *rez = long_to_atom (im[0]); } - a erlist; +a erlist; /* used to leave error message list in usepas after scaner return it to another usepas call later - when it will be retrieved */ -Void use_35(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_35 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* scaner receives data from file */ /* format #call_pas(35 $dos_filename [ $options ]) */ /* returns null if file does not exist */ erlist = 0; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) /* file name */ + if (!plstr (p1, str_, &l, true, sv1)) /* file name */ return; - if (!plstr(p2, str_, &l, true, sv2)) /* options */ + if (!plstr (p2, str_, &l, true, sv2)) /* options */ *sv2 = '\0'; - initialize_scan_variables(); - scaner(1L, sv1, sv2, rez, &erlist, (long)null_, 0L, 0L); + initialize_scan_variables (); + scaner (1L, sv1, sv2, rez, &erlist, (long) null_, 0L, 0L); } -Void use_121(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_121 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* scaner receives data from file */ /* format #call_pas(121 $mif_filename [ $options ]) */ /* returns null if file does not exist */ erlist = 0; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) /* file name */ + if (!plstr (p1, str_, &l, true, sv1)) /* file name */ return; - if (!plstr(p2, str_, &l, true, sv2)) /* options */ + if (!plstr (p2, str_, &l, true, sv2)) /* options */ *sv2 = '\0'; - initialize_scan_variables_mif(); - scaner_mif(1L, sv1, sv2, rez, &erlist, (long)null_, 0L, 0L); + initialize_scan_variables_mif (); + scaner_mif (1L, sv1, sv2, rez, &erlist, (long) null_, 0L, 0L); } -Void use_36(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_36 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* scaner receives data from list of strings, numbers and complex structures in the input list are ignored */ /* format #call_pas(36 $list [$options] ) */ *rez = 0; erlist = 0; - if (!plstr(p2, str_, &l, true, sv2)) /* options */ + if (!plstr (p2, str_, &l, true, sv2)) /* options */ *sv2 = '\0'; - initialize_scan_variables(); - scaner(2L, "", sv2, rez, &erlist, p1, 0L, 0L); + initialize_scan_variables (); + scaner (2L, "", sv2, rez, &erlist, p1, 0L, 0L); } -Void use_38(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_38 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* returns error message list, produced after last call of "scaner" */ @@ -427,13 +471,14 @@ long p1, p2, p3, *rez; -Void use_40(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_40 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* any -> s-address */ numberdescriptor *WITH; - gets1(rez, &xx.sa); + gets1 (rez, &xx.sa); WITH = xx.snd; WITH->dtype = number; WITH->cord = 0; @@ -441,13 +486,14 @@ long p1, p2, p3, *rez; } -Void use_41(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_41 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* returns current s-address */ numberdescriptor *WITH; - gets1(rez, &xx.sa); + gets1 (rez, &xx.sa); WITH = xx.snd; WITH->dtype = number; WITH->cord = 0; @@ -455,192 +501,217 @@ long p1, p2, p3, *rez; } -Void use_44(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_44 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* sets coordinate to atom */ *rez = 0; - if (!plnum(p2, im)) + if (!plnum (p2, im)) goto _L1; - if (p1 != 0) { - *rez = p1; - a2 = p1; - points(a2, &xx.sa); - if (((1L << ((long)xx.sad->dtype)) & ((1L << ((long)fatom + 1)) - - (1L << ((long)atom))) & (~(1L << ((long)number)))) != 0) - xx.sad->cord = im[0]; - else if (xx.snd->dtype == number) - xx.snd->cord = im[0]; - } -_L1: ; + if (p1 != 0) + { + *rez = p1; + a2 = p1; + assert_and_assign_real_pointer (a2, &xx.sa); + if (((1L << ((long) xx.sad->dtype)) & ((1L << ((long) fatom + 1)) - + (1L << ((long) atom))) & (~(1L << + ((long) number)))) != 0) + xx.sad->cord = im[0]; + else if (xx.snd->dtype == number) + xx.snd->cord = im[0]; + } +_L1:; } -Void use_45(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_45 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - reopen(rez, &p1); + reopen (rez, &p1); /* removes all s-space saving only this p1 value in result; all variables after that moment will have wrong values */ /* this not allowed in interpreter ! */ } -Void use_46(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_46 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = null_; -} /* returns null if we are in compiler */ +} /* returns null if we are in compiler */ -Void use_9(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_9 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { *rez = 0; } -Void use_85(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_85 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* upcase */ long FORLIM; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) + if (!plstr (p1, str_, &l, true, sv1)) return; - FORLIM = strlen(sv1); - for (j = 1; j <= FORLIM; j++) { - if (islower(sv1[j - 1])) - sv1[j - 1] -= 32; - } - *rez = str_to_textatom(sv1); + FORLIM = strlen (sv1); + for (j = 1; j <= FORLIM; j++) + { + if (islower (sv1[j - 1])) + sv1[j - 1] -= 32; + } + *rez = str_to_textatom (sv1); } -Void use_86(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_86 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* locase */ long FORLIM; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) + if (!plstr (p1, str_, &l, true, sv1)) return; - FORLIM = strlen(sv1); - for (j = 1; j <= FORLIM; j++) { - if (isupper(sv1[j - 1])) - sv1[j - 1] += 32; - } - *rez = str_to_textatom(sv1); + FORLIM = strlen (sv1); + for (j = 1; j <= FORLIM; j++) + { + if (isupper (sv1[j - 1])) + sv1[j - 1] += 32; + } + *rez = str_to_textatom (sv1); } -Void use_87(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_87 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* substr */ - Char STR1[256]; + char STR1[256]; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) + if (!plstr (p1, str_, &l, true, sv1)) return; - if (plnum(p2, im)) { - if (!plnum(p3, &im[1])) - im[1] = l; - } - sprintf(STR1, "%.*s", (int)im[1], sv1 + im[0] - 1); - *rez = str_to_textatom(STR1); + if (plnum (p2, im)) + { + if (!plnum (p3, &im[1])) + im[1] = l; + } + sprintf (STR1, "%.*s", (int) im[1], sv1 + im[0] - 1); + *rez = str_to_textatom (STR1); } -Void use_88(p1, p2, p3, rez) -long p1, p2, p3, *rez; -{ char * tmp; +void +use_88 (p1, p2, p3, rez) + long p1, p2, p3, *rez; +{ + char *tmp; /* position */ *rez = 0; - if (plstr(p1, str_, &l, true, sv1)) { - if (plstr(p2, str_, &l, true, sv2)) - { tmp=strstr(sv2,sv1); - *rez = long_to_atom((long) (tmp?((long)tmp-(long)sv1):0) );} - } + if (plstr (p1, str_, &l, true, sv1)) + { + if (plstr (p2, str_, &l, true, sv2)) + { + tmp = strstr (sv2, sv1); + *rez = long_to_atom ((long) (tmp ? ((long) tmp - (long) sv1) : 0)); + } + } } -Void use_90(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_90 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { long iii; /* if plnum(p2,im[1]) then hlt:=im[1] else hlt:=0; */ - for (iii = 0; iii < filenum; iii++) { - if (filetab[iii].isopen) { - if (filetab[iii].screen) - putchar('\n'); /* Corrected 29/5/95 */ - else - {putc('\n', files[iii]); - if (files[iii] != NULL) - fclose(files[iii]);} - files[iii] = NULL; + for (iii = 0; iii < filenum; iii++) + { + if (filetab[iii].isopen) + { + if (filetab[iii].screen) + putchar ('\n'); /* Corrected 29/5/95 */ + else + { + putc ('\n', files[iii]); + if (files[iii] != NULL) fclose (files[iii]); + } + files[iii] = NULL; + } + } + if (out_open) + { + if (out != NULL) fclose (out); + out = NULL; } - } - if (out_open) { - if (out != NULL) - fclose(out); - out = NULL; - } - closea(); - closes(); - exit(0); + + exit (0); } -Void use_78(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_78 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - if (plnum(p1, im)) + if (plnum (p1, im)) max_printlevel = im[0]; } -Void use_79(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_79 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - boolean is_tree; + bool is_tree; ptr_ ap; longint elnum; atomdescriptor *WITH; *rez = null_; - first(p1, &ap); + first (p1, &ap); is_tree = (ap.ptrtype == ptrtree); elnum = 0; - while (ap.nel != 0) { - elnum++; - if (eqatoms(ap.cel, p2)) - goto _L22; - next(&ap); - } + while (ap.nel != 0) + { + elnum++; + if (eqatoms (ap.cel, p2)) + goto _L22; + next (&ap); + } return; _L22: - if (!is_tree) { - *rez = long_to_atom(elnum); - return; - } + if (!is_tree) + { + *rez = long_to_atom (elnum); + return; + } - gets1(rez, &xx.sa); /* makes s-address */ + gets1 (rez, &xx.sa); /* makes s-address */ /* fills descriptor */ - WITH = xx.sad; /* with */ + WITH = xx.sad; /* with */ WITH->dtype = idatom; WITH->name = ap.UU.U1.arc; } -Void use_91(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_91 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* for lists - modifies list descriptor and makes it 1 element shorter by deleting ladst element ; @@ -650,128 +721,139 @@ long p1, p2, p3, *rez; if argument is not list then returns null. e.g. - $a:=(.a.) - #call_pas(91 $a) returns null , but $a retain (.a.) + $a:=(.a.) + #call_pas(91 $a) returns null , but $a retain (.a.) - $a:=(.a b.) - #call_pas(91 $a) returns (.a.), and $a is (.a.) + $a:=(.a b.) + #call_pas(91 $a) returns (.a.), and $a is (.a.) */ ptr_ ap; longint len, i; *rez = null_; - points(p1, &xx.sa); + assert_and_assign_real_pointer (p1, &xx.sa); if (xx.smld->dtype != listmain) return; len = xx.smld->totalelnum; if (len == 1 || len == 0) return; - first(p1, &ap); + first (p1, &ap); for (i = 1; i <= len - 2; i++) - next(&ap); + next (&ap); /* we are standing on the last element of future list */ /* the next elements (or descriptor) are to cut off, we split to 4 cases main/fragm element/descriptor */ *rez = p1; - points(ap.UU.U1.curfragment, &xx.sa); - if (xx.smld->dtype == listmain) { - if (ap.nel == mainlistelnum) { - xx.smld->next = null_; + assert_and_assign_real_pointer (ap.UU.U1.curfragment, &xx.sa); + if (xx.smld->dtype == listmain) + { + if (ap.nel == mainlistelnum) + { + xx.smld->next = null_; + xx.smld->lastfragm = ap.UU.U1.curfragment; + /* correction 8-apr-1993 */ + } + else + xx.smld->elnum--; + xx.smld->totalelnum--; + return; + } + if (ap.nel == fragmlistelnum) + { + xx.sfld->next = null_; + assert_and_assign_real_pointer (p1, &xx.sa); xx.smld->lastfragm = ap.UU.U1.curfragment; /* correction 8-apr-1993 */ - } else - xx.smld->elnum--; - xx.smld->totalelnum--; - return; - } - if (ap.nel == fragmlistelnum) { - xx.sfld->next = null_; - points(p1, &xx.sa); - xx.smld->lastfragm = ap.UU.U1.curfragment; - /* correction 8-apr-1993 */ - } else + } + else xx.sfld->elnum--; - points(p1, &xx.sa); + assert_and_assign_real_pointer (p1, &xx.sa); xx.smld->totalelnum--; } -Static long selection(tree, arc) -long tree, arc; +static long +selection (tree, arc) + long tree, arc; { long Result; ptr_ ap; Result = null_; - first(tree, &ap); + first (tree, &ap); if (ap.ptrtype != ptrtree) return Result; while (ap.nel != null_ && ap.UU.U1.arc != arc) - next(&ap); + next (&ap); if (ap.UU.U1.arc == arc) return (ap.cel); return Result; } -Static long indexing(list, index) -long list, index; +static long +indexing (list, index) + long list, index; { long Result; ptr_ ap; longint maxind, i; Result = null_; - first(list, &ap); + first (list, &ap); if (ap.ptrtype != ptrlist) return Result; - pointr(list, &xx.sa); + assert_and_assign_real_pointer (list, &xx.sa); maxind = xx.smld->totalelnum; if (index < -maxind || index == 0 || index > maxind) return Result; if (index < 0) index += maxind + 1; for (i = 1; i < index; i++) - next(&ap); + next (&ap); return (ap.cel); } -Void use_92(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_92 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* traverses list "p1". - if element is a number then index is applied to "p2" - if element is an atom the selection ia applied to "p2" */ + if element is a number then index is applied to "p2" + if element is an atom the selection ia applied to "p2" */ ptr_ ap; *rez = p2; - first(p1, &ap); - if (ap.ptrtype != ptrlist) { - *rez = null_; - return; - } - while (ap.nel != null_) { - pointr(ap.cel, &xx.sa); - if (xx.snd->dtype == number) - *rez = indexing(*rez, xx.snd->val); - else if (xx.sad->dtype == idatom) - *rez = selection(*rez, xx.sad->name); - else + first (p1, &ap); + if (ap.ptrtype != ptrlist) + { *rez = null_; - if (*rez == null_) return; - next(&ap); - } + } + while (ap.nel != null_) + { + assert_and_assign_real_pointer (ap.cel, &xx.sa); + if (xx.snd->dtype == number) + *rez = indexing (*rez, xx.snd->val); + else if (xx.sad->dtype == idatom) + *rez = selection (*rez, xx.sad->name); + else + *rez = null_; + if (*rez == null_) + return; + next (&ap); + } } -Void use_93(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_93 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - /* returns stack size*/ + /* returns stack size */ *rez = 0; } @@ -779,261 +861,297 @@ long p1, p2, p3, *rez; -Void use_108(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_108 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* get environment variable ; requires variable name(string) returns null if absent - or value (converted to number if possible) */ + or value (converted to number if possible) */ *rez = 0; - if (plstr(p1, str_, &l, true, sv1)) { + if (plstr (p1, str_, &l, true, sv1)) + { - *rez = str_to_atom(getenv(sv1)); - } + *rez = str_to_atom (getenv (sv1)); + } } -Void use_110(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_110 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - *rez = 0; - } + *rez = 0; +} -Void use_111(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_111 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { - *rez = 0; - } + *rez = 0; +} -Void use_116(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_116 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { /* returns c-string value 'a"bc\n' -> '"abc\\m\"' */ long i, FORLIM; *rez = 0; - if (!plstr(p1, str_, &l, true, sv1)) + if (!plstr (p1, str_, &l, true, sv1)) return; - strcpy(sv2, "\""); + strcpy (sv2, "\""); FORLIM = l; - for (i = 0; i < FORLIM; i++) { - if (sv1[i] == '\\' || sv1[i] == '"') - strcat(sv2, "\\"); - sprintf(sv2 + strlen(sv2), "%c", sv1[i]); - } - strcat(sv2, "\""); - *rez = str_to_atom(sv2); + for (i = 0; i < FORLIM; i++) + { + if (sv1[i] == '\\' || sv1[i] == '"') + strcat (sv2, "\\"); + sprintf (sv2 + strlen (sv2), "%c", sv1[i]); + } + strcat (sv2, "\""); + *rez = str_to_atom (sv2); } /* floating point processor */ -Void use_80(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_80 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { long real_size; long i; double re1, re2, re3; - Char c1, c2_; + char c1, c2_; mpd x; double *refr2, *refr3; numberdescriptor *WITH; atomdescriptor *WITH1; - real_size = sizeof(double); - *rez = 0; /* in case of unsuccessful data returns null */ - if (!plstr(p1, str1_, &l, false, sv1)) + real_size = sizeof (double); + *rez = 0; /* in case of unsuccessful data returns null */ + if (!plstr (p1, str1_, &l, false, sv1)) goto _L1; c1 = str1_[0]; - if (l > 1 ) + if (l > 1) c2_ = str1_[1]; else c2_ = ' '; - switch (c1) { /*1*/ - - case 'S': /* string -> real */ - if (!plstr(p2, str_, &l, true, sv1)) - goto _L1; - val2(sv1, &re1, &i); - if (i != 0) - goto _L1; - break; - - case 'I': /*2*/ - /* integer -> real */ - if (!plnum(p2, &im[1])) - goto _L1; - re1 = im[1]; /* *1.0 */ - break; - - - /* real -> ... */ - - default: - if (!plstr(p2, str_, &l, false, sv1)) - goto _L1; - if (l != real_size) - goto _L1; - refr2 = (double *)str_; - /* re2 = *refr2; */ - memcpy(&re2,refr2,sizeof(double)); - switch (c1) { /*3*/ - - case 'T': - im[2] = (long)re2; - gets1(rez, &x.sa); - WITH = x.snd; - WITH->dtype = number; - WITH->val = im[2]; - goto _L1; - break; + switch (c1) + { /*1 */ - case 'Z': /*4*/ - if (!plnum(p3, &im[1])) + case 'S': /* string -> real */ + if (!plstr (p2, str_, &l, true, sv1)) + goto _L1; + val2 (sv1, &re1, &i); + if (i != 0) goto _L1; - real_to_string_f(svar, re2, im[1] / 100, im[1] % 100); -/* p2c: ./use80.pas, line 48: - * Note: Using % for possibly-negative arguments [317] */ - i = strlen(svar); - putatm(svar, i, &atm); - gets1(rez, &x.sa); - WITH1 = x.sad; - WITH1->dtype = atom; - WITH1->name = atm; - goto _L1; break; - case 'V': /*4*/ - sprintf(svar,"%E",re2); - i = strlen(svar); - putatm(svar, i, &atm); - gets1(rez, &x.sa); - WITH1 = x.sad; - WITH1->dtype = atom; - WITH1->name = atm; - goto _L1; - break; - - case 'F': - if (!plstr(p3, str_, &l, true, sv1)) - goto _L1; - sprintf(svar,sv1,re2); - i = strlen(svar); - putatm(svar, i, &atm); - gets1(rez, &x.sa); - WITH1 = x.sad; - WITH1->dtype = atom; - WITH1->name = atm; - goto _L1; - break; - - - - case 'Q': if (re2>0) re1=sqrt(re2); else goto _L1; break; - case 'X': re1=exp(re2); break; - case 'L': if (re2>0) re1=log(re2); else goto _L1; break; - - - case 't': - if (!strncmp("tSIN",str1_,4)) re1=sin(re2); - else if (!strncmp("tCOS",str1_,4)) re1=cos(re2); - else if (!strncmp("tTAN",str1_,4)) re1=tan(re2); - else if (!strncmp("tASIN",str1_,5)) re1=asin(re2); - else if (!strncmp("tACOS",str1_,5)) re1=acos(re2); - else if (!strncmp("tATAN",str1_,5)) re1=atan(re2); - break; - - default: - if (!plstr(p3, str_, &l, false, sv1)) - goto _L1; - if (l != real_size) + case 'I': /*2 */ + /* integer -> real */ + if (!plnum (p2, &im[1])) goto _L1; - refr3 = (double *)str_; - /* re3 = *refr3; */ - memcpy(&re3,refr3,sizeof(double)); - - switch (c1) { /*5*/ - - case '+': - re1 = re2 + re3; - break; - - case '-': - re1 = re2 - re3; - break; + re1 = im[1]; /* *1.0 */ + break; - case '*': - re1 = re2 * re3; - break; - case '/': - if (re3 == 0) - goto _L1; - re1 = re2 / re3; - break; + /* real -> ... */ - case '=': - if (re2 == re3) - *rez = p2; - goto _L1; - break; - - case '>': - if (c2_ == '=') { - if (re2 >= re3) - *rez = p2; - } else { - if (re2 > re3) - *rez = p2; - } + default: + if (!plstr (p2, str_, &l, false, sv1)) goto _L1; - break; - - case '<': - if (c2_ == '=') { - if (re2 <= re3) - *rez = p2; - } else if (c2_ == '>') { - if (re2 != re3) - *rez = p2; - } else if (re2 < re3) - *rez = p2; + if (l != real_size) goto _L1; - break; - - - case 'P': - re1=pow(re2,re3); break; + refr2 = (double *) str_; + /* re2 = *refr2; */ + memcpy (&re2, refr2, sizeof (double)); + switch (c1) + { /*3 */ + + case 'T': + im[2] = (long) re2; + gets1 (rez, &x.sa); + WITH = x.snd; + WITH->dtype = number; + WITH->val = im[2]; + goto _L1; + break; - default: /* wrong real operation */ - goto _L1; - break; - }/*5*/ - /*4*/ + case 'Z': /*4 */ + if (!plnum (p3, &im[1])) + goto _L1; + real_to_string_f (svar, re2, im[1] / 100, im[1] % 100); +/* p2c: ./use80.pas, line 48: + * Note: Using % for possibly-negative arguments [317] */ + i = strlen (svar); + putatm (svar, i, &atm); + gets1 (rez, &x.sa); + WITH1 = x.sad; + WITH1->dtype = atom; + WITH1->name = atm; + goto _L1; + break; + + case 'V': /*4 */ + sprintf (svar, "%E", re2); + i = strlen (svar); + putatm (svar, i, &atm); + gets1 (rez, &x.sa); + WITH1 = x.sad; + WITH1->dtype = atom; + WITH1->name = atm; + goto _L1; + break; + + case 'F': + if (!plstr (p3, str_, &l, true, sv1)) + goto _L1; + sprintf (svar, sv1, re2); + i = strlen (svar); + putatm (svar, i, &atm); + gets1 (rez, &x.sa); + WITH1 = x.sad; + WITH1->dtype = atom; + WITH1->name = atm; + goto _L1; + break; + + + + case 'Q': + if (re2 > 0) + re1 = sqrt (re2); + else + goto _L1; + break; + case 'X': + re1 = exp (re2); + break; + case 'L': + if (re2 > 0) + re1 = log (re2); + else + goto _L1; + break; + + + case 't': + if (!strncmp ("tSIN", str1_, 4)) + re1 = sin (re2); + else if (!strncmp ("tCOS", str1_, 4)) + re1 = cos (re2); + else if (!strncmp ("tTAN", str1_, 4)) + re1 = tan (re2); + else if (!strncmp ("tASIN", str1_, 5)) + re1 = asin (re2); + else if (!strncmp ("tACOS", str1_, 5)) + re1 = acos (re2); + else if (!strncmp ("tATAN", str1_, 5)) + re1 = atan (re2); + break; + + default: + if (!plstr (p3, str_, &l, false, sv1)) + goto _L1; + if (l != real_size) + goto _L1; + refr3 = (double *) str_; + /* re3 = *refr3; */ + memcpy (&re3, refr3, sizeof (double)); + + switch (c1) + { /*5 */ + + case '+': + re1 = re2 + re3; + break; + + case '-': + re1 = re2 - re3; + break; + + case '*': + re1 = re2 * re3; + break; + + case '/': + if (re3 == 0) + goto _L1; + re1 = re2 / re3; + break; + + case '=': + if (re2 == re3) + *rez = p2; + goto _L1; + break; + + case '>': + if (c2_ == '=') + { + if (re2 >= re3) + *rez = p2; + } + else + { + if (re2 > re3) + *rez = p2; + } + goto _L1; + break; + + case '<': + if (c2_ == '=') + { + if (re2 <= re3) + *rez = p2; + } + else if (c2_ == '>') + { + if (re2 != re3) + *rez = p2; + } + else if (re2 < re3) + *rez = p2; + goto _L1; + break; + + + case 'P': + re1 = pow (re2, re3); + break; + + default: /* wrong real operation */ + goto _L1; + break; + } /*5 */ + /*4 */ + break; + } /*3 */ + /*2 */ break; - }/*3*/ - /*2*/ - break; - }/*1*/ + } /*1 */ /* this part processes only + - * / s(str->real) i(int->real) */ - refr2 = (double *)svar; + refr2 = (double *) svar; /* *refr2 = re1; */ - memcpy(refr2,&re1,sizeof(double)); + memcpy (refr2, &re1, sizeof (double)); - putatm(svar, real_size, &atm); - gets1(rez, &x.sa); + putatm (svar, real_size, &atm); + gets1 (rez, &x.sa); WITH1 = x.sad; WITH1->dtype = fatom; WITH1->name = atm; -_L1: ; +_L1:; } @@ -1042,664 +1160,774 @@ _L1: ; /* these procedures currently are used in ibm/pc version of rigal. don't use them for future compatibility */ -Void use_2(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_2 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_3(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_3 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_5(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_5 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_6(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_6 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_7(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_7 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_8(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_8 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_11(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_11 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_17(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_17 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_18(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_18 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_22(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_22 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_23(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_23 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_24(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_24 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_25(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_25 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_26(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_26 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_27(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_27 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_28(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_28 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_29(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_29 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_32(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_32 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_33(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_33 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_34(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_34 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_37(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_37 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_39(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_39 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_47(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_47 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_48(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_48 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_49(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_49 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_50(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_50 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_51(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_51 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_52(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_52 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_53(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_53 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_54(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_54 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_55(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_55 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_56(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_56 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_57(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_57 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_58(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_58 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_59(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_59 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_60(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_60 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_61(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_61 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_62(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_62 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_63(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_63 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_64(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_64 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_65(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_65 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_66(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_66 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_67(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_67 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_68(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_68 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_69(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_69 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_70(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_70 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_71(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_71 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_72(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_72 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_73(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_73 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_74(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_74 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_75(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_75 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_76(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_76 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_77(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_77 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_81(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_81 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_82(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_82 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_83(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_83 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_84(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_84 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_89(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_89 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_94(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_94 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_95(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_95 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_96(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_96 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_97(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_97 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_98(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_98 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_99(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_99 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_100(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_100 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_101(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_101 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_102(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_102 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_103(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_103 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_104(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_104 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_105(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_105 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_106(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_106 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_107(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_107 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_109(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_109 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_112(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_112 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_113(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_113 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_114(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_114 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_115(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_115 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_117(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_117 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_118(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_118 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_119(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_119 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } /* these procedures are not used , you can use them ! */ -Void use_120(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_120 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_122(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_122 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_123(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_123 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_124(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_124 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_125(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_125 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_126(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_126 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_127(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_127 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_128(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_128 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_129(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_129 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_130(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_130 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_131(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_131 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_132(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_132 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_133(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_133 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_134(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_134 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_135(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_135 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_136(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_136 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_137(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_137 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_138(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_138 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_139(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_139 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_140(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_140 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_141(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_141 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_142(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_142 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_143(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_143 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_144(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_144 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_145(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_145 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_146(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_146 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_147(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_147 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_148(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_148 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_149(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_149 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } -Void use_150(p1, p2, p3, rez) -long p1, p2, p3, *rez; +void +use_150 (p1, p2, p3, rez) + long p1, p2, p3, *rez; { } @@ -1707,4 +1935,3 @@ long p1, p2, p3, *rez; /* End. */ - diff --git a/RIGAL/rigsc.446/src/v.c b/RIGAL/rigsc.446/src/v.c index 669a06c1eb739e9d56b59f393ff109024953e76d..f514d63d999610028c40d2e8195a9602d3459cf1 100644 --- a/RIGAL/rigsc.446/src/v.c +++ b/RIGAL/rigsc.446/src/v.c @@ -4,29 +4,34 @@ #include "ley.h" #include "nef2.h" -int main(int argc,char *argv[]) +int +main (int argc, char *argv[]) { string80 s; a a1; out = NULL; - if (argc > 1) { - strcpy(s,argv[1]); - brt(s); - if (existfile(s)) { - max_printlevel = max_printconst; - opena(); - opens('&'); - init_dinform(); - loads(s, &a1); - pscr(a1); - } else - printf("Error: file %s not found\n", s); - } else - printf("Usage: v filename\n"); + if (argc > 1) + { + strcpy (s, argv[1]); + keep_string_up_to_first_space (s); + if (existfile (s)) + { + max_printlevel = max_printconst; + opena (); + opens (); + init_dinform (); + loads (s, &a1); + pscr (a1); + } + else + printf ("Error: file %s not found\n", s); + } + else + printf ("Usage: v filename\n"); if (out != NULL) - fclose(out); - exit(0); + fclose (out); + exit (0); }