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

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

编译器/解释器

开发平台：

C/C++

funcs.c.3：源码内容
  1.     ex2 = p_expr(tp_str255);
  2.     skipcloseparen();
  3.     return makestmt_assign(ex, makeexpr_concat(copyexpr(ex), ex2, 0));
  4. }
  8. Static Stmt *proc_strdelete()
  9. {
  10.     Meaning *tvar = NULL, *tvari;
  11.     Expr *ex, *ex2, *ex3, *ex4, *exi, *exn;
  12.     Stmt *sp;
  14.     if (!skipopenparen())
  15. return NULL;
  16.     ex = p_expr(tp_str255);
  17.     if (!skipcomma())
  18. return NULL;
  19.     exi = p_expr(tp_integer);
  20.     if (curtok == TOK_COMMA) {
  21. gettok();
  22. exn = p_expr(tp_integer);
  23.     } else
  24. exn = makeexpr_long(1);
  25.     skipcloseparen();
  26.     if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
  27.         sp = NULL;
  28.     else {
  29.         tvari = makestmttempvar(tp_int, name_TEMP);
  30.         sp = makestmt_assign(makeexpr_var(tvari), exi);
  31.         exi = makeexpr_var(tvari);
  32.     }
  33.     ex3 = bumpstring(copyexpr(ex), copyexpr(exi), 1);
  34.     ex4 = bumpstring(copyexpr(ex), makeexpr_plus(exi, exn), 1);
  35.     if (strcpyleft) {
  36.         ex2 = ex3;
  37.     } else {
  38.         tvar = makestmttempvar(tp_str255, name_STRING);
  39.         ex2 = makeexpr_var(tvar);
  40.     }
  41.     sp = makestmt_seq(sp, makestmt_assign(ex2, ex4));
  42.     if (!strcpyleft)
  43.         sp = makestmt_seq(sp, makestmt_assign(ex3, makeexpr_var(tvar)));
  44.     return sp;
  45. }
  49. Static Stmt *proc_strinsert()
  50. {
  51.     Meaning *tvari;
  52.     Expr *exs, *exd, *exi;
  53.     Stmt *sp;
  55.     if (!skipopenparen())
  56. return NULL;
  57.     exs = p_expr(tp_str255);
  58.     if (!skipcomma())
  59. return NULL;
  60.     exd = p_expr(tp_str255);
  61.     if (!skipcomma())
  62. return NULL;
  63.     exi = p_expr(tp_integer);
  64.     skipcloseparen();
  65. #if 0
  66.     if (checkconst(exi, 1)) {
  67.         freeexpr(exi);
  68.         return makestmt_assign(exd,
  69.                                makeexpr_concat(exs, copyexpr(exd)));
  70.     }
  71. #endif
  72.     if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
  73.         sp = NULL;
  74.     else {
  75.         tvari = makestmttempvar(tp_int, name_TEMP);
  76.         sp = makestmt_assign(makeexpr_var(tvari), exi);
  77.         exi = makeexpr_var(tvari);
  78.     }
  79.     exd = bumpstring(exd, exi, 1);
  80.     sp = makestmt_seq(sp, makestmt_assign(exd,
  81.                                           makeexpr_concat(exs, copyexpr(exd), 0)));
  82.     return sp;
  83. }
  87. Static Stmt *proc_strmove()
  88. {
  89.     Expr *exlen, *exs, *exsi, *exd, *exdi;
  91.     if (!skipopenparen())
  92. return NULL;
  93.     exlen = p_expr(tp_integer);
  94.     if (!skipcomma())
  95. return NULL;
  96.     exs = p_expr(tp_str255);
  97.     if (!skipcomma())
  98. return NULL;
  99.     exsi = p_expr(tp_integer);
  100.     if (!skipcomma())
  101. return NULL;
  102.     exd = p_expr(tp_str255);
  103.     if (!skipcomma())
  104. return NULL;
  105.     exdi = p_expr(tp_integer);
  106.     skipcloseparen();
  107.     exsi = makeexpr_arglong(exsi, 0);
  108.     exdi = makeexpr_arglong(exdi, 0);
  109.     return makestmt_call(makeexpr_bicall_5(strmovename, tp_str255,
  110.    exlen, exs, exsi, exd, exdi));
  111. }
  115. Static Expr *func_strlen(ex)
  116. Expr *ex;
  117. {
  118.     return makeexpr_bicall_1("strlen", tp_int, grabarg(ex, 0));
  119. }
  123. Static Expr *func_strltrim(ex)
  124. Expr *ex;
  125. {
  126.     return makeexpr_assign(makeexpr_hat(ex->args[0], 0),
  127.                            makeexpr_bicall_1(strltrimname, tp_str255, ex->args[1]));
  128. }
  132. Static Expr *func_strmax(ex)
  133. Expr *ex;
  134. {
  135.     return strmax_func(grabarg(ex, 0));
  136. }
  140. Static Expr *func_strpos(ex)
  141. Expr *ex;
  142. {
  143.     char *cp;
  145.     if (!switch_strpos)
  146.         swapexprs(ex->args[0], ex->args[1]);
  147.     cp = strposname;
  148.     if (!*cp) {
  149.         note("STRPOS function used [201]");
  150.         cp = "STRPOS";
  151.     } 
  152.     return makeexpr_bicall_3(cp, tp_int,
  153.                              ex->args[0], 
  154.                              ex->args[1],
  155.                              makeexpr_long(1));
  156. }
  160. Static Expr *func_strrpt(ex)
  161. Expr *ex;
  162. {
  163.     if (ex->args[1]->kind == EK_CONST &&
  164.         ex->args[1]->val.i == 1 && ex->args[1]->val.s[0] == ' ') {
  165.         return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
  166.                                  makeexpr_string("%*s"),
  167.                                  makeexpr_longcast(ex->args[2], 0),
  168.                                  makeexpr_string(""));
  169.     } else
  170.         return makeexpr_bicall_3(strrptname, tp_strptr, ex->args[0], ex->args[1],
  171.                                  makeexpr_arglong(ex->args[2], 0));
  172. }
  176. Static Expr *func_strrtrim(ex)
  177. Expr *ex;
  178. {
  179.     return makeexpr_bicall_1(strrtrimname, tp_strptr,
  180.                              makeexpr_assign(makeexpr_hat(ex->args[0], 0),
  181.                                              ex->args[1]));
  182. }
  186. Static Expr *func_succ()
  187. {
  188.     Expr *ex;
  190.     if (wneedtok(TOK_LPAR)) {
  191. ex = p_ord_expr();
  192. skipcloseparen();
  193.     } else
  194. ex = p_ord_expr();
  195. #if 1
  196.     ex = makeexpr_inc(ex, makeexpr_long(1));
  197. #else
  198.     ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(1)), ex->val.type);
  199. #endif
  200.     return ex;
  201. }
  205. Static Expr *func_sqr()
  206. {
  207.     return makeexpr_sqr(p_parexpr(tp_integer), 0);
  208. }
  212. Static Expr *func_sqrt(ex)
  213. Expr *ex;
  214. {
  215.     return makeexpr_bicall_1("sqrt", tp_longreal, grabarg(ex, 0));
  216. }
  220. Static Expr *func_swap(ex)
  221. Expr *ex;
  222. {
  223.     char *cp;
  225.     ex = grabarg(ex, 0);
  226.     cp = swapname;
  227.     if (!*cp) {
  228.         note("SWAP function was used [202]");
  229.         cp = "SWAP";
  230.     }
  231.     return makeexpr_bicall_1(swapname, tp_int, ex);
  232. }
  236. Static Expr *func_tan(ex)
  237. Expr *ex;
  238. {
  239.     return makeexpr_bicall_1("tan", tp_longreal, grabarg(ex, 0));
  240. }
  243. Static Expr *func_tanh(ex)
  244. Expr *ex;
  245. {
  246.     return makeexpr_bicall_1("tanh", tp_longreal, grabarg(ex, 0));
  247. }
  251. Static Expr *func_trunc(ex)
  252. Expr *ex;
  253. {
  254.     return makeexpr_actcast(grabarg(ex, 0), tp_integer);
  255. }
  259. Static Expr *func_utrunc(ex)
  260. Expr *ex;
  261. {
  262.     return makeexpr_actcast(grabarg(ex, 0), tp_unsigned);
  263. }
  267. Static Expr *func_uand()
  268. {
  269.     Expr *ex;
  271.     if (!skipopenparen())
  272. return NULL;
  273.     ex = p_expr(tp_unsigned);
  274.     if (skipcomma()) {
  275. ex = makeexpr_bin(EK_BAND, ex->val.type, ex, p_expr(tp_unsigned));
  276. skipcloseparen();
  277.     }
  278.     return ex;
  279. }
  283. Static Expr *func_udec()
  284. {
  285.     return handle_vax_hex(NULL, "u", 0);
  286. }
  290. Static Expr *func_unot()
  291. {
  292.     Expr *ex;
  294.     if (!skipopenparen())
  295. return NULL;
  296.     ex = p_expr(tp_unsigned);
  297.     ex = makeexpr_un(EK_BNOT, ex->val.type, ex);
  298.     skipcloseparen();
  299.     return ex;
  300. }
  304. Static Expr *func_uor()
  305. {
  306.     Expr *ex;
  308.     if (!skipopenparen())
  309. return NULL;
  310.     ex = p_expr(tp_unsigned);
  311.     if (skipcomma()) {
  312. ex = makeexpr_bin(EK_BOR, ex->val.type, ex, p_expr(tp_unsigned));
  313. skipcloseparen();
  314.     }
  315.     return ex;
  316. }
  320. Static Expr *func_upcase(ex)
  321. Expr *ex;
  322. {
  323.     return makeexpr_bicall_1("toupper", tp_char, grabarg(ex, 0));
  324. }
  328. Static Expr *func_upper()
  329. {
  330.     Expr *ex;
  331.     Value val;
  333.     if (!skipopenparen())
  334. return NULL;
  335.     ex = p_expr(tp_integer);
  336.     if (curtok == TOK_COMMA) {
  337. gettok();
  338. val = p_constant(tp_integer);
  339. if (!val.type || val.i != 1)
  340.     note("UPPER(v,n) not supported for n>1 [190]");
  341.     }
  342.     skipcloseparen();
  343.     return copyexpr(ex->val.type->indextype->smax);
  344. }
  348. Static Expr *func_uxor()
  349. {
  350.     Expr *ex;
  352.     if (!skipopenparen())
  353. return NULL;
  354.     ex = p_expr(tp_unsigned);
  355.     if (skipcomma()) {
  356. ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, p_expr(tp_unsigned));
  357. skipcloseparen();
  358.     }
  359.     return ex;
  360. }
  364. Static Expr *func_val_modula()
  365. {
  366.     Expr *ex;
  367.     Type *tp;
  369.     if (!skipopenparen())
  370. return NULL;
  371.     tp = p_type(NULL);
  372.     if (!skipcomma())
  373. return NULL;
  374.     ex = p_expr(tp);
  375.     skipcloseparen();
  376.     return pascaltypecast(tp, ex);
  377. }
  381. Static Stmt *proc_val_turbo()
  382. {
  383.     Expr *ex, *vex, *code, *fmt;
  385.     if (!skipopenparen())
  386. return NULL;
  387.     ex = gentle_cast(p_expr(tp_str255), tp_str255);
  388.     if (!skipcomma())
  389. return NULL;
  390.     vex = p_expr(NULL);
  391.     if (curtok == TOK_COMMA) {
  392. gettok();
  393. code = gentle_cast(p_expr(tp_integer), tp_integer);
  394.     } else
  395. code = NULL;
  396.     skipcloseparen();
  397.     if (vex->val.type->kind == TK_REAL)
  398.         fmt = makeexpr_string("%lg");
  399.     else if (exprlongness(vex) > 0)
  400.         fmt = makeexpr_string("%ld");
  401.     else
  402.         fmt = makeexpr_string("%d");
  403.     ex = makeexpr_bicall_3("sscanf", tp_int,
  404.                            ex, fmt, makeexpr_addr(vex));
  405.     if (code) {
  406. ex = makeexpr_rel(EK_EQ, ex, makeexpr_long(0));
  407. return makestmt_assign(code, makeexpr_ord(ex));
  408.     } else
  409. return makestmt_call(ex);
  410. }
  418. Static Expr *writestrelement(ex, wid, vex, code, needboth)
  419. Expr *ex, *wid, *vex;
  420. int code, needboth;
  421. {
  422.     if (formatstrings && needboth) {
  423.         return makeexpr_bicall_5("sprintf", tp_str255, vex,
  424.                                  makeexpr_string(format_d("%%*.*%c", code)),
  425.                                  copyexpr(wid),
  426.                                  wid,
  427.                                  ex);
  428.     } else {
  429.         return makeexpr_bicall_4("sprintf", tp_str255, vex,
  430.                                  makeexpr_string(format_d("%%*%c", code)),
  431.                                  wid,
  432.                                  ex);
  433.     }
  434. }
  438. Static char *makeenumnames(tp)
  439. Type *tp;
  440. {
  441.     Strlist *sp;
  442.     char *name;
  443.     Meaning *mp;
  444.     int saveindent;
  446.     for (sp = enumnames; sp && sp->value != (long)tp; sp = sp->next) ;
  447.     if (!sp) {
  448.         if (tp->meaning)
  449.             name = format_s(name_ENUM, tp->meaning->name);
  450.         else
  451.             name = format_s(name_ENUM, format_d("_%d", ++enumnamecount));
  452.         sp = strlist_insert(&enumnames, name);
  453.         sp->value = (long)tp;
  454.         outsection(2);
  455.         output(format_s("Static %s *", charname));
  456.         output(sp->s);
  457.         output("[] = {n");
  458. saveindent = outindent;
  459. moreindent(tabsize);
  460. moreindent(structinitindent);
  461.         for (mp = tp->fbase; mp; mp = mp->xnext) {
  462.             output(makeCstring(mp->sym->name, strlen(mp->sym->name)));
  463.             if (mp->xnext)
  464.                 output(",02 ");
  465.         }
  466.         outindent = saveindent;
  467.         output("n} ;n");
  468.         outsection(2);
  469.     }
  470.     return sp->s;
  471. }
  477. /* This function must return a "tempsprintf" */
  479. Expr *writeelement(ex, wid, prec, base)
  480. Expr *ex, *wid, *prec;
  481. int base;
  482. {
  483.     Expr *vex, *ex1, *ex2;
  484.     Meaning *tvar;
  485.     char *fmtcode;
  486.     Type *type;
  488.     ex = makeexpr_charcast(ex);
  489.     if (ex->val.type->kind == TK_POINTER) {
  490.         ex = makeexpr_hat(ex, 0);   /* convert char *'s to strings */
  491.         intwarning("writeelement", "got a char * instead of a string [214]");
  492.     }
  493.     if ((ex->val.type->kind == TK_STRING && !wid) ||
  494.         (ord_type(ex->val.type)->kind == TK_CHAR && (!wid || checkconst(wid, 1)))) {
  495.         return makeexpr_sprintfify(ex);
  496.     }
  497.     tvar = makestmttempvar(tp_str255, name_STRING);
  498.     vex = makeexpr_var(tvar);
  499.     if (wid)
  500.         wid = makeexpr_longcast(wid, 0);
  501.     if (prec)
  502.         prec = makeexpr_longcast(prec, 0);
  503. #if 0
  504.     if (wid && (wid->kind == EK_CONST && wid->val.i < 0 ||
  505.                 checkconst(wid, -1))) {
  506.         freeexpr(wid);     /* P-system uses write(x:-1) to mean write(x) */
  507.         wid = NULL;
  508.     }
  509.     if (prec && (prec->kind == EK_CONST && prec->val.i < 0 ||
  510.                  checkconst(prec, -1))) {
  511.         freeexpr(prec);
  512.         prec = NULL;
  513.     }
  514. #endif
  515.     switch (ord_type(ex->val.type)->kind) {
  517.         case TK_INTEGER:
  518.             if (!wid) {
  519. if (integerwidth < 0)
  520.     integerwidth = (which_lang == LANG_TURBO) ? 1 : 12;
  521. wid = makeexpr_long(integerwidth);
  522.     }
  523.     type = findbasetype(ex->val.type, 0);
  524.     if (base == 16)
  525. fmtcode = "x";
  526.     else if (base == 8)
  527. fmtcode = "o";
  528.     else if ((possiblesigns(wid) & (1|4)) == 1) {
  529. wid = makeexpr_neg(wid);
  530. fmtcode = "x";
  531.     } else if (type == tp_unsigned ||
  532.        type == tp_uint ||
  533.        (type == tp_ushort && sizeof_int < 32))
  534. fmtcode = "u";
  535.     else
  536. fmtcode = "d";
  537.             ex = makeexpr_forcelongness(ex);
  538.             if (checkconst(wid, 0) || checkconst(wid, 1)) {
  539.                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  540.                                        makeexpr_string(format_ss("%%%s%s",
  541.  (exprlongness(ex) > 0) ? "l" : "",
  542.  fmtcode)),
  543.                                        ex);
  544.             } else {
  545.                 ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  546.                                        makeexpr_string(format_ss("%%*%s%s",
  547.  (exprlongness(ex) > 0) ? "l" : "",
  548.  fmtcode)),
  549.                                        wid,
  550.                                        ex);
  551.             }
  552.             break;
  554.         case TK_CHAR:
  555.             ex = writestrelement(ex, wid, vex, 'c',
  556.                                      (wid->kind != EK_CONST || wid->val.i < 1));
  557.             break;
  559.         case TK_BOOLEAN:
  560.             if (!wid) {
  561.                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  562.                                        makeexpr_string("%s"),
  563.                                        makeexpr_cond(ex,
  564.                                                      makeexpr_string(" TRUE"),
  565.                                                      makeexpr_string("FALSE")));
  566.             } else if (checkconst(wid, 1)) {
  567.                 ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  568.                                        makeexpr_string("%c"),
  569.                                        makeexpr_cond(ex,
  570.                                                      makeexpr_char('T'),
  571.                                                      makeexpr_char('F')));
  572.             } else {
  573.                 ex = writestrelement(makeexpr_cond(ex,
  574.                                                    makeexpr_string("TRUE"),
  575.                                                    makeexpr_string("FALSE")),
  576.                                      wid, vex, 's',
  577.                                      (wid->kind != EK_CONST || wid->val.i < 5));
  578.             }
  579.             break;
  581.         case TK_ENUM:
  582.             ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  583.                                    makeexpr_string("%s"),
  584.                                    makeexpr_index(makeexpr_name(makeenumnames(ex->val.type),
  585.                                                                 tp_strptr),
  586.                                                   ex, NULL));
  587.             break;
  589.         case TK_REAL:
  590.             if (!wid)
  591.                 wid = makeexpr_long(realwidth);
  592.             if (prec && (possiblesigns(prec) & (1|4)) != 1) {
  593.                 ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
  594.                                        makeexpr_string("%*.*f"),
  595.                                        wid,
  596.                                        prec,
  597.                                        ex);
  598.             } else {
  599. if (prec)
  600.     prec = makeexpr_neg(prec);
  601. else
  602.     prec = makeexpr_minus(copyexpr(wid),
  603.   makeexpr_long(7));
  604. if (prec->kind == EK_CONST) {
  605.     if (prec->val.i <= 0)
  606. prec = makeexpr_long(1);
  607. } else {
  608.     prec = makeexpr_bicall_2("P_max", tp_integer, prec,
  609.      makeexpr_long(1));
  610. }
  611.                 if (wid->kind == EK_CONST && wid->val.i > 21) {
  612.                     ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
  613.                                            makeexpr_string("%*.*E"),
  614.                                            wid,
  615.    prec,
  616.                                            ex);
  617. #if 0
  618.                 } else if (checkconst(wid, 7)) {
  619.                     ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
  620.                                            makeexpr_string("%E"),
  621.                                            ex);
  622. #endif
  623.                 } else {
  624.                     ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  625.                                            makeexpr_string("% .*E"),
  626.    prec,
  627.                                            ex);
  628.                 }
  629.             }
  630.             break;
  632.         case TK_STRING:
  633.             ex = writestrelement(ex, wid, vex, 's', 1);
  634.             break;
  636.         case TK_ARRAY:     /* assume packed array of char */
  637.     ord_range_expr(ex->val.type->indextype, &ex1, &ex2);
  638.     ex1 = makeexpr_plus(makeexpr_minus(copyexpr(ex2),
  639.        copyexpr(ex1)),
  640. makeexpr_long(1));
  641.     ex1 = makeexpr_longcast(ex1, 0);
  642.     fmtcode = "%.*s";
  643.             if (!wid) {
  644. wid = ex1;
  645.             } else {
  646. if (isliteralconst(wid, NULL) == 2 &&
  647.     isliteralconst(ex1, NULL) == 2) {
  648.     if (wid->val.i > ex1->val.i) {
  649. fmtcode = format_ds("%*s%%.*s",
  650.     wid->val.i - ex1->val.i, "");
  651. wid = ex1;
  652.     }
  653. } else
  654.     note("Format for packed-array-of-char will work only if width < length [321]");
  655.     }
  656.             ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
  657.                                    makeexpr_string(fmtcode),
  658.                                    wid,
  659.                                    makeexpr_addr(ex));
  660.             break;
  662.         default:
  663.             note("Element has wrong type for WRITE statement [196]");
  664.             ex = makeexpr_bicall_2("sprintf", tp_str255, vex, makeexpr_string("<meef>"));
  665.             break;
  667.     }
  668.     return ex;
  669. }
  673. Static Stmt *handlewrite_text(fex, ex, iswriteln)
  674. Expr *fex, *ex;
  675. int iswriteln;
  676. {
  677.     Expr *print, *wid, *prec;
  678.     unsigned char *ucp;
  679.     int i, done, base;
  681.     print = NULL;
  682.     for (;;) {
  683.         wid = NULL;
  684.         prec = NULL;
  685. base = 10;
  686. if (curtok == TOK_COLON && iswriteln >= 0) {
  687.     gettok();
  688.     wid = p_expr(tp_integer);
  689.     if (curtok == TOK_COLON) {
  690. gettok();
  691. prec = p_expr(tp_integer);
  692.     }
  693. }
  694. if (curtok == TOK_IDENT &&
  695.     !strcicmp(curtokbuf, "OCT")) {
  696.     base = 8;
  697.     gettok();
  698. } else if (curtok == TOK_IDENT &&
  699.    !strcicmp(curtokbuf, "HEX")) {
  700.     base = 16;
  701.     gettok();
  702. }
  703.         ex = writeelement(ex, wid, prec, base);
  704.         print = makeexpr_concat(print, cleansprintf(ex), 1);
  705.         if (curtok == TOK_COMMA && iswriteln >= 0) {
  706.             gettok();
  707.             ex = p_expr(NULL);
  708.         } else
  709.             break;
  710.     }
  711.     if (fex->val.type->kind != TK_STRING) {      /* not strwrite */
  712.         switch (iswriteln) {
  713.             case 1:
  714.             case -1:
  715.                 print = makeexpr_concat(print, makeexpr_string("n"), 1);
  716.                 break;
  717.             case 2:
  718.             case -2:
  719.                 print = makeexpr_concat(print, makeexpr_string("r"), 1);
  720.                 break;
  721.         }
  722.         if (isvar(fex, mp_output)) {
  723.             ucp = (unsigned char *)print->args[1]->val.s;
  724.             for (i = 0; i < print->args[1]->val.i; i++) {
  725.                 if (ucp[i] >= 128 && ucp[i] < 144) {
  726.                     note("WRITE statement contains color/attribute characters [203]");
  727.     break;
  728. }
  729.             }
  730.         }
  731.         if ((i = sprintflength(print, 0)) > 0 && print->nargs == 2 && printfonly != 1) {
  732.             print = makeexpr_unsprintfify(print);
  733.             done = 1;
  734.             if (isvar(fex, mp_output)) {
  735.                 if (i == 1) {
  736.                     print = makeexpr_bicall_1("putchar", tp_int,
  737.                                               makeexpr_charcast(print));
  738.                 } else {
  739.                     if (printfonly == 0) {
  740.                         if (print->val.s[print->val.i-1] == 'n') {
  741.     print->val.s[--(print->val.i)] = 0;
  742.                             print = makeexpr_bicall_1("puts", tp_int, print);
  743.                         } else {
  744.                             print = makeexpr_bicall_2("fputs", tp_int,
  745.                                                       print,
  746.                                                       copyexpr(fex));
  747.                         }
  748.                     } else {
  749.                         print = makeexpr_sprintfify(print);
  750.                         done = 0;
  751.                     }
  752.                 }
  753.             } else {
  754.                 if (i == 1) {
  755.                     print = makeexpr_bicall_2("putc", tp_int,
  756.                                               makeexpr_charcast(print),
  757.                                               copyexpr(fex));
  758.                 } else if (printfonly == 0) {
  759.                     print = makeexpr_bicall_2("fputs", tp_int,
  760.                                               print,
  761.                                               copyexpr(fex));
  762.                 } else {
  763.                     print = makeexpr_sprintfify(print);
  764.                     done = 0;
  765.                 }
  766.             }
  767.         } else
  768.             done = 0;
  769.         if (!done) {
  770.             canceltempvar(istempvar(print->args[0]));
  771.             if (checkstring(print->args[1], "%s") && printfonly != 1) {
  772.                 print = makeexpr_bicall_2("fputs", tp_int,
  773.                                           grabarg(print, 2),
  774.                                           copyexpr(fex));
  775.             } else if (checkstring(print->args[1], "%c") && printfonly != 1 &&
  776.                        !nosideeffects(print->args[2], 0)) {
  777.                 print = makeexpr_bicall_2("fputc", tp_int,
  778.                                           grabarg(print, 2),
  779.                                           copyexpr(fex));
  780.             } else if (isvar(fex, mp_output)) {
  781.                 if (checkstring(print->args[1], "%sn") && printfonly != 1) {
  782.                     print = makeexpr_bicall_1("puts", tp_int, grabarg(print, 2));
  783.                 } else if (checkstring(print->args[1], "%c") && printfonly != 1) {
  784.                     print = makeexpr_bicall_1("putchar", tp_int, grabarg(print, 2));
  785.                 } else {
  786.                     strchange(&print->val.s, "printf");
  787.                     delfreearg(&print, 0);
  788.                     print->val.type = tp_int;
  789.                 }
  790.             } else {
  791.                 if (checkstring(print->args[1], "%c") && printfonly != 1) {
  792.                     print = makeexpr_bicall_2("putc", tp_int,
  793.                                               grabarg(print, 2),
  794.                                               copyexpr(fex));
  795.                 } else {
  796.                     strchange(&print->val.s, "fprintf");
  797.                     freeexpr(print->args[0]);
  798.                     print->args[0] = copyexpr(fex);
  799.                     print->val.type = tp_int;
  800.                 }
  801.             }
  802.         }
  803.         if (FCheck(checkfilewrite)) {
  804.             print = makeexpr_bicall_2("~SETIO", tp_void,
  805.                                       makeexpr_rel(EK_GE, print, makeexpr_long(0)),
  806.       makeexpr_name(filewriteerrorname, tp_int));
  807.         }
  808.     }
  809.     return makestmt_call(print);
  810. }
  814. Static Stmt *handlewrite_bin(fex, ex)
  815. Expr *fex, *ex;
  816. {
  817.     Type *basetype;
  818.     Stmt *sp;
  819.     Expr *tvardef = NULL;
  820.     Meaning *tvar = NULL;
  822.     sp = NULL;
  823.     basetype = fex->val.type->basetype->basetype;
  824.     for (;;) {
  825.         if (!expr_has_address(ex) || ex->val.type != basetype) {
  826.             if (!tvar)
  827.                 tvar = makestmttempvar(basetype, name_TEMP);
  828.             if (!tvardef || !exprsame(tvardef, ex, 1)) {
  829.                 freeexpr(tvardef);
  830.                 tvardef = copyexpr(ex);
  831.                 sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(tvar),
  832.                                                       ex));
  833.             } else
  834.                 freeexpr(ex);
  835.             ex = makeexpr_var(tvar);
  836.         }
  837.         ex = makeexpr_bicall_4("fwrite", tp_integer, makeexpr_addr(ex),
  838.                                                      makeexpr_sizeof(makeexpr_type(basetype), 0),
  839.                                                      makeexpr_long(1),
  840.                                                      copyexpr(fex));
  841.         if (FCheck(checkfilewrite)) {
  842.             ex = makeexpr_bicall_2("~SETIO", tp_void,
  843.                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
  844.    makeexpr_name(filewriteerrorname, tp_int));
  845.         }
  846.         sp = makestmt_seq(sp, makestmt_call(ex));
  847.         if (curtok == TOK_COMMA) {
  848.             gettok();
  849.             ex = p_expr(NULL);
  850.         } else
  851.             break;
  852.     }
  853.     freeexpr(tvardef);
  854.     return sp;
  855. }
  859. Static Stmt *proc_write()
  860. {
  861.     Expr *fex, *ex;
  862.     Stmt *sp;
  864.     if (!skipopenparen())
  865. return NULL;
  866.     ex = p_expr(NULL);
  867.     if (isfiletype(ex->val.type) && wneedtok(TOK_COMMA)) {
  868.         fex = ex;
  869.         ex = p_expr(NULL);
  870.     } else {
  871.         fex = makeexpr_var(mp_output);
  872.     }
  873.     if (fex->val.type == tp_text)
  874.         sp = handlewrite_text(fex, ex, 0);
  875.     else
  876.         sp = handlewrite_bin(fex, ex);
  877.     skipcloseparen();
  878.     return wrapopencheck(sp, fex);
  879. }
  883. Static Stmt *handle_modula_write(fmt)
  884. char *fmt;
  885. {
  886.     Expr *ex, *wid;
  888.     if (!skipopenparen())
  889. return NULL;
  890.     ex = makeexpr_forcelongness(p_expr(NULL));
  891.     if (skipcomma())
  892. wid = p_expr(tp_integer);
  893.     else
  894. wid = makeexpr_long(1);
  895.     if (checkconst(wid, 0) || checkconst(wid, 1))
  896. ex = makeexpr_bicall_2("printf", tp_str255,
  897.        makeexpr_string(format_ss("%%%s%s",
  898.  (exprlongness(ex) > 0) ? "l" : "",
  899.  fmt)),
  900.        ex);
  901.     else
  902. ex = makeexpr_bicall_3("printf", tp_str255,
  903.        makeexpr_string(format_ss("%%*%s%s",
  904.  (exprlongness(ex) > 0) ? "l" : "",
  905.  fmt)),
  906.        makeexpr_arglong(wid, 0),
  907.        ex);
  908.     skipcloseparen();
  909.     return makestmt_call(ex);
  910. }
  913. Static Stmt *proc_writecard()
  914. {
  915.     return handle_modula_write("u");
  916. }
  919. Static Stmt *proc_writeint()
  920. {
  921.     return handle_modula_write("d");
  922. }
  925. Static Stmt *proc_writehex()
  926. {
  927.     return handle_modula_write("x");
  928. }
  931. Static Stmt *proc_writeoct()
  932. {
  933.     return handle_modula_write("o");
  934. }
  937. Static Stmt *proc_writereal()
  938. {
  939.     return handle_modula_write("f");
  940. }
  944. Static Stmt *proc_writedir()
  945. {
  946.     Expr *fex, *ex;
  947.     Stmt *sp;
  949.     if (!skipopenparen())
  950. return NULL;
  951.     fex = p_expr(tp_text);
  952.     if (!skipcomma())
  953. return NULL;
  954.     ex = p_expr(tp_integer);
  955.     sp = doseek(fex, ex);
  956.     if (!skipcomma())
  957. return sp;
  958.     sp = makestmt_seq(sp, handlewrite_bin(fex, p_expr(NULL)));
  959.     skipcloseparen();
  960.     return wrapopencheck(sp, fex);
  961. }
  965. Static Stmt *handlewriteln(iswriteln)
  966. int iswriteln;
  967. {
  968.     Expr *fex, *ex;
  969.     Stmt *sp;
  970.     Meaning *deffile = mp_output;
  972.     sp = NULL;
  973.     if (iswriteln == 3) {
  974. iswriteln = 1;
  975. if (messagestderr)
  976.     deffile = mp_stderr;
  977.     }
  978.     if (curtok != TOK_LPAR) {
  979.         fex = makeexpr_var(deffile);
  980.         if (iswriteln)
  981.             sp = handlewrite_text(fex, makeexpr_string(""), -iswriteln);
  982.     } else {
  983.         gettok();
  984.         ex = p_expr(NULL);
  985.         if (isfiletype(ex->val.type)) {
  986.             fex = ex;
  987.             if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
  988.                 if (iswriteln)
  989.                     ex = makeexpr_string("");
  990.                 else
  991.                     ex = NULL;
  992.             } else {
  993.                 ex = p_expr(NULL);
  994.             }
  995.         } else {
  996.             fex = makeexpr_var(deffile);
  997.         }
  998.         if (ex)
  999.             sp = handlewrite_text(fex, ex, iswriteln);
  1000.         skipcloseparen();
  1001.     }
  1002.     if (iswriteln == 0) {
  1003.         sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_1("fflush", tp_void,
  1004.                                                               copyexpr(fex))));
  1005.     }
  1006.     return wrapopencheck(sp, fex);
  1007. }
  1011. Static Stmt *proc_overprint()
  1012. {
  1013.     return handlewriteln(2);
  1014. }
  1018. Static Stmt *proc_prompt()
  1019. {
  1020.     return handlewriteln(0);
  1021. }
  1025. Static Stmt *proc_writeln()
  1026. {
  1027.     return handlewriteln(1);
  1028. }
  1031. Static Stmt *proc_message()
  1032. {
  1033.     return handlewriteln(3);
  1034. }
  1038. Static Stmt *proc_writev()
  1039. {
  1040.     Expr *vex, *ex;
  1041.     Stmt *sp;
  1042.     Meaning *mp;
  1044.     if (!skipopenparen())
  1045. return NULL;
  1046.     vex = p_expr(tp_str255);
  1047.     if (curtok == TOK_RPAR) {
  1048. gettok();
  1049. return makestmt_assign(vex, makeexpr_string(""));
  1050.     }
  1051.     if (!skipcomma())
  1052. return NULL;
  1053.     sp = handlewrite_text(vex, p_expr(NULL), 0);
  1054.     skipcloseparen();
  1055.     ex = sp->exp1;
  1056.     if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
  1057.         (mp = istempvar(ex->args[0])) != NULL) {
  1058.         canceltempvar(mp);
  1059.         ex->args[0] = vex;
  1060.     } else
  1061.         sp->exp1 = makeexpr_assign(vex, ex);
  1062.     return sp;
  1063. }
  1066. Static Stmt *proc_strwrite(mp_x, spbase)
  1067. Meaning *mp_x;
  1068. Stmt *spbase;
  1069. {
  1070.     Expr *vex, *exi, *exj, *ex;
  1071.     Stmt *sp;
  1072.     Meaning *mp;
  1074.     if (!skipopenparen())
  1075. return NULL;
  1076.     vex = p_expr(tp_str255);
  1077.     if (!skipcomma())
  1078. return NULL;
  1079.     exi = p_expr(tp_integer);
  1080.     if (!skipcomma())
  1081. return NULL;
  1082.     exj = p_expr(tp_integer);
  1083.     if (!skipcomma())
  1084. return NULL;
  1085.     sp = handlewrite_text(vex, p_expr(NULL), 0);
  1086.     skipcloseparen();
  1087.     ex = sp->exp1;
  1088.     FREE(sp);
  1089.     if (checkconst(exi, 1)) {
  1090.         sp = spbase;
  1091.         while (sp && sp->next)
  1092.             sp = sp->next;
  1093.         if (sp && sp->kind == SK_ASSIGN && sp->exp1->kind == EK_ASSIGN &&
  1094.              (sp->exp1->args[0]->kind == EK_HAT ||
  1095.               sp->exp1->args[0]->kind == EK_INDEX) &&
  1096.              exprsame(sp->exp1->args[0]->args[0], vex, 1) &&
  1097.              checkconst(sp->exp1->args[1], 0)) {
  1098.             nukestmt(sp);     /* remove preceding bogus setstrlen */
  1099.         }
  1100.     }
  1101.     if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
  1102.         (mp = istempvar(ex->args[0])) != NULL) {
  1103.         canceltempvar(mp);
  1104.         ex->args[0] = bumpstring(copyexpr(vex), exi, 1);
  1105.         sp = makestmt_call(ex);
  1106.     } else
  1107.         sp = makestmt_assign(bumpstring(copyexpr(vex), exi, 1), ex);
  1108.     if (fullstrwrite != 0) {
  1109.         sp = makestmt_seq(sp, makestmt_assign(exj,
  1110.                                               makeexpr_plus(makeexpr_bicall_1("strlen", tp_int, vex),
  1111.                                                             makeexpr_long(1))));
  1112.         if (fullstrwrite == 1)
  1113.             note("FullStrWrite=1 not yet supported [204]");
  1114.         if (fullstrwrite == 2)
  1115.             note("STRWRITE was used [205]");
  1116.     } else {
  1117.         freeexpr(vex);
  1118.     }
  1119.     return mixassignments(sp, NULL);
  1120. }
  1124. Static Stmt *proc_str_turbo()
  1125. {
  1126.     Expr *ex, *wid, *prec;
  1128.     if (!skipopenparen())
  1129. return NULL;
  1130.     ex = p_expr(NULL);
  1131.     wid = NULL;
  1132.     prec = NULL;
  1133.     if (curtok == TOK_COLON) {
  1134.         gettok();
  1135.         wid = p_expr(tp_integer);
  1136.         if (curtok == TOK_COLON) {
  1137.             gettok();
  1138.             prec = p_expr(tp_integer);
  1139.         }
  1140.     }
  1141.     ex = writeelement(ex, wid, prec, 10);
  1142.     if (!skipcomma())
  1143. return NULL;
  1144.     wid = p_expr(tp_str255);
  1145.     skipcloseparen();
  1146.     return makestmt_assign(wid, ex);
  1147. }
  1151. Static Expr *func_xor()
  1152. {
  1153.     Expr *ex, *ex2;
  1154.     Type *type;
  1155.     Meaning *tvar;
  1157.     if (!skipopenparen())
  1158. return NULL;
  1159.     ex = p_expr(NULL);
  1160.     if (!skipcomma())
  1161. return ex;
  1162.     ex2 = p_expr(ex->val.type);
  1163.     skipcloseparen();
  1164.     if (ex->val.type->kind != TK_SET &&
  1165. ex->val.type->kind != TK_SMALLSET) {
  1166. ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
  1167.     } else {
  1168. type = mixsets(&ex, &ex2);
  1169. tvar = makestmttempvar(type, name_SET);
  1170. ex = makeexpr_bicall_3(setxorname, type,
  1171.        makeexpr_var(tvar),
  1172.        ex, ex2);
  1173.     }
  1174.     return ex;
  1175. }
  1183. void decl_builtins()
  1184. {
  1185.     makespecialfunc( "ABS",           func_abs);
  1186.     makespecialfunc( "ADDR",          func_addr);
  1187.     if (!modula2)
  1188. makespecialfunc( "ADDRESS",   func_addr);
  1189.     makespecialfunc( "ADDTOPOINTER",  func_addtopointer);
  1190.     makespecialfunc( "ADR",           func_addr);
  1191.     makespecialfunc( "ASL",       func_lsl);
  1192.     makespecialfunc( "ASR",       func_asr);
  1193.     makespecialfunc( "BADDRESS",      func_iaddress);
  1194.     makespecialfunc( "BAND",       func_uand);
  1195.     makespecialfunc( "BIN",           func_bin);
  1196.     makespecialfunc( "BITNEXT",       func_bitnext);
  1197.     makespecialfunc( "BITSIZE",       func_bitsize);
  1198.     makespecialfunc( "BITSIZEOF",     func_bitsize);
  1199. mp_blockread_ucsd =
  1200.     makespecialfunc( "BLOCKREAD",     func_blockread);
  1201. mp_blockwrite_ucsd =
  1202.     makespecialfunc( "BLOCKWRITE",    func_blockwrite);
  1203.     makespecialfunc( "BNOT",       func_unot);
  1204.     makespecialfunc( "BOR",       func_uor);
  1205.     makespecialfunc( "BSL",       func_bsl);
  1206.     makespecialfunc( "BSR",       func_bsr);
  1207.     makespecialfunc( "BTST",       func_btst);
  1208.     makespecialfunc( "BXOR",       func_uxor);
  1209.     makespecialfunc( "BYTEREAD",      func_byteread);
  1210.     makespecialfunc( "BYTEWRITE",     func_bytewrite);
  1211.     makespecialfunc( "BYTE_OFFSET",   func_byte_offset);
  1212.     makespecialfunc( "CHR",           func_chr);         
  1213.     makespecialfunc( "CONCAT",        func_concat);
  1214.     makespecialfunc( "DBLE",          func_float);
  1215. mp_dec_dec =
  1216.     makespecialfunc( "DEC",           func_dec);
  1217.     makespecialfunc( "EOF",           func_eof);
  1218.     makespecialfunc( "EOLN",          func_eoln);
  1219.     makespecialfunc( "FCALL",         func_fcall);
  1220.     makespecialfunc( "FILEPOS",       func_filepos);
  1221.     makespecialfunc( "FILESIZE",      func_filesize);
  1222.     makespecialfunc( "FLOAT",       func_float);
  1223.     makespecialfunc( "HEX",           func_hex);         
  1224.     makespecialfunc( "HI",            func_hi);
  1225.     makespecialfunc( "HIWORD",        func_hiword);
  1226.     makespecialfunc( "HIWRD",         func_hiword);
  1227.     makespecialfunc( "HIGH",          func_high);
  1228.     makespecialfunc( "IADDRESS",      func_iaddress);
  1229.     makespecialfunc( "INT",           func_int);         
  1230.     makespecialfunc( "LAND",       func_uand);
  1231.     makespecialfunc( "LNOT",       func_unot);
  1232.     makespecialfunc( "LO",            func_lo);
  1233.     makespecialfunc( "LOOPHOLE",      func_loophole);
  1234.     makespecialfunc( "LOR",       func_uor);
  1235.     makespecialfunc( "LOWER",       func_lower);
  1236.     makespecialfunc( "LOWORD",        func_loword);
  1237.     makespecialfunc( "LOWRD",         func_loword);
  1238.     makespecialfunc( "LSL",       func_lsl);
  1239.     makespecialfunc( "LSR",       func_lsr);
  1240.     makespecialfunc( "MAX",       func_max);
  1241.     makespecialfunc( "MAXPOS",        func_maxpos);
  1242.     makespecialfunc( "MIN",       func_min);
  1243.     makespecialfunc( "NEXT",          func_sizeof);
  1244.     makespecialfunc( "OCT",           func_oct);
  1245.     makespecialfunc( "ORD",           func_ord);
  1246.     makespecialfunc( "ORD4",          func_ord4);
  1247.     makespecialfunc( "PI",       func_pi);
  1248.     makespecialfunc( "POSITION",      func_position);
  1249.     makespecialfunc( "PRED",          func_pred);
  1250.     makespecialfunc( "QUAD",          func_float);
  1251.     makespecialfunc( "RANDOM",        func_random);
  1252.     makespecialfunc( "REF",       func_addr);
  1253.     makespecialfunc( "SCAN",       func_scan);
  1254.     makespecialfunc( "SEEKEOF",       func_seekeof);
  1255.     makespecialfunc( "SEEKEOLN",      func_seekeoln);
  1256.     makespecialfunc( "SIZE",          func_sizeof);
  1257.     makespecialfunc( "SIZEOF",        func_sizeof);
  1258.     makespecialfunc( "SNGL",          func_sngl);
  1259.     makespecialfunc( "SQR",           func_sqr);
  1260.     makespecialfunc( "STATUSV",       func_statusv);
  1261.     makespecialfunc( "SUCC",          func_succ);
  1262.     makespecialfunc( "TSIZE",         func_sizeof);
  1263.     makespecialfunc( "UAND",       func_uand);
  1264.     makespecialfunc( "UDEC",          func_udec);
  1265.     makespecialfunc( "UINT",          func_uint);         
  1266.     makespecialfunc( "UNOT",       func_unot);
  1267.     makespecialfunc( "UOR",       func_uor);
  1268.     makespecialfunc( "UPPER",       func_upper);
  1269.     makespecialfunc( "UXOR",       func_uxor);
  1270. mp_val_modula =
  1271.     makespecialfunc( "VAL",       func_val_modula);
  1272.     makespecialfunc( "WADDRESS",      func_iaddress);
  1273.     makespecialfunc( "XOR",       func_xor);
  1275.     makestandardfunc("ARCTAN",        func_arctan);
  1276.     makestandardfunc("ARCTANH",       func_arctanh);
  1277.     makestandardfunc("BINARY",        func_binary);      
  1278.     makestandardfunc("CAP",           func_upcase);
  1279.     makestandardfunc("COPY",          func_copy);        
  1280.     makestandardfunc("COS",           func_cos);         
  1281.     makestandardfunc("COSH",          func_cosh);         
  1282.     makestandardfunc("EXP",           func_exp);         
  1283.     makestandardfunc("EXP10",         func_pwroften);
  1284.     makestandardfunc("EXPO",          func_expo);         
  1285.     makestandardfunc("FRAC",          func_frac);        
  1286.     makestandardfunc("INDEX",         func_strpos);      
  1287.     makestandardfunc("LASTPOS",       NULL);             
  1288.     makestandardfunc("LINEPOS",       NULL);             
  1289.     makestandardfunc("LENGTH",        func_strlen);      
  1290.     makestandardfunc("LN",            func_ln);          
  1291.     makestandardfunc("LOG",           func_log);
  1292.     makestandardfunc("LOG10",         func_log);
  1293.     makestandardfunc("MAXAVAIL",      func_maxavail);
  1294.     makestandardfunc("MEMAVAIL",      func_memavail);
  1295.     makestandardfunc("OCTAL",         func_octal);       
  1296.     makestandardfunc("ODD",           func_odd);         
  1297.     makestandardfunc("PAD",           func_pad);
  1298.     makestandardfunc("PARAMCOUNT",    func_paramcount);
  1299.     makestandardfunc("PARAMSTR",      func_paramstr);    
  1300.     makestandardfunc("POS",           func_pos);         
  1301.     makestandardfunc("PTR",           func_ptr);
  1302.     makestandardfunc("PWROFTEN",      func_pwroften);
  1303.     makestandardfunc("ROUND",         func_round);       
  1304.     makestandardfunc("SCANEQ",        func_scaneq);
  1305.     makestandardfunc("SCANNE",        func_scanne);
  1306.     makestandardfunc("SIN",           func_sin);         
  1307.     makestandardfunc("SINH",          func_sinh);         
  1308.     makestandardfunc("SQRT",          func_sqrt);        
  1309. mp_str_hp =
  1310.     makestandardfunc("STR",           func_str_hp);
  1311.     makestandardfunc("STRLEN",        func_strlen);      
  1312.     makestandardfunc("STRLTRIM",      func_strltrim);    
  1313.     makestandardfunc("STRMAX",        func_strmax);      
  1314.     makestandardfunc("STRPOS",        func_strpos);      
  1315.     makestandardfunc("STRRPT",        func_strrpt);      
  1316.     makestandardfunc("STRRTRIM",      func_strrtrim);    
  1317.     makestandardfunc("SUBSTR",        func_str_hp);
  1318.     makestandardfunc("SWAP",          func_swap);        
  1319.     makestandardfunc("TAN",           func_tan);       
  1320.     makestandardfunc("TANH",          func_tanh);       
  1321.     makestandardfunc("TRUNC",         func_trunc);       
  1322.     makestandardfunc("UPCASE",        func_upcase);      
  1323.     makestandardfunc("UROUND",        func_uround);
  1324.     makestandardfunc("UTRUNC",        func_utrunc);
  1326.     makespecialproc( "APPEND",        proc_append);
  1327.     makespecialproc( "ARGV",       proc_argv);
  1328.     makespecialproc( "ASSERT",        proc_assert);
  1329.     makespecialproc( "ASSIGN",        proc_assign);
  1330.     makespecialproc( "BCLR",       proc_bclr);
  1331. mp_blockread_turbo =
  1332.     makespecialproc( "BLOCKREAD_TURBO", proc_blockread);
  1333. mp_blockwrite_turbo =
  1334.     makespecialproc( "BLOCKWRITE_TURBO", proc_blockwrite);
  1335.     makespecialproc( "BREAK",         proc_flush);
  1336.     makespecialproc( "BSET",       proc_bset);
  1337.     makespecialproc( "CALL",          proc_call);
  1338.     makespecialproc( "CLOSE",         proc_close);
  1339.     makespecialproc( "CONNECT",       proc_assign);
  1340.     makespecialproc( "CYCLE",       proc_cycle);
  1341. mp_dec_turbo =
  1342.     makespecialproc( "DEC_TURBO",     proc_dec);
  1343.     makespecialproc( "DISPOSE",       proc_dispose);
  1344.     makespecialproc( "ESCAPE",        proc_escape);
  1345.     makespecialproc( "EXCL",          proc_excl);
  1346.     makespecialproc( "EXIT",          proc_exit);
  1347.     makespecialproc( "FILLCHAR",      proc_fillchar);
  1348.     makespecialproc( "FLUSH",         proc_flush);
  1349.     makespecialproc( "GET",           proc_get);
  1350.     makespecialproc( "HALT",          proc_escape);
  1351.     makespecialproc( "INC",           proc_inc);
  1352.     makespecialproc( "INCL",          proc_incl);
  1353.     makespecialproc( "LEAVE",       proc_leave);
  1354.     makespecialproc( "LOCATE",        proc_seek);
  1355.     makespecialproc( "MESSAGE",       proc_message);
  1356.     makespecialproc( "MOVE_FAST",     proc_move_fast);        
  1357.     makespecialproc( "MOVE_L_TO_R",   proc_move_fast);        
  1358.     makespecialproc( "MOVE_R_TO_L",   proc_move_fast);        
  1359.     makespecialproc( "NEW",           proc_new);
  1360.     if (which_lang != LANG_VAX)
  1361. makespecialproc( "OPEN",      proc_open);
  1362.     makespecialproc( "OVERPRINT",     proc_overprint);
  1363.     makespecialproc( "PACK",          NULL);
  1364.     makespecialproc( "PAGE",          proc_page);
  1365.     makespecialproc( "PUT",           proc_put);
  1366.     makespecialproc( "PROMPT",        proc_prompt);
  1367.     makespecialproc( "RANDOMIZE",     proc_randomize);
  1368.     makespecialproc( "READ",          proc_read);
  1369.     makespecialproc( "READDIR",       proc_readdir);
  1370.     makespecialproc( "READLN",        proc_readln);
  1371.     makespecialproc( "READV",         proc_readv);
  1372.     makespecialproc( "RESET",         proc_reset);
  1373.     makespecialproc( "REWRITE",       proc_rewrite);
  1374.     makespecialproc( "SEEK",          proc_seek);
  1375.     makespecialproc( "SETSTRLEN",     proc_setstrlen);
  1376.     makespecialproc( "SETTEXTBUF",    proc_settextbuf);
  1377. mp_str_turbo =
  1378.     makespecialproc( "STR_TURBO",     proc_str_turbo);
  1379.     makespecialproc( "STRAPPEND",     proc_strappend);
  1380.     makespecialproc( "STRDELETE",     proc_strdelete);
  1381.     makespecialproc( "STRINSERT",     proc_strinsert);
  1382.     makespecialproc( "STRMOVE",       proc_strmove);
  1383.     makespecialproc( "STRREAD",       proc_strread);
  1384.     makespecialproc( "STRWRITE",      proc_strwrite);
  1385.     makespecialproc( "UNPACK",        NULL);
  1386.     makespecialproc( "WRITE",         proc_write);
  1387.     makespecialproc( "WRITEDIR",      proc_writedir);
  1388.     makespecialproc( "WRITELN",       proc_writeln);
  1389.     makespecialproc( "WRITEV",        proc_writev);
  1390. mp_val_turbo =
  1391.     makespecialproc( "VAL_TURBO",     proc_val_turbo);
  1393.     makestandardproc("DELETE",        proc_delete);      
  1394.     makestandardproc("FREEMEM",       proc_freemem);     
  1395.     makestandardproc("GETMEM",        proc_getmem);
  1396.     makestandardproc("GOTOXY",        proc_gotoxy);      
  1397.     makestandardproc("INSERT",        proc_insert);      
  1398.     makestandardproc("MARK",          NULL);             
  1399.     makestandardproc("MOVE",          proc_move);        
  1400.     makestandardproc("MOVELEFT",      proc_move);        
  1401.     makestandardproc("MOVERIGHT",     proc_move);        
  1402.     makestandardproc("RELEASE",       NULL);             
  1404.     makespecialvar(  "MEM",           var_mem);
  1405.     makespecialvar(  "MEMW",          var_memw);
  1406.     makespecialvar(  "MEML",          var_meml);
  1407.     makespecialvar(  "PORT",          var_port);
  1408.     makespecialvar(  "PORTW",         var_portw);
  1410.     /* Modula-2 standard I/O procedures (case-sensitive!) */
  1411.     makespecialproc( "Read",          proc_read);
  1412.     makespecialproc( "ReadCard",      proc_read);
  1413.     makespecialproc( "ReadInt",       proc_read);
  1414.     makespecialproc( "ReadReal",      proc_read);
  1415.     makespecialproc( "ReadString",    proc_read);
  1416.     makespecialproc( "Write",         proc_write);
  1417.     makespecialproc( "WriteCard",     proc_writecard);
  1418.     makespecialproc( "WriteHex",      proc_writehex);
  1419.     makespecialproc( "WriteInt",      proc_writeint);
  1420.     makespecialproc( "WriteOct",      proc_writeoct);
  1421.     makespecialproc( "WriteLn",       proc_writeln);
  1422.     makespecialproc( "WriteReal",     proc_writereal);
  1423.     makespecialproc( "WriteString",   proc_write);
  1424. }
  1429. /* End. */