home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / dev / misc / p2c / src / citmods.c next >
C/C++ Source or Header  |  1993-12-21  |  31KB  |  1,154 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18.  
  19.  
  20. #define PROTO_CITMODS_C
  21. #include "trans.h"
  22.  
  23.  
  24.  
  25. /* The following functions define special translations for several
  26.  * HP Pascal modules developed locally at Caltech.  For non-Caltech
  27.  * readers this file will serve mainly as a body of examples.
  28.  *
  29.  * The FuncMacro mechanism (introduced after this file was written)
  30.  * provides a simpler method for cases where the function translates
  31.  * into some fixed C equivalent.
  32.  */
  33.  
  34.  
  35.  
  36.  
  37. /* NEWASM functions */
  38.  
  39.  
  40. /* na_fillbyte: equivalent to memset, though convert_size is used to
  41.  * generalize the size a bit:  na_fillbyte(a, 0, 80) where a is an array
  42.  * of integers (4 bytes in HP Pascal) will be translated to
  43.  * memset(a, 0, 20 * sizeof(int)).
  44.  */
  45.  
  46. Static Stmt *proc_na_fillbyte(ex)
  47. Expr *ex;
  48. {
  49.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  50.     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILLBYTE");
  51.     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
  52.                                            ex->args[0],
  53.                                            makeexpr_arglong(ex->args[1], 0),
  54.                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  55. }
  56.  
  57.  
  58.  
  59. /* This function fills with a 32-bit pattern.  If all four bytes of the
  60.  * pattern are equal, memset is used, otherwise the na_fill call is
  61.  * left unchanged.
  62.  */
  63.  
  64. Static Stmt *proc_na_fill(ex)
  65. Expr *ex;
  66. {
  67.     unsigned long ul;
  68.     Symbol *sym;
  69.  
  70.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  71.     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILL");
  72.     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_FILLP")) {
  73.         sym = findsymbol("NA_FILL");
  74.         if (sym->mbase)
  75.             ex->val.i = (long)sym->mbase;
  76.     }
  77.     if (isliteralconst(ex->args[1], NULL) != 2)
  78.         return makestmt_call(ex);
  79.     ul = ex->args[1]->val.i;
  80.     if ((((ul >> 16) ^ ul) & 0xffff) ||    /* all four bytes must be the same */
  81.         (((ul >> 8) ^ ul) & 0xff))
  82.         return makestmt_call(ex);
  83.     ex->args[1]->val.i &= 0xff;
  84.     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
  85.                                            ex->args[0],
  86.                                            makeexpr_arglong(ex->args[1], 0),
  87.                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  88. }
  89.  
  90.  
  91.  
  92. Static Stmt *proc_na_move(ex)
  93. Expr *ex;
  94. {
  95.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);   /* source */
  96.     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);   /* dest */
  97.     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  98.                                           argbasetype(ex->args[1])), ex->args[2], "NA_MOVE");
  99.     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  100.                                            ex->args[1],
  101.                                            ex->args[0],
  102.                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  103. }
  104.  
  105.  
  106.  
  107. /* This just generalizes the size and leaves the function call alone,
  108.  * except that na_exchp (a version using pointer args) is transformed
  109.  * to na_exch (a version using VAR args, equivalent in C).
  110.  */
  111.  
  112. Static Stmt *proc_na_exch(ex)
  113. Expr *ex;
  114. {
  115.     Symbol *sym;
  116.  
  117.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  118.     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
  119.     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  120.                                           argbasetype(ex->args[1])), ex->args[2], "NA_EXCH");
  121.     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_EXCHP")) {
  122.         sym = findsymbol("NA_EXCH");
  123.         if (sym->mbase)
  124.             ex->val.i = (long)sym->mbase;
  125.     }
  126.     return makestmt_call(ex);
  127. }
  128.  
  129.  
  130.  
  131. Static Expr *func_na_comp(ex)
  132. Expr *ex;
  133. {
  134.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  135.     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
  136.     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  137.                                           argbasetype(ex->args[1])), ex->args[2], "NA_COMP");
  138.     return makeexpr_bicall_3("memcmp", tp_int,
  139.                              ex->args[0],
  140.                              ex->args[1],
  141.                              makeexpr_arglong(ex->args[2], (size_t_long != 0)));
  142. }
  143.  
  144.  
  145.  
  146. Static Expr *func_na_scaneq(ex)
  147. Expr *ex;
  148. {
  149.     Symbol *sym;
  150.  
  151.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  152.     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANEQ");
  153.     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANEQP")) {
  154.         sym = findsymbol("NA_SCANEQ");
  155.         if (sym->mbase)
  156.             ex->val.i = (long)sym->mbase;
  157.     }
  158.     return ex;
  159. }
  160.  
  161.  
  162.  
  163. Static Expr *func_na_scanne(ex)
  164. Expr *ex;
  165. {
  166.     Symbol *sym;
  167.  
  168.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
  169.     ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANNE");
  170.     if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANNEP")) {
  171.         sym = findsymbol("NA_SCANNE");
  172.         if (sym->mbase)
  173.             ex->val.i = (long)sym->mbase;
  174.     }
  175.     return ex;
  176. }
  177.  
  178.  
  179.  
  180. Static Stmt *proc_na_new(ex)
  181. Expr *ex;
  182. {
  183.     Expr *vex, *ex2, *sz = NULL;
  184.     Stmt *sp;
  185.  
  186.     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
  187.     ex2 = ex->args[1];
  188.     if (vex->val.type->kind == TK_POINTER)
  189.         ex2 = convert_size(vex->val.type->basetype, ex2, "NA_NEW");
  190.     if (alloczeronil)
  191.         sz = copyexpr(ex2);
  192.     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
  193.     sp = makestmt_assign(copyexpr(vex), ex2);
  194.     if (malloccheck) {
  195.         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
  196.                                           makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int, 
  197.                                                                           makeexpr_long(-2))),
  198.                                           NULL));
  199.     }
  200.     if (sz && !isconstantexpr(sz)) {
  201.         if (alloczeronil == 2)
  202.             note("Called NA_NEW with variable argument [500]");
  203.         sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
  204.                          sp,
  205.                          makestmt_assign(vex, makeexpr_nil()));
  206.     } else
  207.         freeexpr(vex);
  208.     return sp;
  209. }
  210.  
  211.  
  212.  
  213. Static Stmt *proc_na_dispose(ex)
  214. Expr *ex;
  215. {
  216.     Stmt *sp;
  217.     Expr *vex;
  218.  
  219.     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
  220.     sp = makestmt_call(makeexpr_bicall_1(freename, tp_void, copyexpr(vex)));
  221.     if (alloczeronil) {
  222.         sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
  223.                          sp, NULL);
  224.     } else
  225.         freeexpr(vex);
  226.     return sp;
  227. }
  228.  
  229.  
  230.  
  231. /* These functions provide functionality similar to alloca; we just warn
  232.  * about them here since alloca would not have been portable enough for
  233.  * our purposes anyway.
  234.  */
  235.  
  236. Static Stmt *proc_na_alloc(ex)
  237. Expr *ex;
  238. {
  239.     Expr *ex2;
  240.  
  241.     note("Call to NA_ALLOC [501]");
  242.     ex->args[0] = eatcasts(ex->args[0]);
  243.     ex2 = ex->args[0];
  244.     if (ex2->val.type->kind == TK_POINTER &&
  245.     ex2->val.type->basetype->kind == TK_POINTER)
  246.         ex->args[1] = convert_size(ex2->val.type->basetype->basetype,
  247.                    ex->args[1], "NA_ALLOC");
  248.     return makestmt_call(ex);
  249. }
  250.  
  251.  
  252.  
  253. Static Stmt *proc_na_outeralloc(ex)
  254. Expr *ex;
  255. {
  256.     note("Call to NA_OUTERALLOC [502]");
  257.     return makestmt_call(ex);
  258. }
  259.  
  260.  
  261.  
  262. Static Stmt *proc_na_free(ex)
  263. Expr *ex;
  264. {
  265.     note("Call to NA_FREE [503]");
  266.     return makestmt_call(ex);
  267. }
  268.  
  269.  
  270.  
  271.  
  272. Static Expr *func_na_memavail(ex)
  273. Expr *ex;
  274. {
  275.