开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
funcs.c.2
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：47k
源码类别：

编译器/解释器

开发平台：

C/C++

funcs.c.2：源码内容
  1. return makestmt_call(makeexpr_bicall_2(getname, tp_void, ex,
  2.        makeexpr_type(type->basetype->basetype)));
  3. }
  7. Static Stmt *proc_getmem(ex)
  8. Expr *ex;
  9. {
  10.     Expr *vex, *ex2, *sz = NULL;
  11.     Stmt *sp;
  13.     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
  14.     ex2 = ex->args[1];
  15.     if (vex->val.type->kind == TK_POINTER)
  16.         ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM");
  17.     if (alloczeronil)
  18.         sz = copyexpr(ex2);
  19.     ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
  20.     sp = makestmt_assign(copyexpr(vex), ex2);
  21.     if (malloccheck) {
  22.         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
  23.                                           makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
  24.                                           NULL));
  25.     }
  26.     if (sz && !isconstantexpr(sz)) {
  27.         if (alloczeronil == 2)
  28.             note("Called GETMEM with variable argument [189]");
  29.         sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
  30.                          sp,
  31.                          makestmt_assign(vex, makeexpr_nil()));
  32.     } else
  33.         freeexpr(vex);
  34.     return sp;
  35. }
  39. Static Stmt *proc_gotoxy(ex)
  40. Expr *ex;
  41. {
  42.     return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
  43.                                            makeexpr_arglong(ex->args[0], 0),
  44.                                            makeexpr_arglong(ex->args[1], 0)));
  45. }
  49. Static Expr *handle_vax_hex(ex, fmt, scale)
  50. Expr *ex;
  51. char *fmt;
  52. int scale;
  53. {
  54.     Expr *lex, *dex, *vex;
  55.     Meaning *tvar;
  56.     Type *tp;
  57.     long smin, smax;
  58.     int bits;
  60.     if (!ex) {
  61. if (!skipopenparen())
  62.     return NULL;
  63. ex = p_expr(tp_integer);
  64.     }
  65.     tp = true_type(ex);
  66.     if (ord_range(tp, &smin, &smax))
  67. bits = typebits(smin, smax);
  68.     else
  69. bits = 32;
  70.     if (curtok == TOK_COMMA) {
  71. gettok();
  72. if (curtok != TOK_COMMA)
  73.     lex = makeexpr_arglong(p_expr(tp_integer), 0);
  74. else
  75.     lex = NULL;
  76.     } else
  77. lex = NULL;
  78.     if (!lex) {
  79. if (!scale)
  80.     lex = makeexpr_long(11);
  81. else
  82.     lex = makeexpr_long((bits+scale-1) / scale + 1);
  83.     }
  84.     if (curtok == TOK_COMMA) {
  85. gettok();
  86. dex = makeexpr_arglong(p_expr(tp_integer), 0);
  87.     } else {
  88. if (!scale)
  89.     dex = makeexpr_long(10);
  90. else
  91.     dex = makeexpr_long((bits+scale-1) / scale);
  92.     }
  93.     if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
  94. lex->val.i < dex->val.i)
  95. lex = NULL;
  96.     skipcloseparen();
  97.     tvar = makestmttempvar(tp_str255, name_STRING);
  98.     vex = makeexpr_var(tvar);
  99.     ex = makeexpr_forcelongness(ex);
  100.     if (exprlongness(ex) > 0)
  101. fmt = format_s("l%s", fmt);
  102.     if (checkconst(lex, 0) || checkconst(lex, 1))
  103. lex = NULL;
  104.     if (checkconst(dex, 0) || checkconst(dex, 1))
  105. dex = NULL;
  106.     if (lex) {
  107. if (dex)
  108.     ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
  109.    makeexpr_string(format_s("%%*.*%s", fmt)),
  110.    lex, dex, ex);
  111. else
  112.     ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  113.    makeexpr_string(format_s("%%*%s", fmt)),
  114.    lex, ex);
  115.     } else {
  116. if (dex)
  117.     ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  118.    makeexpr_string(format_s("%%.*%s", fmt)),
  119.    dex, ex);
  120. else
  121.     ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  122.    makeexpr_string(format_s("%%%s", fmt)),
  123.    ex);
  124.     }
  125.     return ex;
  126. }
  131. Static Expr *func_hex()
  132. {
  133.     Expr *ex;
  134.     char *cp;
  136.     if (!skipopenparen())
  137. return NULL;
  138.     ex = makeexpr_stringcast(p_expr(tp_integer));
  139.     if ((ex->val.type->kind == TK_STRING ||
  140.  ex->val.type == tp_strptr) &&
  141. curtok != TOK_COMMA) {
  142. skipcloseparen();
  143. if (ex->kind == EK_CONST) {    /* HP Pascal */
  144.     cp = getstring(ex);
  145.     ex = makeexpr_long(my_strtol(cp, NULL, 16));
  146.     insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  147.     return ex;
  148. } else {
  149.     return makeexpr_bicall_3("strtol", tp_integer, 
  150.      ex, makeexpr_nil(), makeexpr_long(16));
  151. }
  152.     } else {    /* VAX Pascal */
  153. return handle_vax_hex(ex, "x", 4);
  154.     }
  155. }
  159. Static Expr *func_hi()
  160. {
  161.     Expr *ex;
  163.     ex = force_unsigned(p_parexpr(tp_integer));
  164.     return makeexpr_bin(EK_RSH, tp_ubyte,
  165.                         ex, makeexpr_long(8));
  166. }
  170. Static Expr *func_high()
  171. {
  172.     Expr *ex;
  173.     Type *type;
  175.     ex = p_parexpr(tp_integer);
  176.     type = ex->val.type;
  177.     if (type->kind == TK_POINTER)
  178. type = type->basetype;
  179.     if (type->kind == TK_ARRAY ||
  180. type->kind == TK_SMALLARRAY) {
  181. ex = makeexpr_minus(copyexpr(type->indextype->smax),
  182.     copyexpr(type->indextype->smin));
  183.     } else {
  184. warning("HIGH requires an array name parameter [210]");
  185. ex = makeexpr_bicall_1("HIGH", tp_int, ex);
  186.     }
  187.     return ex;
  188. }
  192. Static Expr *func_hiword()
  193. {
  194.     Expr *ex;
  196.     ex = force_unsigned(p_parexpr(tp_unsigned));
  197.     return makeexpr_bin(EK_RSH, tp_unsigned,
  198.                         ex, makeexpr_long(16));
  199. }
  203. Static Stmt *proc_inc()
  204. {
  205.     Expr *vex, *ex;
  207.     if (!skipopenparen())
  208. return NULL;
  209.     vex = p_expr(NULL);
  210.     if (curtok == TOK_COMMA) {
  211.         gettok();
  212.         ex = p_expr(tp_integer);
  213.     } else
  214.         ex = makeexpr_long(1);
  215.     skipcloseparen();
  216.     return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
  217. }
  221. Static Stmt *proc_incl()
  222. {
  223.     Expr *vex, *ex;
  225.     if (!skipopenparen())
  226. return NULL;
  227.     vex = p_expr(NULL);
  228.     if (!skipcomma())
  229. return NULL;
  230.     ex = p_expr(vex->val.type->indextype);
  231.     skipcloseparen();
  232.     if (vex->val.type->kind == TK_SMALLSET)
  233. return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type,
  234.  copyexpr(vex),
  235.  makeexpr_bin(EK_LSH, vex->val.type,
  236.       makeexpr_longcast(makeexpr_long(1), 1),
  237.       ex)));
  238.     else
  239. return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
  240.        makeexpr_arglong(enum_to_int(ex), 0)));
  241. }
  245. Static Stmt *proc_insert(ex)
  246. Expr *ex;
  247. {
  248.     return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
  249.                                            ex->args[0], 
  250.                                            ex->args[1],
  251.                                            makeexpr_arglong(ex->args[2], 0)));
  252. }
  256. Static Expr *func_int()
  257. {
  258.     Expr *ex;
  259.     Meaning *tvar;
  261.     ex = p_parexpr(tp_integer);
  262.     if (ex->val.type->kind == TK_REAL) {    /* Turbo Pascal INT */
  263. tvar = makestmttempvar(tp_longreal, name_TEMP);
  264. return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
  265. grabarg(ex, 0),
  266. makeexpr_addr(makeexpr_var(tvar))),
  267.       makeexpr_var(tvar));
  268.     } else {     /* VAX Pascal INT */
  269. return makeexpr_ord(ex);
  270.     }
  271. }
  274. Static Expr *func_uint()
  275. {
  276.     Expr *ex;
  278.     ex = p_parexpr(tp_integer);
  279.     return makeexpr_cast(ex, tp_unsigned);
  280. }
  284. Static Stmt *proc_leave()
  285. {
  286.     return makestmt(SK_BREAK);
  287. }
  291. Static Expr *func_lo()
  292. {
  293.     Expr *ex;
  295.     ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
  296.     return makeexpr_bin(EK_BAND, tp_ubyte,
  297.                         ex, makeexpr_long(255));
  298. }
  301. Static Expr *func_loophole()
  302. {
  303.     Type *type;
  304.     Expr *ex;
  306.     if (!skipopenparen())
  307. return NULL;
  308.     type = p_type(NULL);
  309.     if (!skipcomma())
  310. return NULL;
  311.     ex = p_expr(tp_integer);
  312.     skipcloseparen();
  313.     return pascaltypecast(type, ex);
  314. }
  318. Static Expr *func_lower()
  319. {
  320.     Expr *ex;
  321.     Value val;
  323.     if (!skipopenparen())
  324. return NULL;
  325.     ex = p_expr(tp_integer);
  326.     if (curtok == TOK_COMMA) {
  327. gettok();
  328. val = p_constant(tp_integer);
  329. if (!val.type || val.i != 1)
  330.     note("LOWER(v,n) not supported for n>1 [190]");
  331.     }
  332.     skipcloseparen();
  333.     return copyexpr(ex->val.type->indextype->smin);
  334. }
  338. Static Expr *func_loword()
  339. {
  340.     Expr *ex;
  342.     ex = p_parexpr(tp_integer);
  343.     return makeexpr_bin(EK_BAND, tp_ushort,
  344.                         ex, makeexpr_long(65535));
  345. }
  349. Static Expr *func_ln(ex)
  350. Expr *ex;
  351. {
  352.     return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0));
  353. }
  357. Static Expr *func_log(ex)
  358. Expr *ex;
  359. {
  360.     return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0));
  361. }
  365. Static Expr *func_max()
  366. {
  367.     Type *tp;
  368.     Expr *ex, *ex2;
  370.     if (!skipopenparen())
  371. return NULL;
  372.     if (curtok == TOK_IDENT && curtokmeaning &&
  373. curtokmeaning->kind == MK_TYPE) {
  374. tp = curtokmeaning->type;
  375. gettok();
  376. skipcloseparen();
  377. return copyexpr(tp->smax);
  378.     }
  379.     ex = p_expr(tp_integer);
  380.     while (curtok == TOK_COMMA) {
  381. gettok();
  382. ex2 = p_expr(ex->val.type);
  383. if (ex->val.type->kind == TK_REAL) {
  384.     tp = ex->val.type;
  385.     if (ex2->val.type->kind != TK_REAL)
  386. ex2 = makeexpr_cast(ex2, tp);
  387. } else {
  388.     tp = ex2->val.type;
  389.     if (ex->val.type->kind != TK_REAL)
  390. ex = makeexpr_cast(ex, tp);
  391. }
  392. ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
  393.        tp, ex, ex2);
  394.     }
  395.     skipcloseparen();
  396.     return ex;
  397. }
  401. Static Expr *func_maxavail(ex)
  402. Expr *ex;
  403. {
  404.     freeexpr(ex);
  405.     return makeexpr_bicall_0("maxavail", tp_integer);
  406. }
  410. Static Expr *func_maxpos()
  411. {
  412.     return file_iofunc(3, seek_base);
  413. }
  417. Static Expr *func_memavail(ex)
  418. Expr *ex;
  419. {
  420.     freeexpr(ex);
  421.     return makeexpr_bicall_0("memavail", tp_integer);
  422. }
  426. Static Expr *var_mem()
  427. {
  428.     Expr *ex, *ex2;
  430.     if (!wneedtok(TOK_LBR))
  431. return makeexpr_name("MEM", tp_integer);
  432.     ex = p_expr(tp_integer);
  433.     if (curtok == TOK_COLON) {
  434. gettok();
  435. ex2 = p_expr(tp_integer);
  436. ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
  437.     } else {
  438. ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
  439.     }
  440.     if (!wneedtok(TOK_RBR))
  441. skippasttotoken(TOK_RBR, TOK_SEMI);
  442.     note("Reference to MEM [191]");
  443.     return ex;
  444. }
  448. Static Expr *var_memw()
  449. {
  450.     Expr *ex, *ex2;
  452.     if (!wneedtok(TOK_LBR))
  453. return makeexpr_name("MEMW", tp_integer);
  454.     ex = p_expr(tp_integer);
  455.     if (curtok == TOK_COLON) {
  456. gettok();
  457. ex2 = p_expr(tp_integer);
  458. ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
  459.     } else {
  460. ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
  461.     }
  462.     if (!wneedtok(TOK_RBR))
  463. skippasttotoken(TOK_RBR, TOK_SEMI);
  464.     note("Reference to MEMW [191]");
  465.     return ex;
  466. }
  470. Static Expr *var_meml()
  471. {
  472.     Expr *ex, *ex2;
  474.     if (!wneedtok(TOK_LBR))
  475. return makeexpr_name("MEML", tp_integer);
  476.     ex = p_expr(tp_integer);
  477.     if (curtok == TOK_COLON) {
  478. gettok();
  479. ex2 = p_expr(tp_integer);
  480. ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
  481.     } else {
  482. ex = makeexpr_bicall_1("MEML", tp_integer, ex);
  483.     }
  484.     if (!wneedtok(TOK_RBR))
  485. skippasttotoken(TOK_RBR, TOK_SEMI);
  486.     note("Reference to MEML [191]");
  487.     return ex;
  488. }
  492. Static Expr *func_min()
  493. {
  494.     Type *tp;
  495.     Expr *ex, *ex2;
  497.     if (!skipopenparen())
  498. return NULL;
  499.     if (curtok == TOK_IDENT && curtokmeaning &&
  500. curtokmeaning->kind == MK_TYPE) {
  501. tp = curtokmeaning->type;
  502. gettok();
  503. skipcloseparen();
  504. return copyexpr(tp->smin);
  505.     }
  506.     ex = p_expr(tp_integer);
  507.     while (curtok == TOK_COMMA) {
  508. gettok();
  509. ex2 = p_expr(ex->val.type);
  510. if (ex->val.type->kind == TK_REAL) {
  511.     tp = ex->val.type;
  512.     if (ex2->val.type->kind != TK_REAL)
  513. ex2 = makeexpr_cast(ex2, tp);
  514. } else {
  515.     tp = ex2->val.type;
  516.     if (ex->val.type->kind != TK_REAL)
  517. ex = makeexpr_cast(ex, tp);
  518. }
  519. ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
  520.        tp, ex, ex2);
  521.     }
  522.     skipcloseparen();
  523.     return ex;
  524. }
  528. Static Stmt *proc_move(ex)
  529. Expr *ex;
  530. {
  531.     ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);    /* source */
  532.     ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);    /* dest */
  533.     ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
  534.                                           argbasetype(ex->args[1])), ex->args[2], "MOVE");
  535.     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  536.                                            ex->args[1],
  537.                                            ex->args[0],
  538.                                            makeexpr_arglong(ex->args[2], (size_t_long != 0))));
  539. }
  543. Static Stmt *proc_move_fast()
  544. {
  545.     Expr *ex, *ex2, *ex3, *ex4;
  547.     if (!skipopenparen())
  548. return NULL;
  549.     ex = p_expr(tp_integer);
  550.     if (!skipcomma())
  551. return NULL;
  552.     ex2 = p_expr(tp_integer);
  553.     if (!skipcomma())
  554. return NULL;
  555.     ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
  556.     ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
  557.     if (!skipcomma())
  558. return NULL;
  559.     ex3 = p_expr(tp_integer);
  560.     if (!skipcomma())
  561. return NULL;
  562.     ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
  563.     ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
  564.     skipcloseparen();
  565.     ex = convert_size(choosetype(argbasetype(ex2),
  566.  argbasetype(ex3)), ex, "MOVE_FAST");
  567.     return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
  568.    makeexpr_addr(ex3),
  569.    makeexpr_addr(ex2),
  570.    makeexpr_arglong(ex, (size_t_long != 0))));
  571. }
  575. Static Stmt *proc_new()
  576. {
  577.     Expr *ex, *ex2;
  578.     Stmt *sp, **spp;
  579.     Type *type;
  580.     char *name, *name2 = NULL, vbuf[1000];
  582.     if (!skipopenparen())
  583. return NULL;
  584.     ex = p_expr(tp_anyptr);
  585.     type = ex->val.type;
  586.     if (type->kind == TK_POINTER)
  587. type = type->basetype;
  588.     parse_special_variant(type, vbuf);
  589.     skipcloseparen();
  590.     name = find_special_variant(vbuf, NULL, specialmallocs, 3);
  591.     if (!name) {
  592.         name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
  593. if (!name2) {
  594.     name = find_special_variant(vbuf, NULL, specialmallocs, 1);
  595.     name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
  596.     if (name || !name2)
  597. name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
  598.     else
  599. name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
  600. }
  601.     }
  602.     if (name) {
  603. ex2 = makeexpr_bicall_0(name, ex->val.type);
  604.     } else if (name2) {
  605. ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
  606.     } else {
  607. ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
  608. makeexpr_sizeof(makeexpr_type(type), 1));
  609.     }
  610.     sp = makestmt_assign(copyexpr(ex), ex2);
  611.     if (malloccheck) {
  612.         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
  613.        copyexpr(ex),
  614.        makeexpr_nil()),
  615.                                           makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
  616.                                           NULL));
  617.     }
  618.     spp = &sp->next;
  619.     while (*spp)
  620. spp = &(*spp)->next;
  621.     if (type->kind == TK_RECORD)
  622. initfilevars(type->fbase, &spp, makeexpr_hat(copyexpr(ex), 0));
  623.     else if (isfiletype(type))
  624. sp = makestmt_seq(sp, makestmt_assign(makeexpr_hat(copyexpr(ex), 0),
  625.       makeexpr_nil()));
  626.     freeexpr(ex);
  627.     return sp;
  628. }
  632. Static Expr *func_oct()
  633. {
  634.     return handle_vax_hex(NULL, "o", 3);
  635. }
  639. Static Expr *func_octal(ex)
  640. Expr *ex;
  641. {
  642.     char *cp;
  644.     ex = grabarg(ex, 0);
  645.     if (ex->kind == EK_CONST) {
  646.         cp = getstring(ex);
  647.         ex = makeexpr_long(my_strtol(cp, NULL, 8));
  648.         insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer));
  649.         return ex;
  650.     } else {
  651.         return makeexpr_bicall_3("strtol", tp_integer, 
  652.                                  ex, makeexpr_nil(), makeexpr_long(8));
  653.     }
  654. }
  658. Static Expr *func_odd(ex)
  659. Expr *ex;
  660. {
  661.     ex = makeexpr_unlongcast(grabarg(ex, 0));
  662.     if (*oddname)
  663.         return makeexpr_bicall_1(oddname, tp_boolean, ex);
  664.     else
  665.         return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
  666. }
  670. Static Stmt *proc_open()
  671. {
  672.     return handleopen(2);
  673. }
  677. Static Expr *func_ord()
  678. {
  679.     Expr *ex;
  681.     if (wneedtok(TOK_LPAR)) {
  682. ex = p_ord_expr();
  683. skipcloseparen();
  684.     } else
  685. ex = p_ord_expr();
  686.     return makeexpr_ord(ex);
  687. }
  691. Static Expr *func_ord4()
  692. {
  693.     Expr *ex;
  695.     if (wneedtok(TOK_LPAR)) {
  696. ex = p_ord_expr();
  697. skipcloseparen();
  698.     } else
  699. ex = p_ord_expr();
  700.     return makeexpr_longcast(makeexpr_ord(ex), 1);
  701. }
  705. Static Expr *func_pad(ex)
  706. Expr *ex;
  707. {
  708.     if (checkconst(ex->args[1], 0) ||    /* "s" is null string */
  709. checkconst(ex->args[2], ' ')) {
  710.         return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
  711.                                  makeexpr_string("%*s"),
  712.                                  makeexpr_longcast(ex->args[3], 0),
  713.                                  makeexpr_string(""));
  714.     }
  715.     return makeexpr_bicall_4(strpadname, tp_strptr,
  716.      ex->args[0], ex->args[1], ex->args[2],
  717.      makeexpr_arglong(ex->args[3], 0));
  718. }
  722. Static Stmt *proc_page()
  723. {
  724.     Expr *fex, *ex;
  726.     if (curtok == TOK_LPAR) {
  727.         fex = p_parexpr(tp_text);
  728.         ex = makeexpr_bicall_2("fprintf", tp_int,
  729.                                copyexpr(fex),
  730.                                makeexpr_string("f"));
  731.     } else {
  732.         fex = makeexpr_var(mp_output);
  733.         ex = makeexpr_bicall_1("printf", tp_int,
  734.                                makeexpr_string("f"));
  735.     }
  736.     if (FCheck(checkfilewrite)) {
  737.         ex = makeexpr_bicall_2("~SETIO", tp_void,
  738.                                makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
  739.        makeexpr_name(filewriteerrorname, tp_int));
  740.     }
  741.     return wrapopencheck(makestmt_call(ex), fex);
  742. }
  746. Static Expr *func_paramcount(ex)
  747. Expr *ex;
  748. {
  749.     freeexpr(ex);
  750.     return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
  751.                           makeexpr_long(1));
  752. }
  756. Static Expr *func_paramstr(ex)
  757. Expr *ex;
  758. {
  759.     Expr *ex2;
  761.     ex2 = makeexpr_index(makeexpr_name(name_ARGV,
  762.        makepointertype(tp_strptr)),
  763.  makeexpr_unlongcast(ex->args[1]),
  764.  makeexpr_long(0));
  765.     ex2->val.type = tp_str255;
  766.     return makeexpr_bicall_3("sprintf", tp_strptr,
  767.      ex->args[0],
  768.      makeexpr_string("%s"),
  769.      ex2);
  770. }
  774. Static Expr *func_pi()
  775. {
  776.     return makeexpr_name("M_PI", tp_longreal);
  777. }
  781. Static Expr *var_port()
  782. {
  783.     Expr *ex;
  785.     if (!wneedtok(TOK_LBR))
  786. return makeexpr_name("PORT", tp_integer);
  787.     ex = p_expr(tp_integer);
  788.     if (!wneedtok(TOK_RBR))
  789. skippasttotoken(TOK_RBR, TOK_SEMI);
  790.     note("Reference to PORT [191]");
  791.     return makeexpr_bicall_1("PORT", tp_ubyte, ex);
  792. }
  796. Static Expr *var_portw()
  797. {
  798.     Expr *ex;
  800.     if (!wneedtok(TOK_LBR))
  801. return makeexpr_name("PORTW", tp_integer);
  802.     ex = p_expr(tp_integer);
  803.     if (!wneedtok(TOK_RBR))
  804. skippasttotoken(TOK_RBR, TOK_SEMI);
  805.     note("Reference to PORTW [191]");
  806.     return makeexpr_bicall_1("PORTW", tp_ushort, ex);
  807. }
  811. Static Expr *func_pos(ex)
  812. Expr *ex;
  813. {
  814.     char *cp;
  816.     cp = strposname;
  817.     if (!*cp) {
  818.         note("POS function used [192]");
  819.         cp = "POS";
  820.     } 
  821.     return makeexpr_bicall_3(cp, tp_int,
  822.                              ex->args[1], 
  823.                              ex->args[0],
  824.                              makeexpr_long(1));
  825. }
  829. Static Expr *func_ptr(ex)
  830. Expr *ex;
  831. {
  832.     note("PTR function was used [193]");
  833.     return ex;
  834. }
  838. Static Expr *func_position()
  839. {
  840.     return file_iofunc(2, seek_base);
  841. }
  845. Static Expr *func_pred()
  846. {
  847.     Expr *ex;
  849.     if (wneedtok(TOK_LPAR)) {
  850. ex = p_ord_expr();
  851. skipcloseparen();
  852.     } else
  853. ex = p_ord_expr();
  854. #if 1
  855.     ex = makeexpr_inc(ex, makeexpr_long(-1));
  856. #else
  857.     ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
  858. #endif
  859.     return ex;
  860. }
  864. Static Stmt *proc_put()
  865. {
  866.     Expr *ex;
  867.     Type *type;
  869.     if (curtok == TOK_LPAR)
  870. ex = p_parexpr(tp_text);
  871.     else
  872. ex = makeexpr_var(mp_output);
  873.     requirefilebuffer(ex);
  874.     type = ex->val.type;
  875.     if (isfiletype(type) && *charputname &&
  876. type->basetype->basetype->kind == TK_CHAR)
  877. return makestmt_call(makeexpr_bicall_1(charputname, tp_void, ex));
  878.     else if (isfiletype(type) && *arrayputname &&
  879.      type->basetype->basetype->kind == TK_ARRAY)
  880. return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void, ex,
  881.        makeexpr_type(type->basetype->basetype)));
  882.     else
  883. return makestmt_call(makeexpr_bicall_2(putname, tp_void, ex,
  884.        makeexpr_type(type->basetype->basetype)));
  885. }
  889. Static Expr *func_pwroften(ex)
  890. Expr *ex;
  891. {
  892.     return makeexpr_bicall_2("pow", tp_longreal,
  893.      makeexpr_real("10.0"), grabarg(ex, 0));
  894. }
  898. Static Stmt *proc_reset()
  899. {
  900.     return handleopen(0);
  901. }
  905. Static Stmt *proc_rewrite()
  906. {
  907.     return handleopen(1);
  908. }
  913. Stmt *doseek(fex, ex)
  914. Expr *fex, *ex;
  915. {
  916.     Expr *ex2;
  917.     Type *basetype = fex->val.type->basetype->basetype;
  919.     if (ansiC == 1)
  920.         ex2 = makeexpr_name("SEEK_SET", tp_int);
  921.     else
  922.         ex2 = makeexpr_long(0);
  923.     ex = makeexpr_bicall_3("fseek", tp_int, 
  924.                            copyexpr(fex),
  925.                            makeexpr_arglong(
  926.                                makeexpr_times(makeexpr_minus(ex,
  927.                                                              makeexpr_long(seek_base)),
  928.                                               makeexpr_sizeof(makeexpr_type(basetype), 0)),
  929.                                1),
  930.                            ex2);
  931.     if (FCheck(checkfileseek)) {
  932.         ex = makeexpr_bicall_2("~SETIO", tp_void,
  933.                                makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
  934.        makeexpr_name(endoffilename, tp_int));
  935.     }
  936.     return makestmt_call(ex);
  937. }
  942. Static Expr *makegetchar(fex)
  943. Expr *fex;
  944. {
  945.     if (isvar(fex, mp_input))
  946.         return makeexpr_bicall_0("getchar", tp_char);
  947.     else
  948.         return makeexpr_bicall_1("getc", tp_char, copyexpr(fex));
  949. }
  953. Static Stmt *fixscanf(sp, fex)
  954. Stmt *sp;
  955. Expr *fex;
  956. {
  957.     int nargs, i, isstrread;
  958.     char *cp;
  959.     Expr *ex;
  960.     Stmt *sp2;
  962.     isstrread = (fex->val.type->kind == TK_STRING);
  963.     if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
  964.         !strcmp(sp->exp1->val.s, "scanf")) {
  965.         if (sp->exp1->args[0]->kind == EK_CONST &&
  966.             !(sp->exp1->args[0]->val.i&1) && !isstrread) {
  967.             cp = sp->exp1->args[0]->val.s;    /* scanf("%c%c") -> getchar;getchar */
  968.             for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
  969.                 i += 2;
  970.                 if (i == sp->exp1->args[0]->val.i) {
  971.                     sp2 = NULL;
  972.                     for (i = 1; i < sp->exp1->nargs; i++) {
  973.                         ex = makeexpr_hat(sp->exp1->args[i], 0);
  974.                         sp2 = makestmt_seq(sp2,
  975.                                            makestmt_assign(copyexpr(ex),
  976.                                                            makegetchar(fex)));
  977.                         if (checkeof(fex)) {
  978.                             sp2 = makestmt_seq(sp2,
  979.                                 makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
  980.                                                                 makeexpr_rel(EK_NE,
  981.                                                                              ex,
  982.                                                                              makeexpr_name("EOF", tp_char)),
  983. makeexpr_name(endoffilename, tp_int))));
  984.                         } else
  985.                             freeexpr(ex);
  986.                     }
  987.                     return sp2;
  988.                 }
  989.             }
  990.         }
  991.         nargs = sp->exp1->nargs - 1;
  992.         if (isstrread) {
  993.             strchange(&sp->exp1->val.s, "sscanf");
  994.             insertarg(&sp->exp1, 0, copyexpr(fex));
  995.         } else if (!isvar(fex, mp_input)) {
  996.             strchange(&sp->exp1->val.s, "fscanf");
  997.             insertarg(&sp->exp1, 0, copyexpr(fex));
  998.         }
  999.         if (FCheck(checkreadformat)) {
  1000.             if (checkeof(fex) && !isstrread)
  1001.                 ex = makeexpr_cond(makeexpr_rel(EK_NE,
  1002.                                                 makeexpr_bicall_1("feof", tp_int, copyexpr(fex)),
  1003.                                                 makeexpr_long(0)),
  1004.    makeexpr_name(endoffilename, tp_int),
  1005.    makeexpr_name(badinputformatname, tp_int));
  1006.             else
  1007. ex = makeexpr_name(badinputformatname, tp_int);
  1008.             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  1009.                                          makeexpr_rel(EK_EQ,
  1010.                                                       sp->exp1,
  1011.                                                       makeexpr_long(nargs)),
  1012.                                          ex);
  1013.         } else if (checkeof(fex) && !isstrread) {
  1014.             sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
  1015.                                          makeexpr_rel(EK_NE,
  1016.                                                       sp->exp1,
  1017.                                                       makeexpr_name("EOF", tp_int)),
  1018.  makeexpr_name(endoffilename, tp_int));
  1019.         }
  1020.     }
  1021.     return sp;
  1022. }
  1026. Static Expr *makefgets(vex, lex, fex)
  1027. Expr *vex, *lex, *fex;
  1028. {
  1029.     Expr *ex;
  1031.     ex = makeexpr_bicall_3("fgets", tp_strptr,
  1032.                            vex,
  1033.                            lex,
  1034.                            copyexpr(fex));
  1035.     if (checkeof(fex)) {
  1036.         ex = makeexpr_bicall_2("~SETIO", tp_void,
  1037.                                makeexpr_rel(EK_NE, ex, makeexpr_nil()),
  1038.        makeexpr_name(endoffilename, tp_int));
  1039.     }
  1040.     return ex;
  1041. }
  1045. Static Stmt *skipeoln(fex)
  1046. Expr *fex;
  1047. {
  1048.     Meaning *tvar;
  1049.     Expr *ex;
  1051.     if (!strcmp(readlnname, "fgets")) {
  1052.         tvar = makestmttempvar(tp_str255, name_STRING);
  1053.         return makestmt_call(makefgets(makeexpr_var(tvar),
  1054.                                        makeexpr_long(stringceiling+1),
  1055.                                        fex));
  1056.     } else if (!strcmp(readlnname, "scanf") || !*readlnname) {
  1057.         if (checkeof(fex))
  1058.             ex = makeexpr_bicall_2("~SETIO", tp_void,
  1059.                                    makeexpr_rel(EK_NE,
  1060.                                                 makegetchar(fex),
  1061.                                                 makeexpr_name("EOF", tp_char)),
  1062.    makeexpr_name(endoffilename, tp_int));
  1063.         else
  1064.             ex = makegetchar(fex);
  1065.         return makestmt_seq(fixscanf(
  1066.                     makestmt_call(makeexpr_bicall_1("scanf", tp_int,
  1067.                                                     makeexpr_string("%*[^n]"))), fex),
  1068.                     makestmt_call(ex));
  1069.     } else {
  1070.         return makestmt_call(makeexpr_bicall_1(readlnname, tp_void,
  1071.                                                copyexpr(fex)));
  1072.     }
  1073. }
  1077. Static Stmt *handleread_text(fex, var, isreadln)
  1078. Expr *fex, *var;
  1079. int isreadln;
  1080. {
  1081.     Stmt *spbase, *spafter, *sp;
  1082.     Expr *ex = NULL, *exj = NULL;
  1083.     Type *type;
  1084.     Meaning *tvar, *tempcp, *mp;
  1085.     int i, isstrread, scanfmode, readlnflag, varstring, maxstring;
  1086.     int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling;
  1087.     long rmin, rmax;
  1088.     char *fmt;
  1090.     spbase = NULL;
  1091.     spafter = NULL;
  1092.     sp = NULL;
  1093.     tempcp = NULL;
  1094.     isstrread = (fex->val.type->kind == TK_STRING);
  1095.     if (isstrread) {
  1096.         exj = var;
  1097.         var = p_expr(NULL);
  1098.     }
  1099.     scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread;
  1100.     for (;;) {
  1101.         readlnflag = isreadln && curtok == TOK_RPAR;
  1102.         if (var->val.type->kind == TK_STRING && !isstrread) {
  1103.             if (sp)
  1104.                 spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1105.             spbase = makestmt_seq(spbase, spafter);
  1106.             varstring = (varstrings && var->kind == EK_VAR &&
  1107.                          (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM &&
  1108.                          mp->type == tp_strptr);
  1109.             maxstring = (strmax(var) >= longstrsize && !varstring);
  1110.             if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) {
  1111.                 spbase = makestmt_seq(spbase,
  1112.                                       makestmt_call(makeexpr_bicall_1("gets", tp_str255,
  1113.                                                                       makeexpr_addr(var))));
  1114.                 isreadln = 0;
  1115.             } else if (scanfmode && !varstring &&
  1116.                        (*readlnname || !isreadln)) {
  1117.                 spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0),
  1118.                                                               makeexpr_char(0)));
  1119.                 if (maxstring && usegets)
  1120.                     ex = makeexpr_string("%[^n]");
  1121.                 else
  1122.                     ex = makeexpr_string(format_d("%%%d[^n]", strmax(var)));
  1123.                 ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var));
  1124.                 spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex));
  1125.                 if (readlnflag && maxstring && usegets) {
  1126.                     spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex)));
  1127.                     isreadln = 0;
  1128.                 }
  1129.             } else {
  1130.                 ex = makeexpr_plus(strmax_func(var), makeexpr_long(1));
  1131.                 spbase = makestmt_seq(spbase,
  1132.                                       makestmt_call(makefgets(makeexpr_addr(copyexpr(var)),
  1133.                                                               ex,
  1134.                                                               fex)));
  1135.                 if (!tempcp)
  1136.                     tempcp = makestmttempvar(tp_charptr, name_TEMP);
  1137.                 spbase = makestmt_seq(spbase,
  1138.                                       makestmt_assign(makeexpr_var(tempcp),
  1139.                                                       makeexpr_bicall_2("strchr", tp_charptr,
  1140.                                                                         makeexpr_addr(copyexpr(var)),
  1141.                                                                         makeexpr_char('n'))));
  1142.                 sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0),
  1143.                                      makeexpr_long(0));
  1144.                 if (readlnflag)
  1145.                     isreadln = 0;
  1146.                 else
  1147.                     sp = makestmt_seq(sp,
  1148.                                       makestmt_call(makeexpr_bicall_2("ungetc", tp_void,
  1149.                                                                       makeexpr_char('n'),
  1150.                                                                       copyexpr(fex))));
  1151.                 spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE,
  1152.                                                                        makeexpr_var(tempcp),
  1153.                                                                        makeexpr_nil()),
  1154.                                                           sp,
  1155.                                                           NULL));
  1156.             }
  1157.             sp = NULL;
  1158.             spafter = NULL;
  1159.         } else if (var->val.type->kind == TK_ARRAY && !isstrread) {
  1160.             if (sp)
  1161.                 spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1162.             spbase = makestmt_seq(spbase, spafter);
  1163.     ex = makeexpr_sizeof(copyexpr(var), 0);
  1164.     if (readlnflag) {
  1165. spbase = makestmt_seq(spbase,
  1166.      makestmt_call(
  1167.  makeexpr_bicall_3("P_readlnpaoc", tp_void,
  1168.    copyexpr(fex),
  1169.    makeexpr_addr(var),
  1170.    makeexpr_arglong(ex, 0))));
  1171. isreadln = 0;
  1172.     } else {
  1173. spbase = makestmt_seq(spbase,
  1174.      makestmt_call(
  1175.  makeexpr_bicall_3("P_readpaoc", tp_void,
  1176.    copyexpr(fex),
  1177.    makeexpr_addr(var),
  1178.    makeexpr_arglong(ex, 0))));
  1179.     }
  1180.             sp = NULL;
  1181.             spafter = NULL;
  1182.         } else {
  1183.             switch (ord_type(var->val.type)->kind) {
  1185.                 case TK_INTEGER:
  1186.     fmt = "d";
  1187.     if (curtok == TOK_COLON) {
  1188. gettok();
  1189. if (curtok == TOK_IDENT &&
  1190.     !strcicmp(curtokbuf, "HEX")) {
  1191.     fmt = "x";
  1192. } else if (curtok == TOK_IDENT &&
  1193.     !strcicmp(curtokbuf, "OCT")) {
  1194.     fmt = "o";
  1195. } else if (curtok == TOK_IDENT &&
  1196.     !strcicmp(curtokbuf, "BIN")) {
  1197.     fmt = "b";
  1198.     note("Using %b for binary format in scanf [194]");
  1199. } else
  1200.     warning("Unrecognized format specified in READ [212]");
  1201. gettok();
  1202.     }
  1203.                     type = findbasetype(var->val.type, 0);
  1204.                     if (exprlongness(var) > 0)
  1205.                         ex = makeexpr_string(format_s("%%l%s", fmt));
  1206.                     else if (type == tp_integer || type == tp_int ||
  1207.                              type == tp_uint || type == tp_sint)
  1208.                         ex = makeexpr_string(format_s("%%%s", fmt));
  1209.                     else if (type == tp_sshort || type == tp_ushort)
  1210.                         ex = makeexpr_string(format_s("%%h%s", fmt));
  1211.                     else {
  1212.                         tvar = makestmttempvar(tp_int, name_TEMP);
  1213.                         spafter = makestmt_seq(spafter,
  1214.                                                makestmt_assign(var,
  1215.                                                                makeexpr_var(tvar)));
  1216.                         var = makeexpr_var(tvar);
  1217.                         ex = makeexpr_string(format_s("%%%s", fmt));
  1218.                     }
  1219.                     break;
  1221.                 case TK_CHAR:
  1222.                     ex = makeexpr_string("%c");
  1223.                     if (newlinespace && !isstrread) {
  1224.                         spafter = makestmt_seq(spafter,
  1225.                                                makestmt_if(makeexpr_rel(EK_EQ,
  1226.                                                                         copyexpr(var),
  1227.                                                                         makeexpr_char('n')),
  1228.                                                            makestmt_assign(copyexpr(var),
  1229.                                                                            makeexpr_char(' ')),
  1230.                                                            NULL));
  1231.                     }
  1232.                     break;
  1234.                 case TK_BOOLEAN:
  1235.                     tvar = makestmttempvar(tp_str255, name_STRING);
  1236.                     spafter = makestmt_seq(spafter,
  1237.                         makestmt_assign(var,
  1238.                                         makeexpr_or(makeexpr_rel(EK_EQ,
  1239.                                                                  makeexpr_hat(makeexpr_var(tvar), 0),
  1240.                                                                  makeexpr_char('T')),
  1241.                                                     makeexpr_rel(EK_EQ,
  1242.                                                                  makeexpr_hat(makeexpr_var(tvar), 0),
  1243.                                                                  makeexpr_char('t')))));
  1244.                     var = makeexpr_var(tvar);
  1245.                     ex = makeexpr_string(" %[a-zA-Z]");
  1246.                     break;
  1248.                 case TK_ENUM:
  1249.                     warning("READ on enumerated types not yet supported [213]");
  1250.                     if (useenum)
  1251.                         ex = makeexpr_string("%d");
  1252.                     else
  1253.                         ex = makeexpr_string("%hd");
  1254.                     break;
  1256.                 case TK_REAL:
  1257.                     ex = makeexpr_string("%lg");
  1258.                     break;
  1260.                 case TK_STRING:     /* strread only */
  1261.                     ex = makeexpr_string(format_d("%%%dc", strmax(fex)));
  1262.                     break;
  1264.                 case TK_ARRAY:      /* strread only */
  1265.                     if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) {
  1266.                         rmin = 1;
  1267.                         rmax = 1;
  1268.                         note("Can't determine length of packed array of chars [195]");
  1269.                     }
  1270.                     ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1));
  1271.                     break;
  1273.                 default:
  1274.                     note("Element has wrong type for WRITE statement [196]");
  1275.                     ex = NULL;
  1276.                     break;
  1278.             }
  1279.             if (ex) {
  1280.                 var = makeexpr_addr(var);
  1281.                 if (sp) {
  1282.                     sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0);
  1283.                     insertarg(&sp->exp1, sp->exp1->nargs, var);
  1284.                 } else {
  1285.                     sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var));
  1286.                 }
  1287.             }
  1288.         }
  1289.         if (curtok == TOK_COMMA) {
  1290.             gettok();
  1291.             var = p_expr(NULL);
  1292.         } else
  1293.             break;
  1294.     }
  1295.     if (sp) {
  1296.         if (isstrread && !FCheck(checkreadformat) &&
  1297.             ((i=0, checkstring(sp->exp1->args[0], "%d")) ||
  1298.              (i++, checkstring(sp->exp1->args[0], "%ld")) ||
  1299.              (i++, checkstring(sp->exp1->args[0], "%hd")) ||
  1300.              (i++, checkstring(sp->exp1->args[0], "%lg")))) {
  1301.             if (fullstrread != 0 && exj) {
  1302.                 tvar = makestmttempvar(tp_strptr, name_STRING);
  1303.                 sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
  1304.                                            (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal,
  1305.                                                                         copyexpr(fex),
  1306.                                                                         makeexpr_addr(makeexpr_var(tvar)))
  1307.                                                     : makeexpr_bicall_3("strtol", tp_integer,
  1308.                                                                         copyexpr(fex),
  1309.                                                                         makeexpr_addr(makeexpr_var(tvar)),
  1310.                                                                         makeexpr_long(10)));
  1311. spafter = makestmt_seq(spafter,
  1312.        makestmt_assign(copyexpr(exj),
  1313.        makeexpr_minus(makeexpr_var(tvar),
  1314.       makeexpr_addr(copyexpr(fex)))));
  1315.             } else {
  1316.                 sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
  1317.                                            makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi",
  1318.                                                              (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int,
  1319.                                                              copyexpr(fex)));
  1320.             }
  1321.         } else if (isstrread && fullstrread != 0 && exj) {
  1322.             sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
  1323.                                                 makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0);
  1324.             insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj)));
  1325.         } else if (isreadln && scanfmode && !FCheck(checkreadformat)) {
  1326.             isreadln = 0;
  1327.             sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
  1328.                                                 makeexpr_string("%*[^n]"), 0);
  1329.             spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter);
  1330.         }
  1331.         spbase = makestmt_seq(spbase, fixscanf(sp, fex));
  1332.     }
  1333.     spbase = makestmt_seq(spbase, spafter);
  1334.     if (isreadln)
  1335.         spbase = makestmt_seq(spbase, skipeoln(fex));
  1336.     return spbase;
  1337. }
  1341. Static Stmt *handleread_bin(fex, var)
  1342. Expr *fex, *var;
  1343. {
  1344.     Type *basetype;
  1345.     Stmt *sp;
  1346.     Expr *ex, *tvardef = NULL;
  1348.     sp = NULL;
  1349.     basetype = fex->val.type->basetype->basetype;
  1350.     for (;;) {
  1351.         ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
  1352.                                                     makeexpr_sizeof(makeexpr_type(basetype), 0),
  1353.                                                     makeexpr_long(1),
  1354.                                                     copyexpr(fex));
  1355.         if (checkeof(fex)) {
  1356.             ex = makeexpr_bicall_2("~SETIO", tp_void,
  1357.                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
  1358.    makeexpr_name(endoffilename, tp_int));
  1359.         }
  1360.         sp = makestmt_seq(sp, makestmt_call(ex));
  1361.         if (curtok == TOK_COMMA) {
  1362.             gettok();
  1363.             var = p_expr(NULL);
  1364.         } else
  1365.             break;
  1366.     }
  1367.     freeexpr(tvardef);
  1368.     return sp;
  1369. }
  1373. Static Stmt *proc_read()
  1374. {
  1375.     Expr *fex, *ex;
  1376.     Stmt *sp;
  1378.     if (!skipopenparen())
  1379. return NULL;
  1380.     ex = p_expr(NULL);
  1381.     if (isfiletype(ex->val.type) && wneedtok(TOK_COMMA)) {
  1382.         fex = ex;
  1383.         ex = p_expr(NULL);
  1384.     } else {
  1385.         fex = makeexpr_var(mp_input);
  1386.     }
  1387.     if (fex->val.type == tp_text)
  1388.         sp = handleread_text(fex, ex, 0);
  1389.     else
  1390.         sp = handleread_bin(fex, ex);
  1391.     skipcloseparen();
  1392.     return wrapopencheck(sp, fex);
  1393. }
  1397. Static Stmt *proc_readdir()
  1398. {
  1399.     Expr *fex, *ex;
  1400.     Stmt *sp;
  1402.     if (!skipopenparen())
  1403. return NULL;
  1404.     fex = p_expr(tp_text);
  1405.     if (!skipcomma())
  1406. return NULL;
  1407.     ex = p_expr(tp_integer);
  1408.     sp = doseek(fex, ex);
  1409.     if (!skipopenparen())
  1410. return sp;
  1411.     sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL)));
  1412.     skipcloseparen();
  1413.     return wrapopencheck(sp, fex);
  1414. }
  1418. Static Stmt *proc_readln()
  1419. {
  1420.     Expr *fex, *ex;
  1421.     Stmt *sp;
  1423.     if (curtok != TOK_LPAR) {
  1424.         fex = makeexpr_var(mp_input);
  1425.         return wrapopencheck(skipeoln(copyexpr(fex)), fex);
  1426.     } else {
  1427.         gettok();
  1428.         ex = p_expr(NULL);
  1429.         if (isfiletype(ex->val.type)) {
  1430.             fex = ex;
  1431.             if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
  1432.                 skippasttotoken(TOK_RPAR, TOK_SEMI);
  1433.                 return wrapopencheck(skipeoln(copyexpr(fex)), fex);
  1434.             } else {
  1435.                 ex = p_expr(NULL);
  1436.             }
  1437.         } else {
  1438.             fex = makeexpr_var(mp_input);
  1439.         }
  1440.         sp = handleread_text(fex, ex, 1);
  1441.         skipcloseparen();
  1442.     }
  1443.     return wrapopencheck(sp, fex);
  1444. }
  1448. Static Stmt *proc_readv()
  1449. {
  1450.     Expr *vex;
  1451.     Stmt *sp;
  1453.     if (!skipopenparen())
  1454. return NULL;
  1455.     vex = p_expr(tp_str255);
  1456.     if (!skipcomma())
  1457. return NULL;
  1458.     sp = handleread_text(vex, NULL, 0);
  1459.     skipcloseparen();
  1460.     return sp;
  1461. }
  1465. Static Stmt *proc_strread()
  1466. {
  1467.     Expr *vex, *exi, *exj, *exjj, *ex;
  1468.     Stmt *sp, *sp2;
  1469.     Meaning *tvar, *jvar;
  1471.     if (!skipopenparen())
  1472. return NULL;
  1473.     vex = p_expr(tp_str255);
  1474.     if (vex->kind != EK_VAR) {
  1475.         tvar = makestmttempvar(tp_str255, name_STRING);
  1476.         sp = makestmt_assign(makeexpr_var(tvar), vex);
  1477.         vex = makeexpr_var(tvar);
  1478.     } else
  1479.         sp = NULL;
  1480.     if (!skipcomma())
  1481. return NULL;
  1482.     exi = p_expr(tp_integer);
  1483.     if (!skipcomma())
  1484. return NULL;
  1485.     exj = p_expr(tp_integer);
  1486.     if (!skipcomma())
  1487. return NULL;
  1488.     if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) {
  1489.         sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi));
  1490.         exi = copyexpr(exj);
  1491.     }
  1492.     if (fullstrread != 0 &&
  1493.         ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) {
  1494.         jvar = makestmttempvar(exj->val.type, name_TEMP);
  1495.         exjj = makeexpr_var(jvar);
  1496.     } else {
  1497.         exjj = copyexpr(exj);
  1498.         jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL;
  1499.     }
  1500.     sp2 = handleread_text(bumpstring(copyexpr(vex),
  1501.                                      copyexpr(exi), 1),
  1502.                           exjj, 0);
  1503.     sp = makestmt_seq(sp, sp2);
  1504.     skipcloseparen();
  1505.     if (fullstrread == 0) {
  1506.         sp = makestmt_seq(sp, makestmt_assign(exj,
  1507.                                               makeexpr_plus(makeexpr_bicall_1("strlen", tp_int,
  1508.                                                                               vex),
  1509.                                                             makeexpr_long(1))));
  1510.         freeexpr(exjj);
  1511.         freeexpr(exi);
  1512.     } else {
  1513.         sp = makestmt_seq(sp, makestmt_assign(exj,
  1514.                                               makeexpr_plus(exjj, exi)));
  1515.         if (fullstrread == 2)
  1516.             note("STRREAD was used [197]");
  1517.         freeexpr(vex);
  1518.     }
  1519.     return mixassignments(sp, jvar);
  1520. }
  1525. Static Expr *func_random()
  1526. {
  1527.     Expr *ex;
  1529.     if (curtok == TOK_LPAR) {
  1530.         gettok();
  1531.         ex = p_expr(tp_integer);
  1532.         skipcloseparen();
  1533.         return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1));
  1534.     } else {
  1535.         return makeexpr_bicall_0(randrealname, tp_longreal);
  1536.     }
  1537. }
  1541. Static Stmt *proc_randomize()
  1542. {
  1543.     if (*randomizename)
  1544.         return makestmt_call(makeexpr_bicall_0(randomizename, tp_void));
  1545.     else
  1546.         return NULL;
  1547. }
  1551. Static Expr *func_round(ex)
  1552. Expr *ex;
  1553. {
  1554.     Meaning *tvar;
  1556.     ex = grabarg(ex, 0);
  1557.     if (ex->val.type->kind != TK_REAL)
  1558. return ex;
  1559.     if (*roundname) {
  1560.         if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
  1561.             return makeexpr_bicall_1(roundname, tp_integer, ex);
  1562.         } else {
  1563.             tvar = makestmttempvar(tp_longreal, name_TEMP);
  1564.             return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex),
  1565.                                   makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar)));
  1566.         }
  1567.     } else {
  1568.         return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
  1569.   makeexpr_plus(ex, makeexpr_real("0.5"))),
  1570.                                 tp_integer);
  1571.     }
  1572. }
  1576. Static Expr *func_uround(ex)
  1577. Expr *ex;
  1578. {
  1579.     ex = grabarg(ex, 0);
  1580.     if (ex->val.type->kind != TK_REAL)
  1581. return ex;
  1582.     return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
  1583.       makeexpr_plus(ex, makeexpr_real("0.5"))),
  1584.     tp_unsigned);
  1585. }
  1589. Static Expr *func_scan()
  1590. {
  1591.     Expr *ex, *ex2, *ex3;
  1592.     char *name;
  1594.     if (!skipopenparen())
  1595. return NULL;
  1596.     ex = p_expr(tp_integer);
  1597.     if (!skipcomma())
  1598. return NULL;
  1599.     if (curtok == TOK_EQ)
  1600. name = "P_scaneq";
  1601.     else 
  1602. name = "P_scanne";
  1603.     gettok();
  1604.     ex2 = p_expr(tp_char);
  1605.     if (!skipcomma())
  1606. return NULL;
  1607.     ex3 = p_expr(tp_str255);
  1608.     skipcloseparen();
  1609.     return makeexpr_bicall_3(name, tp_int,
  1610.      makeexpr_arglong(ex, 0),
  1611.      makeexpr_charcast(ex2), ex3);
  1612. }
  1616. Static Expr *func_scaneq(ex)
  1617. Expr *ex;
  1618. {
  1619.     return makeexpr_bicall_3("P_scaneq", tp_int,
  1620.      makeexpr_arglong(ex->args[0], 0),
  1621.      makeexpr_charcast(ex->args[1]),
  1622.      ex->args[2]);
  1623. }
  1626. Static Expr *func_scanne(ex)
  1627. Expr *ex;
  1628. {
  1629.     return makeexpr_bicall_3("P_scanne", tp_int,
  1630.      makeexpr_arglong(ex->args[0], 0),
  1631.      makeexpr_charcast(ex->args[1]),
  1632.      ex->args[2]);
  1633. }
  1637. Static Stmt *proc_seek()
  1638. {
  1639.     Expr *fex, *ex;
  1640.     Stmt *sp;
  1642.     if (!skipopenparen())
  1643. return NULL;
  1644.     fex = p_expr(tp_text);
  1645.     if (!skipcomma())
  1646. return NULL;
  1647.     ex = p_expr(tp_integer);
  1648.     skipcloseparen();
  1649.     sp = wrapopencheck(doseek(fex, ex), copyexpr(fex));
  1650.     if (*setupbufname && isfilevar(fex))
  1651. sp = makestmt_seq(sp,
  1652.  makestmt_call(
  1653.      makeexpr_bicall_2(setupbufname, tp_void, fex,
  1654.  makeexpr_type(fex->val.type->basetype->basetype))));
  1655.     else
  1656. freeexpr(fex);
  1657.     return sp;
  1658. }
  1662. Static Expr *func_seekeof()
  1663. {
  1664.     Expr *ex;
  1666.     if (curtok == TOK_LPAR)
  1667.         ex = p_parexpr(tp_text);
  1668.     else
  1669.         ex = makeexpr_var(mp_input);
  1670.     if (*skipspacename)
  1671.         ex = makeexpr_bicall_1(skipspacename, tp_text, ex);
  1672.     else
  1673.         note("SEEKEOF was used [198]");
  1674.     return iofunc(ex, 0);
  1675. }
  1679. Static Expr *func_seekeoln()
  1680. {
  1681.     Expr *ex;
  1683.     if (curtok == TOK_LPAR)
  1684.         ex = p_parexpr(tp_text);
  1685.     else
  1686.         ex = makeexpr_var(mp_input);
  1687.     if (*skipspacename)
  1688.         ex = makeexpr_bicall_1(skipspacename, tp_text, ex);
  1689.     else
  1690.         note("SEEKEOLN was used [199]");
  1691.     return iofunc(ex, 1);
  1692. }
  1696. Static Stmt *proc_setstrlen()
  1697. {
  1698.     Expr *ex, *ex2;
  1700.     if (!skipopenparen())
  1701. return NULL;
  1702.     ex = p_expr(tp_str255);
  1703.     if (!skipcomma())
  1704. return NULL;
  1705.     ex2 = p_expr(tp_integer);
  1706.     skipcloseparen();
  1707.     return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex),
  1708.                            ex2);
  1709. }
  1713. Static Stmt *proc_settextbuf()
  1714. {
  1715.     Expr *fex, *bex, *sex;
  1717.     if (!skipopenparen())
  1718. return NULL;
  1719.     fex = p_expr(tp_text);
  1720.     if (!skipcomma())
  1721. return NULL;
  1722.     bex = p_expr(NULL);
  1723.     if (curtok == TOK_COMMA) {
  1724.         gettok();
  1725.         sex = p_expr(tp_integer);
  1726.     } else
  1727.         sex = makeexpr_sizeof(copyexpr(bex), 0);
  1728.     skipcloseparen();
  1729.     note("Make sure setvbuf() call occurs when file is open [200]");
  1730.     return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void,
  1731.                                            fex,
  1732.                                            makeexpr_addr(bex),
  1733.                                            makeexpr_name("_IOFBF", tp_integer),
  1734.                                            sex));
  1735. }
  1739. Static Expr *func_sin(ex)
  1740. Expr *ex;
  1741. {
  1742.     return makeexpr_bicall_1("sin", tp_longreal, grabarg(ex, 0));
  1743. }
  1746. Static Expr *func_sinh(ex)
  1747. Expr *ex;
  1748. {
  1749.     return makeexpr_bicall_1("sinh", tp_longreal, grabarg(ex, 0));
  1750. }
  1754. Static Expr *func_sizeof()
  1755. {
  1756.     Expr *ex;
  1757.     Type *type;
  1758.     char *name, vbuf[1000];
  1759.     int lpar;
  1761.     lpar = (curtok == TOK_LPAR);
  1762.     if (lpar)
  1763. gettok();
  1764.     if (curtok == TOK_IDENT && curtokmeaning && curtokmeaning->kind == MK_TYPE) {
  1765.         ex = makeexpr_type(curtokmeaning->type);
  1766.         gettok();
  1767.     } else
  1768.         ex = p_expr(NULL);
  1769.     type = ex->val.type;
  1770.     parse_special_variant(type, vbuf);
  1771.     if (lpar)
  1772. skipcloseparen();
  1773.     name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
  1774.     if (name) {
  1775. freeexpr(ex);
  1776. return pc_expr_str(name);
  1777.     } else
  1778. return makeexpr_sizeof(ex, 0);
  1779. }
  1783. Static Expr *func_statusv()
  1784. {
  1785.     return makeexpr_name(name_IORESULT, tp_integer);
  1786. }
  1790. Static Expr *func_str_hp(ex)
  1791. Expr *ex;
  1792. {
  1793.     return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
  1794.                                             ex->args[2], ex->args[3]));
  1795. }
  1799. Static Stmt *proc_strappend()
  1800. {
  1801.     Expr *ex, *ex2;
  1803.     if (!skipopenparen())
  1804. return NULL;
  1805.     ex = p_expr(tp_str255);
  1806.     if (!skipcomma())
  1807. return NULL;