home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / alt / sources / 3071 < prev    next >
Encoding:
Text File  |  1993-01-23  |  41.3 KB  |  1,203 lines
  1. Newsgroups: alt.sources
  2. Path: sparky!uunet!cs.utexas.edu!qt.cs.utexas.edu!yale.edu!newsserver.jvnc.net!princeton!csservices!tyrolia!mg
  3. From: mg@tyrolia (Michael Golan)
  4. Subject: Duel - a language for debugging C programs part 3/6
  5. Message-ID: <1993Jan22.034626.21105@csservices.Princeton.EDU>
  6. Sender: news@csservices.Princeton.EDU (USENET News System)
  7. Organization: Department of Computer Science, Princeton University
  8. Date: Fri, 22 Jan 1993 03:46:26 GMT
  9. Lines: 1192
  10.  
  11. Submitted-by: mg@cs.princeton.edu
  12. Archive-name: duel/part03
  13.  
  14. #!/bin/sh
  15. # This is part 03 of duel
  16. if touch 2>&1 | fgrep 'amc' > /dev/null
  17.  then TOUCH=touch
  18.  else TOUCH=true
  19. fi
  20. # ============= src/proto.h ==============
  21. echo "x - extracting src/proto.h (Text)"
  22. sed 's/^X//' << 'SHAR_EOF' > src/proto.h &&
  23. X/*   DUEL - A Very High Level Debugging Langauge.  */
  24. X/*   Public domain code                       */
  25. X/*   Written by Michael Golan mg@cs.princeton.edu  */
  26. X/*$Header: /tmp_mnt/n/fs/grad2/mg/duel/RCS/proto.h,v 1.9 93/01/13 16:22:37 mg Exp $*/
  27. X
  28. X/* prototypes for all of duel's global functions */
  29. X
  30. XFUNC tctype* duel_mkctype_ptr(tctype *t);
  31. XFUNC tctype* duel_mkctype_func(tctype *t);
  32. XFUNC tctype* duel_mkctype_array(tctype *t,int size);
  33. XFUNC tctype* duel_mkctype_struct(char *name,size_t size,int fields_no,
  34. X                 bool is_union);
  35. XPROC duel_mkctype_struct_field(tctype *t,int field_no,char *name,
  36. X                   int bitpos,int bitlen, tctype *fctype);
  37. XFUNC tctype* duel_mkctype_enum(char *name,tctype_kind real_type_kind,
  38. X                   size_t size,int enumerators_no);
  39. XPROC duel_mkctype_enumerator(tctype *t,int enumerator_no,char *name,int val);
  40. X
  41. XPROC duel_init_basic_ctypes(void);
  42. X
  43. XPROC duel_print_value(tvalue *v);
  44. XPROC duel_print_type(tctype *t,int expand);
  45. XPROC duel_sprint_scalar_value(char *s,tvalue *v);
  46. X
  47. X
  48. XPROC duel_fatal(char *msg);
  49. XPROC duel_abort(void);
  50. XPROC duel_cleanup(void);
  51. X
  52. XFUNC tnode* duel_parse(char *s);
  53. X
  54. X
  55. XPROC duel_reset_eval(void);
  56. XFUNC bool duel_eval(tnode *n,tvalue *v);
  57. XFUNC bool duel_get_dot_name(tvalue *v,char *name,tvalue *ret);
  58. X
  59. XFUNC tnode* duel_set_eval_loc(tnode *n);
  60. XFUNC char* duel_set_input_string(char *s);
  61. XPROC duel_op_error(char *mesg,char *op,tvalue *v1,tvalue *v2);
  62. XPROC duel_gen_error(char *mesg,char *arg1);
  63. X
  64. X
  65. XFUNC bool duel_try_get_rvalue(tvalue *v,char *op);
  66. XPROC duel_standardize_func_parm(tvalue *p);
  67. XFUNC bool duel_do_op_to(tvalue *v1,tvalue *v2,int n,tvalue *r);
  68. XPROC duel_do_cast(tctype *tout,tvalue *v);
  69. XFUNC bool duel_mk_logical(tvalue *v,char *op);
  70. XPROC duel_set_symb_val(tvalue *r,char *format,tvalue *v1,tvalue *v2);
  71. XPROC duel_get_struct_val(tvalue *v,char *op);
  72. XPROC duel_get_struct_ptr_val(tvalue *v,char *op);
  73. XFUNC int duel_get_int_val(tvalue *v,char *op);
  74. XFUNC int duel_get_posint_val(tvalue *v,char *op);
  75. XPROC duel_apply_unary_op(topcode op,tvalue *v);
  76. XPROC duel_apply_post_unary_op(topcode op,tvalue *v);
  77. XFUNC bool duel_apply_bin_op(topcode op,tvalue *v1,tvalue *v2,tvalue *r);
  78. XPROC duel_find_func_frame(tvalue *v,char *op);
  79. X
  80. X
  81. X/* debugger dependent functions */
  82. X
  83. XFUNC void* duel_malloc(size_t size);
  84. XPROC duel_free(void *);
  85. X
  86. XFUNC bool duel_get_target_bytes(ttarget_ptr from,void *to,size_t n);
  87. XFUNC bool duel_put_target_bytes(ttarget_ptr to,void *from,size_t n);
  88. X
  89. XFUNC bool duel_get_target_bitfield(ttarget_ptr struct_at,int bitpos,
  90. X                    int bitlen,void *to,tctype_kind tkind);
  91. XFUNC bool duel_get_target_variable(char *name, int frame_no, tvalue *v);
  92. XFUNC tctype* duel_get_target_typedef(char *name);
  93. XFUNC tctype* duel_get_target_struct_tag(char *name);
  94. XFUNC tctype* duel_get_target_union_tag(char *name);
  95. XFUNC tctype* duel_get_target_enum_tag(char *name);
  96. XFUNC ttarget_ptr duel_alloc_target_space(size_t n);
  97. X
  98. XFUNC int duel_get_frames_number(void);
  99. XFUNC ttarget_ptr duel_get_function_for_frame(int frame_no);
  100. XPROC duel_target_func_call(tvalue *func, tvalue *parms[],
  101. X                int parms_no,tvalue *ret);
  102. X
  103. X/* prototypes for misc functions */
  104. X
  105. XFUNC char* strncpyz(char *to,char *from,size_t len);
  106. X
  107. XPROC duel_free_val_list(tval_list *l);
  108. XPROC duel_free_nodes(tnode *);
  109. X
  110. XFUNC tvalue* duel_find_alias(char *name);
  111. XPROC duel_set_alias(char *name,tvalue *v);
  112. XPROC duel_clear_aliases(void);
  113. XPROC duel_show_aliases(void);
  114. X
  115. SHAR_EOF
  116. $TOUCH -am 0113165193 src/proto.h &&
  117. chmod 0644 src/proto.h ||
  118. echo "restore of src/proto.h failed"
  119. set `wc -c src/proto.h`;Wc_c=$1
  120. if test "$Wc_c" != "3352"; then
  121.     echo original size 3352, current size $Wc_c
  122. fi
  123. # ============= src/duel.c ==============
  124. echo "x - extracting src/duel.c (Text)"
  125. sed 's/^X//' << 'SHAR_EOF' > src/duel.c &&
  126. X/*   DUEL - A Very High Level Debugging Langauge.  */
  127. X/*   Public domain code                            */
  128. X/*   Written by Michael Golan mg@cs.princeton.edu  */
  129. X/*$Header: /tmp_mnt/n/fs/grad2/mg/duel/RCS/duel.c,v 1.7 93/01/12 21:28:44 mg Exp $*/
  130. X
  131. X/* this module contains the entery point to duel - duel_eval_and_pasre.
  132. X */
  133. X
  134. X/*
  135. X * $Log:    duel.c,v $
  136. X * Revision 1.7  93/01/12  21:28:44  mg
  137. X * cleanup and set for release
  138. X * 
  139. X * Revision 1.6  93/01/06  23:57:10  mg
  140. X * added alias, clear commands, new memory alloc/release
  141. X * 
  142. X * Revision 1.5  93/01/03  07:26:47  mg
  143. X * new printing setup
  144. X * 
  145. X * Revision 1.4  92/12/24  23:32:38  mg
  146. X * better struct support, misc changes
  147. X * 
  148. X * Revision 1.3  92/10/19  15:02:04  mg
  149. X * lcc happy, size zero arrays
  150. X * 
  151. X * Revision 1.2  92/10/14  02:03:15  mg
  152. X * misc
  153. X * 
  154. X */
  155. X
  156. X#include <setjmp.h>     
  157. X#define DEF             /* define global variables */
  158. X#include "duel.h"
  159. X#include "patchlevel.h"
  160. X#define  VERSION "DUEL 1.00"
  161. X
  162. Xstatic jmp_buf duel_abort_jmp ; /* abort current execution */
  163. Xstatic tnode *root ;            /* root of current eval node */
  164. X
  165. X
  166. X/* abort evaluation of current expression */
  167. X
  168. XPROC duel_abort(void)
  169. X{
  170. X    longjmp(duel_abort_jmp,1);
  171. X}
  172. X
  173. XPROC duel_cleanup(void) /* cleanup malloc, etc, when duel eval ends*/
  174. X{
  175. X    duel_free_nodes(root);
  176. X    root=NULL ;
  177. X}
  178. X
  179. XLPROC help(void)
  180. X{
  181. X        printf(
  182. X"Duel - Debugging U (might) Even Like -- A high level debugging language\n\n\
  183. XDuel was designed to overcome problems with traditional debuggers' print\n\
  184. Xstatement. It supports the C operators, many C constructs, and many new\n\
  185. Xoperators for easy exploration of the program's space, e.g.\n\
  186. Xx[..100] >? 0                 show positive x[i] for i=0 to 99\n\
  187. Xy[10..20].code !=? 0          show non-zero y[i].code for i=10 to 20\n\
  188. Xh-->next->code                expand linked list h->next, h->next->next ...\n\
  189. Xhead-->next.if(code>0) name   show name for each element with code>0\n\
  190. Xx[i:=..100]=y[i];             array copy. i is an alias to vals 0..99\n\
  191. Xhead-->next[[10..15]]         the 10th to 15th element of a linked list\n\
  192. X#/(head-->next->val==?4)      count elements with val==4\n\
  193. Xhead-->next->if(next) val >? next->val    check if list is sorted by val\n\
  194. X\n\
  195. XDuel was written by Michael Golan at Princeton University. Send email to\n\
  196. Xmg@cs.princeton.edu. Duel is public domain code. No copy left or right.\n\
  197. Xall but 500 lines are independent of gdb. Port it! Make it Commercial!\n\
  198. X\n\
  199. XTry \"dl\" without paramaters for a list of commands\n");
  200. X}
  201. X
  202. XLPROC examples(void)
  203. X{
  204. X    printf("\
  205. Xx[10..20,22,24,40..60]    display x[i] for the selected indexes\n\
  206. Xx[9..0]                   display x[i] backwards\n\
  207. Xx[..100] >? 5 <? 10       display x[i] if 5<x[i]<10\n\
  208. Xx[0..99]=>if(_>5 && _<10) _     same\n\
  209. Xval[..50].if(is_dx) x else y   \
  210. Xval[i].x or val[i].y depending on val[i].is_dx\n\
  211. Xemp[..50].if(is_m) _      return emp[i] if emp[i].is_m.\n\
  212. Xx[i:=..100]=y[i] ;        assign y[i] to x[i]\n\
  213. Xx[i:=..100] >? x[i+1]     check if x[i] is not sorted\n\
  214. X(x[..100] >? 0)[[2]]      return the 3rd positive x[i]\n\
  215. Xargv[0..]@0               argv[0] argv[1] .. until first null\n\
  216. Xemp[0..]@(code==0)        emp[0]..emp[n-1] where emp[n].code==0\n\
  217. Xhead-->next->val          val of each element in a linked list\n\
  218. X*head-->next[[20]]        element 20 of list, '*' display struct w/fields\n\
  219. X#/head-->next             count elements on a linked list\n\
  220. X#/(head-->next-val>?5)    count those over 5\n\
  221. Xhead-->(next!=?head)      expand cyclic linked list (tail->head)\n\
  222. X(T mytype) x              convert x to a user defined type mytype\n\
  223. Xint i ; for(i=0 ;i<5 ..   declare variable, use C construct.\n");
  224. X}
  225. X
  226. XLPROC operators(void)
  227. X{
  228. X    printf("\
  229. XDUEL operators in decreasing precedence. All C operators are accepted!\n\n\
  230. X{x}     same as (x) but x's value is used for symbol                emp[{i}]\n\
  231. Xx-->y   expands data structure from x, using y      root-->(left,right)->key\n\
  232. Xx.y     eval y under x's scope, like pascal \"with\". x is accesible as '_'\n\
  233. Xx->y    same as (*x).y.                             hash[..50]->if(_!=0) key\n\
  234. Xx[[y]]  select the y'th elements of x                     head-->next[[..6]]\n\
  235. Xx@y     eval x, stop as soon as y true (_==y if y const).        argv[0..]@0\n\
  236. Xx@y     eval x, set alias y as counter of generated values\n");
  237. X    printf("\
  238. X#/x     count number of values from x                          #/head-->next\n\
  239. Xframe(n) use with '.' to reference stack frames.                frame(3).val\n\
  240. Xx..y    x, x+1, x+2 .. y. (if x>y, return them backwards)          x[10..20]\n\
  241. X..y     like 0..y-1                                                x[..1024]\n\
  242. Xx..     like x..maxint. Caution: use only with x@y or x[[y]]\n\
  243. Xx>?y    x if x>y else nothing. also <? <=? >=? ==? and !=?        x[..10]<?0\n\
  244. X&&/x    1 or 0 if x!=0 for all x values. ||/x similar         &&/x[..100]>=0\n\
  245. Xx,y     x, then y.\n\
  246. Xx=>y    eval y for each x, setting '_' to x's values            x[..50]=>_*_\n\
  247. Xif(x) y C statements are operators. Also for(), while(), if() else\n\
  248. Xx;y     Evaluate and ignore x's value, then return y\n");
  249. X}
  250. X
  251. X/* entry point into duel. s is the expression to evaluate */
  252. X
  253. Xvoid duel_parse_and_eval(char *s)
  254. X{
  255. X   static first=1 ;
  256. X   if(first)  {                 /* init stuff */
  257. X       duel_init_basic_ctypes(); 
  258. X       printf("%s.%d, public domain debugging language. \"dl\" for help\n",
  259. X               VERSION,PATCHLEVEL);
  260. X       first=0 ; 
  261. X   }
  262. X   if(!s || *s==0) {  /* no input, give some help */
  263. X       printf("Supported DUEL commands: (see man page duel(1))\n");
  264. X       printf("duel help     - give basic help\n");
  265. X       printf("duel examples - show useful usage examples\n");
  266. X       printf("duel ops      - operators summary\n");
  267. X       printf("duel alias    - show current aliases\n");
  268. X       printf("duel clear    - clear all aliases\n\n");
  269. X       return ;
  270. X   }
  271. X   if(strcmp(s,"?")==0 || strcmp(s,"help")==0) {
  272. X       help();
  273. X       return ;
  274. X   }
  275. X   if(strcmp(s,"examples")==0 || strcmp(s,"ex")==0 ) {
  276. X       examples();
  277. X       return ;
  278. X   }
  279. X   if(strcmp(s,"operators")==0 || strcmp(s,"ops")==0) {
  280. X       operators();
  281. X       return ;
  282. X   }
  283. X   if(strcmp(s,"debug")==0) {           /* turn debugging of duel itself */
  284. X       duel_debug= !duel_debug ;
  285. X       printf("duel debug mode %d\n",duel_debug);
  286. X       return ;
  287. X   }
  288. X   if(strcmp(s,"clear")==0) {
  289. X       duel_clear_aliases();
  290. X       printf("Aliases table cleared\n");
  291. X       return ;
  292. X   }
  293. X   if(strcmp(s,"alias")==0 || strcmp(s,"aliases")==0) {
  294. X       duel_show_aliases();
  295. X       return ;
  296. X   }
  297. X   if(setjmp(duel_abort_jmp)==0) {              /* set abort point */
  298. X     if((root=duel_parse(s))!=NULL) {
  299. X       tvalue v ; 
  300. X       duel_set_input_string(s);
  301. X       duel_reset_eval();
  302. X
  303. X       while(duel_eval(root,&v)) {
  304. X           duel_print_value(&v);
  305. X           printf("\n");
  306. X       }
  307. X     }
  308. X   }
  309. X   duel_cleanup();
  310. X}
  311. X
  312. X
  313. X
  314. X
  315. X
  316. X
  317. X
  318. X
  319. X
  320. X
  321. SHAR_EOF
  322. $TOUCH -am 0113165193 src/duel.c &&
  323. chmod 0644 src/duel.c ||
  324. echo "restore of src/duel.c failed"
  325. set `wc -c src/duel.c`;Wc_c=$1
  326. if test "$Wc_c" != "6871"; then
  327.     echo original size 6871, current size $Wc_c
  328. fi
  329. # ============= src/parse.y ==============
  330. echo "x - extracting src/parse.y (Text)"
  331. sed 's/^X//' << 'SHAR_EOF' > src/parse.y &&
  332. X%{
  333. X/*   DUEL - A Very High Level Debugging Langauge.  */
  334. X/*   Public domain code                       */
  335. X/*   Written by Michael Golan mg@cs.princeton.edu  */
  336. X/*$Header: /tmp_mnt/n/fs/grad2/mg/duel/RCS/parse.y,v 1.9 93/01/12 21:53:07 mg Exp $*/
  337. X
  338. X/* this module contains the duel parser, in yacc, plus a simple lexer.
  339. X * the lexer is slow, but duel expressions are tiny.
  340. X * the parsing generate an AST with essentially no type checking.
  341. X * names are only looked up when the refer explicitly to types. This forces
  342. X * the use of "T" before user types. You can't parse (x)(y) correctly, if
  343. X * you want the node to contain "cast" or "func", without knowing the x is 
  344. X * not a type. (It is interesting to note that (x *)(y) is clearly a cast,
  345. X * but it can not be parsed without a context sensitive grammer!). 
  346. X * yacc is also not smart enough to recognize e.g. "if(e) e ; else e" as
  347. X * a special case (redundent ';'). I hacked this in the lexer. It should
  348. X * reduce the trouble with C->duel coding. (It can also be done for {e1}e2,
  349. X * in some speical cases, e.g. if e2 is a keyword, or a name or a unary op,
  350. X * but this can confuse some people, e.g. in {i}[5], so I left it alone.)
  351. X * Finally, the %/ operator is accepted as "#/" and "%%" as "#", to those
  352. X * who wish to keep gdb with # comments.
  353. X * memory: nodes are alloc'ed dynamically. a parsing error loose so-far
  354. X * allocated nodes, which is normally acceptable (yyerror can probably hack
  355. X * into the yacc stack to release them.)
  356. X */
  357. X
  358. X/*
  359. X * $Log:    parse.y,v $
  360. X * Revision 1.9  93/01/12  21:53:07  mg
  361. X * cleanup and set for release
  362. X * 
  363. X * Revision 1.8  93/01/07  00:14:33  mg
  364. X * add &&/ ||/
  365. X * fixed parsing of trailing ';' was a mess.
  366. X * ignore ';' before 'else' and '}' w/warning.
  367. X * 
  368. X * Revision 1.7  93/01/03  07:31:01  mg
  369. X * error reporting
  370. X * 
  371. X * Revision 1.6  92/12/24  23:35:50  mg
  372. X * began src pos support
  373. X * 
  374. X * Revision 1.5  92/10/19  15:08:02  mg
  375. X * frames() added; bug fixed
  376. X * 
  377. X * Revision 1.4  92/10/14  02:06:32  mg
  378. X * misc/change casting parsing/variable def.
  379. X * 
  380. X * Revision 1.3  92/09/16  11:09:39  mg
  381. X * add typedef/struct support, const strings 
  382. X * cleanup s/r conflict by setting ELSE to a token. explained some stuff in
  383. X * comments.
  384. X * 
  385. X * Revision 1.2  92/09/15  06:10:46  mg
  386. X * cosmetics and new ops: x@y, for() while() ..x and x..
  387. X * generic '.' and '_'  support. x@y. '..x' and 'x..'.  while(), for(), ?:
  388. X * 
  389. X */
  390. X
  391. X#include "duel.h"
  392. X
  393. Xstatic char *inputstr ;        /* pointer to string being parsed */
  394. Xstatic char *lexptr ;           /* current lexer pointer into input str */
  395. Xstatic tnode *root ;        /* result of parsing stored here */
  396. X
  397. X/* pick unique names for globals of yacc. gdb has other parsers! */
  398. X#define    yyparse    duel_yyparse
  399. X#define    yylex    duel_yylex
  400. X#define    yyerror    duel_yyerror
  401. X#define    yylval    duel_yylval
  402. X#define    yychar    duel_yychar
  403. X#define    yydebug    duel_yydebug
  404. X#define    yypact    duel_yypact    
  405. X#define    yyr1    duel_yyr1            
  406. X#define    yyr2    duel_yyr2            
  407. X#define    yydef    duel_yydef        
  408. X#define    yychk    duel_yychk        
  409. X#define    yypgo    duel_yypgo        
  410. X#define    yyact    duel_yyact        
  411. X#define    yyexca    duel_yyexca
  412. X#define yyerrflag duel_yyerrflag
  413. X#define yynerrs    duel_yynerrs
  414. X#define    yyps    duel_yyps
  415. X#define    yypv    duel_yypv
  416. X#define    yys    duel_yys
  417. X#define    yystate    duel_yystate
  418. X#define    yytmp    duel_yytmp
  419. X#define    yyv    duel_yyv
  420. X#define    yyval    duel_yyval
  421. X#define    yylloc    duel_yylloc
  422. X
  423. Xtypedef struct {                /* token info for operators */
  424. X        int src_pos ;            /* source position */
  425. X        topcode opcode ;        /* opcode          */
  426. X       } topinfo ;
  427. X
  428. Xtypedef struct {                /* token info for symbols */
  429. X        int src_pos ;            /* source position */
  430. X        char *name ;             /* symbol          */
  431. X       } tnameinfo ;
  432. X
  433. X/* these are used as operators to mknode_... when source location is unknown*/
  434. Xstatic topinfo seq_op  = { -1,';' } ; /* sequencing operator, src pos unkown */
  435. Xstatic topinfo decl_op = { -1,OP_DECL } ; /* declare var op, src pos unkown */
  436. X
  437. X/* local prototypes. */
  438. XLPROC  yyerror(char *msg);
  439. XLFUNC  int yylex (void);
  440. X
  441. XLPROC push_type(char desc) ;
  442. XLPROC push_type_int(char desc,tnode *n)  ;
  443. XLFUNC bool pop_type(char *desc,int *size);
  444. X
  445. XLFUNC tnode* mknode_op(top_kind,topinfo opinfo,tnode*,tnode*,tnode*,tnode*);
  446. XLFUNC tnode* mknode_const(int src_pos,tctype *ctype);
  447. XLFUNC tnode* mknode_ctype(tctype *ctype);
  448. XLFUNC tnode* mknode_name(tnameinfo nameinfo);
  449. XLFUNC tnode* mknode_modified_ctype(tctype *base);
  450. X
  451. X#define mknode_post_unary(op,n) (mknode_op(OPK_POST_UNARY,op,n, 0, 0,0))
  452. X#define mknode_unary(op,n)      (mknode_op(OPK_UNARY,     op,n, 0, 0,0))
  453. X#define mknode_sunary(op,n)     (mknode_op(OPK_SUNARY,    op,n, 0, 0,0))
  454. X#define mknode_bin(op,n1,n2)    (mknode_op(OPK_BIN,       op,n1,n2,0,0))
  455. X#define mknode_sbin(op,n1,n2)   (mknode_op(OPK_SBIN,      op,n1,n2,0,0))
  456. X#define mknode_tri(op,n1,n2,n3) (mknode_op(OPK_TRI,       op,n1,n2,n3,0))
  457. X
  458. Xstatic tctype *decl_tbase ; /* used for variables decl */
  459. X
  460. X/* #define    YYDEBUG    1 */
  461. X
  462. X%}
  463. X
  464. X%union
  465. X  {
  466. X    tnode   *node ;                 /* node pointer for constructed exp tree */
  467. X    tctype  *ctype;                 /* type for type nodes                   */
  468. X    tnameinfo nameinfo ;            /* a name/symbol + src position */
  469. X    topinfo opinfo;                 /* keyword/operator + source position    */
  470. X  }
  471. X
  472. X%type  <node>   start duel_inp duel_exp exp type nameexp sm_exp oexp  
  473. X%type  <node>   all_decls vars_decl var_decl name_decl1 name_decl
  474. X%type  <ctype>  typebase 
  475. X%type  <nameinfo>   name
  476. X
  477. X%token <node>   T_CONST
  478. X%token <nameinfo>   T_SYM
  479. X%token <opinfo> T_ASSIGN T_DEFVAR
  480. X
  481. X
  482. X%token <opinfo> T_CHAR T_INT T_SHORT T_LONG  T_UNSIGNED T_FLOAT T_DOUBLE T_VOID
  483. X%token <opinfo> T_STRUCT T_UNION T_ENUM T_SIZEOF T_TYPEDEF_INDICATOR
  484. X
  485. X%token <opinfo> T_IF T_ELSE T_FOR T_WHILE 
  486. X%token <opinfo> ';' ',' '=' '?' '|' '^' '&' '<' '>' '+' '-' '*' '/' '%'
  487. X%token <opinfo> '.' '[' ']' '(' ')' '{' '}' '#' '@' '!' '~' 
  488. X%token <opinfo> T_OR T_AND T_RSH T_LSH T_INC T_DEC T_COUNT T_FRAME T_TO
  489. X%token <opinfo> T_DFS T_BFS T_ARROW T_OSEL T_CSEL T_IMP T_ANDL T_ORL
  490. X%token <opinfo> T_EQ T_NE T_EQQ T_NEQ T_LE T_GE T_LSQ T_GTQ T_LEQ T_GEQ
  491. X
  492. X%left  ';'
  493. X%right STMT T_ELSE
  494. X%right T_IMP
  495. X%right ','
  496. X%right '=' T_ASSIGN T_DEFVAR
  497. X%right '?'
  498. X%left  T_OR  T_ORL
  499. X%left  T_AND T_ANDL
  500. X%left  '|'
  501. X%left  '^'
  502. X%left  '&'
  503. X%left  T_EQ T_NE T_EQQ T_NEQ
  504. X%left  '<' '>' T_LE T_GE T_LSQ T_GTQ T_LEQ T_GEQ
  505. X%nonassoc T_TO
  506. X%left  T_LSH T_RSH
  507. X%left  '+' '-'
  508. X%left  '*' '/' '%'
  509. X%right UNARY T_INC T_DEC T_COUNT T_FRAME
  510. X%left T_DFS T_BFS T_POS T_ARROW '.' '[' ']' '(' ')' '{' '}' '#' '@' T_OSEL T_CSEL
  511. X%%
  512. X
  513. Xstart : duel_inp     { root=$1 ; }
  514. X      ;
  515. X
  516. Xduel_inp : all_decls 
  517. X         | all_decls ';'
  518. X         | all_decls ';' duel_exp    { $$=mknode_sbin($2,$1,$3);}
  519. X         | duel_exp
  520. X         ;
  521. Xduel_exp : sm_exp
  522. X         | sm_exp ';' { $$=mknode_sbin($2,$1,0); }
  523. X         ;
  524. Xall_decls:  vars_decl                  
  525. X          | all_decls ';' vars_decl      { $$=mknode_sbin($2,$1,$3); }
  526. X          ;
  527. X
  528. Xvars_decl: typebase { decl_tbase=$1 ; } var_decl { $$=$3 ; }
  529. X         ;
  530. Xvar_decl : name_decl1
  531. X         | var_decl ',' name_decl1  { $$=mknode_sbin(seq_op,$1,$3); }
  532. X         ;
  533. X
  534. Xname_decl1: name_decl        { $$=mknode_sbin(decl_op,$1,
  535. X                    mknode_modified_ctype(decl_tbase)); }
  536. X          ;
  537. X
  538. Xname_decl : '(' name_decl ')'           { $$=$2 ; }
  539. X      | '(' name_decl ')' '(' ')'       { $$=$2 ; push_type('('); }
  540. X      | '*' name_decl               { $$=$2 ; push_type('*'); }
  541. X      | name_decl '[' T_CONST ']'        { $$=$1 ; push_type_int('[',$3); }
  542. X      | nameexp
  543. X      ;
  544. X
  545. X/* Statements   - not really, these are expressions too!
  546. X   Notes: for(;;) oexp - will create lots of shift/reduce conflicts, 
  547. X                        'for(;;;)' and 'for(;;) exp' are specified
  548. X            instead and yacc handle this as a "standard" s/r.
  549. X            the only diff is yacc dont complain on these!
  550. X       if() - same comments as above, plus, we prevent meaningless
  551. X              if's like in C: ' if(x); else;' - a useless statement.
  552. X */
  553. Xexp   :   T_IF '(' exp ')' exp %prec STMT { $$=mknode_tri($1,$3,$5,0); }
  554. X      |   T_IF '(' exp ')' exp T_ELSE %prec STMT 
  555. X                                          { $$=mknode_tri($1,$3,$5,0); } 
  556. X      |   T_IF '(' exp ')' T_ELSE exp %prec STMT 
  557. X                                          { $$=mknode_tri($1,$3,0,$6); } 
  558. X      |   T_IF '(' exp ')' exp T_ELSE exp %prec STMT 
  559. X                                          { $$=mknode_tri($1,$3,$5,$7); } 
  560. X
  561. X      |   T_FOR '(' oexp ';' exp ';' oexp ')' exp %prec STMT
  562. X                              {  $$=mknode_op(OPK_QUAD,$1,$3,$5,$7,$9); } 
  563. X      |   T_FOR '(' oexp ';' exp ';' oexp ')' %prec STMT
  564. X                              {  $$=mknode_op(OPK_QUAD,$1,$3,$5,$7,0); } 
  565. X      |   T_WHILE '(' exp ')' exp %prec STMT
  566. X                              {  $$=mknode_sbin($1,$3,$5); } 
  567. X      |   T_WHILE '(' exp ')' %prec STMT
  568. X                              {  $$=mknode_sbin($1,$3,0); } 
  569. X      ;
  570. X
  571. X/* Expressions  */
  572. X
  573. Xexp   :      '*' exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  574. X      |      '&' exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  575. X      |      '-' exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  576. X      |      '!' exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  577. X      |      '~' exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  578. X      |  T_COUNT exp          %prec UNARY  { $$=mknode_sunary($1,$2); }
  579. X      |   T_ANDL exp                     { $$=mknode_sunary($1,$2); }
  580. X      |   T_ORL  exp                     { $$=mknode_sunary($1,$2); }
  581. X      |    T_INC exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  582. X      |    T_DEC exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  583. X      |    exp T_INC          %prec UNARY  { $$=mknode_post_unary($2,$1); }
  584. X      |    exp T_DEC          %prec UNARY  { $$=mknode_post_unary($2,$1); }
  585. X      | T_SIZEOF exp          %prec UNARY  { $$=mknode_unary( $1,$2); }
  586. X      |    T_SIZEOF '(' type ')' %prec UNARY  { $$=mknode_sunary($1,$3); }
  587. X      | T_FRAME '(' exp ')'   %prec UNARY  { $$=mknode_unary( $1,$3); }
  588. X      ;
  589. X
  590. Xexp  :  exp T_DFS exp             { $$=mknode_sbin($2,$1,$3); }
  591. X      |  exp T_BFS exp             { $$=mknode_sbin($2,$1,$3); }
  592. X
  593. X      |  exp '#' nameexp        { $$=mknode_sbin($2,$1,$3); }
  594. X      |  exp '@'     exp            { $$=mknode_sbin($2,$1,$3); }
  595. X      |  exp T_ARROW exp            { $$=mknode_sbin($2,$1,$3); }
  596. X      |  exp '.'     exp            { $$=mknode_sbin($2,$1,$3); }
  597. X      |  exp '[' exp ']'            { $$=mknode_bin( $2,$1,$3); }
  598. X      |  exp T_OSEL exp T_CSEL      { $$=mknode_sbin($2,$1,$3); }
  599. X      |  exp '(' oexp ')' %prec '.' { $$=mknode_op(OPK_FUNC,$2,$1,$3,0,0); }
  600. X      |  '(' sm_exp ')'             { $$=mknode_unary($1,$2); }
  601. X      |  '{' sm_exp '}'             { $$=mknode_unary($1,$2); }
  602. X      ;
  603. X
  604. Xexp  :    '(' type ')' exp  %prec UNARY
  605. X            { $$=mknode_op(OPK_CAST,$1,$2,$4,0,0); }
  606. X      ;
  607. X
  608. X /* Bin ops in decreasing precedence order:  */
  609. X
  610. Xexp    :      exp  '*'  exp    { $$=mknode_bin($2,$1,$3); }
  611. X       |      exp  '/'  exp    { $$=mknode_bin($2,$1,$3); }
  612. X       |      exp  '%'  exp    { $$=mknode_bin($2,$1,$3); }
  613. X       |      exp  '+'  exp    { $$=mknode_bin($2,$1,$3); }
  614. X       |      exp  '-'  exp    { $$=mknode_bin($2,$1,$3); }
  615. X       |      exp T_LSH exp    { $$=mknode_bin($2,$1,$3); }
  616. X       |      exp T_RSH exp    { $$=mknode_bin($2,$1,$3); }
  617. X       |      exp T_EQ  exp    { $$=mknode_bin($2,$1,$3); }
  618. X       |      exp T_NE  exp    { $$=mknode_bin($2,$1,$3); }
  619. X       |      exp T_EQQ exp    { $$=mknode_bin($2,$1,$3); }
  620. X       |      exp T_NEQ exp    { $$=mknode_bin($2,$1,$3); }
  621. X       |      exp T_LE  exp    { $$=mknode_bin($2,$1,$3); }
  622. X       |      exp T_GE  exp    { $$=mknode_bin($2,$1,$3); }
  623. X       |      exp T_LEQ exp    { $$=mknode_bin($2,$1,$3); }
  624. X       |      exp T_GEQ exp    { $$=mknode_bin($2,$1,$3); }
  625. X       |      exp  '<'  exp    { $$=mknode_bin($2,$1,$3); }
  626. X       |      exp  '>'  exp    { $$=mknode_bin($2,$1,$3); }
  627. X       |      exp T_LSQ exp    { $$=mknode_bin($2,$1,$3); }
  628. X       |      exp T_GTQ exp    { $$=mknode_bin($2,$1,$3); }
  629. X       |      exp  '&'  exp    { $$=mknode_bin($2,$1,$3); }
  630. X       |      exp  '|'  exp    { $$=mknode_bin($2,$1,$3); }
  631. X       |      exp  '^'  exp    { $$=mknode_bin($2,$1,$3); }
  632. X       |      exp T_AND exp    { $$=mknode_sbin($2,$1,$3); }
  633. X       |      exp T_OR  exp    { $$=mknode_sbin($2,$1,$3); }
  634. X        ;
  635. X
  636. Xexp    :    exp '?' exp ':' exp  %prec '?'
  637. X                    { $$=mknode_tri($2,$1,$3,$5); }
  638. X    ;
  639. X              
  640. Xexp    :    exp   '='    exp  { $$=mknode_bin($2,$1,$3); }
  641. X       |    exp T_ASSIGN exp  { $$=mknode_op(OPK_ASSIGN,$2, $1,$3,0,0);  }
  642. X       |nameexp T_DEFVAR exp  { $$=mknode_sbin($2,$1,$3);  }
  643. X    ;
  644. X
  645. X     /* generating expressions */
  646. X
  647. Xexp    :      exp T_TO  exp   { $$=mknode_sbin($2,$1,$3); }
  648. X        |      T_TO exp           { $$=mknode_sbin($1, 0,$2); }
  649. X        |      exp T_TO        { $$=mknode_sbin($2,$1, 0); }
  650. X        |    exp ',' exp    { $$=mknode_sbin($2,$1,$3); }
  651. X        |      exp T_IMP exp   { $$=mknode_sbin($2,$1,$3); }
  652. X        ;
  653. X
  654. Xsm_exp  :    sm_exp ';' exp { $$=mknode_sbin($2,$1,$3); }
  655. X        |       exp 
  656. X    ;
  657. X
  658. Xoexp    :    exp        /* optional expression, eg in for() */
  659. X        |            { $$=0 ; }
  660. X        ;
  661. X
  662. Xexp    :    T_CONST  ;
  663. Xexp    :    nameexp  ;
  664. Xnameexp    :    name     { $$=mknode_name($1) ; } ;
  665. X
  666. Xtype    :    typebase type_mod { $$=mknode_modified_ctype($1); }
  667. X        ;
  668. X/* type_mod has no value. bison warning is meaningless. I cant find a way
  669. X * to shut it up
  670. X */
  671. Xtype_mod: '(' type_mod ')'
  672. X    | '(' type_mod ')' '(' ')'       {  push_type('('); }
  673. X    | '*' type_mod                    {  push_type('*'); }
  674. X    | type_mod '[' T_CONST ']'        {  push_type_int('[',$3); }
  675. X    | 
  676. X    ;
  677. X
  678. X
  679. X/* note that names are evaluated at runtime. hence (name)(x) is ambigious
  680. X * as either a function call or a cast.
  681. X * We could identify a typedef 'name' as such and return a special token from
  682. X * the lexr, but this will make 'x.(5+y)' illegal if y is both a field and
  683. X * a typedef (Note that gdb's own code include such things).
  684. X *
  685. X * there is a complex solution, that keeps the the casting as a syntax tree,
  686. X * and compute ctype at runtime, too. However, we want to compute all types at
  687. X * parse time. Out solution forces the reserved word T_TYPEDEF_INDICATOR to
  688. X * appear before any typedef name. (the reserved word is normally just 'T')
  689. X * example: instead of '(list *) x'  use in duel:  '(T list *) x'
  690. X */
  691. X
  692. Xtypebase:    T_TYPEDEF_INDICATOR name           {
  693. X                    $$=duel_get_target_typedef($2.name);
  694. X            if($$==NULL) {
  695. X               tvalue v;
  696. X               if(duel_get_target_variable($2.name,-1,&v)) $$=v.ctype;
  697. X               else  { yyerror("not a typedef name"); YYABORT ; }
  698. X            }
  699. X        } 
  700. X        ;
  701. X
  702. Xtypebase:    T_CHAR                   { $$ = ctype_char;  }
  703. X    |    T_UNSIGNED T_CHAR        { $$ = ctype_uchar; }
  704. X    |    T_INT                    { $$ = ctype_int;   }
  705. X    |    T_UNSIGNED               { $$ = ctype_uint;  }
  706. X    |    T_UNSIGNED T_INT         { $$ = ctype_uint;  }
  707. X    |    T_LONG                   { $$ = ctype_long;  }
  708. X    |    T_LONG T_INT             { $$ = ctype_long;  }
  709. X    |    T_UNSIGNED T_LONG        { $$ = ctype_ulong; }
  710. X    |    T_UNSIGNED T_LONG T_INT  { $$ = ctype_ulong; }
  711. X    |    T_SHORT                  { $$ = ctype_short; }
  712. X        |    T_SHORT T_INT         { $$ = ctype_short; }
  713. X    |    T_UNSIGNED T_SHORT         { $$ = ctype_ushort; }
  714. X    |    T_UNSIGNED T_SHORT T_INT { $$ = ctype_ushort; }
  715. X        |       T_FLOAT                  { $$ = ctype_float ; }
  716. X        |       T_DOUBLE                 { $$ = ctype_double; }
  717. X        |    T_VOID             { $$ = ctype_void;   }
  718. X    |    T_STRUCT name
  719. X           { $$ = duel_get_target_struct_tag($2.name);
  720. X             if($$==NULL) { yyerror("not a struct tag"); YYABORT ; }}
  721. X    |    T_UNION name
  722. X           { $$ = duel_get_target_union_tag($2.name);
  723. X             if($$==NULL) { yyerror("not a union tag"); YYABORT ; }}
  724. X    |    T_ENUM name
  725. X           { $$ = duel_get_target_enum_tag($2.name);
  726. X             if($$==NULL) { yyerror("not an enum tag"); YYABORT ; }}
  727. X        ;
  728. X
  729. Xname    : T_SYM ;
  730. X%%
  731. X
  732. Xstatic struct stoken {    /* all opcodes we recognize */
  733. X  char *opstr ;                 /* op code as a string      */
  734. X  int token ;                   /* token to return to yacc  */
  735. X  int opcode ;                  /* opcode value associated with the token */
  736. X } tokens[] =  {                /* the special tokens, longer ones 1st! */
  737. X    {">>=",T_ASSIGN, OP_RSH},
  738. X    {"<<=",T_ASSIGN, OP_LSH},
  739. X    {"-->",T_DFS,    OP_DFS},
  740. X    {"->>",T_BFS,    OP_BFS},
  741. X    {"==?", T_EQQ,   OP_EQQ},
  742. X    {"!=?", T_NEQ,   OP_NEQ},
  743. X    {"<=?", T_LEQ,   OP_LEQ},
  744. X    {">=?", T_GEQ,   OP_GEQ},
  745. X    {"&&/", T_ANDL,  OP_AND},
  746. X    {"||/", T_ORL,   OP_OR},
  747. X
  748. X    {"<?", T_LSQ,    OP_LSQ},
  749. X    {">?", T_GTQ,    OP_GTQ},
  750. X    {"#/", T_COUNT,  '#' },
  751. X    {"%/", T_COUNT,  '#' }, /* gdb insists to recognize # as start of comma!*/
  752. X    {"%%", '#',      '#' }, /* same. so %/ for #/ and %% for #. not doc!*/
  753. X    {"+=", T_ASSIGN,  '+'},
  754. X    {"-=", T_ASSIGN,  '-'},
  755. X    {"*=", T_ASSIGN,  '*'},
  756. X    {"/=", T_ASSIGN,  '/'},
  757. X    {"%=", T_ASSIGN,  '%'},
  758. X    {"|=", T_ASSIGN,  '|'},
  759. X    {"&=", T_ASSIGN,  '&'},
  760. X    {"^=", T_ASSIGN,  '^'},
  761. X    {":=", T_DEFVAR,OP_DEF},
  762. X    {"++", T_INC,   OP_INC },
  763. X    {"--", T_DEC,   OP_DEC },
  764. X    {"->", T_ARROW, OP_ARR },
  765. X    {"&&", T_AND,   OP_AND },
  766. X    {"||", T_OR,    OP_OR  },
  767. X    {"<<", T_LSH,   OP_LSH },
  768. X    {">>", T_RSH,   OP_RSH },
  769. X    {"==", T_EQ,    OP_EQ  },
  770. X    {"!=", T_NE,    OP_NE  },
  771. X    {"<=", T_LE,    OP_LE  },
  772. X    {">=", T_GE,    OP_GE  },
  773. X    {"..", T_TO,    OP_TO  },
  774. X    {"=>", T_IMP,   OP_IMP },
  775. X    {"[[", T_OSEL,  OP_SEL },
  776. X    {"]]", T_CSEL,  OP_SEL },
  777. X  };
  778. X
  779. Xstatic struct skeyword {  /* all keywords we recognize */
  780. X  char *keyword_str ;           /* keyword as a string       */
  781. X  int token ;                   /* token to return to yacc   */
  782. X  topcode opcode ;              /* opcode associated w/keyword */
  783. X } keywords[] = {
  784. X    {"if",    T_IF       , OP_IF},
  785. X    {"else",    T_ELSE       },
  786. X    {"for",    T_FOR       , OP_FOR},
  787. X    {"while",    T_WHILE       , OP_WHILE},
  788. X    {"sizeof",  T_SIZEOF   , OP_SIZ},
  789. X    {"frame",    T_FRAME       , OP_FRAME},
  790. X
  791. X    {"T",     T_TYPEDEF_INDICATOR  },
  792. X    {"struct",  T_STRUCT   },
  793. X    {"union",   T_UNION    },
  794. X    {"enum",    T_ENUM     },
  795. X
  796. X    {"unsigned",T_UNSIGNED },
  797. X    /*{"signed",  T_SIGNED   },*/
  798. X    {"short",   T_SHORT    },
  799. X    {"long",    T_LONG     },
  800. X    {"char",    T_CHAR     },
  801. X    {"int",     T_INT      },
  802. X    {"double",  T_DOUBLE   },
  803. X    {"float",   T_FLOAT    },
  804. X    {"void",    T_VOID       },
  805. X   } ;
  806. X
  807. X
  808. XLFUNC tnode* duel_lex_int(void)    /* parse next token as integer num */
  809. X{
  810. X   tnode *n ;
  811. X   ulong val=0 ;
  812. X   char *p=lexptr ;
  813. X   bool is_l=0,is_u=0 ;
  814. X   int base=10 ;
  815. X   int src_pos=lexptr-inputstr ;
  816. X   
  817. X   if(*p=='0') {                        /* figure out the base */
  818. X      p++ ;
  819. X      if(*p=='x' || *p=='X') base=16,p++ ;
  820. X      else 
  821. X      if(isdigit(*p)) base=8 ; /* avoid having '0' as a base 8 (uint) */
  822. X   }
  823. X
  824. X   while(isdigit(*p) || base==16 && isxdigit(*p)) {  /* get the value */
  825. X      val*=base ;
  826. X      if(isupper(*p)) val+= *p-'A'+10 ;
  827. X      else if(islower(*p)) val+= *p-'a'+10 ;
  828. X      else val+= *p-'0' ;
  829. X      p++ ;
  830. X   }
  831. X   if(*p=='l' || *p=='L') is_l=1,p++ ;          /* yuk. figure 0L etc */
  832. X   if(*p=='u' || *p=='U') is_u=1,p++ ;
  833. X   if(!is_l && (*p=='l' || *p=='L')) is_l=1,p++ ;
  834. X   is_u=is_u || base!=10 ;
  835. X
  836. X   if(is_l && is_u || (long) val < 0 || ((uint) val != val && is_u)) {
  837. X        n=mknode_const(src_pos,ctype_ulong);
  838. X        n->cnst.u.rval_ulong=val ;
  839. X   }
  840. X   else
  841. X   if(is_l || (uint) val != val) {
  842. X        n=mknode_const(src_pos,ctype_long) ; 
  843. X        n->cnst.u.rval_long=(long) val ; 
  844. X   }
  845. X   else
  846. X   if(is_u || (int) val < 0) {
  847. X        n=mknode_const(src_pos,ctype_uint) ; 
  848. X        n->cnst.u.rval_uint=(uint) val ; 
  849. X   }
  850. X   else {
  851. X        n=mknode_const(src_pos,ctype_int) ; 
  852. X        n->cnst.u.rval_int=(int) val ; 
  853. X   }
  854. X   strncpyz(n->cnst.symb_val,lexptr,p-lexptr); /* save the symbolic val*/
  855. X   lexptr=p ;
  856. X   return n ;
  857. X}
  858. X
  859. XLFUNC tnode* duel_lex_float(void)    /* parse next token as float num */
  860. X{
  861. X  tnode *n=0 ;
  862. X  char *p=lexptr ;
  863. X  double val ;
  864. X  char c,tmpc ;
  865. X  bool ok=TRUE;
  866. X  int src_pos = lexptr - inputstr ;
  867. X
  868. X  /* this is disgusting.. why isnt there a lib call to recognize floats?! */
  869. X  while(isdigit(*p)) p++ ;
  870. X  if(*p=='.') p++ ;
  871. X  while(isdigit(*p)) p++ ;
  872. X  if(*p=='e' || *p=='E') {
  873. X     p++ ;
  874. X     if(*p=='+' || *p=='-') p++ ;
  875. X     if(!isdigit(*p)) ok=FALSE ;     /* force digit (scanf allows 1e-.2 ?!) */
  876. X     while(isdigit(*p)) p++ ;
  877. X  }
  878. X  tmpc= *p ; *p=0 ;
  879. X  ok=ok && sscanf(lexptr,"%lf%c",&val,&c)==1 ;
  880. X  *p=tmpc ;
  881. X  if(!ok) yyerror("Invalid float constant.");
  882. X
  883. X  n=mknode_const(src_pos,ctype_double); 
  884. X  n->cnst.u.rval_double=val ; 
  885. X  strncpyz(n->cnst.symb_val,lexptr,p-lexptr); /* save the symbolic val*/
  886. X  lexptr=p ;
  887. X  return(n);
  888. X}
  889. X
  890. X/* parse_escaped_char -- parse an escaped char (e.g. '\n'). 
  891. X * lexptr expected to point to text right after the '\'. 
  892. X * return: actual char value (e.g. 012 if 'n' or '012' is found.)
  893. X *         lexptr is advanced after the espaced char.
  894. X */
  895. X
  896. XLFUNC char parse_escaped_char(void)
  897. X{
  898. X  char retc ;
  899. X  switch(lexptr[0]) { 
  900. X   case 'n': retc='\n' ; break ;
  901. X   case 'r': retc='\r' ; break ;
  902. X   case '0': case '1': case '2': case '3': 
  903. X             retc= (char) ((lexptr[0]-'0')*0100 + (lexptr[1]-'0')*010 + 
  904. X                           (lexptr[2]-'0')) ;
  905. X             lexptr+=2 ;
  906. X             break ;
  907. X   default:  retc=lexptr[0] ;     /* default also takes care of '\'' '\\' */
  908. X  }
  909. X  lexptr++ ;
  910. X  return retc ;
  911. X}
  912. X
  913. X/* FUNC yylex -- return the next token to yacc. 
  914. X * GLOBALS: lexptr point to the string we are parsing next. it is updated.
  915. X */
  916. X
  917. XLFUNC int yylex (void)
  918. X{
  919. X  int c,i,src_pos ;
  920. X  char *p ;
  921. X
  922. X  for(c= *lexptr; c==' ' || c=='\t' || c=='\n' ; c= *++lexptr); /* skip blank*/
  923. X
  924. X  src_pos = lexptr - inputstr ;    /* current char being parsed */
  925. X  yylval.opinfo.src_pos = src_pos ;
  926. X  
  927. X  for (i = 0;  i < sizeof(tokens)/sizeof(struct stoken) ; i++) { 
  928. X    int l=strlen(tokens[i].opstr) ;             /* check next token vs table */
  929. X    if(strncmp(lexptr,tokens[i].opstr,l)==0) {
  930. X    lexptr+=l ;
  931. X    yylval.opinfo.opcode = tokens[i].opcode;
  932. X    return tokens[i].token ;
  933. X    }
  934. X  }
  935. X
  936. X  switch (c = *lexptr) {
  937. X    case 0: return 0;
  938. X    case '\'':                /* char constant, but stored as int (ansi-c) */
  939. X      p=lexptr++ ;
  940. X      c = *lexptr++ ;
  941. X      if (c == '\\') c=parse_escaped_char();
  942. X      if( *lexptr++ != '\'') yyerror("Invalid character constant.");
  943. X      yylval.node=mknode_const(src_pos,ctype_int) ;
  944. X      yylval.node->cnst.u.rval_int=c ;
  945. X      strncpyz(yylval.node->cnst.symb_val,p,lexptr-p); /*save the symbol. val*/
  946. X      return T_CONST ;
  947. X    
  948. X    case '0':                           /* chk hex  */
  949. X        if(lexptr[1]=='x' || lexptr[1]=='X') {
  950. X           yylval.node=duel_lex_int(); 
  951. X           return T_CONST ;
  952. X        }
  953. X        /* fall thru for other numbers */
  954. X    case '1': case '2': case '3':      /* decimal or floating point number */
  955. X    case '4': case '5': case '6': case '7': case '8': case '9':
  956. X          for(p=lexptr ; *p>='0' && *p<='9' ; p++ ) ;  /*find next non digit*/
  957. X          if(*p=='.' && p[1]!='.' || *p=='e' || *p=='E') 
  958. X               yylval.node=duel_lex_float();
  959. X          else yylval.node=duel_lex_int();
  960. X          return T_CONST ;
  961. X
  962. X    case '(':  case ')':
  963. X    case '<':  case '>':
  964. X    case '[':  case ']':
  965. X    case '{':  case '}':
  966. X    case '+':  case '-':  case '*':  case '/':  case '%':
  967. X    case '|':  case '&':  case '^':  case '~':  case '!':
  968. X    case ',':  case '?':  case ':':  case '=':  
  969. X    case '.':  case '@':  case '$':  case '#':  case '`': case '\\': 
  970. X      lexptr++;
  971. X      yylval.opinfo.opcode=c ;
  972. X      return c;
  973. X    case ';': { /* hack, ignore ';' before '}' and else. for C compatability*/
  974. X            char *save_lexptr= ++lexptr ;
  975. X        int tok=yylex()    ;    /* hack, call myself for next token */
  976. X        if(tok=='}' || tok==T_ELSE) {
  977. X            printf("warning: useless ';' ignored\n");
  978. X            return tok ;
  979. X        }
  980. X        /* else restore position and return the ';' */
  981. X        lexptr=save_lexptr ;
  982. X        yylval.opinfo.opcode=';' ;
  983. X        yylval.opinfo.src_pos = src_pos ;
  984. X        return ';';
  985. X    }
  986. X    case '"': {
  987. X          char s[512] ;
  988. X      size_t len=0 ;
  989. X      ttarget_ptr dptr ;
  990. X      tnode *n ;
  991. X
  992. X      p=lexptr++ ; 
  993. X      while((c= *lexptr++)!='"') {
  994. X           if (c == '\\') c=parse_escaped_char();
  995. X           s[len++]=c ;
  996. X      }
  997. X      s[len++]=0 ;
  998. X      dptr=duel_alloc_target_space(len);
  999. X      duel_put_target_bytes(dptr,s,len);
  1000. X      
  1001. X      n=mknode_const(src_pos,ctype_charptr); 
  1002. X      n->cnst.u.rval_ptr=dptr ; 
  1003. X      len=lexptr-p ;
  1004. X      if(len>60) len=60 ;
  1005. X      strncpyz(n->cnst.symb_val,p,len); /* save the symbolic val*/
  1006. X          yylval.node=n ;
  1007. X          return T_CONST ;
  1008. X      }
  1009. X    }
  1010. X
  1011. X  if(c != '_' && !isalpha(c))
  1012. X     yyerror ("Invalid character in expression.");
  1013. X
  1014. X  p=lexptr ;
  1015. X  do { c= *++lexptr ; } while(c=='_' || isalnum(c));
  1016. X  
  1017. X  for (i = 0;  i < sizeof(keywords)/sizeof(struct skeyword) ; i++) { 
  1018. X    int l=strlen(keywords[i].keyword_str) ;   /* check next token vs keywords*/
  1019. X    if(l==lexptr-p && strncmp(p,keywords[i].keyword_str,l)==0) {
  1020. X        yylval.opinfo.opcode=keywords[i].opcode ;
  1021. X    return keywords[i].token ;
  1022. X    }
  1023. X  }
  1024. X
  1025. X  /* the symbol/name found is not a reserved word, so return it as a T_SYM
  1026. X   */
  1027. X    
  1028. X  i=lexptr-p ;          /* length of string found (symbol/name) */
  1029. X  yylval.nameinfo.src_pos=src_pos ;
  1030. X  yylval.nameinfo.name=duel_malloc(i+1);
  1031. X  strncpyz(yylval.nameinfo.name,p,i);
  1032. X  return T_SYM;
  1033. X}
  1034. X
  1035. XLPROC yyerror(char *msg)
  1036. X{
  1037. X  int i,n=lexptr-inputstr ;
  1038. X  printf("%s\n",inputstr);
  1039. X  for(i=0 ; i<n ; i++) printf("-");
  1040. X  printf("^ %s\n",msg);
  1041. X}
  1042. X
  1043. X/*************************************************************************/
  1044. X/* utility functions used to parse the expression and build it as a tree */
  1045. X/*************************************************************************/
  1046. X
  1047. X/* mknode_op -- make a tree node of type op with given opcode and kids
  1048. X */
  1049. X
  1050. XLFUNC tnode* mknode_op(top_kind op_kind,topinfo opinfo,
  1051. X                       tnode *k1,tnode *k2,tnode *k3,tnode *k4)
  1052. X{
  1053. X   tnode *n ;
  1054. X   duel_assert(opinfo.opcode>' ');
  1055. X   n=(tnode *) duel_malloc(sizeof(tnode));
  1056. X   duel_bzero((char*) n,sizeof(tnode));
  1057. X   n->node_kind=NK_OP ;
  1058. X   n->op_kind=op_kind ;
  1059. X   n->op=opinfo.opcode ;
  1060. X   n->src_pos=opinfo.src_pos ;
  1061. X   n->kids[0]=k1 ;  n->kids[1]=k2 ;  n->kids[2]=k3 ; n->kids[3]=k4 ;
  1062. X   return n ;
  1063. X}
  1064. X
  1065. X
  1066. X /* mknode_const -- make a constant node for the given type. 
  1067. X  */
  1068. X
  1069. XLFUNC tnode* mknode_const(int src_pos,tctype *ctype)
  1070. X{
  1071. X   tnode *n ;
  1072. X   n=(tnode *) duel_malloc(sizeof(tnode));
  1073. X   duel_bzero((char*) n,sizeof(tnode));
  1074. X   n->node_kind=NK_CONST ;
  1075. X   n->src_pos=src_pos ;
  1076. X   n->cnst.val_kind=VK_RVALUE ;
  1077. X   n->cnst.ctype=ctype ;
  1078. X   return n ;
  1079. X}
  1080. X
  1081. X /* mknode_ctype -- make a node of the given c-type. 
  1082. X  */
  1083. X
  1084. XLFUNC tnode* mknode_ctype(tctype *ctype)
  1085. X{
  1086. X   tnode *n ;
  1087. X   n=(tnode *) duel_malloc(sizeof(tnode));
  1088. X   duel_bzero((char*) n,sizeof(tnode));
  1089. X   n->node_kind=NK_CTYPE ;
  1090. X   n->ctype=ctype ;
  1091. X   return n ;
  1092. X}
  1093. X
  1094. X /* mknode_name -- make a node of the given name/symbol.
  1095. X  * input is pointer to the saved name (on heap)
  1096. X  */
  1097. X
  1098. XLFUNC tnode* mknode_name(tnameinfo nameinfo)
  1099. X{
  1100. X   tnode *n ;
  1101. X   n=(tnode *) duel_malloc(sizeof(tnode));
  1102. X   duel_bzero((char*) n,sizeof(tnode));
  1103. X   n->node_kind=NK_NAME ;
  1104. X   n->name=nameinfo.name ;
  1105. X   n->src_pos=nameinfo.src_pos ;
  1106. X   return n ;
  1107. X}
  1108. X
  1109. X/* In order to parse C types, which are 'reversed' in the parser, a stack
  1110. X * is used to push abstract declarators, e.g. in (*)() we first push a func
  1111. X * indicator '(' and then push a pointer indicator '*'. for arrays we push
  1112. X * a '[' and the array size. 
  1113. X * This stack is popped and a ctype is constructed at the end of the 
  1114. X * abstract type parsing. The following functions implement the stack
  1115. X */
  1116. X
  1117. Xtypedef struct stype_desc {  /* stack of type descriptors is made of these */
  1118. X        char desc ; 
  1119. X        int size ;
  1120. X        struct stype_desc *next ;       /* next on stack */
  1121. X      } ttype_desc ;
  1122. X
  1123. Xttype_desc *top = 0 ;
  1124. X
  1125. X
  1126. XLPROC push_type(char desc)     /* put desc on the types stack */
  1127. X{
  1128. X    ttype_desc *p = (ttype_desc* ) duel_malloc(sizeof(ttype_desc));
  1129. X    p->desc=desc ;
  1130. X    p->size=0 ;
  1131. X    p->next=top ;
  1132. X    top=p ;
  1133. X}
  1134. X
  1135. X/* push_type_int -- same as push_type but also set the size parameter, which
  1136. X *                  is given as a constant node (which is expected to be int)
  1137. X */
  1138. X
  1139. XLPROC push_type_int(char desc,tnode *n)  
  1140. X{
  1141. X   duel_assert(n->node_kind==NK_CONST);
  1142. X   if(n->cnst.ctype != ctype_int || 
  1143. X      n->cnst.u.rval_int <=0 ) duel_gen_error("Illegal array size",0);
  1144. X   push_type(desc);
  1145. X   top->size=n->cnst.u.rval_int ;
  1146. X}
  1147. X
  1148. XLFUNC bool pop_type(char *desc,int *size)  /* pop item from stack. */
  1149. X{
  1150. X   ttype_desc *p = top ;
  1151. X   if(p==0) return FALSE ;
  1152. X   *desc=p->desc ;
  1153. X   *size=p->size ;
  1154. X   top=p->next ;
  1155. X   duel_free(p) ;
  1156. X   return TRUE ;
  1157. X}
  1158. X
  1159. X
  1160. X/* abstract type-modifiers were pushed on a stack. Retrieve
  1161. X * them (reversed) creating type nodes as we go 
  1162. X * input: base type (e.g. 'long'). 
  1163. X * returns: node of the modified type. 
  1164. X * modification is based on the stack of things pushed while parsing.
  1165. X */
  1166. X
  1167. XLFUNC tnode* mknode_modified_ctype(tctype *base)
  1168. X{  
  1169. X    int size;
  1170. X    char tdesc ;           /* descriptor of abs decl eg '*' */
  1171. X    tctype *t=base ;       /* type under construction       */
  1172. X    
  1173. X    while(pop_type(&tdesc,&size))    /* pop next abs decl    */
  1174. X    switch (tdesc) {
  1175. X      case '*':  t=duel_mkctype_ptr(t);         break ;
  1176. X      case '(':  t=duel_mkctype_func(t);        break ;
  1177. X      case '[':  t=duel_mkctype_array(t,size);  break ;
  1178. X    }    
  1179. X    return mknode_ctype(t) ;
  1180. X}
  1181. X
  1182. X/* entry point for parsing. the given expression is parsed into the given
  1183. X * node as root.
  1184. X */
  1185. X
  1186. XFUNC tnode* duel_parse(char *s)
  1187. X{
  1188. X  lexptr=inputstr=s ;
  1189. X  top=0 ;                 /* reset the types stack */
  1190. X  if(duel_yyparse()) root=NULL ;
  1191. X  return root ;
  1192. X}
  1193. SHAR_EOF
  1194. $TOUCH -am 0113165193 src/parse.y &&
  1195. chmod 0644 src/parse.y ||
  1196. echo "restore of src/parse.y failed"
  1197. set `wc -c src/parse.y`;Wc_c=$1
  1198. if test "$Wc_c" != "29171"; then
  1199.     echo original size 29171, current size $Wc_c
  1200. fi
  1201. echo "End of part 3, continue with part 4"
  1202. exit 0
  1203.