occam.g 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750
  1. /* $Header$ */
  2. /*
  3. * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
  4. * See the copyright notice in the ACK home directory, in the file "Copyright".
  5. */
  6. /* OCCAM */
  7. {
  8. #include "token.h"
  9. #include "symtab.h"
  10. #include "expr.h"
  11. #include "code.h"
  12. #include "sizes.h"
  13. #include <system.h>
  14. #include <em.h>
  15. #define MAXERRORS 10 /* Maximum number of insert/delete errors */
  16. static void nonconst(), nonpositive(), rep_cleanup(), check_assoc();
  17. void init_builtins();
  18. extern int yylineno, LLsymb;
  19. union type_info info, none;
  20. }
  21. %token AFTER, ALLOCATE, ALT, AND, ANY, BYTE, CHAN, DEF, FALSE, FOR, IF, LOAD;
  22. %token NOT, NOW, OR, PAR, PLACED, PORT, PRI, PROC, SEQ, SKIP, TABLE, TRUE;
  23. %token VALUE, VAR, WAIT, WHILE;
  24. %token IDENTIFIER, NUMBER, CHAR_CONST, STRING;
  25. %token AS, LE, GE, NE, LS, RS, BA, BO, BX, BS;
  26. %start occam, program;
  27. program : { init_builtins();
  28. header();
  29. }
  30. process
  31. ;
  32. process : primitive
  33. | construct
  34. | { sym_down(); }
  35. declaration ':' process
  36. { sym_up(); }
  37. ;
  38. primitive { struct expr *e; } :
  39. statement(&e) { if (!valueless(e))
  40. report("primitive may not have a value");
  41. code_void(e);
  42. destroy(e);
  43. }
  44. | WAIT val_expr(&e) { int BEGIN=0, END=0, TEST=0;
  45. check_wait(e);
  46. no_deadlock();
  47. branch(&TEST);
  48. Label(new_label(&BEGIN));
  49. resumenext();
  50. Label(TEST);
  51. code_bool(e, positive, &END, &BEGIN);
  52. Label(END);
  53. destroy(e);
  54. }
  55. | SKIP
  56. ;
  57. guard(register *F;) { struct expr *e1, *e2;
  58. register full_guard=0;
  59. int T=0;
  60. static char EXPECT_INP[]="input process expected as guard";
  61. } :
  62. expression(&e1)
  63. [ '&' { full_guard=1;
  64. if (!valued(e1))
  65. report("boolean part of guard has no value");
  66. code_bool(e1, positive, &T, F);
  67. Label(T);
  68. }
  69. [ statement(&e2)
  70. { if (!input_process(e2))
  71. report(EXPECT_INP);
  72. code_any(e2, F);
  73. destroy(e2);
  74. }
  75. | WAIT val_expr(&e2)
  76. { check_wait(e2);
  77. code_bool(e2, positive, &T, F);
  78. Label(T);
  79. destroy(e2);
  80. }
  81. | SKIP
  82. ]
  83. ]?
  84. { if (!full_guard) {
  85. if (!input_process(e1))
  86. report(EXPECT_INP);
  87. code_any(e1, F);
  88. }
  89. destroy(e1);
  90. }
  91. | WAIT val_expr(&e1)
  92. { check_wait(e1);
  93. code_bool(e1, positive, &T, F);
  94. Label(T);
  95. destroy(e1);
  96. }
  97. | SKIP
  98. ;
  99. guarded_process(register *END;) { struct symbol *v;
  100. struct expr *e1, *e2;
  101. struct replicator to_test;
  102. register line, oind;
  103. int F=0;
  104. } :
  105. guard(&F) process { branch(END);
  106. Label(F);
  107. }
  108. | ALT { line=yylineno; oind=ind; }
  109. [ %if (line==yylineno)
  110. replicator(&v, &e1, &e2)
  111. { rep_init(v, e1, e2, &to_test); }
  112. guarded_process(END)
  113. { rep_test(v, e1, e2, &to_test);
  114. rep_cleanup(e1, e2);
  115. }
  116. |
  117. [ %while (tabulated(oind, ind)) guarded_process(END) ]*
  118. ]
  119. ;
  120. conditional(register *END; ) { struct symbol *v;
  121. struct expr *e1, *e2;
  122. struct replicator to_test;
  123. register line, oind;
  124. int T=0, F=0;
  125. } :
  126. val_expr(&e1) { if (!valued(e1))
  127. report("conditional needs valued expression");
  128. code_bool(e1, positive, &T, &F);
  129. Label(T);
  130. destroy(e1);
  131. }
  132. process
  133. { branch(END);
  134. Label(F);
  135. }
  136. | IF { line=yylineno; oind=ind; }
  137. [ %if (line==yylineno)
  138. replicator(&v, &e1, &e2)
  139. { rep_init(v, e1, e2, &to_test); }
  140. conditional(END)
  141. { rep_test(v, e1, e2, &to_test);
  142. rep_cleanup(e1, e2);
  143. }
  144. |
  145. [ %while (tabulated(oind, ind)) conditional(END) ]*
  146. ]
  147. ;
  148. replicator(register struct symbol **s; register struct expr **e1, **e2; )
  149. { register char *index; }:
  150. IDENTIFIER { index=token.t_sval; }
  151. '=' '[' val_expr(e1) FOR val_expr(e2) ']'
  152. { if (!valued(*e1) || !valued(*e2))
  153. report("replicator needs valued expressions");
  154. sym_down();
  155. var_memory(&info, T_VAR, 1);
  156. *s=insert(index,
  157. T_VAR|T_REP|T_USED|T_ASSIGNED, 1, &info);
  158. }
  159. ;
  160. construct { struct symbol *v;
  161. struct expr *e1, *e2;
  162. struct replicator to_test;
  163. register line, oind;
  164. int BEGIN=0, END=0, NONZERO;
  165. }:
  166. SEQ { line=yylineno; oind=ind; }
  167. [ %if (line==yylineno)
  168. replicator(&v, &e1, &e2)
  169. { rep_init(v, e1, e2, &to_test); }
  170. process
  171. { rep_test(v, e1, e2, &to_test);
  172. rep_cleanup(e1, e2);
  173. }
  174. |
  175. [ %while (tabulated(oind, ind)) process ]*
  176. ]
  177. | PRI ?
  178. [ PAR { line=yylineno; oind=ind;
  179. par_begin();
  180. }
  181. [ %if (line==yylineno)
  182. replicator(&v, &e1, &e2)
  183. { rep_init(v, e1, e2, &to_test);
  184. NONZERO=0;
  185. par_fork(&NONZERO);
  186. }
  187. process
  188. { branch(&END);
  189. Label(NONZERO);
  190. rep_test(v, e1, e2, &to_test);
  191. rep_cleanup(e1, e2);
  192. }
  193. |
  194. [ %while (tabulated(oind, ind))
  195. { NONZERO=0;
  196. par_fork(&NONZERO);
  197. }
  198. process
  199. { branch(&END);
  200. Label(NONZERO);
  201. }
  202. ]*
  203. ]
  204. { Label(END);
  205. par_end();
  206. }
  207. | ALT { line=yylineno; oind=ind;
  208. no_deadlock();
  209. Label(new_label(&BEGIN));
  210. }
  211. [ %if (line==yylineno)
  212. replicator(&v, &e1, &e2)
  213. { rep_init(v, e1, e2, &to_test); }
  214. guarded_process(&END)
  215. { rep_test(v, e1, e2, &to_test);
  216. rep_cleanup(e1, e2);
  217. }
  218. |
  219. [ %while (tabulated(oind, ind)) guarded_process(&END)
  220. ]*
  221. ]
  222. { resumenext();
  223. branch(&BEGIN);
  224. Label(END);
  225. }
  226. ]
  227. | IF { line=yylineno; oind=ind; }
  228. [ %if (line==yylineno)
  229. replicator(&v, &e1, &e2)
  230. { rep_init(v, e1, e2, &to_test); }
  231. conditional(&END)
  232. { rep_test(v, e1, e2, &to_test);
  233. rep_cleanup(e1, e2);
  234. }
  235. |
  236. [ %while (tabulated(oind, ind)) conditional(&END) ]*
  237. ]
  238. { Label(END); }
  239. | WHILE val_expr(&e1) { if (!valued(e1))
  240. report("WHILE needs valued expression");
  241. branch(&END);
  242. Label(new_label(&BEGIN));
  243. }
  244. process
  245. { int DONE=0;
  246. Label(END);
  247. code_bool(e1, negative, &DONE, &BEGIN);
  248. Label(DONE);
  249. destroy(e1);
  250. }
  251. ;
  252. subscript(register *byte; register struct expr **e; )
  253. { struct expr *e1;
  254. register slice=0, err=0;
  255. } :
  256. '[' { *byte=0; }
  257. [ BYTE { *byte=T_BYTE; }
  258. ]?
  259. val_expr(e) { if (!valued(*e))
  260. err++;
  261. }
  262. [ FOR expression(&e1)
  263. { static char siz[]="slize size";
  264. if (!constant(e1)) {
  265. if (!err)
  266. nonconst(siz);
  267. destroy(e1);
  268. e1=new_const(0L);
  269. } else
  270. if (e1->u.const<=0)
  271. nonpositive(siz);
  272. *e=new_node(FOR, *e, e1);
  273. slice=1;
  274. }
  275. ]?
  276. ']'
  277. { if (err)
  278. report(slice ?
  279. "slice must be '[' value FOR constant ']'" :
  280. "subscript needs valued expression");
  281. }
  282. ;
  283. chan { register type, arr_siz=1; register char *name; struct expr *e; }:
  284. IDENTIFIER { type=T_CHAN;
  285. name=token.t_sval;
  286. }
  287. [ '[' expression(&e) ']'
  288. { static char siz[]="channel array size";
  289. if (!constant(e))
  290. nonconst(siz);
  291. else
  292. if (e->u.const<0)
  293. nonpositive(siz);
  294. else
  295. arr_siz=e->u.const;
  296. destroy(e);
  297. type|=T_ARR;
  298. }
  299. ]?
  300. { chan_memory(&info, arr_siz);
  301. chan_init(&info, arr_siz);
  302. insert(name, type, arr_siz, &info);
  303. }
  304. ;
  305. var { register type, byte=0, arr_siz=1;
  306. register char *name;
  307. struct expr *e;
  308. }:
  309. IDENTIFIER { type=T_VAR; name=token.t_sval; }
  310. [ '['
  311. [ BYTE { byte=T_BYTE; }
  312. ]?
  313. expression(&e) ']'
  314. { static char siz[]="variable array size";
  315. if (!constant(e))
  316. nonconst(siz);
  317. else
  318. if (e->u.const<=0)
  319. nonpositive(siz);
  320. else
  321. arr_siz=e->u.const;
  322. destroy(e);
  323. type|=T_ARR|byte;
  324. }
  325. ]?
  326. { var_memory(&info, type, arr_siz);
  327. insert(name, type, arr_siz, &info);
  328. }
  329. ;
  330. const_def { register char *name; struct expr *e; }:
  331. IDENTIFIER { name=token.t_sval; }
  332. '=' expression(&e)
  333. { if (!constant(e) && !arr_constant(e))
  334. nonconst("expression in constant definition");
  335. info.const=e;
  336. insert(name, T_CONST|T_USED, 0, &info);
  337. }
  338. ;
  339. form_parm(register struct par_list ***aapars; register *g_type;)
  340. { register char *name;
  341. register type= *g_type;
  342. }:
  343. [ VAR { type=T_VAR|T_ASSIGNED|T_USED; }
  344. | CHAN { type=T_CHAN; }
  345. | VALUE { type=T_VALUE|T_ASSIGNED; }
  346. ]?
  347. IDENTIFIER {
  348. if (type<0) {
  349. report("VAR, CHAN or VALUE expected");
  350. type=T_VAR;
  351. }
  352. name=token.t_sval;
  353. *g_type=type;
  354. }
  355. [ '[' ']'
  356. { type|=T_ARR; }
  357. ]?
  358. { pars_add(aapars, type&(T_TYPE|T_ARR),
  359. insert(name, type|T_PARAM, 0, &none));
  360. }
  361. ;
  362. form_parms(struct par_list **apars;) { int type= -1; }:
  363. '(' form_parm(&apars, &type)
  364. [ ',' form_parm(&apars, &type)
  365. ]*
  366. ')'
  367. ;
  368. declaration:
  369. VAR
  370. var [ ',' var ]*
  371. | CHAN
  372. chan [ ',' chan ]*
  373. | DEF
  374. const_def [ ',' const_def ]*
  375. | proc_declaration
  376. ;
  377. proc_declaration { struct par_list *pars=nil;
  378. register struct symbol *proc;
  379. int OVER=0;
  380. register old_min_offset;
  381. }:
  382. PROC IDENTIFIER { branch(&OVER);
  383. proc=insert(token.t_sval,
  384. T_PROC|T_RECURS, 0, &none);
  385. old_min_offset=min_offset;
  386. sym_down();
  387. prologue(proc);
  388. }
  389. form_parms(&pars) ? { form_offsets(pars);
  390. proc->info.proc.pars=pars;
  391. }
  392. '=' process { epilogue(proc);
  393. sym_up();
  394. proc->type&= ~T_RECURS;
  395. min_offset=old_min_offset;
  396. Label(OVER);
  397. }
  398. ;
  399. vector_constant(register struct expr **e;)
  400. { struct table *pt=nil, **apt= &pt;
  401. register Tlen=0;
  402. }:
  403. table(e)
  404. | STRING { register char *ps= token.t_sval;
  405. register len;
  406. Tlen+= len= (*ps++ & 0377);
  407. while (--len>=0)
  408. table_add(&apt, (long) *ps++);
  409. }
  410. [ %while (1) STRING
  411. { register char *ps= token.t_sval;
  412. register len;
  413. Tlen+= len= (*ps++ & 0377);
  414. while (--len>=0)
  415. table_add(&apt, (long) *ps++);
  416. }
  417. ]*
  418. { apt= &pt;
  419. table_add(&apt, (long) Tlen);
  420. *e=new_table(E_BTAB, pt);
  421. }
  422. ;
  423. item(register struct expr **e;)
  424. { struct expr *e1;
  425. register struct symbol *var;
  426. struct par_list *pars=nil;
  427. register line, oind;
  428. int byte, err=0, subs_call=0;
  429. struct expr_list *elp=nil, **aelp= &elp;
  430. }:
  431. IDENTIFIER { line=yylineno;
  432. oind=ind;
  433. var=searchall(token.t_sval);
  434. if (var_constant(var))
  435. *e=copy_const(var->info.const);
  436. else {
  437. if (var_proc(var))
  438. pars=var->info.proc.pars;
  439. *e=new_var(var);
  440. }
  441. }
  442. [ %while (line==yylineno || tabulated(oind, ind))
  443. [ subscript(&byte, &e1)
  444. { *e=new_node('[', *e, e1, byte); }
  445. | '(' { if (!var_declared(var)) {
  446. var->type=T_PROC|T_USED|T_NOTDECL;
  447. var->info.proc.pars=nil;
  448. err=1;
  449. }
  450. if (!var_proc(var)) {
  451. report("%s is not a named process",
  452. var->name);
  453. err=1;
  454. }
  455. }
  456. expression(&e1)
  457. { check_param(&pars, e1, &err);
  458. expr_list_add(&aelp, e1);
  459. }
  460. [ ',' expression(&e1)
  461. { check_param(&pars, e1, &err);
  462. expr_list_add(&aelp, e1);
  463. }
  464. ]*
  465. {
  466. if (pars!=nil)
  467. report("too few actual parameters");
  468. }
  469. ')'
  470. { *e=new_call(*e, elp); }
  471. ]
  472. { subs_call=1; }
  473. ]?
  474. { if (!subs_call && var_proc(var)) {
  475. if (pars!=nil)
  476. report("no actual parameters");
  477. *e=new_call(*e, nil);
  478. }
  479. }
  480. | vector_constant(e)
  481. [ subscript(&byte, &e1)
  482. { *e=new_node('[', *e, e1, byte); }
  483. ]?
  484. ;
  485. statement(register struct expr **e;)
  486. { struct expr *e1;
  487. struct expr_list *elp=nil, **aelp= &elp;
  488. register out;
  489. }:
  490. item(e)
  491. [ AS expression(&e1)
  492. { *e=new_node(AS, *e, e1); }
  493. | [
  494. '?' { out=0; }
  495. | '!' { out=1; }
  496. ]
  497. io_arg(&e1)
  498. { if (e1!=nil) check_io(out, e1);
  499. expr_list_add(&aelp, e1);
  500. }
  501. [ %while (1) ';' io_arg(&e1)
  502. { if (e1!=nil) check_io(out, e1);
  503. expr_list_add(&aelp, e1);
  504. }
  505. ]*
  506. { *e=new_io(out, *e, elp); }
  507. ]?
  508. ;
  509. io_arg(struct expr **e; ) :
  510. expression(e)
  511. | ANY { *e=nil; }
  512. ;
  513. table(register struct expr **e;)
  514. { struct table *pt=nil, **apt= &pt;
  515. struct expr *e1;
  516. register type;
  517. }:
  518. TABLE '[' { type=E_TABLE; }
  519. [ BYTE { type=E_BTAB; }
  520. ]?
  521. expression(&e1) { if (!constant(e1))
  522. nonconst("table element");
  523. else
  524. table_add(&apt, e1->u.const);
  525. destroy(e1);
  526. }
  527. [ ',' expression(&e1)
  528. { if (!constant(e1))
  529. nonconst("table element");
  530. else
  531. table_add(&apt, e1->u.const);
  532. destroy(e1);
  533. }
  534. ]*
  535. { *e=new_table(type, pt); }
  536. ']'
  537. ;
  538. arithmetic_op: '+' | '-' | '*' | '/' | BS
  539. ;
  540. comparison_op: '<' | '>' | LE | GE | NE | '=' | AFTER
  541. ;
  542. logical_op: BA | BO | BX
  543. ;
  544. boolean_op: AND | OR
  545. ;
  546. shift_op: LS | RS
  547. ;
  548. monadic_op(register *op;):
  549. '-' { *op='~'; }
  550. | NOT { *op=NOT; }
  551. ;
  552. operator: arithmetic_op | comparison_op | logical_op | boolean_op | shift_op
  553. ;
  554. element(register struct expr **e;) :
  555. %default NUMBER { *e=new_const(token.t_lval); }
  556. | statement(e)
  557. | TRUE { *e=new_const(-1L); }
  558. | FALSE { *e=new_const(0L); }
  559. | NOW { *e=new_now(); }
  560. | CHAR_CONST { *e=new_const(token.t_lval); }
  561. | '(' expression(e) ')' { if (valueless(*e))
  562. warning("primitive should not be parenthesized");
  563. }
  564. ;
  565. expression(register struct expr **e;)
  566. { int op=0;
  567. struct expr *e1;
  568. }:
  569. element(e)
  570. [ %while (1) { if (op!=0) check_assoc(op, LLsymb);
  571. op=LLsymb;
  572. }
  573. operator element(&e1)
  574. { *e=new_node(op, *e, e1); }
  575. ]*
  576. | monadic_op(&op) element(&e1)
  577. { *e=new_node(op, e1, nil); }
  578. ;
  579. val_expr(register struct expr **e;) :
  580. expression(e) { used(*e); }
  581. ;
  582. %lexical scanner;
  583. {
  584. int err=0;
  585. main(argc, argv) register argc; register char **argv;
  586. {
  587. while (argc > 1 && argv[1][0] == '-') {
  588. do_option(&argv[1][1]);
  589. argc--;
  590. argv++;
  591. }
  592. leader();
  593. occam();
  594. trailer();
  595. exit(err);
  596. }
  597. do_option(text)
  598. char *text;
  599. {
  600. extern int Lflag;
  601. switch(*text++) {
  602. default:
  603. fatal("illegal option: %c", *--text);
  604. case 'L' : /* no fil/lin */
  605. Lflag++;
  606. break;
  607. case 'V' : /* set object sizes and alignment requirements */
  608. {
  609. arith size, align;
  610. char c;
  611. while (c = *text++) {
  612. size = txt2int(&text);
  613. switch (c) {
  614. case 'w': /* word */
  615. if (size != (arith)0)
  616. wz = size;
  617. break;
  618. case 'p': /* pointer */
  619. if (size != (arith)0)
  620. pz = size;
  621. break;
  622. case 'l': /* long */
  623. if (size != (arith)0)
  624. vz = size;
  625. break;
  626. default:
  627. fatal("-V: bad type indicator %c\n", c);
  628. }
  629. }
  630. break;
  631. }
  632. }
  633. }
  634. int
  635. txt2int(tp)
  636. char **tp;
  637. {
  638. /* the integer pointed to by *tp is read, while increasing
  639. *tp; the resulting value is yielded.
  640. */
  641. register int val = 0, ch;
  642. while (ch = **tp, ch >= '0' && ch <= '9') {
  643. val = val * 10 + ch - '0';
  644. (*tp)++;
  645. }
  646. return val;
  647. }
  648. LLmessage(tk) register tk;
  649. {
  650. static errors=0;
  651. if (tk>0) {
  652. repeat_token(LLsymb);
  653. warning("syntax error: %s expected (inserted)", tokenname(tk, 1));
  654. } else
  655. if (tk==0)
  656. warning("syntax error: bad token %s (deleted)", tokenname(LLsymb, 0));
  657. else { /* tk<0 */
  658. warning("syntax error: garbage at end of program");
  659. }
  660. if (++errors==MAXERRORS) {
  661. fprint(STDERR, "Too many insert/delete errors. Compiler ends.\n");
  662. err=1; trailer(); exit(1);
  663. }
  664. }
  665. static void nonconst(siz) char *siz;
  666. {
  667. report("%s should be a constant", siz);
  668. }
  669. static void nonpositive(siz) char *siz;
  670. {
  671. report("%s must be positive", siz);
  672. }
  673. static void rep_cleanup(e1, e2) struct expr *e1, *e2;
  674. {
  675. destroy(e1);
  676. destroy(e2);
  677. sym_up();
  678. }
  679. static void check_assoc(prev_op, op) register prev_op, op;
  680. {
  681. switch (op) {
  682. char prev[5];
  683. case '+': case '*':
  684. case AND: case OR:
  685. case BA: case BO: case BX:
  686. if (prev_op==op) break;
  687. default:
  688. strcpy(prev, tokenname(prev_op, 0));
  689. warning("Operators %s and %s don't associate",
  690. prev, tokenname(op, 0)
  691. );
  692. }
  693. }
  694. }