rsalz@uunet.uu.net (Rich Salz) (03/29/90)
Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu> Posting-number: Volume 21, Issue 67 Archive-name: p2c/part22 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 22 (of 32)." # Contents: src/funcs.c.2 # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:45 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'src/funcs.c.2' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/funcs.c.2'\" else echo shar: Extracting \"'src/funcs.c.2'\" \(48594 characters\) sed "s/^X//" >'src/funcs.c.2' <<'END_OF_FILE' X return makestmt_call(makeexpr_bicall_2(getname, tp_void, ex, X makeexpr_type(type->basetype->basetype))); X} X X X XStatic Stmt *proc_getmem(ex) XExpr *ex; X{ X Expr *vex, *ex2, *sz = NULL; X Stmt *sp; X X vex = makeexpr_hat(eatcasts(ex->args[0]), 0); X ex2 = ex->args[1]; X if (vex->val.type->kind == TK_POINTER) X ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM"); X if (alloczeronil) X sz = copyexpr(ex2); X ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2); X sp = makestmt_assign(copyexpr(vex), ex2); X if (malloccheck) { X sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()), X makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)), X NULL)); X } X if (sz && !isconstantexpr(sz)) { X if (alloczeronil == 2) X note("Called GETMEM with variable argument [189]"); X sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)), X sp, X makestmt_assign(vex, makeexpr_nil())); X } else X freeexpr(vex); X return sp; X} X X X XStatic Stmt *proc_gotoxy(ex) XExpr *ex; X{ X return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void, X makeexpr_arglong(ex->args[0], 0), X makeexpr_arglong(ex->args[1], 0))); X} X X X XStatic Expr *handle_vax_hex(ex, fmt, scale) XExpr *ex; Xchar *fmt; Xint scale; X{ X Expr *lex, *dex, *vex; X Meaning *tvar; X Type *tp; X long smin, smax; X int bits; X X if (!ex) { X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_integer); X } X tp = true_type(ex); X if (ord_range(tp, &smin, &smax)) X bits = typebits(smin, smax); X else X bits = 32; X if (curtok == TOK_COMMA) { X gettok(); X if (curtok != TOK_COMMA) X lex = makeexpr_arglong(p_expr(tp_integer), 0); X else X lex = NULL; X } else X lex = NULL; X if (!lex) { X if (!scale) X lex = makeexpr_long(11); X else X lex = makeexpr_long((bits+scale-1) / scale + 1); X } X if (curtok == TOK_COMMA) { X gettok(); X dex = makeexpr_arglong(p_expr(tp_integer), 0); X } else { X if (!scale) X dex = makeexpr_long(10); X else X dex = makeexpr_long((bits+scale-1) / scale); X } X if (lex->kind == EK_CONST && dex->kind == EK_CONST && X lex->val.i < dex->val.i) X lex = NULL; X skipcloseparen(); X tvar = makestmttempvar(tp_str255, name_STRING); X vex = makeexpr_var(tvar); X ex = makeexpr_forcelongness(ex); X if (exprlongness(ex) > 0) X fmt = format_s("l%s", fmt); X if (checkconst(lex, 0) || checkconst(lex, 1)) X lex = NULL; X if (checkconst(dex, 0) || checkconst(dex, 1)) X dex = NULL; X if (lex) { X if (dex) X ex = makeexpr_bicall_5("sprintf", tp_str255, vex, X makeexpr_string(format_s("%%*.*%s", fmt)), X lex, dex, ex); X else X ex = makeexpr_bicall_4("sprintf", tp_str255, vex, X makeexpr_string(format_s("%%*%s", fmt)), X lex, ex); X } else { X if (dex) X ex = makeexpr_bicall_4("sprintf", tp_str255, vex, X makeexpr_string(format_s("%%.*%s", fmt)), X dex, ex); X else X ex = makeexpr_bicall_3("sprintf", tp_str255, vex, X makeexpr_string(format_s("%%%s", fmt)), X ex); X } X return ex; X} X X X X XStatic Expr *func_hex() X{ X Expr *ex; X char *cp; X X if (!skipopenparen()) X return NULL; X ex = makeexpr_stringcast(p_expr(tp_integer)); X if ((ex->val.type->kind == TK_STRING || X ex->val.type == tp_strptr) && X curtok != TOK_COMMA) { X skipcloseparen(); X if (ex->kind == EK_CONST) { /* HP Pascal */ X cp = getstring(ex); X ex = makeexpr_long(my_strtol(cp, NULL, 16)); X insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer)); X return ex; X } else { X return makeexpr_bicall_3("strtol", tp_integer, X ex, makeexpr_nil(), makeexpr_long(16)); X } X } else { /* VAX Pascal */ X return handle_vax_hex(ex, "x", 4); X } X} X X X XStatic Expr *func_hi() X{ X Expr *ex; X X ex = force_unsigned(p_parexpr(tp_integer)); X return makeexpr_bin(EK_RSH, tp_ubyte, X ex, makeexpr_long(8)); X} X X X XStatic Expr *func_high() X{ X Expr *ex; X Type *type; X X ex = p_parexpr(tp_integer); X type = ex->val.type; X if (type->kind == TK_POINTER) X type = type->basetype; X if (type->kind == TK_ARRAY || X type->kind == TK_SMALLARRAY) { X ex = makeexpr_minus(copyexpr(type->indextype->smax), X copyexpr(type->indextype->smin)); X } else { X warning("HIGH requires an array name parameter [210]"); X ex = makeexpr_bicall_1("HIGH", tp_int, ex); X } X return ex; X} X X X XStatic Expr *func_hiword() X{ X Expr *ex; X X ex = force_unsigned(p_parexpr(tp_unsigned)); X return makeexpr_bin(EK_RSH, tp_unsigned, X ex, makeexpr_long(16)); X} X X X XStatic Stmt *proc_inc() X{ X Expr *vex, *ex; X X if (!skipopenparen()) X return NULL; X vex = p_expr(NULL); X if (curtok == TOK_COMMA) { X gettok(); X ex = p_expr(tp_integer); X } else X ex = makeexpr_long(1); X skipcloseparen(); X return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex)); X} X X X XStatic Stmt *proc_incl() X{ X Expr *vex, *ex; X X if (!skipopenparen()) X return NULL; X vex = p_expr(NULL); X if (!skipcomma()) X return NULL; X ex = p_expr(vex->val.type->indextype); X skipcloseparen(); X if (vex->val.type->kind == TK_SMALLSET) X return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type, X copyexpr(vex), X makeexpr_bin(EK_LSH, vex->val.type, X makeexpr_longcast(makeexpr_long(1), 1), X ex))); X else X return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex, X makeexpr_arglong(enum_to_int(ex), 0))); X} X X X XStatic Stmt *proc_insert(ex) XExpr *ex; X{ X return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void, X ex->args[0], X ex->args[1], X makeexpr_arglong(ex->args[2], 0))); X} X X X XStatic Expr *func_int() X{ X Expr *ex; X Meaning *tvar; X X ex = p_parexpr(tp_integer); X if (ex->val.type->kind == TK_REAL) { /* Turbo Pascal INT */ X tvar = makestmttempvar(tp_longreal, name_TEMP); X return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal, X grabarg(ex, 0), X makeexpr_addr(makeexpr_var(tvar))), X makeexpr_var(tvar)); X } else { /* VAX Pascal INT */ X return makeexpr_ord(ex); X } X} X X XStatic Expr *func_uint() X{ X Expr *ex; X X ex = p_parexpr(tp_integer); X return makeexpr_cast(ex, tp_unsigned); X} X X X XStatic Stmt *proc_leave() X{ X return makestmt(SK_BREAK); X} X X X XStatic Expr *func_lo() X{ X Expr *ex; X X ex = gentle_cast(p_parexpr(tp_integer), tp_ushort); X return makeexpr_bin(EK_BAND, tp_ubyte, X ex, makeexpr_long(255)); X} X X XStatic Expr *func_loophole() X{ X Type *type; X Expr *ex; X X if (!skipopenparen()) X return NULL; X type = p_type(NULL); X if (!skipcomma()) X return NULL; X ex = p_expr(tp_integer); X skipcloseparen(); X return pascaltypecast(type, ex); X} X X X XStatic Expr *func_lower() X{ X Expr *ex; X Value val; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_integer); X if (curtok == TOK_COMMA) { X gettok(); X val = p_constant(tp_integer); X if (!val.type || val.i != 1) X note("LOWER(v,n) not supported for n>1 [190]"); X } X skipcloseparen(); X return copyexpr(ex->val.type->indextype->smin); X} X X X XStatic Expr *func_loword() X{ X Expr *ex; X X ex = p_parexpr(tp_integer); X return makeexpr_bin(EK_BAND, tp_ushort, X ex, makeexpr_long(65535)); X} X X X XStatic Expr *func_ln(ex) XExpr *ex; X{ X return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0)); X} X X X XStatic Expr *func_log(ex) XExpr *ex; X{ X return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0)); X} X X X XStatic Expr *func_max() X{ X Type *tp; X Expr *ex, *ex2; X X if (!skipopenparen()) X return NULL; X if (curtok == TOK_IDENT && curtokmeaning && X curtokmeaning->kind == MK_TYPE) { X tp = curtokmeaning->type; X gettok(); X skipcloseparen(); X return copyexpr(tp->smax); X } X ex = p_expr(tp_integer); X while (curtok == TOK_COMMA) { X gettok(); X ex2 = p_expr(ex->val.type); X if (ex->val.type->kind == TK_REAL) { X tp = ex->val.type; X if (ex2->val.type->kind != TK_REAL) X ex2 = makeexpr_cast(ex2, tp); X } else { X tp = ex2->val.type; X if (ex->val.type->kind != TK_REAL) X ex = makeexpr_cast(ex, tp); X } X ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax", X tp, ex, ex2); X } X skipcloseparen(); X return ex; X} X X X XStatic Expr *func_maxavail(ex) XExpr *ex; X{ X freeexpr(ex); X return makeexpr_bicall_0("maxavail", tp_integer); X} X X X XStatic Expr *func_maxpos() X{ X return file_iofunc(3, seek_base); X} X X X XStatic Expr *func_memavail(ex) XExpr *ex; X{ X freeexpr(ex); X return makeexpr_bicall_0("memavail", tp_integer); X} X X X XStatic Expr *var_mem() X{ X Expr *ex, *ex2; X X if (!wneedtok(TOK_LBR)) X return makeexpr_name("MEM", tp_integer); X ex = p_expr(tp_integer); X if (curtok == TOK_COLON) { X gettok(); X ex2 = p_expr(tp_integer); X ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2); X } else { X ex = makeexpr_bicall_1("MEM", tp_ubyte, ex); X } X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X note("Reference to MEM [191]"); X return ex; X} X X X XStatic Expr *var_memw() X{ X Expr *ex, *ex2; X X if (!wneedtok(TOK_LBR)) X return makeexpr_name("MEMW", tp_integer); X ex = p_expr(tp_integer); X if (curtok == TOK_COLON) { X gettok(); X ex2 = p_expr(tp_integer); X ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2); X } else { X ex = makeexpr_bicall_1("MEMW", tp_ushort, ex); X } X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X note("Reference to MEMW [191]"); X return ex; X} X X X XStatic Expr *var_meml() X{ X Expr *ex, *ex2; X X if (!wneedtok(TOK_LBR)) X return makeexpr_name("MEML", tp_integer); X ex = p_expr(tp_integer); X if (curtok == TOK_COLON) { X gettok(); X ex2 = p_expr(tp_integer); X ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2); X } else { X ex = makeexpr_bicall_1("MEML", tp_integer, ex); X } X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X note("Reference to MEML [191]"); X return ex; X} X X X XStatic Expr *func_min() X{ X Type *tp; X Expr *ex, *ex2; X X if (!skipopenparen()) X return NULL; X if (curtok == TOK_IDENT && curtokmeaning && X curtokmeaning->kind == MK_TYPE) { X tp = curtokmeaning->type; X gettok(); X skipcloseparen(); X return copyexpr(tp->smin); X } X ex = p_expr(tp_integer); X while (curtok == TOK_COMMA) { X gettok(); X ex2 = p_expr(ex->val.type); X if (ex->val.type->kind == TK_REAL) { X tp = ex->val.type; X if (ex2->val.type->kind != TK_REAL) X ex2 = makeexpr_cast(ex2, tp); X } else { X tp = ex2->val.type; X if (ex->val.type->kind != TK_REAL) X ex = makeexpr_cast(ex, tp); X } X ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin", X tp, ex, ex2); X } X skipcloseparen(); X return ex; X} X X X XStatic Stmt *proc_move(ex) XExpr *ex; X{ X ex->args[0] = gentle_cast(ex->args[0], tp_anyptr); /* source */ X ex->args[1] = gentle_cast(ex->args[1], tp_anyptr); /* dest */ X ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]), X argbasetype(ex->args[1])), ex->args[2], "MOVE"); X return makestmt_call(makeexpr_bicall_3("memmove", tp_void, X ex->args[1], X ex->args[0], X makeexpr_arglong(ex->args[2], (size_t_long != 0)))); X} X X X XStatic Stmt *proc_move_fast() X{ X Expr *ex, *ex2, *ex3, *ex4; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X ex2 = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X ord_range_expr(ex2->val.type->indextype, &ex4, NULL); X ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4)); X if (!skipcomma()) X return NULL; X ex3 = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X ord_range_expr(ex3->val.type->indextype, &ex4, NULL); X ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4)); X skipcloseparen(); X ex = convert_size(choosetype(argbasetype(ex2), X argbasetype(ex3)), ex, "MOVE_FAST"); X return makestmt_call(makeexpr_bicall_3("memmove", tp_void, X makeexpr_addr(ex3), X makeexpr_addr(ex2), X makeexpr_arglong(ex, (size_t_long != 0)))); X} X X X XStatic Stmt *proc_new() X{ X Expr *ex, *ex2; X Stmt *sp, **spp; X Type *type; X char *name, *name2 = NULL, vbuf[1000]; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_anyptr); X type = ex->val.type; X if (type->kind == TK_POINTER) X type = type->basetype; X parse_special_variant(type, vbuf); X skipcloseparen(); X name = find_special_variant(vbuf, NULL, specialmallocs, 3); X if (!name) { X name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3); X if (!name2) { X name = find_special_variant(vbuf, NULL, specialmallocs, 1); X name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1); X if (name || !name2) X name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1); X else X name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1); X } X } X if (name) { X ex2 = makeexpr_bicall_0(name, ex->val.type); X } else if (name2) { X ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2)); X } else { X ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, X makeexpr_sizeof(makeexpr_type(type), 1)); X } X sp = makestmt_assign(copyexpr(ex), ex2); X if (malloccheck) { X sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, X copyexpr(ex), X makeexpr_nil()), X makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)), X NULL)); X } X spp = &sp->next; X while (*spp) X spp = &(*spp)->next; X if (type->kind == TK_RECORD) X initfilevars(type->fbase, &spp, makeexpr_hat(copyexpr(ex), 0)); X else if (isfiletype(type)) X sp = makestmt_seq(sp, makestmt_assign(makeexpr_hat(copyexpr(ex), 0), X makeexpr_nil())); X freeexpr(ex); X return sp; X} X X X XStatic Expr *func_oct() X{ X return handle_vax_hex(NULL, "o", 3); X} X X X XStatic Expr *func_octal(ex) XExpr *ex; X{ X char *cp; X X ex = grabarg(ex, 0); X if (ex->kind == EK_CONST) { X cp = getstring(ex); X ex = makeexpr_long(my_strtol(cp, NULL, 8)); X insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer)); X return ex; X } else { X return makeexpr_bicall_3("strtol", tp_integer, X ex, makeexpr_nil(), makeexpr_long(8)); X } X} X X X XStatic Expr *func_odd(ex) XExpr *ex; X{ X ex = makeexpr_unlongcast(grabarg(ex, 0)); X if (*oddname) X return makeexpr_bicall_1(oddname, tp_boolean, ex); X else X return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1)); X} X X X XStatic Stmt *proc_open() X{ X return handleopen(2); X} X X X XStatic Expr *func_ord() X{ X Expr *ex; X X if (wneedtok(TOK_LPAR)) { X ex = p_ord_expr(); X skipcloseparen(); X } else X ex = p_ord_expr(); X return makeexpr_ord(ex); X} X X X XStatic Expr *func_ord4() X{ X Expr *ex; X X if (wneedtok(TOK_LPAR)) { X ex = p_ord_expr(); X skipcloseparen(); X } else X ex = p_ord_expr(); X return makeexpr_longcast(makeexpr_ord(ex), 1); X} X X X XStatic Expr *func_pad(ex) XExpr *ex; X{ X if (checkconst(ex->args[1], 0) || /* "s" is null string */ X checkconst(ex->args[2], ' ')) { X return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0], X makeexpr_string("%*s"), X makeexpr_longcast(ex->args[3], 0), X makeexpr_string("")); X } X return makeexpr_bicall_4(strpadname, tp_strptr, X ex->args[0], ex->args[1], ex->args[2], X makeexpr_arglong(ex->args[3], 0)); X} X X X XStatic Stmt *proc_page() X{ X Expr *fex, *ex; X X if (curtok == TOK_LPAR) { X fex = p_parexpr(tp_text); X ex = makeexpr_bicall_2("fprintf", tp_int, X copyexpr(fex), X makeexpr_string("\f")); X } else { X fex = makeexpr_var(mp_output); X ex = makeexpr_bicall_1("printf", tp_int, X makeexpr_string("\f")); X } X if (FCheck(checkfilewrite)) { X ex = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_GE, ex, makeexpr_long(0)), X makeexpr_name(filewriteerrorname, tp_int)); X } X return wrapopencheck(makestmt_call(ex), fex); X} X X X XStatic Expr *func_paramcount(ex) XExpr *ex; X{ X freeexpr(ex); X return makeexpr_minus(makeexpr_name(name_ARGC, tp_int), X makeexpr_long(1)); X} X X X XStatic Expr *func_paramstr(ex) XExpr *ex; X{ X Expr *ex2; X X ex2 = makeexpr_index(makeexpr_name(name_ARGV, X makepointertype(tp_strptr)), X makeexpr_unlongcast(ex->args[1]), X makeexpr_long(0)); X ex2->val.type = tp_str255; X return makeexpr_bicall_3("sprintf", tp_strptr, X ex->args[0], X makeexpr_string("%s"), X ex2); X} X X X XStatic Expr *func_pi() X{ X return makeexpr_name("M_PI", tp_longreal); X} X X X XStatic Expr *var_port() X{ X Expr *ex; X X if (!wneedtok(TOK_LBR)) X return makeexpr_name("PORT", tp_integer); X ex = p_expr(tp_integer); X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X note("Reference to PORT [191]"); X return makeexpr_bicall_1("PORT", tp_ubyte, ex); X} X X X XStatic Expr *var_portw() X{ X Expr *ex; X X if (!wneedtok(TOK_LBR)) X return makeexpr_name("PORTW", tp_integer); X ex = p_expr(tp_integer); X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X note("Reference to PORTW [191]"); X return makeexpr_bicall_1("PORTW", tp_ushort, ex); X} X X X XStatic Expr *func_pos(ex) XExpr *ex; X{ X char *cp; X X cp = strposname; X if (!*cp) { X note("POS function used [192]"); X cp = "POS"; X } X return makeexpr_bicall_3(cp, tp_int, X ex->args[1], X ex->args[0], X makeexpr_long(1)); X} X X X XStatic Expr *func_ptr(ex) XExpr *ex; X{ X note("PTR function was used [193]"); X return ex; X} X X X XStatic Expr *func_position() X{ X return file_iofunc(2, seek_base); X} X X X XStatic Expr *func_pred() X{ X Expr *ex; X X if (wneedtok(TOK_LPAR)) { X ex = p_ord_expr(); X skipcloseparen(); X } else X ex = p_ord_expr(); X#if 1 X ex = makeexpr_inc(ex, makeexpr_long(-1)); X#else X ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type); X#endif X return ex; X} X X X XStatic Stmt *proc_put() X{ X Expr *ex; X Type *type; X X if (curtok == TOK_LPAR) X ex = p_parexpr(tp_text); X else X ex = makeexpr_var(mp_output); X requirefilebuffer(ex); X type = ex->val.type; X if (isfiletype(type) && *charputname && X type->basetype->basetype->kind == TK_CHAR) X return makestmt_call(makeexpr_bicall_1(charputname, tp_void, ex)); X else if (isfiletype(type) && *arrayputname && X type->basetype->basetype->kind == TK_ARRAY) X return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void, ex, X makeexpr_type(type->basetype->basetype))); X else X return makestmt_call(makeexpr_bicall_2(putname, tp_void, ex, X makeexpr_type(type->basetype->basetype))); X} X X X XStatic Expr *func_pwroften(ex) XExpr *ex; X{ X return makeexpr_bicall_2("pow", tp_longreal, X makeexpr_real("10.0"), grabarg(ex, 0)); X} X X X XStatic Stmt *proc_reset() X{ X return handleopen(0); X} X X X XStatic Stmt *proc_rewrite() X{ X return handleopen(1); X} X X X X XStmt *doseek(fex, ex) XExpr *fex, *ex; X{ X Expr *ex2; X Type *basetype = fex->val.type->basetype->basetype; X X if (ansiC == 1) X ex2 = makeexpr_name("SEEK_SET", tp_int); X else X ex2 = makeexpr_long(0); X ex = makeexpr_bicall_3("fseek", tp_int, X copyexpr(fex), X makeexpr_arglong( X makeexpr_times(makeexpr_minus(ex, X makeexpr_long(seek_base)), X makeexpr_sizeof(makeexpr_type(basetype), 0)), X 1), X ex2); X if (FCheck(checkfileseek)) { X ex = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_EQ, ex, makeexpr_long(0)), X makeexpr_name(endoffilename, tp_int)); X } X return makestmt_call(ex); X} X X X X XStatic Expr *makegetchar(fex) XExpr *fex; X{ X if (isvar(fex, mp_input)) X return makeexpr_bicall_0("getchar", tp_char); X else X return makeexpr_bicall_1("getc", tp_char, copyexpr(fex)); X} X X X XStatic Stmt *fixscanf(sp, fex) XStmt *sp; XExpr *fex; X{ X int nargs, i, isstrread; X char *cp; X Expr *ex; X Stmt *sp2; X X isstrread = (fex->val.type->kind == TK_STRING); X if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL && X !strcmp(sp->exp1->val.s, "scanf")) { X if (sp->exp1->args[0]->kind == EK_CONST && X !(sp->exp1->args[0]->val.i&1) && !isstrread) { X cp = sp->exp1->args[0]->val.s; /* scanf("%c%c") -> getchar;getchar */ X for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) { X i += 2; X if (i == sp->exp1->args[0]->val.i) { X sp2 = NULL; X for (i = 1; i < sp->exp1->nargs; i++) { X ex = makeexpr_hat(sp->exp1->args[i], 0); X sp2 = makestmt_seq(sp2, X makestmt_assign(copyexpr(ex), X makegetchar(fex))); X if (checkeof(fex)) { X sp2 = makestmt_seq(sp2, X makestmt_call(makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_NE, X ex, X makeexpr_name("EOF", tp_char)), X makeexpr_name(endoffilename, tp_int)))); X } else X freeexpr(ex); X } X return sp2; X } X } X } X nargs = sp->exp1->nargs - 1; X if (isstrread) { X strchange(&sp->exp1->val.s, "sscanf"); X insertarg(&sp->exp1, 0, copyexpr(fex)); X } else if (!isvar(fex, mp_input)) { X strchange(&sp->exp1->val.s, "fscanf"); X insertarg(&sp->exp1, 0, copyexpr(fex)); X } X if (FCheck(checkreadformat)) { X if (checkeof(fex) && !isstrread) X ex = makeexpr_cond(makeexpr_rel(EK_NE, X makeexpr_bicall_1("feof", tp_int, copyexpr(fex)), X makeexpr_long(0)), X makeexpr_name(endoffilename, tp_int), X makeexpr_name(badinputformatname, tp_int)); X else X ex = makeexpr_name(badinputformatname, tp_int); X sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_EQ, X sp->exp1, X makeexpr_long(nargs)), X ex); X } else if (checkeof(fex) && !isstrread) { X sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_NE, X sp->exp1, X makeexpr_name("EOF", tp_int)), X makeexpr_name(endoffilename, tp_int)); X } X } X return sp; X} X X X XStatic Expr *makefgets(vex, lex, fex) XExpr *vex, *lex, *fex; X{ X Expr *ex; X X ex = makeexpr_bicall_3("fgets", tp_strptr, X vex, X lex, X copyexpr(fex)); X if (checkeof(fex)) { X ex = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_NE, ex, makeexpr_nil()), X makeexpr_name(endoffilename, tp_int)); X } X return ex; X} X X X XStatic Stmt *skipeoln(fex) XExpr *fex; X{ X Meaning *tvar; X Expr *ex; X X if (!strcmp(readlnname, "fgets")) { X tvar = makestmttempvar(tp_str255, name_STRING); X return makestmt_call(makefgets(makeexpr_var(tvar), X makeexpr_long(stringceiling+1), X fex)); X } else if (!strcmp(readlnname, "scanf") || !*readlnname) { X if (checkeof(fex)) X ex = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_NE, X makegetchar(fex), X makeexpr_name("EOF", tp_char)), X makeexpr_name(endoffilename, tp_int)); X else X ex = makegetchar(fex); X return makestmt_seq(fixscanf( X makestmt_call(makeexpr_bicall_1("scanf", tp_int, X makeexpr_string("%*[^\n]"))), fex), X makestmt_call(ex)); X } else { X return makestmt_call(makeexpr_bicall_1(readlnname, tp_void, X copyexpr(fex))); X } X} X X X XStatic Stmt *handleread_text(fex, var, isreadln) XExpr *fex, *var; Xint isreadln; X{ X Stmt *spbase, *spafter, *sp; X Expr *ex = NULL, *exj = NULL; X Type *type; X Meaning *tvar, *tempcp, *mp; X int i, isstrread, scanfmode, readlnflag, varstring, maxstring; X int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling; X long rmin, rmax; X char *fmt; X X spbase = NULL; X spafter = NULL; X sp = NULL; X tempcp = NULL; X isstrread = (fex->val.type->kind == TK_STRING); X if (isstrread) { X exj = var; X var = p_expr(NULL); X } X scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread; X for (;;) { X readlnflag = isreadln && curtok == TOK_RPAR; X if (var->val.type->kind == TK_STRING && !isstrread) { X if (sp) X spbase = makestmt_seq(spbase, fixscanf(sp, fex)); X spbase = makestmt_seq(spbase, spafter); X varstring = (varstrings && var->kind == EK_VAR && X (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM && X mp->type == tp_strptr); X maxstring = (strmax(var) >= longstrsize && !varstring); X if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) { X spbase = makestmt_seq(spbase, X makestmt_call(makeexpr_bicall_1("gets", tp_str255, X makeexpr_addr(var)))); X isreadln = 0; X } else if (scanfmode && !varstring && X (*readlnname || !isreadln)) { X spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0), X makeexpr_char(0))); X if (maxstring && usegets) X ex = makeexpr_string("%[^\n]"); X else X ex = makeexpr_string(format_d("%%%d[^\n]", strmax(var))); X ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var)); X spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex)); X if (readlnflag && maxstring && usegets) { X spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex))); X isreadln = 0; X } X } else { X ex = makeexpr_plus(strmax_func(var), makeexpr_long(1)); X spbase = makestmt_seq(spbase, X makestmt_call(makefgets(makeexpr_addr(copyexpr(var)), X ex, X fex))); X if (!tempcp) X tempcp = makestmttempvar(tp_charptr, name_TEMP); X spbase = makestmt_seq(spbase, X makestmt_assign(makeexpr_var(tempcp), X makeexpr_bicall_2("strchr", tp_charptr, X makeexpr_addr(copyexpr(var)), X makeexpr_char('\n')))); X sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0), X makeexpr_long(0)); X if (readlnflag) X isreadln = 0; X else X sp = makestmt_seq(sp, X makestmt_call(makeexpr_bicall_2("ungetc", tp_void, X makeexpr_char('\n'), X copyexpr(fex)))); X spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE, X makeexpr_var(tempcp), X makeexpr_nil()), X sp, X NULL)); X } X sp = NULL; X spafter = NULL; X } else if (var->val.type->kind == TK_ARRAY && !isstrread) { X if (sp) X spbase = makestmt_seq(spbase, fixscanf(sp, fex)); X spbase = makestmt_seq(spbase, spafter); X ex = makeexpr_sizeof(copyexpr(var), 0); X if (readlnflag) { X spbase = makestmt_seq(spbase, X makestmt_call( X makeexpr_bicall_3("P_readlnpaoc", tp_void, X copyexpr(fex), X makeexpr_addr(var), X makeexpr_arglong(ex, 0)))); X isreadln = 0; X } else { X spbase = makestmt_seq(spbase, X makestmt_call( X makeexpr_bicall_3("P_readpaoc", tp_void, X copyexpr(fex), X makeexpr_addr(var), X makeexpr_arglong(ex, 0)))); X } X sp = NULL; X spafter = NULL; X } else { X switch (ord_type(var->val.type)->kind) { X X case TK_INTEGER: X fmt = "d"; X if (curtok == TOK_COLON) { X gettok(); X if (curtok == TOK_IDENT && X !strcicmp(curtokbuf, "HEX")) { X fmt = "x"; X } else if (curtok == TOK_IDENT && X !strcicmp(curtokbuf, "OCT")) { X fmt = "o"; X } else if (curtok == TOK_IDENT && X !strcicmp(curtokbuf, "BIN")) { X fmt = "b"; X note("Using %b for binary format in scanf [194]"); X } else X warning("Unrecognized format specified in READ [212]"); X gettok(); X } X type = findbasetype(var->val.type, 0); X if (exprlongness(var) > 0) X ex = makeexpr_string(format_s("%%l%s", fmt)); X else if (type == tp_integer || type == tp_int || X type == tp_uint || type == tp_sint) X ex = makeexpr_string(format_s("%%%s", fmt)); X else if (type == tp_sshort || type == tp_ushort) X ex = makeexpr_string(format_s("%%h%s", fmt)); X else { X tvar = makestmttempvar(tp_int, name_TEMP); X spafter = makestmt_seq(spafter, X makestmt_assign(var, X makeexpr_var(tvar))); X var = makeexpr_var(tvar); X ex = makeexpr_string(format_s("%%%s", fmt)); X } X break; X X case TK_CHAR: X ex = makeexpr_string("%c"); X if (newlinespace && !isstrread) { X spafter = makestmt_seq(spafter, X makestmt_if(makeexpr_rel(EK_EQ, X copyexpr(var), X makeexpr_char('\n')), X makestmt_assign(copyexpr(var), X makeexpr_char(' ')), X NULL)); X } X break; X X case TK_BOOLEAN: X tvar = makestmttempvar(tp_str255, name_STRING); X spafter = makestmt_seq(spafter, X makestmt_assign(var, X makeexpr_or(makeexpr_rel(EK_EQ, X makeexpr_hat(makeexpr_var(tvar), 0), X makeexpr_char('T')), X makeexpr_rel(EK_EQ, X makeexpr_hat(makeexpr_var(tvar), 0), X makeexpr_char('t'))))); X var = makeexpr_var(tvar); X ex = makeexpr_string(" %[a-zA-Z]"); X break; X X case TK_ENUM: X warning("READ on enumerated types not yet supported [213]"); X if (useenum) X ex = makeexpr_string("%d"); X else X ex = makeexpr_string("%hd"); X break; X X case TK_REAL: X ex = makeexpr_string("%lg"); X break; X X case TK_STRING: /* strread only */ X ex = makeexpr_string(format_d("%%%dc", strmax(fex))); X break; X X case TK_ARRAY: /* strread only */ X if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) { X rmin = 1; X rmax = 1; X note("Can't determine length of packed array of chars [195]"); X } X ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1)); X break; X X default: X note("Element has wrong type for WRITE statement [196]"); X ex = NULL; X break; X X } X if (ex) { X var = makeexpr_addr(var); X if (sp) { X sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0); X insertarg(&sp->exp1, sp->exp1->nargs, var); X } else { X sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var)); X } X } X } X if (curtok == TOK_COMMA) { X gettok(); X var = p_expr(NULL); X } else X break; X } X if (sp) { X if (isstrread && !FCheck(checkreadformat) && X ((i=0, checkstring(sp->exp1->args[0], "%d")) || X (i++, checkstring(sp->exp1->args[0], "%ld")) || X (i++, checkstring(sp->exp1->args[0], "%hd")) || X (i++, checkstring(sp->exp1->args[0], "%lg")))) { X if (fullstrread != 0 && exj) { X tvar = makestmttempvar(tp_strptr, name_STRING); X sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0), X (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal, X copyexpr(fex), X makeexpr_addr(makeexpr_var(tvar))) X : makeexpr_bicall_3("strtol", tp_integer, X copyexpr(fex), X makeexpr_addr(makeexpr_var(tvar)), X makeexpr_long(10))); X spafter = makestmt_seq(spafter, X makestmt_assign(copyexpr(exj), X makeexpr_minus(makeexpr_var(tvar), X makeexpr_addr(copyexpr(fex))))); X } else { X sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0), X makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi", X (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int, X copyexpr(fex))); X } X } else if (isstrread && fullstrread != 0 && exj) { X sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], X makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0); X insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj))); X } else if (isreadln && scanfmode && !FCheck(checkreadformat)) { X isreadln = 0; X sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], X makeexpr_string("%*[^\n]"), 0); X spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter); X } X spbase = makestmt_seq(spbase, fixscanf(sp, fex)); X } X spbase = makestmt_seq(spbase, spafter); X if (isreadln) X spbase = makestmt_seq(spbase, skipeoln(fex)); X return spbase; X} X X X XStatic Stmt *handleread_bin(fex, var) XExpr *fex, *var; X{ X Type *basetype; X Stmt *sp; X Expr *ex, *tvardef = NULL; X X sp = NULL; X basetype = fex->val.type->basetype->basetype; X for (;;) { X ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var), X makeexpr_sizeof(makeexpr_type(basetype), 0), X makeexpr_long(1), X copyexpr(fex)); X if (checkeof(fex)) { X ex = makeexpr_bicall_2("~SETIO", tp_void, X makeexpr_rel(EK_EQ, ex, makeexpr_long(1)), X makeexpr_name(endoffilename, tp_int)); X } X sp = makestmt_seq(sp, makestmt_call(ex)); X if (curtok == TOK_COMMA) { X gettok(); X var = p_expr(NULL); X } else X break; X } X freeexpr(tvardef); X return sp; X} X X X XStatic Stmt *proc_read() X{ X Expr *fex, *ex; X Stmt *sp; X X if (!skipopenparen()) X return NULL; X ex = p_expr(NULL); X if (isfiletype(ex->val.type) && wneedtok(TOK_COMMA)) { X fex = ex; X ex = p_expr(NULL); X } else { X fex = makeexpr_var(mp_input); X } X if (fex->val.type == tp_text) X sp = handleread_text(fex, ex, 0); X else X sp = handleread_bin(fex, ex); X skipcloseparen(); X return wrapopencheck(sp, fex); X} X X X XStatic Stmt *proc_readdir() X{ X Expr *fex, *ex; X Stmt *sp; X X if (!skipopenparen()) X return NULL; X fex = p_expr(tp_text); X if (!skipcomma()) X return NULL; X ex = p_expr(tp_integer); X sp = doseek(fex, ex); X if (!skipopenparen()) X return sp; X sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL))); X skipcloseparen(); X return wrapopencheck(sp, fex); X} X X X XStatic Stmt *proc_readln() X{ X Expr *fex, *ex; X Stmt *sp; X X if (curtok != TOK_LPAR) { X fex = makeexpr_var(mp_input); X return wrapopencheck(skipeoln(copyexpr(fex)), fex); X } else { X gettok(); X ex = p_expr(NULL); X if (isfiletype(ex->val.type)) { X fex = ex; X if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) { X skippasttotoken(TOK_RPAR, TOK_SEMI); X return wrapopencheck(skipeoln(copyexpr(fex)), fex); X } else { X ex = p_expr(NULL); X } X } else { X fex = makeexpr_var(mp_input); X } X sp = handleread_text(fex, ex, 1); X skipcloseparen(); X } X return wrapopencheck(sp, fex); X} X X X XStatic Stmt *proc_readv() X{ X Expr *vex; X Stmt *sp; X X if (!skipopenparen()) X return NULL; X vex = p_expr(tp_str255); X if (!skipcomma()) X return NULL; X sp = handleread_text(vex, NULL, 0); X skipcloseparen(); X return sp; X} X X X XStatic Stmt *proc_strread() X{ X Expr *vex, *exi, *exj, *exjj, *ex; X Stmt *sp, *sp2; X Meaning *tvar, *jvar; X X if (!skipopenparen()) X return NULL; X vex = p_expr(tp_str255); X if (vex->kind != EK_VAR) { X tvar = makestmttempvar(tp_str255, name_STRING); X sp = makestmt_assign(makeexpr_var(tvar), vex); X vex = makeexpr_var(tvar); X } else X sp = NULL; X if (!skipcomma()) X return NULL; X exi = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X exj = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) { X sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi)); X exi = copyexpr(exj); X } X if (fullstrread != 0 && X ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) { X jvar = makestmttempvar(exj->val.type, name_TEMP); X exjj = makeexpr_var(jvar); X } else { X exjj = copyexpr(exj); X jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL; X } X sp2 = handleread_text(bumpstring(copyexpr(vex), X copyexpr(exi), 1), X exjj, 0); X sp = makestmt_seq(sp, sp2); X skipcloseparen(); X if (fullstrread == 0) { X sp = makestmt_seq(sp, makestmt_assign(exj, X makeexpr_plus(makeexpr_bicall_1("strlen", tp_int, X vex), X makeexpr_long(1)))); X freeexpr(exjj); X freeexpr(exi); X } else { X sp = makestmt_seq(sp, makestmt_assign(exj, X makeexpr_plus(exjj, exi))); X if (fullstrread == 2) X note("STRREAD was used [197]"); X freeexpr(vex); X } X return mixassignments(sp, jvar); X} X X X X XStatic Expr *func_random() X{ X Expr *ex; X X if (curtok == TOK_LPAR) { X gettok(); X ex = p_expr(tp_integer); X skipcloseparen(); X return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1)); X } else { X return makeexpr_bicall_0(randrealname, tp_longreal); X } X} X X X XStatic Stmt *proc_randomize() X{ X if (*randomizename) X return makestmt_call(makeexpr_bicall_0(randomizename, tp_void)); X else X return NULL; X} X X X XStatic Expr *func_round(ex) XExpr *ex; X{ X Meaning *tvar; X X ex = grabarg(ex, 0); X if (ex->val.type->kind != TK_REAL) X return ex; X if (*roundname) { X if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) { X return makeexpr_bicall_1(roundname, tp_integer, ex); X } else { X tvar = makestmttempvar(tp_longreal, name_TEMP); X return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex), X makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar))); X } X } else { X return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal, X makeexpr_plus(ex, makeexpr_real("0.5"))), X tp_integer); X } X} X X X XStatic Expr *func_uround(ex) XExpr *ex; X{ X ex = grabarg(ex, 0); X if (ex->val.type->kind != TK_REAL) X return ex; X return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal, X makeexpr_plus(ex, makeexpr_real("0.5"))), X tp_unsigned); X} X X X XStatic Expr *func_scan() X{ X Expr *ex, *ex2, *ex3; X char *name; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_integer); X if (!skipcomma()) X return NULL; X if (curtok == TOK_EQ) X name = "P_scaneq"; X else X name = "P_scanne"; X gettok(); X ex2 = p_expr(tp_char); X if (!skipcomma()) X return NULL; X ex3 = p_expr(tp_str255); X skipcloseparen(); X return makeexpr_bicall_3(name, tp_int, X makeexpr_arglong(ex, 0), X makeexpr_charcast(ex2), ex3); X} X X X XStatic Expr *func_scaneq(ex) XExpr *ex; X{ X return makeexpr_bicall_3("P_scaneq", tp_int, X makeexpr_arglong(ex->args[0], 0), X makeexpr_charcast(ex->args[1]), X ex->args[2]); X} X X XStatic Expr *func_scanne(ex) XExpr *ex; X{ X return makeexpr_bicall_3("P_scanne", tp_int, X makeexpr_arglong(ex->args[0], 0), X makeexpr_charcast(ex->args[1]), X ex->args[2]); X} X X X XStatic Stmt *proc_seek() X{ X Expr *fex, *ex; X Stmt *sp; X X if (!skipopenparen()) X return NULL; X fex = p_expr(tp_text); X if (!skipcomma()) X return NULL; X ex = p_expr(tp_integer); X skipcloseparen(); X sp = wrapopencheck(doseek(fex, ex), copyexpr(fex)); X if (*setupbufname && isfilevar(fex)) X sp = makestmt_seq(sp, X makestmt_call( X makeexpr_bicall_2(setupbufname, tp_void, fex, X makeexpr_type(fex->val.type->basetype->basetype)))); X else X freeexpr(fex); X return sp; X} X X X XStatic Expr *func_seekeof() X{ X Expr *ex; X X if (curtok == TOK_LPAR) X ex = p_parexpr(tp_text); X else X ex = makeexpr_var(mp_input); X if (*skipspacename) X ex = makeexpr_bicall_1(skipspacename, tp_text, ex); X else X note("SEEKEOF was used [198]"); X return iofunc(ex, 0); X} X X X XStatic Expr *func_seekeoln() X{ X Expr *ex; X X if (curtok == TOK_LPAR) X ex = p_parexpr(tp_text); X else X ex = makeexpr_var(mp_input); X if (*skipspacename) X ex = makeexpr_bicall_1(skipspacename, tp_text, ex); X else X note("SEEKEOLN was used [199]"); X return iofunc(ex, 1); X} X X X XStatic Stmt *proc_setstrlen() X{ X Expr *ex, *ex2; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_str255); X if (!skipcomma()) X return NULL; X ex2 = p_expr(tp_integer); X skipcloseparen(); X return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex), X ex2); X} X X X XStatic Stmt *proc_settextbuf() X{ X Expr *fex, *bex, *sex; X X if (!skipopenparen()) X return NULL; X fex = p_expr(tp_text); X if (!skipcomma()) X return NULL; X bex = p_expr(NULL); X if (curtok == TOK_COMMA) { X gettok(); X sex = p_expr(tp_integer); X } else X sex = makeexpr_sizeof(copyexpr(bex), 0); X skipcloseparen(); X note("Make sure setvbuf() call occurs when file is open [200]"); X return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void, X fex, X makeexpr_addr(bex), X makeexpr_name("_IOFBF", tp_integer), X sex)); X} X X X XStatic Expr *func_sin(ex) XExpr *ex; X{ X return makeexpr_bicall_1("sin", tp_longreal, grabarg(ex, 0)); X} X X XStatic Expr *func_sinh(ex) XExpr *ex; X{ X return makeexpr_bicall_1("sinh", tp_longreal, grabarg(ex, 0)); X} X X X XStatic Expr *func_sizeof() X{ X Expr *ex; X Type *type; X char *name, vbuf[1000]; X int lpar; X X lpar = (curtok == TOK_LPAR); X if (lpar) X gettok(); X if (curtok == TOK_IDENT && curtokmeaning && curtokmeaning->kind == MK_TYPE) { X ex = makeexpr_type(curtokmeaning->type); X gettok(); X } else X ex = p_expr(NULL); X type = ex->val.type; X parse_special_variant(type, vbuf); X if (lpar) X skipcloseparen(); X name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1); X if (name) { X freeexpr(ex); X return pc_expr_str(name); X } else X return makeexpr_sizeof(ex, 0); X} X X X XStatic Expr *func_statusv() X{ X return makeexpr_name(name_IORESULT, tp_integer); X} X X X XStatic Expr *func_str_hp(ex) XExpr *ex; X{ X return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], X ex->args[2], ex->args[3])); X} X X X XStatic Stmt *proc_strappend() X{ X Expr *ex, *ex2; X X if (!skipopenparen()) X return NULL; X ex = p_expr(tp_str255); X if (!skipcomma()) X return NULL; END_OF_FILE if test 48594 -ne `wc -c <'src/funcs.c.2'`; then echo shar: \"'src/funcs.c.2'\" unpacked with wrong size! fi # end of 'src/funcs.c.2' fi echo shar: End of archive 22 \(of 32\). cp /dev/null ark22isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 32 archives. echo "Now see PACKNOTES and the README" rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.