home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / funcs3.c < prev    next >
C/C++ Source or Header  |  1990-03-17  |  23KB  |  982 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  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. #define PROTO_FUNCS3_C
  19. #include "trans.h"
  20.  
  21. extern Strlist *enumnames;
  22. extern int enumnamecount;
  23.  
  24. Stmt *proc_gotoxy(ex)
  25. Expr *ex;
  26. {
  27.     return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
  28.                                            makeexpr_arglong(ex->args[0], 0),
  29.                                            makeexpr_arglong(ex->args[1], 0)));
  30. }
  31.  
  32. Expr *handle_vax_hex(ex, fmt, scale)
  33. Expr *ex;
  34. char *fmt;
  35. int scale;
  36. {
  37.     Expr *lex, *dex, *vex;
  38.     Meaning *tvar;
  39.     Type *tp;
  40.     long smin, smax;
  41.     int bits;
  42.  
  43.     if (!ex) {
  44.     if (!skipopenparen())
  45.         return NULL;
  46.     ex = p_expr(tp_integer);
  47.     }
  48.     tp = true_type(ex);
  49.     if (ord_range(tp, &smin, &smax))
  50.     bits = typebits(smin, smax);
  51.     else
  52.     bits = 32;
  53.     if (curtok == TOK_COMMA) {
  54.     gettok();
  55.     if (curtok != TOK_COMMA)
  56.         lex = makeexpr_arglong(p_expr(tp_integer), 0);
  57.     else
  58.         lex = NULL;
  59.     } else
  60.     lex = NULL;
  61.     if (!lex) {
  62.     if (!scale)
  63.         lex = makeexpr_long(11);
  64.     else
  65.         lex = makeexpr_long((bits+scale-1) / scale + 1);
  66.     }
  67.     if (curtok == TOK_COMMA) {
  68.     gettok();
  69.     dex = makeexpr_arglong(p_expr(tp_integer), 0);
  70.     } else {
  71.     if (!scale)
  72.         dex = makeexpr_long(10);
  73.     else
  74.         dex = makeexpr_long((bits+scale-1) / scale);
  75.     }
  76.     if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
  77.     lex->val.i < dex->val.i)
  78.     lex = NULL;
  79.     skipcloseparen();
  80.     tvar = makestmttempvar(tp_str255, name_STRING);
  81.     vex = makeexpr_var(tvar);
  82.     ex = makeexpr_forcelongness(ex);
  83.     if (exprlongness(ex) > 0)
  84.     fmt = format_s("l%s", fmt);
  85.     if (checkconst(lex, 0) || checkconst(lex, 1))
  86.     lex = NULL;
  87.     if (checkconst(dex, 0) || checkconst(dex, 1))
  88.     dex = NULL;
  89.     if (lex) {
  90.     if (dex)
  91.         ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
  92.                    makeexpr_string(format_s("%%*.*%s", fmt)),
  93.                    lex, dex, ex);
  94.     else
  95.         ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  96.                    makeexpr_string(format_s("%%*%s", fmt)),
  97.                    lex, ex);
  98.     } else {
  99.     if (dex)
  100.         ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  101.                    makeexpr_string(format_s("%%.*%s", fmt)),
  102.                    dex, ex);
  103.     else
  104.         ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  105.                    makeexpr_string(format_s("%%%s", fmt)),
  106.                    ex);
  107.     }
  108.     return ex;
  109. }
  110.  
  111. Expr *func_hex()
  112. {
  113.     Expr *ex;
  114.     char *cp;
  115.  
  116.     if (!skipopenparen())
  117.     return NULL;
  118.     ex = makeexpr_stringcast(p_expr(tp_integer));
  119.     if ((ex->val.type->kind == TK_STRING ||
  120.      ex->val.type == tp_strptr) &&
  121.     curtok != TOK_COMMA) {
  122.     skipcloseparen();
  123.     if (ex->kind == EK_CONST) {    /* HP Pascal */
  124.         cp = getstring(ex);
  125.         ex = makeexpr_long(my_strtol(cp, NULL, 16));
  126.         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  127.         return ex;
  128.     } else {
  129.         return makeexpr_bicall_3("strtol", tp_integer, 
  130.                      ex, makeexpr_nil(), makeexpr_long(16));
  131.     }
  132.     } else {    /* VAX Pascal */
  133.     return handle_vax_hex(ex, "x", 4);
  134.     }
  135. }
  136.  
  137.  
  138.  
  139. Expr *func_hi()
  140. {
  141.     Expr *ex;
  142.  
  143.     ex = force_unsigned(p_parexpr(tp_integer));
  144.     return makeexpr_bin(EK_RSH, tp_ubyte,
  145.                         ex, makeexpr_long(8));
  146. }
  147.  
  148.  
  149.  
  150. Expr *func_high()
  151. {
  152.     Expr *ex;
  153.     Type *type;
  154.  
  155.     ex = p_parexpr(tp_integer);
  156.     type = ex->val.type;
  157.     if (type->kind == TK_POINTER)
  158.     type = type->basetype;
  159.     if (type->kind == TK_ARRAY ||
  160.     type->kind == TK_SMALLARRAY) {
  161.     ex = makeexpr_minus(copyexpr(type->indextype->smax),
  162.                 copyexpr(type->indextype->smin));
  163.     } else {
  164.     warning("HIGH requires an array name parameter [210]");
  165.     ex = makeexpr_bicall_1("HIGH", tp_int, ex);
  166.     }
  167.     return ex;
  168. }
  169.  
  170.  
  171.  
  172. Expr *func_hiword()
  173. {
  174.     Expr *ex;
  175.  
  176.     ex = force_unsigned(p_parexpr(tp_unsigned));
  177.     return makeexpr_bin(EK_RSH, tp_unsigned,
  178.                         ex, makeexpr_long(16));
  179. }
  180.  
  181.  
  182.  
  183. Stmt *proc_inc()
  184. {
  185.     Expr *vex, *ex;
  186.  
  187.     if (!skipopenparen())
  188.     return NULL;
  189.     vex = p_expr(NULL);
  190.     if (curtok == TOK_COMMA) {
  191.         gettok();
  192.         ex = p_expr(tp_integer);
  193.     } else
  194.         ex = makeexpr_long(1);
  195.     skipcloseparen();
  196.     return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
  197. }
  198.  
  199.  
  200.  
  201. Stmt *proc_incl()
  202. {
  203.     Expr *vex, *ex;
  204.  
  205.     if (!skipopenparen())
  206.     return NULL;
  207.     vex = p_expr(NULL);
  208.     if (!skipcomma())
  209.     return NULL;
  210.     ex = p_expr(vex->val.type->indextype);
  211.     skipcloseparen();
  212.     if (vex->val.type->kind == TK_SMALLSET)
  213.     return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type,
  214.                          copyexpr(vex),
  215.                          makeexpr_bin(EK_LSH, vex->val.type,
  216.                                   makeexpr_longcast(makeexpr_long(1), 1),
  217.                                   ex)));
  218.     else
  219.     return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
  220.                            makeexpr_arglong(enum_to_int(ex), 0)));
  221. }
  222.  
  223.  
  224.  
  225. Stmt *proc_insert(ex)
  226. Expr *ex;
  227. {
  228.     return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
  229.                                            ex->args[0], 
  230.                                            ex->args[1],
  231.                                            makeexpr_arglong(ex->args[2], 0)));
  232. }
  233.  
  234.  
  235.  
  236. Expr *func_int()
  237. {
  238.     Expr *ex;
  239.     Meaning *tvar;
  240.  
  241.     ex = p_parexpr(tp_integer);
  242.     if (ex->val.type->kind == TK_REAL) {    /* Turbo Pascal INT */
  243.     tvar = makestmttempvar(tp_longreal, name_TEMP);
  244.     return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
  245.                         grabarg(ex, 0),
  246.                         makeexpr_addr(makeexpr_var(tvar))),
  247.                   makeexpr_var(tvar));
  248.     } else {     /* VAX Pascal INT */
  249.     return makeexpr_ord(ex);
  250.     }
  251. }
  252.  
  253.  
  254. Expr *func_uint()
  255. {
  256.     Expr *ex;
  257.  
  258.     ex = p_parexpr(tp_integer);
  259.     return makeexpr_cast(ex, tp_unsigned);
  260. }
  261.  
  262.  
  263.  
  264. Stmt *proc_leave()
  265. {
  266.     return makestmt(SK_BREAK);
  267. }
  268.  
  269.  
  270.  
  271. Expr *func_lo()
  272. {
  273.     Expr *ex;
  274.  
  275.     ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
  276.     return makeexpr_bin(EK_BAND, tp_ubyte,
  277.                         ex, makeexpr_long(255));
  278. }
  279.  
  280.  
  281. Expr *func_loophole()
  282. {
  283.     Type *type;
  284.     Expr *ex;
  285.  
  286.     if (!skipopenparen())
  287.     return NULL;
  288.     type = p_type(NULL);
  289.     if (!skipcomma())
  290.     return NULL;
  291.     ex = p_expr(tp_integer);
  292.     skipcloseparen();
  293.     return pascaltypecast(type, ex);
  294. }
  295.  
  296.  
  297.  
  298. Expr *func_lower()
  299. {
  300.     Expr *ex;
  301.     Value val;
  302.  
  303.     if (!skipopenparen())
  304.     return NULL;
  305.     ex = p_expr(tp_integer);
  306.     if (curtok == TOK_COMMA) {
  307.     gettok();
  308.     val = p_constant(tp_integer);
  309.     if (!val.type || val.i != 1)
  310.         note("LOWER(v,n) not supported for n>1 [190]");
  311.     }
  312.     skipcloseparen();
  313.     return copyexpr(ex->val.type->indextype->smin);
  314. }
  315.  
  316.  
  317.  
  318. Expr *func_loword()
  319. {
  320.     Expr *ex;
  321.  
  322.     ex = p_parexpr(tp_integer);
  323.     return makeexpr_bin(EK_BAND, tp_ushort,
  324.                         ex, makeexpr_long(65535));
  325. }
  326.  
  327.  
  328.  
  329. Expr *func_ln(ex)
  330. Expr *ex;
  331. {
  332.     return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0));
  333. }
  334.  
  335.  
  336.  
  337. Expr *func_log(ex)
  338. Expr *ex;
  339. {
  340.     return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0));
  341. }
  342.  
  343.  
  344.  
  345. Expr *func_max()
  346. {
  347.     Type *tp;
  348.     Expr *ex, *ex2;
  349.  
  350.     if (!skipopenparen())
  351.     return NULL;
  352.     if (curtok == TOK_IDENT && curtokmeaning &&
  353.     curtokmeaning->kind == MK_TYPE) {
  354.     tp = curtokmeaning->type;
  355.     gettok();
  356.     skipcloseparen();
  357.     return copyexpr(tp->smax);
  358.     }
  359.     ex = p_expr(tp_integer);
  360.     while (curtok == TOK_COMMA) {
  361.     gettok();
  362.     ex2 = p_expr(ex->val.type);
  363.     if (ex->val.type->kind == TK_REAL) {
  364.         tp = ex->val.type;
  365.         if (ex2->val.type->kind != TK_REAL)
  366.         ex2 = makeexpr_cast(ex2, tp);
  367.     } else {
  368.         tp = ex2->val.type;
  369.         if (ex->val.type->kind != TK_REAL)
  370.         ex = makeexpr_cast(ex, tp);
  371.     }
  372.     ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
  373.                    tp, ex, ex2);
  374.     }                
  375.     skipcloseparen();
  376.     return ex;
  377. }
  378.  
  379.  
  380.  
  381. Expr *func_maxavail(ex)
  382. Expr *ex;
  383. {
  384.     freeexpr(ex);
  385.     return makeexpr_bicall_0("maxavail", tp_integer);
  386. }
  387.  
  388. Expr *func_maxpos()
  389. {
  390.     return file_iofunc(3, seek_base);
  391. }
  392.  
  393. Expr *func_memavail(ex)
  394. Expr *ex;
  395. {
  396.     freeexpr(ex);
  397.     return makeexpr_bicall_0("memavail", tp_integer);
  398. }
  399.  
  400.  
  401.  
  402. Expr *var_mem()
  403. {
  404.     Expr *ex, *ex2;
  405.  
  406.     if (!wneedtok(TOK_LBR))
  407.     return makeexpr_name("MEM", tp_integer);
  408.     ex = p_expr(tp_integer);
  409.     if (curtok == TOK_COLON) {
  410.     gettok();
  411.     ex2 = p_expr(tp_integer);
  412.     ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
  413.     } else {
  414.     ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
  415.     }
  416.     if (!wneedtok(TOK_RBR))
  417.     skippasttotoken(TOK_RBR, TOK_SEMI);
  418.     note("Reference to MEM [191]");
  419.     return ex;
  420. }
  421.  
  422.  
  423.  
  424. Expr *var_memw()
  425. {
  426.     Expr *ex, *ex2;
  427.  
  428.     if (!wneedtok(TOK_LBR))
  429.     return makeexpr_name("MEMW", tp_integer);
  430.     ex = p_expr(tp_integer);
  431.     if (curtok == TOK_COLON) {
  432.     gettok();
  433.     ex2 = p_expr(tp_integer);
  434.     ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
  435.     } else {
  436.     ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
  437.     }
  438.     if (!wneedtok(TOK_RBR))
  439.     skippasttotoken(TOK_RBR, TOK_SEMI);
  440.     note("Reference to MEMW [191]");
  441.     return ex;
  442. }
  443.  
  444.  
  445.  
  446. Expr *var_meml()
  447. {
  448.     Expr *ex, *ex2;
  449.  
  450.     if (!wneedtok(TOK_LBR))
  451.     return makeexpr_name("MEML", tp_integer);
  452.     ex = p_expr(tp_integer);
  453.     if (curtok == TOK_COLON) {
  454.     gettok();
  455.     ex2 = p_expr(tp_integer);
  456.     ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
  457.     } else {
  458.     ex = makeexpr_bicall_1("MEML", tp_integer, ex);
  459.     }
  460.     if (!wneedtok(TOK_RBR))
  461.     skippasttotoken(TOK_RBR, TOK_SEMI);
  462.     note("Reference to MEML [191]");
  463.     return ex;
  464. }
  465.  
  466.  
  467.  
  468. Expr *func_min()
  469. {
  470.     Type *tp;
  471.     Expr *ex, *ex2;
  472.  
  473.     if (!skipopenparen())
  474.     return NULL;
  475.     if (curtok == TOK_IDENT && curtokmeaning &&
  476.     curtokmeaning->kind == MK_TYPE) {
  477.     tp = curtokmeaning->type;
  478.     gettok();
  479.     skipcloseparen();
  480.     return copyexpr(tp->smin);
  481.     }
  482.     ex = p_expr(tp_integer);
  483.     while (curtok == TOK_COMMA) {
  484.     gettok();
  485.     ex2 = p_expr(ex->val.type);
  486.     if (ex->val.type->kind == TK_REAL) {
  487.         tp = ex->val.type;
  488.         if (ex2->val.type->kind != TK_REAL)
  489.         ex2 = makeexpr_cast(ex2, tp);
  490.     } else {
  491.         tp = ex2->val.type;
  492.         if (ex->val.type->kind != TK_REAL)
  493.         ex = makeexpr_cast(ex, tp);
  494.     }
  495.     ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
  496.                    tp, ex, ex2);
  497.     }                
  498.     skipcloseparen();
  499.     return ex;
  500. }
  501.  
  502.  
  503.  
  504. Stmt *proc_move(ex)
  505. Expr *ex;
  506. {
  507.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);    /* source */
  508.     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);    /* dest */
  509.     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  510.                                           argbasetype(ex->args[1])), ex->args[2], "MOVE");
  511.     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  512.                                            ex->args[1],
  513.                                            ex->args[0],
  514.                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  515. }
  516.  
  517.  
  518.  
  519. Stmt *proc_move_fast()
  520. {
  521.     Expr *ex, *ex2, *ex3, *ex4;
  522.  
  523.     if (!skipopenparen())
  524.     return NULL;
  525.     ex = p_expr(tp_integer);
  526.     if (!skipcomma())
  527.     return NULL;
  528.     ex2 = p_expr(tp_integer);
  529.     if (!skipcomma())
  530.     return NULL;
  531.     ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
  532.     ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
  533.     if (!skipcomma())
  534.     return NULL;
  535.     ex3 = p_expr(tp_integer);
  536.     if (!skipcomma())
  537.     return NULL;
  538.     ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
  539.     ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
  540.     skipcloseparen();
  541.     ex = convert_size(choosetype(argbasetype(ex2),
  542.                  argbasetype(ex3)), ex, "MOVE_FAST");
  543.     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  544.                        makeexpr_addr(ex3),
  545.                        makeexpr_addr(ex2),
  546.                        makeexpr_arglong(ex, (size_t_long != 0))));
  547. }
  548.  
  549.  
  550.  
  551. Stmt *proc_new()
  552. {
  553.     Expr *ex, *ex2;
  554.     Stmt *sp, **spp;
  555.     Type *type;
  556.     char *name, *name2 = NULL, vbuf[1000];
  557.  
  558.     if (!skipopenparen())
  559.     return NULL;
  560.     ex = p_expr(tp_anyptr);
  561.     type = ex->val.type;
  562.     if (type->kind == TK_POINTER)
  563.     type = type->basetype;
  564.     parse_special_variant(type, vbuf);
  565.     skipcloseparen();
  566.     name = find_special_variant(vbuf, NULL, specialmallocs, 3);
  567.     if (!name) {
  568.         name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
  569.     if (!name2) {
  570.         name = find_special_variant(vbuf, NULL, specialmallocs, 1);
  571.         name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
  572.         if (name || !name2)
  573.         name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
  574.         else
  575.         name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
  576.     }
  577.     }
  578.     if (name) {
  579.     ex2 = makeexpr_bicall_0(name, ex->val.type);
  580.     } else if (name2) {
  581.     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
  582.     } else {
  583.     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
  584.                 makeexpr_sizeof(makeexpr_type(type), 1));
  585.     }
  586.     sp = makestmt_assign(copyexpr(ex), ex2);
  587.     if (malloccheck) {
  588.         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
  589.                                copyexpr(ex),
  590.                                makeexpr_nil()),
  591.                                           makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
  592.                                           NULL));
  593.     }
  594.     spp = &sp->next;
  595.     while (*spp)
  596.     spp = &(*spp)->next;
  597.     if (type->kind == TK_RECORD)
  598.     initfilevars(type->fbase, &spp, makeexpr_hat(copyexpr(ex), 0));
  599.     else if (isfiletype(type))
  600.     sp = makestmt_seq(sp, makestmt_assign(makeexpr_hat(copyexpr(ex), 0),
  601.                           makeexpr_nil()));
  602.     freeexpr(ex);
  603.     return sp;
  604. }
  605.  
  606.  
  607.  
  608. Expr *func_oct()
  609. {
  610.     return handle_vax_hex(NULL, "o", 3);
  611. }
  612.  
  613.  
  614.  
  615. Expr *func_octal(ex)
  616. Expr *ex;
  617. {
  618.     char *cp;
  619.  
  620.     ex = grabarg(ex, 0);
  621.     if (ex->kind == EK_CONST) {
  622.         cp = getstring(ex);
  623.         ex = makeexpr_long(my_strtol(cp, NULL, 8));
  624.         insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer));
  625.         return ex;
  626.     } else {
  627.         return makeexpr_bicall_3("strtol", tp_integer, 
  628.                                  ex, makeexpr_nil(), makeexpr_long(8));
  629.     }
  630. }
  631.  
  632.  
  633.  
  634. Expr *func_odd(ex)
  635. Expr *ex;
  636. {
  637.     ex = makeexpr_unlongcast(grabarg(ex, 0));
  638.     if (*oddname)
  639.         return makeexpr_bicall_1(oddname, tp_boolean, ex);
  640.     else
  641.         return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
  642. }
  643.  
  644. Stmt *proc_open()
  645. {
  646.     return handleopen(2);
  647. }
  648.  
  649. Expr *func_ord()
  650. {
  651.     Expr *ex;
  652.  
  653.     if (wneedtok(TOK_LPAR)) {
  654.     ex = p_ord_expr();
  655.     skipcloseparen();
  656.     } else
  657.     ex = p_ord_expr();
  658.     return makeexpr_ord(ex);
  659. }
  660.  
  661. Expr *func_ord4()
  662. {
  663.     Expr *ex;
  664.  
  665.     if (wneedtok(TOK_LPAR)) {
  666.     ex = p_ord_expr();
  667.     skipcloseparen();
  668.     } else
  669.     ex = p_ord_expr();
  670.     return makeexpr_longcast(makeexpr_ord(ex), 1);
  671. }
  672.  
  673.  
  674.  
  675. Expr *func_pad(ex)
  676. Expr *ex;
  677. {
  678.     if (checkconst(ex->args[1], 0) ||    /* "s" is null string */
  679.     checkconst(ex->args[2], ' ')) {
  680.         return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
  681.                                  makeexpr_string("%*s"),
  682.                                  makeexpr_longcast(ex->args[3], 0),
  683.                                  makeexpr_string(""));
  684.     }
  685.     return makeexpr_bicall_4(strpadname, tp_strptr,
  686.                  ex->args[0], ex->args[1], ex->args[2],
  687.                  makeexpr_arglong(ex->args[3], 0));
  688. }
  689.  
  690.  
  691.  
  692. Stmt *proc_page()
  693. {
  694.     Expr *fex, *ex;
  695.  
  696.     if (curtok == TOK_LPAR) {
  697.         fex = p_parexpr(tp_text);
  698.         ex = makeexpr_bicall_2("fprintf", tp_int,
  699.                                copyexpr(fex),
  700.                                makeexpr_string("\f"));
  701.     } else {
  702.         fex = makeexpr_var(mp_output);
  703.         ex = makeexpr_bicall_1("printf", tp_int,
  704.                                makeexpr_string("\f"));
  705.     }
  706.     if (FCheck(checkfilewrite)) {
  707.         ex = makeexpr_bicall_2("~SETIO", tp_void,
  708.                                makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
  709.                    makeexpr_name(filewriteerrorname, tp_int));
  710.     }
  711.     return wrapopencheck(makestmt_call(ex), fex);
  712. }
  713.  
  714.  
  715.  
  716. Expr *func_paramcount(ex)
  717. Expr *ex;
  718. {
  719.     freeexpr(ex);
  720.     return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
  721.                           makeexpr_long(1));
  722. }
  723.  
  724.  
  725.  
  726. Expr *func_paramstr(ex)
  727. Expr *ex;
  728. {
  729.     Expr *ex2;
  730.  
  731.     ex2 = makeexpr_index(makeexpr_name(name_ARGV,
  732.                        makepointertype(tp_strptr)),
  733.              makeexpr_unlongcast(ex->args[1]),
  734.              makeexpr_long(0));
  735.     ex2->val.type = tp_str255;
  736.     return makeexpr_bicall_3("sprintf", tp_strptr,
  737.                  ex->args[0],
  738.                  makeexpr_string("%s"),
  739.                  ex2);
  740. }
  741.  
  742.  
  743.  
  744. Expr *func_pi()
  745. {
  746.     return makeexpr_name("M_PI", tp_longreal);
  747. }
  748.  
  749.  
  750.  
  751. Expr *var_port()
  752. {
  753.     Expr *ex;
  754.  
  755.     if (!wneedtok(TOK_LBR))
  756.     return makeexpr_name("PORT", tp_integer);
  757.     ex = p_expr(tp_integer);
  758.     if (!wneedtok(TOK_RBR))
  759.     skippasttotoken(TOK_RBR, TOK_SEMI);
  760.     note("Reference to PORT [191]");
  761.     return makeexpr_bicall_1("PORT", tp_ubyte, ex);
  762. }
  763.  
  764.  
  765.  
  766. Expr *var_portw()
  767. {
  768.     Expr *ex;
  769.  
  770.     if (!wneedtok(TOK_LBR))
  771.     return makeexpr_name("PORTW", tp_integer);
  772.     ex = p_expr(tp_integer);
  773.     if (!wneedtok(TOK_RBR))
  774.     skippasttotoken(TOK_RBR, TOK_SEMI);
  775.     note("Reference to PORTW [191]");
  776.     return makeexpr_bicall_1("PORTW", tp_ushort, ex);
  777. }
  778.  
  779.  
  780.  
  781. Expr *func_pos(ex)
  782. Expr *ex;
  783. {
  784.     char *cp;
  785.  
  786.     cp = strposname;
  787.     if (!*cp) {
  788.         note("POS function used [192]");
  789.         cp = "POS";
  790.     } 
  791.     return makeexpr_bicall_3(cp, tp_int,
  792.                              ex->args[1], 
  793.                              ex->args[0],
  794.                              makeexpr_long(1));
  795. }
  796.  
  797.  
  798.  
  799. Expr *func_ptr(ex)
  800. Expr *ex;
  801. {
  802.     note("PTR function was used [193]");
  803.     return ex;
  804. }
  805.  
  806.  
  807.  
  808. Expr *func_position()
  809. {
  810.     return file_iofunc(2, seek_base);
  811. }
  812.  
  813.  
  814.  
  815. Expr *func_pred()
  816. {
  817.     Expr *ex;
  818.  
  819.     if (wneedtok(TOK_LPAR)) {
  820.     ex = p_ord_expr();
  821.     skipcloseparen();
  822.     } else
  823.     ex = p_ord_expr();
  824. #if 1
  825.     ex = makeexpr_inc(ex, makeexpr_long(-1));
  826. #else
  827.     ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
  828. #endif
  829.     return ex;
  830. }
  831.  
  832.  
  833.  
  834. Stmt *proc_put()
  835. {
  836.     Expr *ex;
  837.     Type *type;
  838.  
  839.     if (curtok == TOK_LPAR)
  840.     ex = p_parexpr(tp_text);
  841.     else
  842.     ex = makeexpr_var(mp_output);
  843.     requirefilebuffer(ex);
  844.     type = ex->val.type;
  845.     if (isfiletype(type) && *charputname &&
  846.     type->basetype->basetype->kind == TK_CHAR)
  847.     return makestmt_call(makeexpr_bicall_1(charputname, tp_void, ex));
  848.     else if (isfiletype(type) && *arrayputname &&
  849.          type->basetype->basetype->kind == TK_ARRAY)
  850.     return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void, ex,
  851.                            makeexpr_type(type->basetype->basetype)));
  852.     else
  853.     return makestmt_call(makeexpr_bicall_2(putname, tp_void, ex,
  854.                            makeexpr_type(type->basetype->basetype)));
  855. }
  856.  
  857.  
  858.  
  859. Expr *func_pwroften(ex)
  860. Expr *ex;
  861. {
  862.     return makeexpr_bicall_2("pow", tp_longreal,
  863.                  makeexpr_real("10.0"), grabarg(ex, 0));
  864. }
  865.  
  866. Stmt *proc_reset()
  867. {
  868.     return handleopen(0);
  869. }
  870.  
  871. Stmt *proc_rewrite()
  872. {
  873.     return handleopen(1);
  874. }
  875.  
  876. Stmt *doseek(fex, ex)
  877. Expr *fex, *ex;
  878. {
  879.     Expr *ex2;
  880.     Type *basetype = fex->val.type->basetype->basetype;
  881.  
  882.     if (ansiC == 1)
  883.         ex2 = makeexpr_name("SEEK_SET", tp_int);
  884.     else
  885.         ex2 = makeexpr_long(0);
  886.     ex = makeexpr_bicall_3("fseek", tp_int, 
  887.                            copyexpr(fex),
  888.                            makeexpr_arglong(
  889.                                makeexpr_times(makeexpr_minus(ex,
  890.                                                              makeexpr_long(seek_base)),
  891.                                               makeexpr_sizeof(makeexpr_type(basetype), 0)),
  892.                                1),
  893.                            ex2);
  894.     if (FCheck(checkfileseek)) {
  895.         ex = makeexpr_bicall_2("~SETIO", tp_void,
  896.                                makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
  897.                    makeexpr_name(endoffilename, tp_int));
  898.     }
  899.     return makestmt_call(ex);
  900. }
  901.  
  902. Expr *makegetchar(fex)
  903. Expr *fex;
  904. {
  905.     if (isvar(fex, mp_input))
  906.         return makeexpr_bicall_0("getchar", tp_char);
  907.     else
  908.         return makeexpr_bicall_1("getc", tp_char, copyexpr(fex));
  909. }
  910.  
  911. Stmt *fixscanf(sp, fex)
  912. Stmt *sp;
  913. Expr *fex;
  914. {
  915.     int nargs, i, isstrread;
  916.     char *cp;
  917.     Expr *ex;
  918.     Stmt *sp2;
  919.  
  920.     isstrread = (fex->val.type->kind == TK_STRING);
  921.     if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
  922.         !strcmp(sp->exp1->val.s, "scanf")) {
  923.         if (sp->exp1->args[0]->kind == EK_CONST &&
  924.             !(sp->exp1->args[0]->val.i&1) && !isstrread) {
  925.             cp = sp->exp1->args[0]->val.s;    /* scanf("%c%c") -> getchar;getchar */
  926.             for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
  927.                 i += 2;
  928.                 if (i == sp->exp1->args[0]->val.i) {
  929.                     sp2 = NULL;
  930.                     for (i = 1; i < sp->exp1->nargs; i++) {
  931.                         ex = makeexpr_hat(sp->exp1->args[i], 0);
  932.                         sp2 = makestmt_seq(sp2,
  933.                                            makestmt_assign(copyexpr(ex),
  934.                                                            makegetchar(fex)));
  935.                         if (checkeof(fex)) {
  936.                             sp2 = makestmt_seq(sp2,
  937.                                 makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
  938.                                                                 makeexpr_rel(EK_NE,
  939.                                                                              ex,
  940.                                                                              makeexpr_name("EOF", tp_char)),
  941.                                 makeexpr_name(endoffilename, tp_int))));
  942.                         } else
  943.                             freeexpr(ex);
  944.                     }
  945.                     return sp2;
  946.                 }
  947.             }
  948.         }
  949.         nargs = sp->exp1->nargs - 1;
  950.         if (isstrread) {
  951.             strchange(&sp->exp1->val.s, "sscanf");
  952.             insertarg(&sp->exp1, 0, copyexpr(fex));
  953.         } else if (!isvar(fex, mp_input)) {
  954.             strchange(&sp->exp1->val.s, "fscanf");
  955.             insertarg(&sp->exp1, 0, copyexpr(fex));
  956.         }
  957.         if (FCheck(checkreadformat)) {
  958.             if (checkeof(fex) && !isstrread)
  959.                 ex = makeexpr_cond(makeexpr_rel(EK_NE,
  960.                                                 makeexpr_bicall_1("feof", tp_int, copyexpr(fex)),
  961.                                                 makeexpr_long(0)),
  962.                    makeexpr_name(endoffilename, tp_int),
  963.                    makeexpr_name(badinputformatname, tp_int));
  964.             else
  965.         ex = makeexpr_name(badinputformatname, tp_int);
  966.             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  967.                                          makeexpr_rel(EK_EQ,
  968.                                                       sp->exp1,
  969.                                                       makeexpr_long(nargs)),
  970.                                          ex);
  971.         } else if (checkeof(fex) && !isstrread) {
  972.             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  973.                                          makeexpr_rel(EK_NE,
  974.                                                       sp->exp1,
  975.                                                       makeexpr_name("EOF", tp_int)),
  976.                      makeexpr_name(endoffilename, tp_int));
  977.         }
  978.     }
  979.     return sp;
  980. }
  981.  
  982.