home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume3 / trc / part8 < prev    next >
Encoding:
Text File  |  1986-11-30  |  42.9 KB  |  1,715 lines
  1. Newsgroups: mod.sources
  2. Subject: TRC - expert system building tool (part 8 of 8)
  3. Approved: jpn@panda.UUCP
  4.  
  5. Mod.sources:  Volume 3, Issue 116
  6. Submitted by: ihnp4!dicomed!ndsuvax!nckary (Daniel D. Kary)
  7.  
  8. : This is a shar archive.  Extract with sh, not csh.
  9. : The rest of this file will extract:
  10. : p_out.c parser scanner.c
  11. echo extracting - p_out.c
  12. sed 's/^X//' > p_out.c << '!EOR!'
  13. X/*      P_OUT.C -- Translate production rules to pascal.   Version 1.1    */
  14. X/*      co-authored by Dean Hystad and Dan Kary.                          */
  15. X
  16. X#include    <stdio.h>
  17. X#include     "main.h"
  18. X
  19. XFILE *fp,*lp;
  20. X
  21. Xchar *p_type_names[4] = {
  22. X            "integer",
  23. X            "real",
  24. X            "strings",
  25. X            "record"
  26. X};
  27. X
  28. Xp_gen_test()
  29. X/* generate procedures to test each data type and return a relop code */
  30. X{
  31. X    int i;
  32. X
  33. X    for(i = 0; i < 3; i++){
  34. X            fprintf(fp,"\n\nfunction %stest_%s(", prefix, p_type_names[i]) ;
  35. X            fprintf(fp,"\n\t\ta, b: %s ):", p_type_names[i]) ;
  36. X        fprintf(fp,"\n\t\tinteger ;") ;
  37. X            fprintf(fp,"\n\nvar\n\treturn: integer ;") ;
  38. X        fprintf(fp,"\n\nbegin\n") ;
  39. X        fprintf(fp,"\tif(a < b) then return := 4\n");
  40. X        fprintf(fp,"\telse if(a = b) then return := 2\n");
  41. X        fprintf(fp,"\telse return := 1 ;\n");
  42. X        fprintf(fp,"\t%stest_%s := return\n", prefix, p_type_names[i]) ;
  43. X        fprintf(fp,"end ;\n") ;
  44. X    }
  45. X}
  46. X
  47. X
  48. Xp_gen_search()
  49. X/* generate procedures to search each structure for a compound match */
  50. X{
  51. X    int    i;
  52. X    struct def_list *temp;
  53. X    struct data_type *temp2;
  54. X    struct case_list *c_temp;
  55. X
  56. X    temp = token_list;
  57. X    while(temp){
  58. X        if(temp->data_types){
  59. X        temp2 = temp->data_types;
  60. X        fprintf(fp,"\n\nfunction search_%s%s_record(\n\t\tndx : integer",prefix,temp->name);
  61. X        while(temp2){
  62. X            if(temp2->type <= 2){
  63. X                fprintf(fp," ;\n\t\t%s : %s",temp2->name,p_type_names[temp2->type]);
  64. X                fprintf(fp," ;\n\t\t%s_relop : integer",temp2->name);
  65. X            if(temp2->elts)
  66. X                fprintf(fp," ;\n\t\t%s_case : %s",temp2->name,p_type_names[temp2->type]);
  67. X            }
  68. X            temp2 = temp2->next;
  69. X        }
  70. X        fprintf(fp," ):\n\t\t%s%s_record_ptr ;\n\n",prefix,temp->name);
  71. X        fprintf(fp,"var\n");
  72. X        fprintf(fp,"\tflag : integer ;\n");
  73. X        fprintf(fp,"\ttemp : %s%s_record_ptr ;\n", prefix,temp->name);
  74. X        fprintf(fp,"\treturn : %s%s_record_ptr ;\n\n",prefix,temp->name);
  75. X        fprintf(fp,"begin\n");
  76. X        fprintf(fp,"\treturn := nil ;\n");
  77. X        fprintf(fp,"\tflag := 0 ;\n");
  78. X        fprintf(fp,"\ttemp := %s%s_temp[ndx];\n\twhile (flag=0) and (temp <> nil) do begin", prefix,temp->name);
  79. X        temp2 = temp->data_types;
  80. X        fprintf(fp,"\n\t\tif temp^.MARK = 0 then begin");
  81. X        fprintf(fp,"\n\t\t\tflag := 7 ;");
  82. X        while(temp2){
  83. X            if(temp2->type <= 2){
  84. X            if(temp2->elts){
  85. X                fprintf(fp,"\n\t\t\tcase( %s_case )of",temp2->name);
  86. X                fprintf(fp,"\n\t\t\t0:");
  87. X            }
  88. X            fprintf(fp,"\n");
  89. X            if(temp2->elts) fprintf(fp,"\t");
  90. X                fprintf(fp,"\t\t\tif( (flag and %stest_", prefix);
  91. X            fprintf(fp,"%s",p_type_names[temp2->type]);
  92. X                fprintf(fp,"(temp^.%s, %s) and %s_relop)=0 )then",
  93. X                temp2->name, temp2->name, temp2->name);
  94. X            fprintf(fp,"\n\t\t\t\tflag := 0 ;");
  95. X            if(temp2->elts){
  96. X                c_temp = temp2->elts;
  97. X                while(c_temp){
  98. X                fprintf(fp,"\n\t\t\t%d:", c_temp->id);
  99. X                    fprintf(fp,"\n\t\t\t\tif( (flag and test_");
  100. X                fprintf(fp,"%s",p_type_names[temp2->type]);
  101. X                    fprintf(fp,"(temp^.%s, temp^.%s)and %s_relop)=0 ) then",
  102. X                        temp2->name, c_temp->name, temp2->name);
  103. X                fprintf(fp,"\n\t\t\t\tflag := 0 ;");
  104. X                c_temp = c_temp->next;
  105. X                }
  106. X                fprintf(fp,"\n\t\t\telse: flag := 0 ;\n\t\t\tend ;\n\t\t\tend ;");
  107. X            }
  108. X              }
  109. X              temp2 = temp2->next;
  110. X            }
  111. X            fprintf(fp,"\n\t\t\tif( flag<>0 )then begin\n\t\t\t\ttemp^.MARK := 1;\n");
  112. X            fprintf(fp,"\t\t\t\treturn := temp ;\n\t\t\tend ;\n\t\tend ;\n\t\ttemp := temp^.next ;\n");
  113. X            fprintf(fp,"\tend ;\n\tsearch_%s%s_record := return ;\nend ;\n",prefix, temp->name);
  114. X                
  115. X        }
  116. X        temp = temp->next;
  117. X    }
  118. X}
  119. X    
  120. X
  121. Xp_gen_free()
  122. X/* generate procedures to free a structure */
  123. X{
  124. X    int     i;
  125. X    struct def_list *temp;
  126. X    struct data_type *temp2;
  127. X
  128. X    temp = token_list;
  129. X    while(temp){
  130. X      if(temp->data_types){
  131. X         fprintf(fp,"\n\nprocedure free_%s%s_record(\n",prefix,temp->name);
  132. X         fprintf(fp,"\t\tstart : integer ) ;\n\n");
  133. X         fprintf(fp,"var\n\ti : integer ;\n\nbegin\n");
  134. X         fprintf(fp,"\ti := start ;\n");
  135. X         fprintf(fp,"\twhile( i < %s%s_max )do begin\n",prefix, temp->name);
  136. X         fprintf(fp,"\t\tif( %s%s_list[i] <> nil )then begin\n",prefix, temp->name);
  137. X         fprintf(fp,"\t\t\tif( %s%s_list[i]^.prev = nil )then\n",prefix, temp->name);
  138. X         fprintf(fp,"\t\t\t\t%s%s_list[0] := %s%s_list[i]^.next\n",prefix,temp->name,prefix,temp->name);
  139. X         fprintf(fp,"\t\t\telse\n");
  140. X         fprintf(fp,"\t\t\t\t%s%s_list[i]^.prev^.next := %s%s_list[i]^.next ;\n",prefix,temp->name,prefix,temp->name);
  141. X         fprintf(fp,"\t\t\tif( %s%s_list[i]^.next <> nil )then\n",prefix,temp->name);
  142. X         fprintf(fp,"\t\t\t\t%s%s_list[i]^.next^.prev := %s%s_list[i]^.prev ;\n",prefix,temp->name,prefix,temp->name);
  143. X          temp2 = temp->data_types;
  144. X         fprintf(fp,"\t\t\tdispose( %s%s_list[i] ) ;\n",prefix,temp->name);
  145. X         fprintf(fp,"\t\t\t%s%s_list[i] := nil ;\n",prefix,temp->name);
  146. X         fprintf(fp,"\t\t\ti := %s%s_max ;\n",prefix,temp->name);
  147. X         fprintf(fp,"\t\t\t%stoken[%s%s]:= %stoken[%s%s]-1 ;\n",prefix,prefix,temp->name,prefix,temp->name);
  148. X         fprintf(fp,"\t\tend ;\n\t\ti := i+1 ;\n\tend ;\nend ;\n");
  149. X      }
  150. X      temp = temp->next;
  151. X    }
  152. X}
  153. X
  154. X
  155. Xp_gen_restore()
  156. X/* generate procedure to restore structures */
  157. X{
  158. X    int     i;
  159. X    struct def_list *temp;
  160. X
  161. X    temp = token_list;
  162. X    fprintf(fp,"\n\nprocedure %srestore ;\n\n", prefix);
  163. X    fprintf(fp,"var\n\ti : integer ;\n\nbegin\n");
  164. X    while(temp){
  165. X      if(temp->data_types){
  166. X        fprintf(fp,"\tfor i := 1 to %s%s_max-1 do\n", prefix,temp->name);
  167. X        fprintf(fp,"\t\tif(%s%s_list[i] <> nil)then begin\n", prefix,temp->name);
  168. X        fprintf(fp,"\t\t\t%s%s_list[i]^.MARK := 0 ;\n", prefix, temp->name);
  169. X        fprintf(fp,"\t\t\t%s%s_list[i] := nil ;\n", prefix,temp->name);
  170. X        fprintf(fp,"\t\tend ;\n");
  171. X      }
  172. X      temp = temp->next;
  173. X    }
  174. X    fprintf(fp,"end ;\n");
  175. X}
  176. X
  177. X
  178. Xp_gen_add()
  179. X/* generate procedures to add each structure to a list */
  180. X{
  181. X    int     i;
  182. X    struct def_list *temp;
  183. X    struct data_type *temp2;
  184. X
  185. X    temp = token_list;
  186. X    while(temp){
  187. X        fprintf(fp,"\nprocedure %sadd_%s_record", prefix,temp->name);
  188. X        if(temp->data_types){
  189. X        fprintf(fp,"(\n");
  190. X        temp2 = temp->data_types;
  191. X        i = 0;
  192. X        while(temp2){
  193. X                if(i) fprintf(fp," ;\n");    
  194. X            if((temp2->type >= 0) && (temp2->type <= 2))
  195. X                fprintf(fp,"\t\t%s: %s",temp2->name,p_type_names[temp2->type]);
  196. X            i=1;
  197. X            temp2 = temp2->next;
  198. X        }
  199. X        fprintf(fp," )");
  200. X        }
  201. X        fprintf(fp," ;\n\n");
  202. X        if(temp->data_types){
  203. X        fprintf(fp,"var\n");
  204. X        fprintf(fp,"\ttemp : %s%s_record_ptr ;\n", prefix, temp->name);
  205. X        }
  206. X        fprintf(fp,"\nbegin\n");
  207. X        if(temp->data_types){
  208. X        fprintf(fp,"\tnew(temp) ;\n"); 
  209. X            temp2 = temp->data_types;
  210. X            while(temp2){
  211. X            if(temp2->type <= 2) 
  212. X            fprintf(fp,"\ttemp^.%s := %s ;\n",temp2->name,temp2->name);
  213. X              temp2 = temp2->next;
  214. X            }
  215. X            fprintf(fp,"\ttemp^.MARK := 0 ;\n");
  216. X            fprintf(fp,"\ttemp^.next := %s%s_list[0] ;\n",prefix,temp->name);
  217. X            fprintf(fp,"\ttemp^.prev := nil ;\n");
  218. X            fprintf(fp,"\tif(%s%s_list[0] <> nil)then\n",prefix,temp->name);
  219. X            fprintf(fp,"\t\t%s%s_list[0]^.prev := temp ;\n",prefix,temp->name);
  220. X            fprintf(fp,"\t%s%s_list[0] := temp ;\n",prefix,temp->name);
  221. X        }
  222. X        fprintf(fp,"\t%stoken[%s%s] := %stoken[%s%s]+1 ;\n",prefix,prefix,temp->name,prefix,prefix,temp->name);
  223. X        fprintf(fp,"end ;\n\n");
  224. X            temp = temp->next;
  225. X    }
  226. X}
  227. X
  228. Xp_gen_init(mode)
  229. X/* generate procedure to initialize stm */
  230. X/* if mode is zero, then generate only code to add to stm */
  231. Xint mode;
  232. X{
  233. X    int i;
  234. X    struct init *temp;
  235. X    struct fields *temp2;
  236. X    struct def_list *t, *d_temp;
  237. X    struct data_type *t2;
  238. X
  239. X    temp = init_list->next;            /* the first one is a place holder */
  240. X    if(mode){
  241. X        fprintf(fp,"\n\nprocedure %sinit ;\n\nvar\n\ti : integer ;\n\n", prefix);
  242. X        fprintf(fp,"begin\n");
  243. X        fprintf(fp,"\tfor i := 0 to %d do\n",total_tokens-1);
  244. X        fprintf(fp,"\t\t%stoken[i] := 0 ;\n",prefix);
  245. X        d_temp = token_list;
  246. X        for(i = 0; i < total_tokens; i++){
  247. X            fprintf(fp,"\t%stoken_name[%d] := '%s%s' ;\n",prefix,i,prefix,d_temp->name);
  248. X            d_temp = d_temp->next ;
  249. X        }
  250. X        d_temp = token_list;
  251. X        while(d_temp){
  252. X            if(d_temp->data_types){
  253. X            fprintf(fp,"\tfor i := 0 to %s%s_max do begin\n",prefix,d_temp->name);
  254. X            fprintf(fp,"\t\t%s%s_list[i] := nil ;\n",prefix,d_temp->name);
  255. X            fprintf(fp,"\t\t%s%s_temp[i] := nil ;\n",prefix,d_temp->name);
  256. X            fprintf(fp,"\tend ;\n");
  257. X            }
  258. X            d_temp = d_temp->next;
  259. X        }
  260. X    }
  261. X    while(temp){
  262. X        if(temp->count){
  263. X            if(mode == 0) fprintf(fp,"\t\t");
  264. X        fprintf(fp,"\tfor i := 0 to %d do\n\t",temp->count-1);
  265. X        }
  266. X        if(mode == 0) fprintf(fp,"\t\t");
  267. X        fprintf(fp,"\t%sadd_%s_record" , prefix, temp->object);
  268. X        t = token_list;
  269. X        while(strcmp(t->name, temp->object) != 0)
  270. X        t = t->next;
  271. X        i = 0;
  272. X        t2 = t->data_types;
  273. X            if(t->data_types) fprintf(fp,"( ");
  274. X        while(t2){
  275. X        temp2 = temp->items;
  276. X        while((temp2) && (strcmp(temp2->element, t2->name) != 0))
  277. X            temp2 = temp2->next;
  278. X        if((temp2) && (temp2->type != 3)){
  279. X            if(i) fprintf(fp,", "); i = 1;
  280. X            if(temp2->type >= 0){
  281. X                if(temp2->type == 2) fprintf(fp,"'");
  282. X                fprintf(fp,"%s",temp2->value);
  283. X                if(temp2->type == 2) fprintf(fp,"'");
  284. X            }
  285. X            else{
  286. X            if(temp2->empty)
  287. X               fprintf(fp,"%s%s_empty[%d].%s", prefix,temp2->object,
  288. X                temp2->index, temp2->value);
  289. X            else
  290. X               fprintf(fp,"%s%s_list[%d]^.%s", prefix,temp2->object,
  291. X                temp2->index, temp2->value);
  292. X            }
  293. X        }
  294. X        else if(t2->type != 3){
  295. X            if(i) fprintf(fp,", "); i = 1;
  296. X            if(t2->type == 2)
  297. X            fprintf(fp,"''");
  298. X            if(t2->type == 1)
  299. X            fprintf(fp,"0.0");
  300. X            if(t2->type == 0)
  301. X            fprintf(fp,"0");
  302. X        }
  303. X        t2 = t2->next;
  304. X        }
  305. X        if(t->data_types) fprintf(fp," )");
  306. X        fprintf(fp," ;\n");
  307. X        temp = temp->next;
  308. X    }
  309. X    if(mode){
  310. X        fprintf(fp,"end ;\n\n\n");
  311. X    }
  312. X}
  313. X
  314. X
  315. Xp_gen_structs()
  316. X/* generate structure definitions from token list */
  317. X{
  318. X    int i;
  319. X    struct def_list *temp;
  320. X    struct data_type *temp2;
  321. X
  322. X    i = 0;
  323. X    temp = token_list;
  324. X    while(temp){
  325. X      if(temp->data_types){
  326. X        fprintf(fp,"\n\t%s%s_record_ptr = ^%s%s_record ;\n", prefix,temp->name,prefix,temp->name);
  327. X        fprintf(fp,"\n\t%s%s_record = record\n",prefix,temp->name);
  328. X        if(temp->data_types){
  329. X        temp2 = temp->data_types;
  330. X        while(temp2){
  331. X            if(temp2->type != 3)
  332. X                fprintf(fp,"\t\t%s : %s ;\n",temp2->name,p_type_names[temp2->type]);
  333. X            else
  334. X                fprintf(fp,"\t\t%s : %s%s_record_ptr ;\n", temp2->name,prefix,temp->name);
  335. X            temp2 = temp2->next;
  336. X        }
  337. X        }
  338. X        fprintf(fp,"\t\tMARK : integer ;\n");
  339. X        fprintf(fp,"\t\tprev : %s%s_record_ptr ;\n", prefix,temp->name);
  340. X        fprintf(fp,"\t\tnext : %s%s_record_ptr ;\n", prefix,temp->name);
  341. X        fprintf(fp,"\tend ;\n\n");
  342. X      }
  343. X      i++;
  344. X      temp = temp->next;
  345. X    }
  346. X}
  347. X
  348. X
  349. Xp_gen_zero()
  350. X/*
  351. Xgenerate a procedure that will free or zero all data
  352. Xstructures generated by trc
  353. X*/
  354. X{
  355. X    int i;
  356. X    struct def_list *d_temp;
  357. X    struct data_type *dt_temp;
  358. X
  359. X    fprintf(fp,"\n\nprocedure %szero ;\n\nvar\n\ti : integer ;\n",prefix);
  360. X    /* pointer definitions */
  361. X    d_temp = token_list;
  362. X    while(d_temp){
  363. X        if(d_temp->data_types)
  364. X            fprintf(fp,"\t%s_tmp : %s%s_record_ptr ;\n", d_temp->name, prefix, d_temp->name);
  365. X        d_temp = d_temp->next;
  366. X    }
  367. X    fprintf(fp,"\nbegin\n");
  368. X    /* free struct lists */
  369. X    d_temp = token_list;
  370. X    while(d_temp){
  371. X        if(d_temp->data_types){
  372. X            fprintf(fp,"\twhile( %s%s_list[0] <> nil )do begin\n", prefix,d_temp->name);
  373. X            fprintf(fp,"\t\t%s%s_list[1] := %s%s_list[0] ;\n", prefix,d_temp->name, prefix,d_temp->name);
  374. X            fprintf(fp,"\t\tfree_%s%s_record(1);\n\tend ;\n", prefix,d_temp->name);
  375. X        }
  376. X        d_temp = d_temp->next;
  377. X    }
  378. X    /* zero structure pointers */
  379. X    d_temp = token_list;
  380. X    while(d_temp){
  381. X        if(d_temp->data_types){
  382. X            fprintf(fp,"\tfor i := 0 to %s%s_max-1 do begin\n", prefix,d_temp->name);
  383. X            fprintf(fp,"\t\t%s%s_list[i] := nil ;\n", prefix,d_temp->name);
  384. X        fprintf(fp,"\t\t%s%s_temp[i] := nil ;\n", prefix,d_temp->name);
  385. X                fprintf(fp,"\tend ;\n");
  386. X        }
  387. X        d_temp = d_temp->next;
  388. X    }
  389. X    /* zero integer arrays */
  390. X    fprintf(fp,"\tfor i := 0 to %d do\n",total_tokens-1);
  391. X    fprintf(fp,"\t\t%stoken[i] := 0 ;\n", prefix);
  392. X    fprintf(fp,"end ;\n");
  393. X}
  394. X
  395. X
  396. Xp_trans_code(rule, list, fp, label)
  397. Xstruct rule *rule;
  398. Xstruct list *list;
  399. XFILE *fp;
  400. Xchar *label;
  401. X{
  402. X    struct match *m_temp;
  403. X    struct list *l_temp;
  404. X    int i, j;
  405. X    char c[512];
  406. X
  407. X    l_temp = list;
  408. X    while(l_temp){
  409. X            i = 0;
  410. X            while(l_temp->name[i]){
  411. X            if(l_temp->name[i] == '$'){
  412. X                i++; j = 0;
  413. X                while(l_temp->name[i] != '.'){
  414. X                c[j] = l_temp->name[i];
  415. X                if(c[j] == '\0'){
  416. X                    fprintf(stderr,"cannot translate %s in rule %s\n",c, rule->label);
  417. X                    fprintf(stderr,"%s\n", l_temp->name);
  418. X                    return;
  419. X                }
  420. X                i++; j++;
  421. X                }
  422. X                i++;
  423. X                c[j] = '\0';
  424. X                m_temp = rule->complex;
  425. X                if((strcmp(c, "FAIL")) == 0){
  426. X                fprintf(fp,"begin");
  427. X                if(rule->recurs == 0)
  428. X                    fprintf(fp,"\n\t\t\t\t%srestore ;\n",prefix);
  429. X                fprintf(fp,"\t\t\t\t{1}goto %s\n\t\t\tend\n",label);
  430. X                }
  431. X                else{
  432. X                  while(m_temp && j){
  433. X                if((strcmp(c, m_temp->free_name)) == 0){
  434. X                    fprintf(fp,"%s%s_", prefix , m_temp->object);
  435. X                    if(m_temp->empty)
  436. X                        fprintf(fp,"empty[%d].", m_temp->index);
  437. X                    else
  438. X                        fprintf(fp,"list[%d]^.", m_temp->index);
  439. X                    j = 0;
  440. X                }
  441. X                m_temp = m_temp->next;
  442. X                  }
  443. X                  if(j){
  444. X                fprintf(stderr,"cannot translate %s in rule %s\n",c, rule->label);
  445. X                fprintf(stderr,"%s\n", l_temp->name);
  446. X                return;
  447. X                  }
  448. X                }
  449. X            }
  450. X            else{
  451. X                fprintf(fp,"%c",l_temp->name[i]);
  452. X                i++;
  453. X            }
  454. X            }
  455. X        fprintf(fp,"\n");
  456. X        l_temp = l_temp->next;
  457. X    }
  458. X}
  459. X
  460. X
  461. Xp_gen_header()
  462. X{
  463. X    struct list *l_temp;
  464. X    struct def_list *d_temp;
  465. X    int i,j;
  466. X
  467. X    l_temp = header_code ;
  468. X    while(l_temp){
  469. X        fprintf(fp,"%s\n",l_temp->name);
  470. X        l_temp = l_temp->next;
  471. X    }
  472. X    d_temp = token_list;
  473. X    fprintf(fp,"const\n");
  474. X    for(i = 0; i < total_tokens; i++){
  475. X        fprintf(fp,"\t%s%s = %d ;\n",prefix,d_temp->name,i);
  476. X        j = max_free[i];
  477. X        if(j < 2) j = 2;
  478. X        fprintf(fp,"\t%s%s_max = %d ;\n",prefix, d_temp->name, j);
  479. X        d_temp = d_temp->next;
  480. X    }
  481. X    fprintf(fp,"\ntype\n\tstrings = string[20] ;");
  482. X    p_gen_structs();
  483. X    fprintf(fp,"\nvar\n");
  484. X    fprintf(fp,"\t%stotal_tokens : integer ;\n",prefix);
  485. X    fprintf(fp,"\t%stoken : array[0..%d]of integer ;\n",prefix,total_tokens-1);
  486. X    fprintf(fp,"\t%stoken_name : array[0..%d]of strings ;\n",prefix,total_tokens-1);
  487. X    i = 0;
  488. X    d_temp = token_list;
  489. X    while(d_temp){
  490. X        if(d_temp->data_types){
  491. X        fprintf(fp,"\t%s%s_list : array[0..%s%s_max]of %s%s_record_ptr ;\n",prefix,d_temp->name,prefix,d_temp->name,prefix,d_temp->name);
  492. X        fprintf(fp,"\t%s%s_temp : array[0..%s%s_max]of %s%s_record_ptr ;\n",prefix,d_temp->name,prefix,d_temp->name,prefix,d_temp->name);
  493. X        if(max_empty[i])
  494. X            fprintf(fp,"\t%s%s_empty : array[0..%d]of %s%s_record ;\n",prefix,d_temp->name,max_empty[i]-1,prefix,d_temp->name);
  495. X        }
  496. X        d_temp = d_temp->next;
  497. X        i++;
  498. X    }
  499. X}
  500. X
  501. X
  502. Xp_translate()
  503. X/* Produce the output code */
  504. X{
  505. X    int i, j, k, l, count, prev_index, label_count;
  506. X    char s[512];
  507. X    struct list *l_temp;
  508. X    struct def_list *d_temp, *d_temp2;
  509. X    struct data_type *dt_temp;
  510. X    struct rule *r_temp, *r_temp2, *r_const;
  511. X    struct match *m_temp, *m_temp2, *m_temp3, *m_temp4;
  512. X    struct test *t_temp;
  513. X    struct list *label_temp;
  514. X
  515. X    if((fp = fopen("loop.p", "w")) == NULL){
  516. X        fprintf(stderr,"Unable to open loop.p\n");
  517. X        exit();
  518. X    }
  519. X        if((lp = fopen("loop.l", "w")) == NULL){
  520. X        fprintf(stderr,"Unable to open loop.l\n");
  521. X        exit();
  522. X    }
  523. X    p_gen_header();
  524. X    p_gen_free();
  525. X    p_gen_restore();
  526. X    p_gen_test();
  527. X    p_gen_search();
  528. X    p_gen_add();
  529. X    init_list = init_list2;
  530. X    p_gen_init(1);
  531. X    fprintf(fp,"\nprocedure %sloop ;\n\nvar\n\ti : integer ;\n", prefix);
  532. X    fprintf(fp,"\nlabel\n\tStart,\n****labels*****\n\tStop ;\n\nbegin\n"); 
  533. X    fprintf(fp,"\twhile True do begin\n%sStart:\n", prefix);
  534. X    r_temp = rule_list;
  535. X    while(r_temp->next != NULL)
  536. X        r_temp = r_temp->next;
  537. X    r_const = r_temp;
  538. X    while(r_temp){
  539. X
  540. X        /* label of this rule */
  541. X        fprintf(fp,"%s%s:\n", prefix,r_temp->label);
  542. X        fprintf(lp,"\t%s%s,\n", prefix, r_temp->label);
  543. X
  544. X        /* test for code that must precede all tests */
  545. X        m_temp3 = m_temp = r_temp->complex;
  546. X        /* skip over empty definitions */
  547. X        while((m_temp) && (m_temp->empty)){
  548. X        m_temp3 = m_temp;
  549. X        m_temp = m_temp->next;
  550. X        }
  551. X        /* if the first non empty entry is c_code it must precede all tests */
  552. X          if(m_temp)
  553. X           if(m_temp->c_code){
  554. X        if(r_temp->prev)
  555. X            sprintf(s,"%s%s\0",prefix, r_temp->prev->label);
  556. X        else
  557. X            sprintf(s,"%sEnd\0",prefix);
  558. X        p_trans_code(r_temp, m_temp->c_code, fp, s);
  559. X        /* unlink the code so it isn't inserted twice */
  560. X        m_temp3->next = m_temp->next;
  561. X        }
  562. X
  563. X        /* test for object counts */
  564. X        fprintf(fp,"\t\tif(");
  565. X        d_temp = token_list;
  566. X        for(i = 0; i < total_tokens; i++){
  567. X        if(r_temp->search[i] > 0)
  568. X            fprintf(fp,"(%stoken[%s%s] >= %d) and\n\t\t\t", prefix, prefix,d_temp->name,r_temp->search[i]);
  569. X        if(r_temp->search[i] < 0)
  570. X            fprintf(fp,"(%stoken[%s%s] <= 0) and\n\t\t\t", prefix, prefix,d_temp->name);
  571. X        d_temp = d_temp->next;
  572. X        }
  573. X        d_temp = token_list;
  574. X        fprintf(fp,"True)then begin");
  575. X
  576. X        /* generate complex matching code */
  577. X
  578. X        /* first initialize the current free variable matrix */
  579. X        for(i = 0; i < total_tokens; i++)
  580. X        current_free[i] = 1;
  581. X
  582. X        m_temp = m_temp3 = r_temp->complex;
  583. X        prev_index = 0;
  584. X        while(m_temp){
  585. X        if(m_temp->c_code){
  586. X            if((prev_index == 0) || (r_temp->recurs == 0)){
  587. X                if(r_temp->prev)
  588. X                    sprintf(s,"%s%s\0", prefix,r_temp->prev->label);
  589. X                else
  590. X                    sprintf(s,"%s\0End", prefix);
  591. X            }
  592. X            else
  593. X            sprintf(s,"%s%s_%s_%d\0", prefix,
  594. X                r_temp->label, m_temp3->object, prev_index);
  595. X            p_trans_code(r_temp, m_temp->c_code, fp, s);
  596. X         }
  597. X         else if(m_temp->empty){
  598. X             /* declaration only - don't generate any code */
  599. X             i = 0;
  600. X         }
  601. X         else{
  602. X         i = 0;
  603. X         d_temp = token_list;
  604. X         while(strcmp(m_temp->object, d_temp->name) != 0){
  605. X             i++;
  606. X             d_temp = d_temp->next;
  607. X         }
  608. X         if(d_temp->data_types){
  609. X             for(count = 0; count < m_temp->count; count++){
  610. X
  611. X             /* initialize temp */
  612. X             fprintf(fp,"\n\t\t\t%s%s_temp[%d] := %s%s_list[0];\n"
  613. X             , prefix, m_temp->object, current_free[i], prefix, m_temp->object);
  614. X
  615. X             /* print a label */
  616. X             if(r_temp->recurs){
  617. X            fprintf(fp,"%s%s_%s_%d:\n",prefix,r_temp->label,m_temp->object,current_free[i]);
  618. X            fprintf(lp,"\t%s%s_%s_%d,\n",prefix,r_temp->label,m_temp->object,current_free[i]);
  619. X             }
  620. X
  621. X             /* free the previously found item */
  622. X             if(r_temp->recurs){
  623. X              fprintf(fp,"\t\t\tif(%s%s_list[%d]<>nil)\n", prefix, m_temp->object, current_free[i]);
  624. X             fprintf(fp,"\t\t\t\t%s%s_list[%d]^.MARK := 0;\n", prefix, m_temp->object, current_free[i]);
  625. X             }
  626. X
  627. X             /* do the search */
  628. X             fprintf(fp,"\t\t\t%s%s_list[%d] := search_%s%s_record(%d"
  629. X             , prefix , m_temp->object, current_free[i], prefix, m_temp->object, current_free[i]);
  630. X             dt_temp = d_temp->data_types;
  631. X             while(dt_temp){
  632. X                 if(dt_temp->type <= 2){
  633. X                  t_temp = m_temp->tests;
  634. X                 j = 1;
  635. X                 while(j && t_temp){
  636. X                     if(strcmp(t_temp->element, dt_temp->name) == 0){
  637. X                      j = 0;
  638. X                     if((t_temp->type == 0) || (t_temp->type == 1))
  639. X                         fprintf(fp,", %s",t_temp->value);
  640. X                     if(t_temp->type == 2)
  641. X                         fprintf(fp,", '%s'",t_temp->value);
  642. X                     if(t_temp->type == -1){
  643. X                      if(t_temp->id)
  644. X                         fprintf(fp,", 0");
  645. X                     else{
  646. X                             l = 0;
  647. X                             m_temp2 = r_temp->complex;
  648. X                             while(m_temp2){
  649. X                             if(strcmp(m_temp2->free_name, t_temp->free_name) == 0){
  650. X                                 l = m_temp2->index;
  651. X                              m_temp4 = m_temp2;
  652. X                                 m_temp2 = NULL;
  653. X                             }
  654. X                             else
  655. X                                 m_temp2 = m_temp2->next;
  656. X                             }
  657. X                         if(m_temp4->empty)
  658. X                                 fprintf(fp,", %s%s_empty[%d].%s", prefix,m_temp4->object,l,t_temp->value);
  659. X                         else
  660. X                                 fprintf(fp,", %s%s_list[%d]^.%s", prefix,m_temp4->object,l,t_temp->value);
  661. X                         }
  662. X                     }
  663. X                     fprintf(fp,", %d", t_temp->relop);
  664. X                         if(dt_temp->elts)
  665. X                      fprintf(fp,", %d",t_temp->id);
  666. X                     }
  667. X                     else
  668. X                     t_temp = t_temp->next;
  669. X                 }
  670. X                 if(j){
  671. X                     switch(dt_temp->type){
  672. X                     case 0: fprintf(fp,", 0, 7");
  673. X                        break;
  674. X                     case 1: fprintf(fp,", 0.0, 7");
  675. X                        break;
  676. X                     case 2: fprintf(fp,", '', 7");
  677. X                     default: break;
  678. X                     }
  679. X                     if(dt_temp->elts)
  680. X                      fprintf(fp,", 0");
  681. X                 }
  682. X                 }
  683. X                 dt_temp = dt_temp->next;
  684. X             }
  685. X             fprintf(fp,") ;\n");
  686. X             fprintf(fp,"\t\t\tif( %s%s_list[%d] = nil )then begin\n",prefix,                 m_temp->object,current_free[i]);
  687. X             /* search failed on first of rule */
  688. X
  689. X             if((prev_index == 0) || (r_temp->recurs == 0)){
  690. X                 fprintf(fp,"\t\t\t\t%srestore ;\n", prefix);
  691. X                 if(r_temp->prev)
  692. X                     fprintf(fp,"\t\t\t\t{2}goto %s%s;\n\t\t\tend ;", prefix,r_temp->prev->label);
  693. X                 else
  694. X                     fprintf(fp,"\t\t\t\t{3}goto %sStop ;\n\t\t\tend ;", prefix);
  695. X             }
  696. X
  697. X             /* search failed - not first of rule */
  698. X             else{
  699. X             fprintf(fp,"\t\t\t\t{4}goto %s%s_%s_%d ;\n\t\t\tend ;", prefix,
  700. X                 r_temp->label, m_temp3->object, prev_index);
  701. X             }
  702. X
  703. X             /* move index one beyond the one currently found */
  704. X             if(r_temp->recurs) fprintf(fp,"\n\t\t\t%s%s_temp[%d] := %s%s_list[%d]^.next;", prefix,
  705. X                m_temp->object, current_free[i], prefix,
  706. X                m_temp->object, current_free[i]);
  707. X
  708. X             m_temp3 = m_temp;
  709. X             prev_index = current_free[i];
  710. X             current_free[i]++;
  711. X        }
  712. X        }
  713. X    }
  714. X    m_temp = m_temp->next;
  715. X    }
  716. X
  717. X    /* get rule number for next 3 statements */
  718. X
  719. X    i = 1;
  720. X    r_temp2 = r_const;
  721. X    while(r_temp != r_temp2){
  722. X        r_temp2 = r_temp2->prev;
  723. X        i++;
  724. X    }
  725. X
  726. X
  727. X    /* generate ADD code */
  728. X
  729. X    fprintf(fp,"\n");
  730. X    init_list = r_temp->add;
  731. X    p_gen_init(0);
  732. X
  733. X    /* generate MARK code */
  734. X    /* first MARK objects deleted by name */
  735. X    m_temp = r_temp->complex;
  736. X    while(m_temp){
  737. X    if(m_temp->mark){
  738. X        d_temp = token_list;
  739. X        while(strcmp(m_temp->object, d_temp->name))
  740. X            d_temp = d_temp->next;
  741. X        if(d_temp->data_types)
  742. X                fprintf(fp,"\n\t\t\t\tfree_%s%s_record(%d) ;", prefix,m_temp->object, m_temp->index);
  743. X        else
  744. X                fprintf(fp,"\n\t\t\t\t%stoken%s[%s] := %stoken%s[%s]-1 ;",                    prefix, prefix,d_temp->name,prefix,prefix,d_temp->name);
  745. X        }
  746. X        m_temp = m_temp->next;
  747. X    }
  748. X
  749. X    /* now MARK the rest of the objects */
  750. X    d_temp = token_list;
  751. X    for(i = 0; i < total_tokens; i++){
  752. X        if(r_temp->mark[i]){
  753. X            fprintf(fp,"\n\t\t\tfor i := 0 to %d do",r_temp->mark[i]-1);
  754. X        if(d_temp->data_types)
  755. X                fprintf(fp,"\n\t\t\t\tfree_%s%s_record(1) ;", prefix,d_temp->name);
  756. X        else
  757. X                fprintf(fp,"\n\t\t\t\t%stoken%s[%s] := %stoken%s[%s]-1 ;",                prefix,prefix,d_temp->name,prefix,prefix,d_temp->name);
  758. X        }
  759. X        d_temp = d_temp->next;
  760. X    }
  761. X    d_temp = token_list;
  762. X
  763. X    fprintf(fp,"\n\t\t\t%srestore ;\n", prefix);
  764. X
  765. X    l_temp = r_temp->c_code;
  766. X    p_trans_code(r_temp, l_temp, fp);
  767. X    if(find_name(r_temp->opt))
  768. X        fprintf(fp,"\t\t\t{5}goto %s%s;\n\t\tend ;\n", prefix, r_temp->opt);
  769. X    else
  770. X        fprintf(fp,"\t\t\tgoto %sStart;\n\t\tend ;\n", prefix);
  771. X    r_temp = r_temp->prev;
  772. X    }
  773. X    fprintf(fp,"\t\tgoto Stop ;\n\tend ;\n%sStop:\n", prefix);
  774. X    fprintf(fp,"\nend ;\n");
  775. X    if(zeroing)
  776. X    p_gen_zero;
  777. X    l_temp = trailer_code;
  778. X    while(l_temp){
  779. X    fprintf(fp,"%s\n",l_temp->name);
  780. X    l_temp = l_temp->next;
  781. X    }
  782. X}
  783. X
  784. !EOR!
  785. echo extracting - parser
  786. sed 's/^X//' > parser << '!EOR!'
  787. X%{
  788. X#include    "main.h"
  789. Xint ii, jj, st, last_free;
  790. X%}
  791. X
  792. X%start file
  793. X
  794. X%token DELIM ARROW TOKEN MARK ADD C_CODE NOT INT FLOAT STRING POINTER
  795. X%token OPTIMIZE INTEGER DOUBLE STR LE GE LT GT EQ NE HAT RECURS SEMI
  796. X%token BACKTRACK TRACE PROFILE DUMP NORECURS PREFIX EMPTY SAVE ZERO PASCAL
  797. X
  798. X%%
  799. X
  800. X
  801. Xfile        :  header defs stm ltm DELIM trailer
  802. X        |  error
  803. X            {
  804. X            fprintf(stderr,"%d: syntax error\n", lineno);
  805. X            errors++;
  806. X            }
  807. X        ;
  808. X
  809. Xheader        : error DELIM
  810. X            {
  811. X            fprintf(stderr,"%d: syntax error in header\n",lineno);
  812. X            errors++;
  813. X            }
  814. X        | DELIM
  815. X            {
  816. X            st = 1;
  817. X            last_free = 0;
  818. X            }
  819. X        | C_CODE DELIM
  820. X            {
  821. X            st = 1;
  822. X            do_header();
  823. X            }
  824. X        ;
  825. X
  826. Xdefs        : definitions DELIM
  827. X            {
  828. X                insert_rule();
  829. X                stm = (int *) calloc(total_tokens, sizeof(int));
  830. X                current_free = (int *) calloc(total_tokens, sizeof(int));
  831. X                current_empty = (int *) calloc(total_tokens, sizeof(int));
  832. X                max_free = (int *) calloc(total_tokens, sizeof(int));
  833. X                max_empty = (int *) calloc(total_tokens, sizeof(int));
  834. X                for(ii = 0; ii < total_tokens; ii++){
  835. X                max_free[ii] = current_free[ii] = 1;
  836. X                max_empty[ii] = current_empty[ii] = 0;
  837. X                }
  838. X            }
  839. X        ;
  840. X
  841. Xdefinitions    : /* empty */
  842. X        | error
  843. X            {
  844. X            fprintf(stderr,"%d: syntax error in definition\n",lineno);
  845. X            errors++;
  846. X            }
  847. X        | definitions definition
  848. X        ;
  849. X
  850. Xdefinition    : TOKEN
  851. X            {
  852. X                insert_token($1);
  853. X            }
  854. X        | TOKEN '(' item_list ')'
  855. X            {
  856. X                insert_token($1);
  857. X            }
  858. X        ;
  859. X
  860. Xitem_list    : /* empty */
  861. X        | item_list item
  862. X        ;
  863. X
  864. Xitem        : TOKEN ':' type
  865. X            {
  866. X                if(add_struct($1, $3) == -1){
  867. X                fprintf(stderr,"%d: duplicate name in definition -> %s\n", lineno, $1);
  868. X                errors++;
  869. X                }
  870. X            }
  871. X        ;
  872. X
  873. Xtype        : INT
  874. X            {
  875. X                $$ = 0;
  876. X            }
  877. X        | FLOAT
  878. X            {
  879. X                $$ = 1;
  880. X            }
  881. X        | STRING
  882. X            {
  883. X                $$ = 2;
  884. X            }
  885. X        | POINTER
  886. X            {
  887. X                $$ = 3;
  888. X            }
  889. X        ;
  890. X
  891. Xstm        : error DELIM
  892. X            {
  893. X            fprintf(stderr,"%d: syntax error in short term memory\n",lineno);
  894. X            errors++;
  895. X            }
  896. X        | st DELIM
  897. X            {
  898. X                st = 0;    /* no longer parsing stm */
  899. X                init_list2 = init_list; /* save init_list */
  900. X                init_list = NULL;
  901. X                insert_init();        /* make a new init_list */
  902. X                build_case_list();        /* prepare cross reference for ltm */
  903. X            }
  904. X        ;
  905. X
  906. Xst        : /* empty */
  907. X        | st entry
  908. X        ;
  909. X
  910. Xentry        : count TOKEN
  911. X            {
  912. X                if((ii = find_token($2)) < 0){
  913. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  914. X                errors++;
  915. X                }
  916. X                else{
  917. X                if(st) stm[ii]++;    /* if stm is being parsed */
  918. X                    do_init_list($2);
  919. X                insert_count($1);
  920. X                    insert_init();
  921. X                }
  922. X            }
  923. X        | count TOKEN '(' init_list ')'
  924. X            {
  925. X                if((ii = find_token($2)) < 0){
  926. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  927. X                errors++;
  928. X                }
  929. X                else{
  930. X                if(st) stm[ii]++;    /* if stm is being parsed */
  931. X                    do_init_list($2);
  932. X                insert_count($1);
  933. X                    insert_init();
  934. X                }
  935. X            }
  936. X        ;
  937. X
  938. X
  939. Xcount        : /* empty */
  940. X            {
  941. X                $$ = 1;
  942. X            }
  943. X        | INTEGER
  944. X            {
  945. X                jj = atoi($1);
  946. X                if(jj < 0){
  947. X                    $$ = 1;
  948. X                    fprintf(stderr,"%d: negative count is undefined\n", lineno);
  949. X                    errors++;
  950. X                }
  951. X                else if(jj == 0){
  952. X                    $$ = 1;
  953. X                    fprintf(stderr,"%d: zero count is undefined\n", lineno);
  954. X                    errors++;
  955. X                }
  956. X                else
  957. X                    $$ = jj;
  958. X            }
  959. X        ;
  960. X
  961. X
  962. Xinit_list    : /* empty */
  963. X        | init_list init_item
  964. X        ;
  965. X
  966. Xinit_item    : TOKEN ARROW INTEGER
  967. X            {
  968. X                insert_fields($1, $3, 0, 0, 0);
  969. X            }
  970. X        | TOKEN ARROW DOUBLE 
  971. X            {
  972. X                insert_fields($1, $3, 0, 1, 0);
  973. X            }
  974. X        | TOKEN ARROW STR
  975. X            {
  976. X                insert_fields($1, $3, 0, 2, 0);
  977. X            }
  978. X        | TOKEN ARROW TOKEN '.' TOKEN
  979. X            {
  980. X                if(st) {
  981. X                    fprintf(stderr,
  982. X                    "%d: free variables are not permitted in stm\n",
  983. X                    lineno);
  984. X                    errors++;
  985. X                }
  986. X                else if((jj = find_free($3)) == -1){
  987. X                    fprintf(stderr,"%d: undefined free variable -> %s\n",lineno, $3);
  988. X                    errors++;
  989. X                }
  990. X                else
  991. X                    insert_fields($1, $5, $3, -1, jj);
  992. X            }
  993. X        ;
  994. X
  995. X
  996. Xltm        : opts lt
  997. X        ;
  998. X
  999. Xopts        : /* empty */
  1000. X        | opts opt
  1001. X        ;
  1002. X
  1003. Xopt        : BACKTRACK
  1004. X            {
  1005. X                backtracking = 1;
  1006. X            }
  1007. X        | TRACE
  1008. X            {
  1009. X                tracing = 1;
  1010. X            }
  1011. X        | PROFILE
  1012. X            {
  1013. X                profiling = 1;
  1014. X            }
  1015. X        | DUMP
  1016. X            {
  1017. X                dumping = 1;
  1018. X            }
  1019. X        | RECURS
  1020. X            {
  1021. X                recursing = 1;
  1022. X                rule_list->recurs = 1;
  1023. X            }
  1024. X        | NORECURS
  1025. X            {
  1026. X                recursing = 0;
  1027. X                rule_list->recurs = 0;
  1028. X            }
  1029. X        | PREFIX TOKEN
  1030. X            {
  1031. X                prefix = (char *) $2;
  1032. X            }
  1033. X        | SAVE
  1034. X            {
  1035. X                saving = 1;
  1036. X            }
  1037. X        | ZERO
  1038. X            {
  1039. X                zeroing = 1;
  1040. X            }
  1041. X        | PASCAL
  1042. X            {
  1043. X                pascal = 1;
  1044. X            }
  1045. X        ;
  1046. X
  1047. Xlt        : /* empty */
  1048. X        | lt production
  1049. X        ;
  1050. X
  1051. Xproduction    : error SEMI
  1052. X            {
  1053. X            fprintf(stderr,"%d: syntax error in previous rule\n",lineno);
  1054. X            errors++;
  1055. X            }
  1056. X        | label lhs ARROW rhs SEMI
  1057. X            {
  1058. X                pnum++;
  1059. X                rule_list->add = init_list;
  1060. X                init_list = NULL;
  1061. X                insert_init();
  1062. X                insert_rule();
  1063. X                if(recursing)
  1064. X                rule_list->recurs = 1;
  1065. X                for(ii = 0; ii < total_tokens; ii++){
  1066. X                if(max_free[ii] < current_free[ii])
  1067. X                    max_free[ii] = current_free[ii];
  1068. X                if(max_empty[ii] < current_empty[ii])
  1069. X                    max_empty[ii] = current_empty[ii];
  1070. X                current_free[ii] = 1;
  1071. X                current_empty[ii] = 0;
  1072. X                }
  1073. X            }
  1074. X        ;
  1075. X
  1076. Xlabel        :  TOKEN ':'
  1077. X            {
  1078. X                if(find_name($1)){
  1079. X                fprintf(stderr,"%d: redefined label -> %s\n",lineno,$1);
  1080. X                errors++;
  1081. X                }
  1082. X                else if((find_token($1)) >= 0){
  1083. X                fprintf(stderr,"%d: label repeats object declaration -> %s\n",lineno, $1);
  1084. X                errors++;
  1085. X                }
  1086. X                else{
  1087. X                insert_label($1);
  1088. X                }
  1089. X            }
  1090. X        | ':'
  1091. X            {
  1092. X                insert_label(gen_next_label());
  1093. X            }
  1094. X        ;
  1095. X
  1096. Xlhs        : /* empty */
  1097. X        | lhs match
  1098. X        ;
  1099. X
  1100. Xmatch        :  count TOKEN 
  1101. X            {
  1102. X                if((ii = find_token($2)) == -1){
  1103. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  1104. X                errors++;
  1105. X                }
  1106. X                else if(rule_list->search[ii] < 0){
  1107. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $2, $2);
  1108. X                errors++;
  1109. X                }
  1110. X                else{
  1111. X                add_test($2, 0, 7, 0, 0, 0,current_free[ii], 0);
  1112. X                add_count($1);
  1113. X                if($1 > 1){
  1114. X                    rule_list->search[ii]+= $1;
  1115. X                    current_free[ii]+= $1;
  1116. X                }
  1117. X                else{
  1118. X                    rule_list->search[ii]++;
  1119. X                    current_free[ii]++;
  1120. X                }
  1121. X                }
  1122. X                current_match = NULL;
  1123. X                current_test = NULL;
  1124. X            }
  1125. X        |  NOT TOKEN
  1126. X            {
  1127. X                if((ii = find_token($2)) == -1){
  1128. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  1129. X                errors++;
  1130. X                }
  1131. X                else if(rule_list->search[ii]){
  1132. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $2, $2);
  1133. X                errors++;
  1134. X                }
  1135. X                else rule_list->search[ii]--;
  1136. X                current_match = NULL;
  1137. X                current_test = NULL;
  1138. X                
  1139. X            }
  1140. X        | count '(' free_variable match_list ')'
  1141. X            {
  1142. X                last_free = 0;
  1143. X                if(($1 > 1) && $3){
  1144. X                fprintf(stderr,"%d: count on free variables undefined\n", lineno);
  1145. X                errors++;
  1146. X                }
  1147. X                add_count($1);
  1148. X                current_match = NULL;
  1149. X                current_test = NULL;
  1150. X                if($1 > 1){
  1151. X                    current_free[ii]+= $1;
  1152. X                    rule_list->search[ii]+= $1;
  1153. X                }
  1154. X                else{
  1155. X                    current_free[ii]++;
  1156. X                    rule_list->search[ii]++;
  1157. X                }
  1158. X            }
  1159. X        | EMPTY TOKEN TOKEN
  1160. X            {
  1161. X                if((ii = find_token($2)) == -1){
  1162. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  1163. X                errors++;
  1164. X                }
  1165. X                else if(find_free($3) != -1){
  1166. X                fprintf(stderr,"%d: free variable already defined -> %s\n",lineno, $3);
  1167. X                errors++;
  1168. X                }
  1169. X                else{
  1170. X                add_test($2,0,-1,0,0,$3, current_empty[ii], -1);
  1171. X                current_empty[ii]++;
  1172. X                current_match = NULL;
  1173. X                current_test  = NULL;
  1174. X                }
  1175. X            }
  1176. X        | C_CODE
  1177. X            {
  1178. X                add_test_code();
  1179. X            }
  1180. X        | RECURS
  1181. X            {
  1182. X                rule_list->recurs = 1;
  1183. X            }
  1184. X        | NORECURS
  1185. X            {
  1186. X                rule_list->recurs = 0;
  1187. X            }
  1188. X        ;
  1189. X
  1190. Xfree_variable   : /* empty */
  1191. X            {
  1192. X                $$ = 0;
  1193. X            }
  1194. X        | HAT TOKEN TOKEN
  1195. X            {
  1196. X                if((ii = find_token($2)) == -1){
  1197. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  1198. X                errors++;
  1199. X                }
  1200. X                else if(find_free($3) != -1){
  1201. X                fprintf(stderr,"%d: free variable already defined -> %s\n",lineno, $3);
  1202. X                errors++;
  1203. X                }
  1204. X                else if(rule_list->search[ii] < 0){
  1205. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $2, $2);
  1206. X                errors++;
  1207. X                }
  1208. X                else{
  1209. X                add_test($2,0,7,0,0,$3, current_free[ii], 0);
  1210. X                last_free = $3;
  1211. X                }
  1212. X                $$ = 1;
  1213. X            }
  1214. X        ;
  1215. X
  1216. X
  1217. Xmatch_list    : /* empty */
  1218. X            {
  1219. X            }
  1220. X        | match_list match_element
  1221. X            {
  1222. X            }
  1223. X        ;
  1224. X
  1225. X
  1226. Xmatch_element   : TOKEN '.' TOKEN relop INTEGER
  1227. X            {
  1228. X                if((ii = find_token($1)) == -1){
  1229. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$1);
  1230. X                errors++;
  1231. X                }
  1232. X                else if(rule_list->search[ii] < 0){
  1233. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $1, $1);
  1234. X                errors++;
  1235. X                }
  1236. X                else if((jj = search_structs($1,$3)) < 0){
  1237. X                fprintf(stderr,"%d: undefined object field -> %s.%s\n",lineno,$1,$3);
  1238. X                errors++;
  1239. X                }
  1240. X                else if(jj != 0){
  1241. X                fprintf(stderr,"%d: object field must be integer\n", lineno);
  1242. X                }
  1243. X                else{
  1244. X                add_test($1,$3,$4,$5,0, 0, current_free[ii], 0);
  1245. X                }
  1246. X            }
  1247. X
  1248. X        | TOKEN '.' TOKEN relop DOUBLE
  1249. X            {
  1250. X                if((ii = find_token($1)) == -1){
  1251. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$1);
  1252. X                errors++;
  1253. X                }
  1254. X                else if(rule_list->search[ii] < 0){
  1255. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $1, $1);
  1256. X                errors++;
  1257. X                }
  1258. X                else if((jj = search_structs($1,$3)) < 0){
  1259. X                fprintf(stderr,"%d: undefined object field -> %s.%s\n",lineno,$1,$3);
  1260. X                errors++;
  1261. X                }
  1262. X                else if(jj != 1){
  1263. X                fprintf(stderr,"%d: object field must be double\n",lineno);
  1264. X                }
  1265. X                else{
  1266. X                add_test($1,$3,$4,$5,1, 0, current_free[ii], 0);
  1267. X                }
  1268. X            }
  1269. X
  1270. X        | TOKEN '.' TOKEN relop STR
  1271. X            {
  1272. X                if((ii = find_token($1)) == -1){
  1273. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$1);
  1274. X                errors++;
  1275. X                }
  1276. X                else if(rule_list->search[ii] < 0){
  1277. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $1, $1);
  1278. X                errors++;
  1279. X                }
  1280. X                else if((jj = search_structs($1,$3)) < 0){
  1281. X                fprintf(stderr,"%d: undefined object field -> %s.%s\n",lineno,$1,$3);
  1282. X                errors++;
  1283. X                }
  1284. X                else if(jj != 2){
  1285. X                fprintf(stderr,"%d: object field must be a string\n",lineno);
  1286. X                }
  1287. X                else{
  1288. X                add_test($1,$3,$4,$5,2,0,current_free[ii], 0);
  1289. X                }
  1290. X            }
  1291. X        | TOKEN '.' TOKEN relop TOKEN '.' TOKEN
  1292. X            {
  1293. X                if((ii = find_token($1)) == -1){
  1294. X                fprintf(stderr,"%d: undefined object -> %s\n",lineno,$1);
  1295. X                errors++;
  1296. X                }
  1297. X                else if(rule_list->search[ii] < 0){
  1298. X                fprintf(stderr,"%d: can't have %s and NOT %s in the same rule\n", lineno, $1, $1);
  1299. X                errors++;
  1300. X                }
  1301. X                else if(search_structs($1,$3) < 0){
  1302. X                fprintf(stderr,"%d: undefined element -> %s.%s\n",lineno,$1,$3);
  1303. X                errors++;
  1304. X                }
  1305. X                else if((find_free($5) == -1)  /* not a free var */
  1306. X                || ((jj = strcmp($5, last_free)) == 0)){
  1307. X                if(jj == 0)
  1308. X                     $5 = $1;
  1309. X                if(strcmp($1, $5) != 0){
  1310. X                    fprintf(stderr,"%d: semantic error: use a free variable\n",lineno);
  1311. X                    errors++;
  1312. X                }
  1313. X                else if(strcmp($3, $7) == 0){
  1314. X                    fprintf(stderr,"%d: degenerate case, please rewrite\n",lineno);
  1315. X                    errors++;
  1316. X                }
  1317. X                    else if(search_structs($5,$7) < 0){
  1318. X                    fprintf(stderr,"%d: undefined element -> %s.%s\n",lineno,$5,$7);
  1319. X                    errors++;
  1320. X                    }
  1321. X                else if(cmp_type($1, $3, $7) == -1){
  1322. X                    fprintf(stderr,"%d: types of %s.%s and %s.%s do not match\n", lineno, $1, $3, $5, $7);
  1323. X                    errors++;
  1324. X                }
  1325. X                else{
  1326. X                    add_test($1,$3,$4,$7,-1, $5, current_free[ii], 0);
  1327. X                }
  1328. X                }
  1329. X                else if((jj = match_type($1, $3, $5, $7)) == 0){
  1330. X                fprintf(stderr,"%d: types of %s.%s and %s.%s do not match\n", lineno, $1, $3, $5, $7);
  1331. X                errors++;
  1332. X                }
  1333. X                else{
  1334. X                if((jj == 1) || (jj == 2))
  1335. X                    add_test($1,$3,$4,$7,-1, $5, current_free[ii], 0);
  1336. X                }
  1337. X            }
  1338. X        ;
  1339. X
  1340. Xrhs        : optional_part pass_part
  1341. X        ;
  1342. X
  1343. Xoptional_part    : /* empty */
  1344. X        | optional_part option
  1345. X        ;
  1346. X
  1347. Xoption        : MARK mark_list
  1348. X        | ADD add_list
  1349. X        | OPTIMIZE TOKEN
  1350. X            {
  1351. X                opt($2);
  1352. X            }
  1353. X        | MARK error
  1354. X            {
  1355. X                fprintf(stderr,"%d: syntax error in MARK statement\n", lineno);
  1356. X                errors++;
  1357. X            }
  1358. X        | ADD error
  1359. X            {
  1360. X                fprintf(stderr,"%d: syntax error in ADD statement\n", lineno);
  1361. X                errors++;
  1362. X            }
  1363. X        | OPTIMIZE error
  1364. X            {
  1365. X                fprintf(stderr,"%d: syntax error in OPTIMIZE statement\n", lineno);
  1366. X                errors++;
  1367. X            }
  1368. X        ;
  1369. X
  1370. Xmark_list    : /* empty */
  1371. X        | mark_list mark_item
  1372. X        ;
  1373. X
  1374. Xmark_item    : count TOKEN
  1375. X            {
  1376. X                jj = 1;
  1377. X                if($1 >0) jj = $1;
  1378. X                if((ii = find_token($2)) == -1){
  1379. X                    if(mark_free($2)){
  1380. X                    if(jj > 1){
  1381. X                        fprintf(stderr,"%d: can't MARK more than 1 %s\n",lineno,$2);
  1382. X                        errors++;
  1383. X                    }
  1384. X                    }
  1385. X                else{
  1386. X                    fprintf(stderr,"%d: undefined object -> %s\n",lineno,$2);
  1387. X                    errors++;
  1388. X                }
  1389. X                }
  1390. X                else if(rule_list->search[ii] < (rule_list->mark[ii]  + jj)){
  1391. X                fprintf(stderr,"%d: can't mark more %s's than are found\n", lineno, $2);
  1392. X                errors++;
  1393. X                }
  1394. X                else{
  1395. X                if($1)
  1396. X                    rule_list->mark[ii]+= $1;
  1397. X                else
  1398. X                    rule_list->mark[ii]++;
  1399. X                }
  1400. X            }
  1401. X        ;
  1402. X
  1403. X
  1404. Xadd_list    : entry
  1405. X        | add_list entry
  1406. X        ;
  1407. X
  1408. Xpass_part    :  /* empty */
  1409. X        |  C_CODE 
  1410. X            {
  1411. X            do_code();
  1412. X            }
  1413. X        ;
  1414. X
  1415. Xtrailer        : /* empty */
  1416. X        | error
  1417. X            {
  1418. X            fprintf(stderr,"%d: syntax error in trailer\n",lineno);
  1419. X            errors++;
  1420. X            }
  1421. X        | C_CODE
  1422. X            {
  1423. X            do_trailer();
  1424. X            }
  1425. X        ;
  1426. X
  1427. Xrelop        :  LE        /* <= */
  1428. X            {
  1429. X            $$ = 6;
  1430. X            }
  1431. X        |  GE        /* >= */
  1432. X            {
  1433. X            $$ = 3;
  1434. X            }
  1435. X        |  LT        /* <  */
  1436. X            {
  1437. X            $$ = 4;
  1438. X            }
  1439. X        |  GT        /* >  */
  1440. X            {
  1441. X            $$ = 1;
  1442. X            }
  1443. X        |  EQ        /* == */
  1444. X            {
  1445. X            $$ = 2;
  1446. X            }
  1447. X        |  NE        /* != */
  1448. X            {
  1449. X            $$ = 5;
  1450. X            }
  1451. X        ;
  1452. X
  1453. X%%
  1454. X
  1455. X#include "scanner.c"
  1456. X
  1457. X
  1458. !EOR!
  1459. echo extracting - scanner.c
  1460. sed 's/^X//' > scanner.c << '!EOR!'
  1461. X#include <stdio.h>
  1462. X#include <ctype.h>
  1463. X
  1464. X#define     NUM 19
  1465. X/* number of reserved words */
  1466. Xchar *words[NUM] = {    /* the strings to compare against */
  1467. X        "MARK",
  1468. X        "ADD",
  1469. X        "NOT",
  1470. X        "INT",
  1471. X        "FLOAT",
  1472. X        "STRING",
  1473. X        "POINTER",
  1474. X        "OPTIMIZE",
  1475. X        "RECURS",
  1476. X        "BACKTRACK",
  1477. X        "TRACE",
  1478. X        "PROFILE",
  1479. X        "DUMP",
  1480. X        "NORECURS",
  1481. X        "PREFIX",
  1482. X        "EMPTY",
  1483. X        "SAVE",
  1484. X        "PASCAL",
  1485. X        "ZERO"
  1486. X    };
  1487. Xint ret[NUM] = {    /* the value to return to yyparse */
  1488. X        MARK,
  1489. X        ADD,
  1490. X        NOT,
  1491. X        INT,
  1492. X        FLOAT,
  1493. X        STRING,
  1494. X        POINTER,
  1495. X        OPTIMIZE,
  1496. X        RECURS,
  1497. X        BACKTRACK,
  1498. X        TRACE,
  1499. X        PROFILE,
  1500. X        DUMP,
  1501. X        NORECURS,
  1502. X        PREFIX,
  1503. X        EMPTY,
  1504. X        SAVE,
  1505. X        PASCAL,
  1506. X        ZERO
  1507. X    };
  1508. X
  1509. Xyylex()
  1510. X{
  1511. X    char c, s[512], *t;
  1512. X    int i, nb, dot, current_line;
  1513. X
  1514. X    current_line = lineno;
  1515. X    i = nb = dot = 1;
  1516. X    while((c = getc(stdin)) != EOF){
  1517. X    if(c == ' ');        /* ignore white space */
  1518. X    else if(c == '\t');
  1519. X    else if(c == '%'){
  1520. X        c = getc(stdin);
  1521. X        if(c == '%')
  1522. X        return(DELIM);
  1523. X        ungetc(c, stdin);
  1524. X        fprintf(stderr,"%d: unexpected '%c'\n", '%', lineno);
  1525. X        errors++;
  1526. X    }
  1527. X    else if(c == '.'){
  1528. X        return('.');
  1529. X    }
  1530. X    else if(c == ':'){
  1531. X        return(':');
  1532. X    }
  1533. X    else if(c == '('){
  1534. X        return('(');
  1535. X    }
  1536. X    else if(c == ')'){
  1537. X        return(')');
  1538. X    }
  1539. X    else if(c == '^'){
  1540. X        return(HAT);
  1541. X    }
  1542. X    else if(c == '\n'){
  1543. X        lineno++;
  1544. X    }
  1545. X    else if(c == '>'){
  1546. X        c = getc(stdin);
  1547. X        if(c == '=')
  1548. X        return(GE);
  1549. X        ungetc(c, stdin);
  1550. X        return(GT);
  1551. X    }
  1552. X    else if(c == '<'){
  1553. X        c = getc(stdin);
  1554. X        if(c == '=')
  1555. X        return(LE);
  1556. X        ungetc(c, stdin);
  1557. X        return(LT);
  1558. X    }
  1559. X    else if(c == '!'){
  1560. X        c = getc(stdin);
  1561. X        if(c == '=')
  1562. X        return(NE);
  1563. X        ungetc(c, stdin);
  1564. X        fprintf(stderr,"%d: unexpected '!'\n", lineno);
  1565. X        errors++;
  1566. X    }
  1567. X    else if(c == '='){
  1568. X        c = getc(stdin);
  1569. X        if(c == '>')
  1570. X        return(ARROW);
  1571. X        if(c == '=')
  1572. X        return(EQ);
  1573. X        ungetc(c, stdin);
  1574. X        fprintf(stderr,"%d: unexpected '='\n", lineno);
  1575. X        errors++;
  1576. X     }
  1577. X    else if(c == ';'){
  1578. X        return(SEMI);
  1579. X    }
  1580. X    else if(c == '{'){
  1581. X        i = 0;
  1582. X        while(nb){
  1583. X        c = getc(stdin);
  1584. X        if(c == EOF){
  1585. X            fprintf(stderr,"%d: unterminated C code\n", current_line);
  1586. X            errors++;
  1587. X            return(EOF);
  1588. X        }
  1589. X        if(c == '}') {
  1590. X            nb--;
  1591. X            if(nb) 
  1592. X            s[i++] = c;
  1593. X            else{
  1594. X            s[i] = '\0';
  1595. X            t = (char *) malloc (i + 1);
  1596. X            strcpy(t,s); 
  1597. X            append_code(t);
  1598. X            return(C_CODE);
  1599. X            }
  1600. X        }
  1601. X        else{
  1602. X            if(c == '{') nb++;
  1603. X            if((c == '\n') || (i == 510)){
  1604. X            lineno++;
  1605. X            s[i] = '\0';
  1606. X            t = (char *) malloc(i + 1);
  1607. X            strcpy(t,s);
  1608. X            append_code(t);
  1609. X            i = 0;
  1610. X            }
  1611. X            else
  1612. X            s[i++] = c;
  1613. X        }
  1614. X        }
  1615. X        return(C_CODE);
  1616. X    }
  1617. X    else if(c == '\042'){
  1618. X        i = 0;
  1619. X        while(dot){
  1620. X        c = getc(stdin);
  1621. X        if(c == '\042'){
  1622. X            s[i] = '\0';
  1623. X            dot = 0;
  1624. X        }
  1625. X        else if(c == '\n'){
  1626. X            fprintf(stderr,"%d: newline embedded in string\n",lineno);
  1627. X            s[i] = '\0'; lineno++;
  1628. X            errors++; dot = 0;
  1629. X        }
  1630. X        else{
  1631. X            s[i++] = c;
  1632. X            if(c == '\\')
  1633. X            s[i++] = getc(stdin);
  1634. X        }
  1635. X        }
  1636. X        yylval = malloc(strlen(s) + 1);
  1637. X        strcpy(yylval, s);
  1638. X        return(STR);
  1639. X    }
  1640. X    else if((isdigit(c)) || (c == '-')){
  1641. X        s[0] = c;
  1642. X        i = 1;
  1643. X        while(i){
  1644. X        c = getc(stdin);
  1645. X        if((isdigit(c)) || ((c == '.') && (dot))){
  1646. X            s[i++] = c;
  1647. X            if(c == '.') dot = 0;
  1648. X        }
  1649. X        else{
  1650. X            ungetc(c, stdin);
  1651. X            s[i] = '\0';
  1652. X            i = 0;
  1653. X        }
  1654. X        }
  1655. X        yylval = malloc(strlen(s) + 1);
  1656. X        strcpy(yylval, s);
  1657. X        if(dot) return(INTEGER);
  1658. X        return(DOUBLE);
  1659. X    }
  1660. X    else if(isalpha(c)){
  1661. X        s[0] = c;
  1662. X        i = 1;
  1663. X        while(i){
  1664. X        c = getc(stdin);
  1665. X        if((c == '_') || (isalpha(c)) || (isdigit(c))){
  1666. X            s[i++] = c;
  1667. X        }
  1668. X        else{
  1669. X            ungetc(c, stdin);
  1670. X            s[i] = '\0';
  1671. X            i = 0;
  1672. X        }
  1673. X        }
  1674. X        for(i = 0; i < NUM; i++)    /* search the reserved word list */
  1675. X        if(strcmp(words[i],s) == 0)
  1676. X            return(ret[i]);
  1677. X        yylval = malloc(strlen(s) + 1);
  1678. X        strcpy(yylval, s);
  1679. X        return(TOKEN);
  1680. X    }
  1681. X    else if(c == '/'){            /* check for comments */
  1682. X        if((c = getc(stdin)) != '*'){
  1683. X        ungetc(c, stdin);
  1684. X        printf("%d: unexpected '/'\n", lineno);
  1685. X        errors++;
  1686. X        }
  1687. X        else{            /* check for comment terminator */
  1688. X        i = 1;
  1689. X        while(i){
  1690. X            c = getc(stdin);
  1691. X            if(c == EOF){
  1692. X            fprintf(stderr,"%d: unterminated comment\n", current_line);
  1693. X            errors++;
  1694. X            return(EOF);
  1695. X            }
  1696. X            else if(c == '\n')
  1697. X            lineno++;
  1698. X            else if(c == '*'){
  1699. X            c = getc(stdin);
  1700. X            if(c == '/')
  1701. X                i = 0;
  1702. X            }
  1703. X        }
  1704. X        }
  1705. X    }
  1706. X    else{
  1707. X         fprintf(stderr,"%d: unexpected or undefined character: \\0%o\n", lineno, c);
  1708. X         errors++;
  1709. X    }
  1710. X    }
  1711. X    return(c);
  1712. X}
  1713. X
  1714. !EOR!
  1715.