Xref: utzoo comp.sources.bugs:2472 comp.lang.perl:2029 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #21 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <9099@jpl-devvax.JPL.NASA.GOV> Date: 10 Aug 90 21:27:16 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1905 System: perl version 3.0 Patch #: 21 Priority: Subject: patch #19, continued Description: See patch #19. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N #define PATCHLEVEL 21 Index: cons.c Prereq: 3.0.1.6 *** cons.c.old Thu Aug 9 05:57:04 1990 --- cons.c Thu Aug 9 05:57:09 1990 *************** *** 1,4 **** ! /* $Header: cons.c,v 3.0.1.6 90/03/27 15:35:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cons.c,v $ + * Revision 3.0.1.7 90/08/09 02:35:52 lwall + * patch19: did preliminary work toward debugging packages and evals + * patch19: Added support for linked-in C subroutines + * patch19: Numeric literals are now stored only in floating point + * patch19: Added -c switch to do compilation only + * * Revision 3.0.1.6 90/03/27 15:35:21 lwall * patch16: formats didn't work inside eval * patch16: $foo++ now optimized to ++$foo where value not required *************** *** 57,71 **** Newz(101,sub,1,SUBR); if (stab_sub(stab)) { if (dowarn) { ! line_t oldline = line; if (cmd) ! line = cmd->c_line; warn("Subroutine %s redefined",name); ! line = oldline; } ! cmd_free(stab_sub(stab)->cmd); ! afree(stab_sub(stab)->tosave); Safefree(stab_sub(stab)); } sub->filename = filename; --- 63,79 ---- Newz(101,sub,1,SUBR); if (stab_sub(stab)) { if (dowarn) { ! CMD *oldcurcmd = curcmd; if (cmd) ! curcmd = cmd; warn("Subroutine %s redefined",name); ! curcmd = oldcurcmd; } ! if (stab_sub(stab)->cmd) { ! cmd_free(stab_sub(stab)->cmd); ! afree(stab_sub(stab)->tosave); ! } Safefree(stab_sub(stab)); } sub->filename = filename; *************** *** 89,95 **** STR *str = str_nmake((double)subline); str_cat(str,"-"); ! sprintf(buf,"%ld",(long)line); str_cat(str,buf); name = str_get(subname); hstore(stab_xhash(DBsub),name,strlen(name),str,0); --- 97,103 ---- STR *str = str_nmake((double)subline); str_cat(str,"-"); ! sprintf(buf,"%ld",(long)curcmd->c_line); str_cat(str,buf); name = str_get(subname); hstore(stab_xhash(DBsub),name,strlen(name),str,0); *************** *** 99,104 **** --- 107,141 ---- return sub; } + SUBR * + make_usub(name, ix, subaddr, filename) + char *name; + int ix; + int (*subaddr)(); + char *filename; + { + register SUBR *sub; + STAB *stab = stabent(name,allstabs); + + if (!stab) /* unused function */ + return; + Newz(101,sub,1,SUBR); + if (stab_sub(stab)) { + if (dowarn) + warn("Subroutine %s redefined",name); + if (stab_sub(stab)->cmd) { + cmd_free(stab_sub(stab)->cmd); + afree(stab_sub(stab)->tosave); + } + Safefree(stab_sub(stab)); + } + sub->filename = filename; + sub->usersub = subaddr; + sub->userindex = ix; + stab_sub(stab) = sub; + return sub; + } + make_form(stab,fcmd) STAB *stab; FCMD *fcmd; *************** *** 428,433 **** --- 465,471 ---- cmd->c_line = head->c_line; cmd->c_label = head->c_label; cmd->c_file = filename; + cmd->c_pack = curpack; return append_line(cmd, cur); } *************** *** 448,459 **** if (cond) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = line; else { cmd->c_line = cmdline; cmdline = NOLINE; } cmd->c_file = filename; if (perldb) cmd = dodb(cmd); return cmd; --- 486,498 ---- if (cond) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = curcmd->c_line; else { cmd->c_line = cmdline; cmdline = NOLINE; } cmd->c_file = filename; + cmd->c_pack = curpack; if (perldb) cmd = dodb(cmd); return cmd; *************** *** 475,481 **** if (arg) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = line; else { cmd->c_line = cmdline; cmdline = NOLINE; --- 514,520 ---- if (arg) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = curcmd->c_line; else { cmd->c_line = cmdline; cmdline = NOLINE; *************** *** 506,512 **** if (arg) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = line; else { cmd->c_line = cmdline; cmdline = NOLINE; --- 545,551 ---- if (arg) cmd->c_flags |= CF_COND; if (cmdline == NOLINE) ! cmd->c_line = curcmd->c_line; else { cmd->c_line = cmdline; cmdline = NOLINE; *************** *** 701,706 **** --- 740,747 ---- arg->arg_type == O_SLT || arg->arg_type == O_SGT) { if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) { if (arg[2].arg_type == A_SINGLE) { + char *junk = str_get(arg[2].arg_ptr.arg_str); + cmd->c_stab = arg[1].arg_ptr.arg_stab; cmd->c_short = str_smake(arg[2].arg_ptr.arg_str); cmd->c_slen = cmd->c_short->str_cur+1; *************** *** 898,905 **** else (void)sprintf(tname,"next char %c",yychar); (void)sprintf(buf, "%s in file %s at line %d, %s\n", ! s,filename,line,tname); ! if (line == multi_end && multi_start < multi_end) sprintf(buf+strlen(buf), " (Might be a runaway multi-line %c%c string starting on line %d)\n", multi_open,multi_close,multi_start); --- 939,946 ---- else (void)sprintf(tname,"next char %c",yychar); (void)sprintf(buf, "%s in file %s at line %d, %s\n", ! s,filename,curcmd->c_line,tname); ! if (curcmd->c_line == multi_end && multi_start < multi_end) sprintf(buf+strlen(buf), " (Might be a runaway multi-line %c%c string starting on line %d)\n", multi_open,multi_close,multi_start); *************** *** 908,914 **** else fputs(buf,stderr); if (++error_count >= 10) ! fatal("Too many errors\n"); } void --- 949,955 ---- else fputs(buf,stderr); if (++error_count >= 10) ! fatal("%s has too many errors.\n", filename); } void *************** *** 1118,1127 **** } tofree = cmd; cmd = cmd->c_next; ! Safefree(tofree); if (cmd && cmd == head) /* reached end of while loop */ break; } } arg_free(arg) --- 1159,1170 ---- } tofree = cmd; cmd = cmd->c_next; ! if (tofree != head) /* to get Saber to shut up */ ! Safefree(tofree); if (cmd && cmd == head) /* reached end of while loop */ break; } + Safefree(head); } arg_free(arg) Index: consarg.c Prereq: 3.0.1.5 *** consarg.c.old Thu Aug 9 05:57:20 1990 --- consarg.c Thu Aug 9 05:57:22 1990 *************** *** 1,4 **** ! /* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: consarg.c,v $ + * Revision 3.0.1.6 90/08/09 02:38:51 lwall + * patch19: fixed problem with % of negative number + * * Revision 3.0.1.5 90/03/27 15:36:45 lwall * patch16: support for machines that can't cast negative floats to unsigned ints * *************** *** 60,65 **** --- 63,69 ---- arg_free(limarg); } else { + arg[3].arg_flags = 0; arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = limarg; } *************** *** 308,314 **** arg->arg_len = 1; arg[1].arg_type = A_ARYSTAB; /* $abc[123] is hoistable now */ arg[1].arg_len = i; - arg[1].arg_ptr = arg[1].arg_ptr; /* get stab pointer */ str_free(s2); } /* FALL THROUGH */ --- 312,317 ---- *************** *** 351,357 **** if (tmp2 >= 0) str_numset(str,(double)(tmp2 % tmplong)); else ! str_numset(str,(double)(tmplong - (-tmp2 % tmplong))); #else tmp2 = tmp2; #endif --- 354,360 ---- if (tmp2 >= 0) str_numset(str,(double)(tmp2 % tmplong)); else ! str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1; #else tmp2 = tmp2; #endif *************** *** 945,950 **** --- 948,954 ---- if (arg->arg_len == 0) arg[1].arg_type = A_NULL; arg->arg_len = 2; + arg[2].arg_flags = 0; arg[2].arg_ptr.arg_hash = curstash; arg[2].arg_type = A_NULL; return arg; Index: lib/ctime.pl *** ctime.pl.old Fri Aug 10 14:01:44 1990 --- ctime.pl Thu Aug 2 14:10:15 1990 *************** *** 10,16 **** ;# usage: ;# ;# #include # see the -P and -I option in perl.man ! ;# $Date = do ctime(time); @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @MoY = ('Jan','Feb','Mar','Apr','May','Jun', --- 10,16 ---- ;# usage: ;# ;# #include # see the -P and -I option in perl.man ! ;# $Date = &ctime(time); @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @MoY = ('Jan','Feb','Mar','Apr','May','Jun', Index: usub/curses.mus *** usub/curses.mus.old Thu Aug 9 06:01:46 1990 --- usub/curses.mus Thu Aug 9 06:01:47 1990 *************** *** 0 **** --- 1,673 ---- + /* $Header: curses.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $ + * + * $Log: curses.mus,v $ + * Revision 3.0.1.1 90/08/09 04:05:21 lwall + * patch19: Initial revision + * + */ + + #include "EXTERN.h" + #include "perl.h" + extern int wantarray; + + char *savestr(); + + #include + + static enum uservars { + UV_curscr, + UV_stdscr, + UV_Def_term, + UV_My_term, + UV_ttytype, + UV_LINES, + UV_COLS, + UV_ERR, + UV_OK, + }; + + static enum usersubs { + US_addch, + US_waddch, + US_addstr, + US_waddstr, + US_box, + US_clear, + US_wclear, + US_clearok, + US_clrtobot, + US_wclrtobot, + US_clrtoeol, + US_wclrtoeol, + US_delch, + US_wdelch, + US_deleteln, + US_wdeleteln, + US_erase, + US_werase, + US_flushok, + US_idlok, + US_insch, + US_winsch, + US_insertln, + US_winsertln, + US_move, + US_wmove, + US_overlay, + US_overwrite, + US_printw, + US_wprintw, + US_refresh, + US_wrefresh, + US_standout, + US_wstandout, + US_standend, + US_wstandend, + US_cbreak, + US_nocbreak, + US_echo, + US_noecho, + US_getch, + US_wgetch, + US_getstr, + US_wgetstr, + US_raw, + US_noraw, + US_scanw, + US_wscanw, + US_baudrate, + US_delwin, + US_endwin, + US_erasechar, + US_getcap, + US_getyx, + US_inch, + US_winch, + US_initscr, + US_killchar, + US_leaveok, + US_longname, + US_fullname, + US_mvwin, + US_newwin, + US_nl, + US_nonl, + US_scrollok, + US_subwin, + US_touchline, + US_touchoverlap, + US_touchwin, + US_unctrl, + US_gettmode, + US_mvcur, + US_scroll, + US_savetty, + US_resetty, + US_setterm, + US_tstp, + US__putchar, + }; + + static int usersub(); + static int userset(); + static int userval(); + + int + init_curses() + { + struct ufuncs uf; + char *filename = "curses.c"; + + uf.uf_set = userset; + uf.uf_val = userval; + + #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf) + + MAGICVAR("curscr", UV_curscr); + MAGICVAR("stdscr", UV_stdscr); + MAGICVAR("Def_term",UV_Def_term); + MAGICVAR("My_term", UV_My_term); + MAGICVAR("ttytype", UV_ttytype); + MAGICVAR("LINES", UV_LINES); + MAGICVAR("COLS", UV_COLS); + MAGICVAR("ERR", UV_ERR); + MAGICVAR("OK", UV_OK); + + make_usub("addch", US_addch, usersub, filename); + make_usub("waddch", US_waddch, usersub, filename); + make_usub("addstr", US_addstr, usersub, filename); + make_usub("waddstr", US_waddstr, usersub, filename); + make_usub("box", US_box, usersub, filename); + make_usub("clear", US_clear, usersub, filename); + make_usub("wclear", US_wclear, usersub, filename); + make_usub("clearok", US_clearok, usersub, filename); + make_usub("clrtobot", US_clrtobot, usersub, filename); + make_usub("wclrtobot", US_wclrtobot, usersub, filename); + make_usub("clrtoeol", US_clrtoeol, usersub, filename); + make_usub("wclrtoeol", US_wclrtoeol, usersub, filename); + make_usub("delch", US_delch, usersub, filename); + make_usub("wdelch", US_wdelch, usersub, filename); + make_usub("deleteln", US_deleteln, usersub, filename); + make_usub("wdeleteln", US_wdeleteln, usersub, filename); + make_usub("erase", US_erase, usersub, filename); + make_usub("werase", US_werase, usersub, filename); + make_usub("flushok", US_flushok, usersub, filename); + make_usub("idlok", US_idlok, usersub, filename); + make_usub("insch", US_insch, usersub, filename); + make_usub("winsch", US_winsch, usersub, filename); + make_usub("insertln", US_insertln, usersub, filename); + make_usub("winsertln", US_winsertln, usersub, filename); + make_usub("move", US_move, usersub, filename); + make_usub("wmove", US_wmove, usersub, filename); + make_usub("overlay", US_overlay, usersub, filename); + make_usub("overwrite", US_overwrite, usersub, filename); + make_usub("printw", US_printw, usersub, filename); + make_usub("wprintw", US_wprintw, usersub, filename); + make_usub("refresh", US_refresh, usersub, filename); + make_usub("wrefresh", US_wrefresh, usersub, filename); + make_usub("standout", US_standout, usersub, filename); + make_usub("wstandout", US_wstandout, usersub, filename); + make_usub("standend", US_standend, usersub, filename); + make_usub("wstandend", US_wstandend, usersub, filename); + make_usub("cbreak", US_cbreak, usersub, filename); + make_usub("nocbreak", US_nocbreak, usersub, filename); + make_usub("echo", US_echo, usersub, filename); + make_usub("noecho", US_noecho, usersub, filename); + make_usub("getch", US_getch, usersub, filename); + make_usub("wgetch", US_wgetch, usersub, filename); + make_usub("getstr", US_getstr, usersub, filename); + make_usub("wgetstr", US_wgetstr, usersub, filename); + make_usub("raw", US_raw, usersub, filename); + make_usub("noraw", US_noraw, usersub, filename); + make_usub("scanw", US_scanw, usersub, filename); + make_usub("wscanw", US_wscanw, usersub, filename); + make_usub("baudrate", US_baudrate, usersub, filename); + make_usub("delwin", US_delwin, usersub, filename); + make_usub("endwin", US_endwin, usersub, filename); + make_usub("erasechar", US_erasechar, usersub, filename); + make_usub("getcap", US_getcap, usersub, filename); + make_usub("getyx", US_getyx, usersub, filename); + make_usub("inch", US_inch, usersub, filename); + make_usub("winch", US_winch, usersub, filename); + make_usub("initscr", US_initscr, usersub, filename); + make_usub("killchar", US_killchar, usersub, filename); + make_usub("leaveok", US_leaveok, usersub, filename); + make_usub("longname", US_longname, usersub, filename); + make_usub("fullname", US_fullname, usersub, filename); + make_usub("mvwin", US_mvwin, usersub, filename); + make_usub("newwin", US_newwin, usersub, filename); + make_usub("nl", US_nl, usersub, filename); + make_usub("nonl", US_nonl, usersub, filename); + make_usub("scrollok", US_scrollok, usersub, filename); + make_usub("subwin", US_subwin, usersub, filename); + make_usub("touchline", US_touchline, usersub, filename); + make_usub("touchoverlap", US_touchoverlap,usersub, filename); + make_usub("touchwin", US_touchwin, usersub, filename); + make_usub("unctrl", US_unctrl, usersub, filename); + make_usub("gettmode", US_gettmode, usersub, filename); + make_usub("mvcur", US_mvcur, usersub, filename); + make_usub("scroll", US_scroll, usersub, filename); + make_usub("savetty", US_savetty, usersub, filename); + make_usub("resetty", US_resetty, usersub, filename); + make_usub("setterm", US_setterm, usersub, filename); + make_usub("tstp", US_tstp, usersub, filename); + make_usub("_putchar", US__putchar, usersub, filename); + }; + + static int + usersub(ix, sp, items) + int ix; + register int sp; + register int items; + { + STR **st = stack->ary_array + sp; + register int i; + register char *tmps; + register STR *Str; /* used in str_get and str_gnum macros */ + + switch (ix) { + CASE int addch + I char ch + END + + CASE int waddch + I WINDOW* win + I char ch + END + + CASE int addstr + I char* str + END + + CASE int waddstr + I WINDOW* win + I char* str + END + + CASE int box + I WINDOW* win + I char vert + I char hor + END + + CASE int clear + END + + CASE int wclear + I WINDOW* win + END + + CASE int clearok + I WINDOW* win + I bool boolf + END + + CASE int clrtobot + END + + CASE int wclrtobot + I WINDOW* win + END + + CASE int clrtoeol + END + + CASE int wclrtoeol + I WINDOW* win + END + + CASE int delch + END + + CASE int wdelch + I WINDOW* win + END + + CASE int deleteln + END + + CASE int wdeleteln + I WINDOW* win + END + + CASE int erase + END + + CASE int werase + I WINDOW* win + END + + CASE int flushok + I WINDOW* win + I bool boolf + END + + CASE int idlok + I WINDOW* win + I bool boolf + END + + CASE int insch + I char c + END + + CASE int winsch + I WINDOW* win + I char c + END + + CASE int insertln + END + + CASE int winsertln + I WINDOW* win + END + + CASE int move + I int y + I int x + END + + CASE int wmove + I WINDOW* win + I int y + I int x + END + + CASE int overlay + I WINDOW* win1 + I WINDOW* win2 + END + + CASE int overwrite + I WINDOW* win1 + I WINDOW* win2 + END + + case US_printw: + if (items < 1) + fatal("Usage: &printw($fmt, $arg1, $arg2, ... )"); + else { + int retval; + STR* str = str_new(0); + + do_sprintf(str, items - 1, st + 1); + retval = addstr(str->str_ptr); + str_numset(st[0], (double) retval); + str_free(str); + } + return sp; + + case US_wprintw: + if (items < 2) + fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )"); + else { + int retval; + STR* str = str_new(0); + WINDOW* win = *(WINDOW**) str_get(st[1]); + + do_sprintf(str, items - 1, st + 1); + retval = waddstr(win, str->str_ptr); + str_numset(st[0], (double) retval); + str_free(str); + } + return sp; + + CASE int refresh + END + + CASE int wrefresh + I WINDOW* win + END + + CASE int standout + END + + CASE int wstandout + I WINDOW* win + END + + CASE int standend + END + + CASE int wstandend + I WINDOW* win + END + + CASE int cbreak + END + + CASE int nocbreak + END + + CASE int echo + END + + CASE int noecho + END + + case US_getch: + if (items != 0) + fatal("Usage: &getch()"); + else { + int retval; + char retch; + + retval = getch(); + if (retval == EOF) + st[0] = &str_undef; + else { + retch = retval; + str_nset(st[0], &retch, 1); + } + } + return sp; + + case US_wgetch: + if (items != 1) + fatal("Usage: &wgetch($win)"); + else { + int retval; + char retch; + WINDOW* win = *(WINDOW**) str_get(st[1]); + + retval = wgetch(win); + if (retval == EOF) + st[0] = &str_undef; + else { + retch = retval; + str_nset(st[0], &retch, 1); + } + } + return sp; + + CASE int getstr + IO char* str + END + + CASE int wgetstr + I WINDOW* win + IO char* str + END + + CASE int raw + END + + CASE int noraw + END + + CASE int baudrate + END + + CASE int delwin + I WINDOW* win + END + + CASE int endwin + END + + CASE int erasechar + END + + CASE char* getcap + I char* str + END + + case US_getyx: + if (items != 3) + fatal("Usage: &getyx($win, $y, $x)"); + else { + int retval; + STR* str = str_new(0); + WINDOW* win = *(WINDOW**) str_get(st[1]); + int y; + int x; + + do_sprintf(str, items - 1, st + 1); + retval = getyx(win, y, x); + str_numset(st[2], (double)y); + str_numset(st[3], (double)x); + str_numset(st[0], (double) retval); + str_free(str); + } + return sp; + + + CASE int inch + END + + CASE int winch + I WINDOW* win + END + + CASE WINDOW* initscr + END + + CASE int killchar + END + + CASE int leaveok + I WINDOW* win + I bool boolf + END + + CASE char* longname + I char* termbuf + IO char* name + END + + CASE int fullname + I char* termbuf + IO char* name + END + + CASE int mvwin + I WINDOW* win + I int y + I int x + END + + CASE WINDOW* newwin + I int lines + I int cols + I int begin_y + I int begin_x + END + + CASE int nl + END + + CASE int nonl + END + + CASE int scrollok + I WINDOW* win + I bool boolf + END + + CASE WINDOW* subwin + I WINDOW* win + I int lines + I int cols + I int begin_y + I int begin_x + END + + CASE int touchline + I WINDOW* win + I int y + I int startx + I int endx + END + + CASE int touchoverlap + I WINDOW* win1 + I WINDOW* win2 + END + + CASE int touchwin + I WINDOW* win + END + + CASE char* unctrl + I char ch + END + + CASE int gettmode + END + + CASE int mvcur + I int lasty + I int lastx + I int newy + I int newx + END + + CASE int scroll + I WINDOW* win + END + + CASE int savetty + END + + CASE void resetty + END + + CASE int setterm + I char* name + END + + CASE int tstp + END + + CASE int _putchar + I char ch + END + + default: + fatal("Unimplemented user-defined subroutine"); + } + return sp; + } + + static int + userval(ix, str) + int ix; + STR *str; + { + switch (ix) { + case UV_COLS: + str_numset(str, (double)COLS); + break; + case UV_Def_term: + str_set(str, Def_term); + break; + case UV_ERR: + str_numset(str, (double)ERR); + break; + case UV_LINES: + str_numset(str, (double)LINES); + break; + case UV_My_term: + str_numset(str, (double)My_term); + break; + case UV_OK: + str_numset(str, (double)OK); + break; + case UV_curscr: + str_nset(str, &curscr, sizeof(WINDOW*)); + break; + case UV_stdscr: + str_nset(str, &stdscr, sizeof(WINDOW*)); + break; + case UV_ttytype: + str_set(str, ttytype); + break; + } + return 0; + } + + static int + userset(ix, str) + int ix; + STR *str; + { + switch (ix) { + case UV_COLS: + COLS = (int)str_gnum(str); + break; + case UV_Def_term: + Def_term = savestr(str_get(str)); /* never freed */ + break; + case UV_LINES: + LINES = (int)str_gnum(str); + break; + case UV_My_term: + My_term = (bool)str_gnum(str); + break; + case UV_ttytype: + strcpy(ttytype, str_get(str)); /* hope it fits */ + break; + } + return 0; + } Index: doarg.c Prereq: 3.0.1.5 *** doarg.c.old Thu Aug 9 05:57:30 1990 --- doarg.c Thu Aug 9 05:57:34 1990 *************** *** 1,4 **** ! /* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,20 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doarg.c,v $ + * Revision 3.0.1.6 90/08/09 02:48:38 lwall + * patch19: fixed double include of + * patch19: pack/unpack can now do native float and double + * patch19: pack/unpack can now have absolute and negative positioning + * patch19: pack/unpack can now have use * to specify all the rest of input + * patch19: unpack can do checksumming + * patch19: $< and $> better supported on machines without setreuid + * patch19: Added support for linked-in C subroutines + * * Revision 3.0.1.5 90/03/27 15:39:03 lwall * patch16: MSDOS support * patch16: support for machines that can't cast negative floats to unsigned ints *************** *** 40,46 **** --- 49,57 ---- #include "EXTERN.h" #include "perl.h" + #ifndef NSIG #include + #endif extern unsigned char fold[]; *************** *** 83,89 **** if (spat->spat_regexp) regfree(spat->spat_regexp); spat->spat_regexp = regcomp(m,m+dstr->str_cur, ! spat->spat_flags & SPAT_FOLD,1); if (spat->spat_flags & SPAT_KEEP) { arg_free(spat->spat_runtime); /* it won't change, so */ spat->spat_runtime = Nullarg; /* no point compiling again */ --- 94,100 ---- if (spat->spat_regexp) regfree(spat->spat_regexp); spat->spat_regexp = regcomp(m,m+dstr->str_cur, ! spat->spat_flags & SPAT_FOLD); if (spat->spat_flags & SPAT_KEEP) { arg_free(spat->spat_runtime); /* it won't change, so */ spat->spat_runtime = Nullarg; /* no point compiling again */ *************** *** 381,386 **** --- 392,399 ---- long along; unsigned long aulong; char *aptr; + float afloat; + double adouble; items = arglast[2] - sp; st += ++sp; *************** *** 388,394 **** while (pat < patend) { #define NEXTFROM (items-- > 0 ? *st++ : &str_no) datumtype = *pat++; ! if (isdigit(*pat)) { len = *pat++ - '0'; while (isdigit(*pat)) len = (len * 10) + (*pat++ - '0'); --- 401,411 ---- while (pat < patend) { #define NEXTFROM (items-- > 0 ? *st++ : &str_no) datumtype = *pat++; ! if (*pat == '*') { ! len = index("@Xxu",datumtype) ? 0 : items; ! pat++; ! } ! else if (isdigit(*pat)) { len = *pat++ - '0'; while (isdigit(*pat)) len = (len * 10) + (*pat++ - '0'); *************** *** 398,404 **** --- 415,439 ---- switch(datumtype) { default: break; + case '%': + fatal("% may only be used in unpack"); + case '@': + len -= str->str_cur; + if (len > 0) + goto grow; + len = -len; + if (len > 0) + goto shrink; + break; + case 'X': + shrink: + str->str_cur -= len; + if (str->str_cur < 0) + fatal("X outside of string"); + str->str_ptr[str->str_cur] = '\0'; + break; case 'x': + grow: while (len >= 10) { str_ncat(str,null10,10); len -= 10; *************** *** 409,414 **** --- 444,451 ---- case 'a': fromstr = NEXTFROM; aptr = str_get(fromstr); + if (pat[-1] == '*') + len = fromstr->str_cur; if (fromstr->str_cur > len) str_ncat(str,aptr,len); else { *************** *** 439,444 **** --- 476,498 ---- str_ncat(str,&achar,sizeof(char)); } break; + /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + case 'F': + while (len-- > 0) { + fromstr = NEXTFROM; + afloat = (float)str_gnum(fromstr); + str_ncat(str, (char *)&afloat, sizeof (float)); + } + break; + case 'd': + case 'D': + while (len-- > 0) { + fromstr = NEXTFROM; + adouble = (double)str_gnum(fromstr); + str_ncat(str, (char *)&adouble, sizeof (double)); + } + break; case 'n': while (len-- > 0) { fromstr = NEXTFROM; *************** *** 502,507 **** --- 556,582 ---- str_ncat(str,(char*)&aptr,sizeof(char*)); } break; + case 'u': + fromstr = NEXTFROM; + aptr = str_get(fromstr); + aint = fromstr->str_cur; + STR_GROW(str,aint * 4 / 3); + if (len <= 1) + len = 45; + else + len = len / 3 * 3; + while (aint > 0) { + int todo; + + if (aint > len) + todo = len; + else + todo = aint; + doencodes(str, aptr, todo); + aint -= todo; + aptr += todo; + } + break; } } STABSET(str); *************** *** 508,513 **** --- 583,610 ---- } #undef NEXTFROM + doencodes(str, s, len) + register STR *str; + register char *s; + register int len; + { + char hunk[5]; + + *hunk = len + ' '; + str_ncat(str, hunk, 1); + hunk[4] = '\0'; + while (len > 0) { + hunk[0] = ' ' + (077 & (*s >> 2)); + hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017)); + hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03)); + hunk[3] = ' ' + (077 & (s[2] & 077)); + str_ncat(str, hunk, 4); + s += 3; + len -= 3; + } + str_ncat(str, "\n", 1); + } + void do_sprintf(str,len,sarg) register STR *str; *************** *** 718,726 **** --- 815,831 ---- } if (!stab) fatal("Undefined subroutine called"); + saveint(&wantarray); + wantarray = gimme; sub = stab_sub(stab); if (!sub) fatal("Undefined subroutine \"%s\" called", stab_name(stab)); + if (sub->usersub) { + st[sp] = arg->arg_ptr.arg_str; + if ((arg[2].arg_type & A_MASK) == A_NULL) + items = 0; + return sub->usersub(sub->userindex,sp,items); + } if ((arg[2].arg_type & A_MASK) != A_NULL) { savearray = stab_xarray(defstab); stab_xarray(defstab) = afake(defstab, items, &st[sp+1]); *************** *** 727,734 **** } savelong(&sub->depth); sub->depth++; - saveint(&wantarray); - wantarray = gimme; if (sub->depth >= 2) { /* save temporaries on recursion? */ if (sub->depth == 100 && dowarn) warn("Deep recursion on subroutine \"%s\"",stab_name(stab)); --- 832,837 ---- *************** *** 783,791 **** } if (!stab) fatal("Undefined subroutine called"); ! sub = stab_sub(stab); ! if (!sub) ! fatal("Undefined subroutine \"%s\" called", stab_name(stab)); /* begin differences */ str = stab_val(DBsub); saveitem(str); --- 886,893 ---- } if (!stab) fatal("Undefined subroutine called"); ! saveint(&wantarray); ! wantarray = gimme; /* begin differences */ str = stab_val(DBsub); saveitem(str); *************** *** 800,807 **** } savelong(&sub->depth); sub->depth++; - saveint(&wantarray); - wantarray = gimme; if (sub->depth >= 2) { /* save temporaries on recursion? */ if (sub->depth == 100 && dowarn) warn("Deep recursion on subroutine \"%s\"",stab_name(stab)); --- 902,907 ---- *************** *** 938,951 **** } } if (delaymagic > 1) { #ifdef SETREUID - if (delaymagic & DM_REUID) setreuid(uid,euid); #endif #ifdef SETREGID - if (delaymagic & DM_REGID) setregid(gid,egid); #endif } delaymagic = 0; localizing = FALSE; --- 1038,1059 ---- } } if (delaymagic > 1) { + if (delaymagic & DM_REUID) { #ifdef SETREUID setreuid(uid,euid); + #else + if (uid != euid || setuid(uid) < 0) + fatal("No setreuid available"); #endif + } + if (delaymagic & DM_REGID) { #ifdef SETREGID setregid(gid,egid); + #else + if (gid != egid || setgid(gid) < 0) + fatal("No setregid available"); #endif + } } delaymagic = 0; localizing = FALSE; *************** *** 1057,1068 **** retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_HASH || type == O_LHASH) retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; - else if (type == O_SUBR || type == O_DBSUBR) - retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_ASLICE || type == O_LASLICE) retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_HSLICE || type == O_LHSLICE) retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; else retval = FALSE; str_numset(str,(double)retval); --- 1165,1176 ---- retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_HASH || type == O_LHASH) retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_ASLICE || type == O_LASLICE) retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; else if (type == O_HSLICE || type == O_LHSLICE) retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; + else if (type == O_SUBR || type == O_DBSUBR) + retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0; else retval = FALSE; str_numset(str,(double)retval); Index: doio.c Prereq: 3.0.1.8 *** doio.c.old Thu Aug 9 05:57:50 1990 --- doio.c Thu Aug 9 05:57:55 1990 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.9 90/08/09 02:56:19 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,19 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.9 90/08/09 02:56:19 lwall + * patch19: various MSDOS and OS/2 patches folded in + * patch19: prints now check error status better + * patch19: printing a list with null elements only printed front of list + * patch19: on machines with vfork child would allocate memory in parent + * patch19: getsockname and getpeername gave bogus warning on error + * patch19: MACH doesn't have seekdir or telldir + * * Revision 3.0.1.8 90/03/27 15:44:02 lwall * patch16: MSDOS support * patch16: support for machines that can't cast negative floats to unsigned ints *************** *** 68,73 **** --- 76,84 ---- #ifdef I_UTIME #include #endif + #ifdef I_FCNTL + #include + #endif bool do_open(stab,name,len) *************** *** 261,270 **** --- 272,292 ---- fileuid = statbuf.st_uid; filegid = statbuf.st_gid; if (*inplace) { + #ifdef SUFFIX + add_suffix(str,inplace); + #else str_cat(str,inplace); + #endif #ifdef RENAME + #ifndef MSDOS (void)rename(oldname,str->str_ptr); #else + do_close(stab,FALSE); + (void)unlink(str->str_ptr); + (void)rename(oldname,str->str_ptr); + do_open(stab,str->str_ptr,stab_val(stab)->str_cur); + #endif /* MSDOS */ + #else (void)UNLINK(str->str_ptr); (void)link(oldname,str->str_ptr); (void)UNLINK(oldname); *************** *** 271,277 **** --- 293,303 ---- #endif } else { + #ifndef MSDOS (void)UNLINK(oldname); + #else + fatal("Can't do inplace edit without backup"); + #endif } str_nset(str,">",1); *************** *** 510,516 **** retval = 256; /* otherwise guess at what's safe */ #endif if (argstr->str_cur < retval) { ! str_grow(argstr,retval+1); argstr->str_cur = retval; } --- 536,542 ---- retval = 256; /* otherwise guess at what's safe */ #endif if (argstr->str_cur < retval) { ! Str_Grow(argstr,retval+1); argstr->str_cur = retval; } *************** *** 632,637 **** --- 658,721 ---- } int + do_truncate(str,arg,gimme,arglast) + STR *str; + register ARG *arg; + int gimme; + int *arglast; + { + register ARRAY *ary = stack; + register int sp = arglast[0] + 1; + off_t len = (off_t)str_gnum(ary->ary_array[sp+1]); + int result = 1; + STAB *tmpstab; + + #if defined(TRUNCATE) || defined(CHSIZE) || defined(F_FREESP) + #ifdef TRUNCATE + if ((arg[1].arg_type & A_MASK) == A_WORD) { + tmpstab = arg[1].arg_ptr.arg_stab; + if (!stab_io(tmpstab) || + ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0) + result = 0; + } + else if (truncate(str_get(ary->ary_array[sp]), len) < 0) + result = 0; + #else + #ifndef CHSIZE + #define chsize(f,l) fcntl(f,F_FREESP,l) + #endif + if ((arg[1].arg_type & A_MASK) == A_WORD) { + tmpstab = arg[1].arg_ptr.arg_stab; + if (!stab_io(tmpstab) || + chsize(fileno(stab_io(tmpstab)->ifp), len) < 0) + result = 0; + } + else { + int tmpfd; + + if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0) + result = 0; + else { + if (chsize(tmpfd, len) < 0) + result = 0; + close(tmpfd); + } + } + #endif + + if (result) + str_sset(str,&str_yes); + else + str_sset(str,&str_undef); + STABSET(str); + ary->ary_array[sp] = str; + return sp; + #else + fatal("truncate not implemented"); + #endif + } + + int looks_like_number(str) STR *str; { *************** *** 687,697 **** return FALSE; } if (!str) ! return FALSE; if (ofmt && ((str->str_nok && str->str_u.str_nval != 0.0) ! || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) fprintf(fp, ofmt, str->str_u.str_nval); else { tmps = str_get(str); if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b' --- 771,783 ---- return FALSE; } if (!str) ! return TRUE; if (ofmt && ((str->str_nok && str->str_u.str_nval != 0.0) ! || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) { fprintf(fp, ofmt, str->str_u.str_nval); + return !ferror(fp); + } else { tmps = str_get(str); if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b' *************** *** 700,706 **** str = ((STAB*)str)->str_magic; putc('*',fp); } ! if (str->str_cur && fwrite(tmps,1,str->str_cur,fp) == 0) return FALSE; } return TRUE; --- 786,792 ---- str = ((STAB*)str)->str_magic; putc('*',fp); } ! if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp))) return FALSE; } return TRUE; *************** *** 731,737 **** retval = (items <= 0); for (; items > 0; items--,st++) { if (retval && ofslen) { ! if (fwrite(ofs, 1, ofslen, fp) == 0) { retval = FALSE; break; } --- 817,823 ---- retval = (items <= 0); for (; items > 0; items--,st++) { if (retval && ofslen) { ! if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) { retval = FALSE; break; } *************** *** 740,746 **** break; } if (retval && orslen) ! if (fwrite(ors, 1, orslen, fp) == 0) retval = FALSE; } return retval; --- 826,832 ---- break; } if (retval && orslen) ! if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp)) retval = FALSE; } return retval; *************** *** 898,903 **** --- 984,1005 ---- return FALSE; } + static char **Argv = Null(char **); + static char *Cmd = Nullch; + + int + do_execfree() + { + if (Argv) { + Safefree(Argv); + Argv = Null(char **); + } + if (Cmd) { + Safefree(Cmd); + Cmd = Nullch; + } + } + bool do_exec(cmd) char *cmd; *************** *** 904,912 **** { register char **a; register char *s; - char **argv; char flags[10]; - char *cmd2; #ifdef TAINT taintenv(); --- 1006,1012 ---- *************** *** 958,967 **** return FALSE; } } ! New(402,argv, (s - cmd) / 2 + 2, char*); ! cmd2 = nsavestr(cmd, s-cmd); ! a = argv; ! for (s = cmd2; *s;) { while (*s && isspace(*s)) s++; if (*s) *(a++) = s; --- 1058,1067 ---- return FALSE; } } ! New(402,Argv, (s - cmd) / 2 + 2, char*); ! Cmd = nsavestr(cmd, s-cmd); ! a = Argv; ! for (s = Cmd; *s;) { while (*s && isspace(*s)) s++; if (*s) *(a++) = s; *************** *** 970,985 **** *s++ = '\0'; } *a = Nullch; ! if (argv[0]) { ! execvp(argv[0],argv); if (errno == ENOEXEC) { /* for system V NIH syndrome */ ! Safefree(argv); ! Safefree(cmd2); goto doshell; } } ! Safefree(cmd2); ! Safefree(argv); return FALSE; } --- 1070,1083 ---- *s++ = '\0'; } *a = Nullch; ! if (Argv[0]) { ! execvp(Argv[0],Argv); if (errno == ENOEXEC) { /* for system V NIH syndrome */ ! do_execfree(); goto doshell; } } ! do_execfree(); return FALSE; } *************** *** 1250,1260 **** switch (optype) { case O_GETSOCKNAME: if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) ! goto nuts; break; case O_GETPEERNAME: if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) ! goto nuts; break; } --- 1348,1358 ---- switch (optype) { case O_GETSOCKNAME: if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) ! goto nuts2; break; case O_GETPEERNAME: if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) ! goto nuts2; break; } *************** *** 1263,1268 **** --- 1361,1367 ---- nuts: if (dowarn) warn("get{sock,peer}name() on closed fd"); + nuts2: st[sp] = &str_undef; return sp; *************** *** 1522,1527 **** --- 1621,1629 ---- return sp; } + #endif /* SOCKET */ + + #ifdef SELECT int do_select(gimme,arglast) int gimme; *************** *** 1581,1587 **** j = str->str_len; if (j < growsize) { if (str->str_pok) { ! str_grow(str,growsize); s = str_get(str) + j; while (++j <= growsize) { *s++ = '\0'; --- 1683,1689 ---- j = str->str_len; if (j < growsize) { if (str->str_pok) { ! Str_Grow(str,growsize); s = str_get(str) + j; while (++j <= growsize) { *s++ = '\0'; *************** *** 1651,1657 **** --- 1753,1761 ---- } return sp; } + #endif /* SELECT */ + #ifdef SOCKET int do_spair(stab1, stab2, arglast) STAB *stab1; *************** *** 1711,1723 **** #ifdef I_PWD register ARRAY *ary = stack; register int sp = arglast[0]; - register char **elem; register STR *str; struct passwd *getpwnam(); struct passwd *getpwuid(); struct passwd *getpwent(); struct passwd *pwent; - unsigned long len; if (gimme != G_ARRAY) { astore(ary, ++sp, str_static(&str_undef)); --- 1815,1825 ---- *************** *** 1797,1803 **** struct group *getgrgid(); struct group *getgrent(); struct group *grent; - unsigned long len; if (gimme != G_ARRAY) { astore(ary, ++sp, str_static(&str_undef)); --- 1899,1904 ---- *************** *** 1895,1901 **** --- 1996,2007 ---- #endif } break; + #if MACH case O_TELLDIR: + case O_SEEKDIR: + goto nope; + #else + case O_TELLDIR: st[sp] = str_static(&str_undef); str_numset(st[sp], (double)telldir(stio->dirp)); break; *************** *** 1904,1909 **** --- 2010,2016 ---- along = (long)str_gnum(st[sp+1]); (void)seekdir(stio->dirp,along); break; + #endif case O_REWINDDIR: st[sp] = str_static(&str_undef); (void)rewinddir(stio->dirp); *** End of Patch 21 ***