From: Larry Wall Date: Mon, 8 Jun 1992 04:52:53 +0000 (+0000) Subject: perl 4.0 patch 22: patch #20, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68decaef0a08fcd5db3193f825cfdfc539b67ccb;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 22: patch #20, continued See patch #20. --- diff --git a/atarist/atarist.c b/atarist/atarist.c new file mode 100644 index 0000000..2d69c9d --- /dev/null +++ b/atarist/atarist.c @@ -0,0 +1,282 @@ +/* + * random stuff for atariST + */ + +#include "EXTERN.h" +#include "perl.h" + +/* call back stuff, atari specific stuff below */ +/* Be sure to refetch the stack pointer after calling these routines. */ + +int +callback(subname, sp, gimme, hasargs, numargs) +char *subname; +int sp; /* stack pointer after args are pushed */ +int gimme; /* called in array or scalar context */ +int hasargs; /* whether to create a @_ array for routine */ +int numargs; /* how many args are pushed on the stack */ +{ + static ARG myarg[3]; /* fake syntax tree node */ + int arglast[3]; + + arglast[2] = sp; + sp -= numargs; + arglast[1] = sp--; + arglast[0] = sp; + + if (!myarg[0].arg_ptr.arg_str) + myarg[0].arg_ptr.arg_str = str_make("",0); + + myarg[1].arg_type = A_WORD; + myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE); + + myarg[2].arg_type = hasargs ? A_EXPR : A_NULL; + + return do_subr(myarg, gimme, arglast); +} + +int +callv(subname, sp, gimme, argv) +char *subname; +register int sp; /* current stack pointer */ +int gimme; /* called in array or scalar context */ +register char **argv; /* null terminated arg list, NULL for no arglist */ +{ + register int items = 0; + int hasargs = (argv != 0); + + astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */ + if (hasargs) { + while (*argv) { + astore(stack, ++sp, str_2mortal(str_make(*argv,0))); + items++; + argv++; + } + } + return callback(subname, sp, gimme, hasargs, items); +} + +#include +#include + +long _stksize = 64*1024L; +unsigned long __DEFAULT_BUFSIZ__ = 4 * 1024L; + +/* + * The following code is based on the do_exec and do_aexec functions + * in file doio.c + */ +int +do_aspawn(really,arglast) +STR *really; +int *arglast; +{ + register STR **st = stack->ary_array; + register int sp = arglast[1]; + register int items = arglast[2] - sp; + register char **a; + char **argv; + char *tmps; + int status; + + if (items) { + New(1101,argv, items+1, char*); + a = argv; + for (st += ++sp; items > 0; items--,st++) { + if (*st) + *a++ = str_get(*st); + else + *a++ = ""; + } + *a = Nullch; + if (really && *(tmps = str_get(really))) + status = spawnvp(-P_WAIT,tmps,argv); /* -P_WAIT is a hack, see spawnvp.c in the lib */ + else + status = spawnvp(-P_WAIT,argv[0],argv); + Safefree(argv); + } + return status; +} + + +int +do_spawn(cmd) +char *cmd; +{ + return system(cmd); +} + +#if 0 /* patchlevel 79 onwards we can */ +/* + * we unfortunately cannot use the super efficient fread/write from the lib + */ +size_t fread(void *data, size_t size, size_t count, FILE *fp) +{ + size_t i, j; + unsigned char *buf = (unsigned char *)data; + int c; + + for(i = 0; i < count; i++) + { + for(j = 0; j < size; j++) + { + if((c = getc(fp)) == EOF) + return 0; + *buf++ = c; + } + } + return i; +} + +size_t fwrite(const void *data, size_t size, size_t count, FILE *fp) +{ + size_t i, j; + const unsigned char *buf = (const unsigned char *)data; + + for(i = 0; i < count; i++) + { + for(j = 0; j < size; j++) + { + if(fputc(*buf++, fp) == EOF) + return 0; + } + } + return i; +} +#endif + +#ifdef HAS_SYSCALL +#define __NO_INLINE__ +#include /* must include this for proper protos */ + +/* these must match osbind.pl */ +#define TRAP_1_W 1 +#define TRAP_1_WW 2 +#define TRAP_1_WL 3 +#define TRAP_1_WLW 4 +#define TRAP_1_WWW 5 +#define TRAP_1_WLL 6 +#define TRAP_1_WWLL 7 +#define TRAP_1_WLWW 8 +#define TRAP_1_WWLLL 9 +#define TRAP_13_W 10 +#define TRAP_13_WW 11 +#define TRAP_13_WL 12 +#define TRAP_13_WWW 13 +#define TRAP_13_WWL 14 +#define TRAP_13_WWLWWW 15 +#define TRAP_14_W 16 +#define TRAP_14_WW 17 +#define TRAP_14_WL 18 +#define TRAP_14_WWW 19 +#define TRAP_14_WWL 20 +#define TRAP_14_WWLL 21 +#define TRAP_14_WLLW 22 +#define TRAP_14_WLLL 23 +#define TRAP_14_WWWL 24 +#define TRAP_14_WWWWL 25 +#define TRAP_14_WLLWW 26 +#define TRAP_14_WWWWWWW 27 +#define TRAP_14_WLLWWWWW 28 +#define TRAP_14_WLLWWWWLW 29 +#define TRAP_14_WLLWWWWWLW 30 + +int syscall(trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 ) +unsigned long trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12; +{ + /* for now */ + switch(trap) + { + case TRAP_1_W: + return trap_1_w(fn); + + case TRAP_1_WW: + return trap_1_ww(fn, a1); + + case TRAP_1_WL: + return trap_1_wl(fn, a1); + + case TRAP_1_WLW: + return trap_1_wlw(fn, a1, a2); + + case TRAP_1_WWW: + return trap_1_www(fn, a1, a2); + + case TRAP_1_WLL: + return trap_1_wll(fn, a1, a2); + + case TRAP_1_WWLL: + return trap_1_wwll(fn, a1, a2, a3); + + case TRAP_1_WLWW: + return trap_1_wlww(fn, a1, a2, a3); + + case TRAP_1_WWLLL: + return trap_1_wwlll(fn, a1, a2, a3, a4); + + case TRAP_13_W: + return trap_13_w(fn); + + case TRAP_13_WW: + return trap_13_ww(fn, a1); + + case TRAP_13_WL: + return trap_13_wl(fn, a1); + + case TRAP_13_WWW: + return trap_13_www(fn, a1, a2); + + case TRAP_13_WWL: + return trap_13_wwl(fn, a1, a2); + + case TRAP_13_WWLWWW: + return trap_13_wwlwww(fn, a1, a2, a3, a4, a5); + + case TRAP_14_W: + return trap_14_w(fn); + + case TRAP_14_WW: + return trap_14_ww(fn, a1); + + case TRAP_14_WL: + return trap_14_wl(fn, a1); + + case TRAP_14_WWW: + return trap_14_www(fn, a1, a2); + + case TRAP_14_WWL: + return trap_14_wwl(fn, a1, a2); + + case TRAP_14_WWLL: + return trap_14_wwll(fn, a1, a2, a3); + + case TRAP_14_WLLW: + return trap_14_wllw(fn, a1, a2, a3); + + case TRAP_14_WLLL: + return trap_14_wlll(fn, a1, a2, a3); + + case TRAP_14_WWWL: + return trap_14_wwwl(fn, a1, a2, a3); + + case TRAP_14_WWWWL: + return trap_14_wwwwl(fn, a1, a2, a3, a4); + + case TRAP_14_WLLWW: + return trap_14_wllww(fn, a1, a2, a3, a4); + + case TRAP_14_WWWWWWW: + return trap_14_wwwwwww(fn, a1, a2, a3, a4, a5, a6); + + case TRAP_14_WLLWWWWW: + return trap_14_wllwwwww(fn, a1, a2, a3, a4, a5, a6, a7); + + case TRAP_14_WLLWWWWLW: + return trap_14_wllwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8); + + case TRAP_14_WLLWWWWWLW: + return trap_14_wllwwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8, a9); + } +} +#endif + diff --git a/atarist/test/ccon b/atarist/test/ccon new file mode 100644 index 0000000..47bc8e2 --- /dev/null +++ b/atarist/test/ccon @@ -0,0 +1,5 @@ +require 'osbind.pl'; + + &Cconws("Hello World\r\n"); + $str = "This is a string being printed by Fwrite Gemdos trap\r\n"; + &Fwrite(1, length($str), $str); diff --git a/c2ph.SH b/c2ph.SH index 4bf52be..13d70ed 100644 --- a/c2ph.SH +++ b/c2ph.SH @@ -19,6 +19,7 @@ echo "Extracting c2ph (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. +rm -f c2ph $spitshell >c2ph <>c2ph <<'!NO!SUBS!' # See the usage message for more. If this isn't enough, read the code. # -$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.1 $$Date: 91/11/05 16:02:29 $'; +$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:56:08 $'; ###################################################################### diff --git a/cflags.SH b/cflags.SH index df07083..c1510ea 100644 --- a/cflags.SH +++ b/cflags.SH @@ -19,6 +19,7 @@ echo "Extracting cflags (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. +rm -f cflags $spitshell >cflags < #endif -static STR str_chop; +static STR strchop; void grow_dlevel(); @@ -81,6 +85,10 @@ VOLATILE int sp; tail_recursion_entry: #ifdef DEBUGGING dlevel = entdlevel; + if (debug & 4) + deb("mortals = (%d/%d) stack, = (%d/%d)\n", + tmps_max, tmps_base, + savestack->ary_fill, firstsave); #endif #ifdef TAINT tainted = 0; /* Each statement is presumed innocent */ @@ -575,12 +583,12 @@ until_loop: match = (retstr->str_cur != 0); tmps = str_get(retstr); tmps += retstr->str_cur - match; - str_nset(&str_chop,tmps,match); + str_nset(&strchop,tmps,match); *tmps = '\0'; retstr->str_nok = 0; retstr->str_cur = tmps - retstr->str_ptr; STABSET(retstr); - retstr = &str_chop; + retstr = &strchop; goto flipmaybe; case CFT_ARRAY: match = cmd->c_short->str_u.str_useful; /* just to get register */ @@ -728,6 +736,10 @@ until_loop: } goto doswitch; case C_CSWITCH: + if (multiline) { + cmd = cmd->c_next; /* can't assume anything */ + goto tail_recursion_entry; + } match = *(str_get(STAB_STR(cmd->c_stab))) & 255; doswitch: match -= cmd->ucmd.scmd.sc_offset; @@ -942,7 +954,7 @@ until_loop: #ifdef DEBUGGING # ifndef I_VARARGS /*VARARGS1*/ -deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) +void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) char *pat; { register int i; @@ -954,7 +966,7 @@ char *pat; } # else /*VARARGS1*/ -deb(va_alist) +void deb(va_alist) va_dcl { va_list args; @@ -973,6 +985,7 @@ va_dcl # endif #endif +int copyopt(cmd,which) register CMD *cmd; register CMD *which; diff --git a/cmd.h b/cmd.h index be047ea..3260335 100644 --- a/cmd.h +++ b/cmd.h @@ -1,4 +1,4 @@ -/* $RCSfile: cmd.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:28:50 $ +/* $RCSfile: cmd.h,v $$Revision: 4.0.1.2 $$Date: 92/06/08 12:01:02 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,9 @@ * License or the Artistic License, as specified in the README file. * * $Log: cmd.h,v $ + * Revision 4.0.1.2 92/06/08 12:01:02 lwall + * patch20: removed implicit int declarations on funcions + * * Revision 4.0.1.1 91/06/07 10:28:50 lwall * patch4: new copyright notice * patch4: length($`), length($&), length($') now optimized to avoid string copy @@ -167,3 +170,7 @@ struct compcmd { void opt_arg(); ARG* evalstatic(); int cmd_exec(); +#ifdef DEBUGGING +void deb(); +#endif +int copyopt(); diff --git a/config.H b/config.H index 5303c03..d3a0e57 100644 --- a/config.H +++ b/config.H @@ -9,6 +9,7 @@ * that running config.h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config.h.SH. */ + /*SUPPRESS 460*/ /* EUNICE @@ -25,11 +26,16 @@ /*#undef EUNICE /**/ /*#undef VMS /**/ +/* LOC_SED + * This symbol holds the complete pathname to the sed program. + */ +#define LOC_SED "/bin/sed" /**/ + /* ALIGNBYTES * This symbol contains the number of bytes required to align a double. * Usual values are 2, 4, and 8. */ -#define ALIGNBYTES 2 /**/ +#define ALIGNBYTES 8 /**/ /* BIN * This symbol holds the name of the directory in which the user wants @@ -40,7 +46,7 @@ /* BYTEORDER * This symbol contains an encoding of the order of bytes in a long. - * Usual values (in octal) are 01234, 04321, 02143, 03412... + * Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412... */ #define BYTEORDER 0x4321 /**/ @@ -68,8 +74,16 @@ /* HAS_BCOPY * This symbol, if defined, indicates that the bcopy routine is available * to copy blocks of memory. Otherwise you should probably use memcpy(). + * If neither is defined, roll your own. + */ +/* SAFE_BCOPY + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping copy blocks of bcopy. Otherwise you + * should probably use memmove() or memcpy(). If neither is defined, + * roll your own. */ #define HAS_BCOPY /**/ +#define SAFE_BCOPY /**/ /* HAS_BZERO * This symbol, if defined, indicates that the bzero routine is available @@ -89,8 +103,8 @@ * 1 = couldn't cast < 0 * 2 = couldn't cast >= 0x80000000 */ -/*#undef CASTNEGFLOAT /**/ -#define CASTFLAGS 1 /**/ +#define CASTNEGFLOAT /**/ +#define CASTFLAGS 0 /**/ /* CHARSPRINTF * This symbol is defined if this system declares "char *sprintf()" in @@ -180,7 +194,7 @@ * This symbol, if defined, indicates that the gethostent() routine is * available to lookup host names in some data base or other. */ -/*#undef HAS_GETHOSTENT /**/ +#define HAS_GETHOSTENT /**/ /* HAS_GETPGRP * This symbol, if defined, indicates that the getpgrp() routine is @@ -232,6 +246,12 @@ /*#undef index strchr /* cultural */ /*#undef rindex strrchr /* differences? */ +/* HAS_ISASCII + * This symbol, if defined, indicates that the isascii routine is available + * to test characters for asciiness. + */ +#define HAS_ISASCII /**/ + /* HAS_KILLPG * This symbol, if defined, indicates that the killpg routine is available * to kill process groups. If unavailable, you probably should use kill @@ -256,7 +276,27 @@ * to copy blocks of memory. Otherwise you should probably use bcopy(). * If neither is defined, roll your own. */ +/* SAFE_MEMCPY + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping copy blocks of memory. Otherwise you + * should probably use memmove() or bcopy(). If neither is defined, + * roll your own. + */ #define HAS_MEMCPY /**/ +/*#undef SAFE_MEMCPY /**/ + +/* HAS_MEMMOVE + * This symbol, if defined, indicates that the memmove routine is available + * to move potentially overlapping blocks of memory. Otherwise you + * should use bcopy() or roll your own. + */ +/*#undef HAS_MEMMOVE /**/ + +/* HAS_MEMSET + * This symbol, if defined, indicates that the memset routine is available + * to set a block of memory to a character. If undefined, roll your own. + */ +#define HAS_MEMSET /**/ /* HAS_MKDIR * This symbol, if defined, indicates that the mkdir routine is available @@ -273,25 +313,25 @@ /* HAS_MSGCTL * This symbol, if defined, indicates that the msgctl() routine is - * available to stat symbolic links. + * available to control message passing. */ #define HAS_MSGCTL /**/ /* HAS_MSGGET * This symbol, if defined, indicates that the msgget() routine is - * available to stat symbolic links. + * available to get messages. */ #define HAS_MSGGET /**/ /* HAS_MSGRCV * This symbol, if defined, indicates that the msgrcv() routine is - * available to stat symbolic links. + * available to receive messages. */ #define HAS_MSGRCV /**/ /* HAS_MSGSND * This symbol, if defined, indicates that the msgsnd() routine is - * available to stat symbolic links. + * available to send messages. */ #define HAS_MSGSND /**/ @@ -326,6 +366,12 @@ */ #define HAS_RENAME /**/ +/* HAS_REWINDDIR + * This symbol, if defined, indicates that the rewindir routine is + * available to rewind directories. + */ +#define HAS_REWINDDIR /**/ + /* HAS_RMDIR * This symbol, if defined, indicates that the rmdir routine is available * to remove directories. Otherwise you should fork off a new process to @@ -333,6 +379,12 @@ */ #define HAS_RMDIR /**/ +/* HAS_SEEKDIR + * This symbol, if defined, indicates that the seekdir routine is + * available to seek into directories. + */ +#define HAS_SEEKDIR /**/ + /* HAS_SELECT * This symbol, if defined, indicates that the select() subroutine * exists. @@ -347,19 +399,19 @@ /* HAS_SEMCTL * This symbol, if defined, indicates that the semctl() routine is - * available to stat symbolic links. + * available to control semaphores. */ #define HAS_SEMCTL /**/ /* HAS_SEMGET * This symbol, if defined, indicates that the semget() routine is - * available to stat symbolic links. + * available to get semaphores ids. */ #define HAS_SEMGET /**/ /* HAS_SEMOP * This symbol, if defined, indicates that the semop() routine is - * available to stat symbolic links. + * available to perform semaphore operations. */ #define HAS_SEMOP /**/ @@ -437,7 +489,7 @@ /* HAS_SHMAT * This symbol, if defined, indicates that the shmat() routine is - * available to stat symbolic links. + * available to attach a shared memory segment. */ /* VOID_SHMAT * This symbol, if defined, indicates that the shmat() routine @@ -449,19 +501,19 @@ /* HAS_SHMCTL * This symbol, if defined, indicates that the shmctl() routine is - * available to stat symbolic links. + * available to control a shared memory segment. */ #define HAS_SHMCTL /**/ /* HAS_SHMDT * This symbol, if defined, indicates that the shmdt() routine is - * available to stat symbolic links. + * available to detach a shared memory segment. */ #define HAS_SHMDT /**/ /* HAS_SHMGET * This symbol, if defined, indicates that the shmget() routine is - * available to stat symbolic links. + * available to get a shared memory segment id. */ #define HAS_SHMGET /**/ @@ -520,6 +572,12 @@ */ #define HAS_SYSCALL /**/ +/* HAS_TELLDIR + * This symbol, if defined, indicates that the telldir routine is + * available to tell your location in directories. + */ +#define HAS_TELLDIR /**/ + /* HAS_TRUNCATE * This symbol, if defined, indicates that the truncate routine is * available to truncate files. @@ -737,9 +795,14 @@ /*#undef I_MY_DIR /**/ /*#undef DIRNAMLEN /**/ +/* MYMALLOC + * This symbol, if defined, indicates that we're using our own malloc. + */ /* MALLOCPTRTYPE * This symbol defines the kind of ptr returned by malloc and realloc. */ +#define MYMALLOC /**/ + #define MALLOCPTRTYPE char /**/ diff --git a/consarg.c b/consarg.c index 2ff52d9..fe4542b 100644 --- a/consarg.c +++ b/consarg.c @@ -1,4 +1,4 @@ -/* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $ +/* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,12 @@ * License or the Artistic License, as specified in the README file. * * $Log: consarg.c,v $ + * Revision 4.0.1.4 92/06/08 12:26:27 lwall + * patch20: new warning for use of x with non-numeric right operand + * patch20: modulus with highest bit in left operand set didn't always work + * patch20: illegal lvalue message could be followed by core dump + * patch20: deleted some minor memory leaks + * * Revision 4.0.1.3 91/11/05 16:21:16 lwall * patch11: random cleanup * patch11: added eval {} @@ -57,12 +63,14 @@ ARG *limarg; } else { arg[3].arg_flags = 0; + arg[3].arg_len = 0; arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = limarg; } } else { arg[3].arg_flags = 0; + arg[3].arg_len = 0; arg[3].arg_type = A_NULL; arg[3].arg_ptr.arg_arg = Nullarg; } @@ -344,7 +352,10 @@ register ARG *arg; str_scat(str,s2); break; case O_REPEAT: - CHECK12; + CHECK2; + if (dowarn && !s2->str_nok && !looks_like_number(s2)) + warn("Right operand of x is not numeric"); + CHECK1; i = (int)str_gnum(s2); tmps = str_get(s1); str_nset(str,"",0); @@ -392,12 +403,14 @@ register ARG *arg; yyerror("Illegal modulus of constant zero"); return arg; } - tmp2 = (long)str_gnum(s1); + value = str_gnum(s1); #ifndef lint - if (tmp2 >= 0) - str_numset(str,(double)(tmp2 % tmplong)); - else + if (value >= 0.0) + str_numset(str,(double)(((unsigned long)value) % tmplong)); + else { + tmp2 = (long)value; str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); + } #else tmp2 = tmp2; #endif @@ -847,6 +860,7 @@ register ARG *arg; (void)sprintf(tokenbuf, "Illegal expression (%s) as lvalue",opname[arg1->arg_type]); yyerror(tokenbuf); + return arg; } arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT); if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) { @@ -871,6 +885,7 @@ register ARG *arg; (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]); yyerror(tokenbuf); + return arg; } arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT); #ifdef DEBUGGING @@ -897,6 +912,7 @@ ARG *arg; return arg; } +void dehoist(arg,i) ARG *arg; { @@ -976,26 +992,14 @@ register ARG *arg; node = arg; arg = op_new(i); tmpstr = arg->arg_ptr.arg_str; -#ifdef STRUCTCOPY - *arg = *node; /* copy everything except the STR */ -#else - (void)bcopy((char *)node, (char *)arg, sizeof(ARG)); -#endif + StructCopy(node, arg, ARG); /* copy everything except the STR */ arg->arg_ptr.arg_str = tmpstr; for (j = i; ; ) { -#ifdef STRUCTCOPY - arg[j] = node[2]; -#else - (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG)); -#endif + StructCopy(node+2, arg+j, ARG); arg[j].arg_flags |= AF_ARYOK; --j; /* Bug in Xenix compiler */ if (j < 2) { -#ifdef STRUCTCOPY - arg[1] = node[1]; -#else - (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG)); -#endif + StructCopy(node+1, arg+1, ARG); free_arg(node); break; } @@ -1008,6 +1012,8 @@ register ARG *arg; arg[2].arg_flags |= AF_ARYOK; arg->arg_type = O_LIST; arg->arg_len = i; + str_free(arg->arg_ptr.arg_str); + arg->arg_ptr.arg_str = Nullstr; return arg; } diff --git a/hints/cray.sh b/hints/cray.sh new file mode 100644 index 0000000..952a021 --- /dev/null +++ b/hints/cray.sh @@ -0,0 +1,3 @@ +case `uname -r` in +6.1*) shellflags="-m+65536" ;; +esac diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl index 99a0079..52fb7e3 100644 --- a/lib/bigfloat.pl +++ b/lib/bigfloat.pl @@ -1,8 +1,9 @@ package bigfloat; require "bigint.pl"; - # Arbitrary length float math package # +# by Mark Biggar +# # number format # canonical strings have the form /[+-]\d+E[+-]\d+/ # Input values can have inbedded whitespace @@ -66,14 +67,15 @@ sub norm { #(mantissa, exponent) return fnum_str # negation sub main'fneg { #(fnum_str) return fnum_str local($_) = &'fnorm($_[0]); - substr($_,0,1) =~ tr/+-/-+/ if ($_ ne '+0E+0'); # flip sign + vec($_,0,8) =^ ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign + s/^H/N/; $_; } # absolute value sub main'fabs { #(fnum_str) return fnum_str local($_) = &'fnorm($_[0]); - substr($_,0,1) = '+' unless $_ eq 'NaN'; # mash sign + s/^-/+/; # mash sign $_; } @@ -198,18 +200,13 @@ sub main'fcmp #(fnum_str, fnum_str) return cond_code local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1])); if ($x eq "NaN" || $y eq "NaN") { undef; - } elsif ($x eq $y) { - 0; - } elsif (ord($x) != ord($y)) { - (ord($y) - ord($x)); # based on signs } else { - local($xm,$xe) = split('E',$x); - local($ym,$ye) = split('E',$y); - if ($xe ne $ye) { - ($xe - $ye) * (substr($x,0,1).'1'); - } else { - &bigint'cmp($xm,$ym); # based on value - } + ord($y) <=> ord($x) + || + ( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"), + (($xe <=> $ye) * (substr($x,0,1).'1') + || &bigint'cmp($xm,$ym)) + ); } } diff --git a/lib/bigint.pl b/lib/bigint.pl index 503c783..9a52fb7 100644 --- a/lib/bigint.pl +++ b/lib/bigint.pl @@ -138,19 +138,15 @@ sub main'bsub { #(num_str, num_str) return num_str # GCD -- Euclids algorithm Knuth Vol 2 pg 296 sub main'bgcd { #(num_str, num_str) return num_str local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1])); - if ($x eq 'NaN') { - 'NaN'; - } - elsif ($y eq 'NaN') { + if ($x eq 'NaN' || $y eq 'NaN') { 'NaN'; - } - else { + } else { ($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0'; $x; } } -# routine to add two base 100000 numbers +# routine to add two base 1e5 numbers # stolen from Knuth Vol 2 Algorithm A pg 231 # there are separate routines to add and sub as per Kunth pg 233 sub add { #(int_num_array, int_num_array) return int_num_array @@ -158,22 +154,22 @@ sub add { #(int_num_array, int_num_array) return int_num_array $car = 0; for $x (@x) { last unless @y || $car; - $x -= 100000 if $car = (($x += shift @y + $car) >= 100000); + $x -= 1e5 if $car = (($x += shift @y + $car) >= 1e5); } for $y (@y) { last unless $car; - $y -= 100000 if $car = (($y += $car) >= 100000); + $y -= 1e5 if $car = (($y += $car) >= 1e5); } (@x, @y, $car); } -# subtract base 100000 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y +# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y sub sub { #(int_num_array, int_num_array) return int_num_array local(*sx, *sy) = @_; $bar = 0; for $sx (@sx) { last unless @y || $bar; - $sx += 100000 if $bar = (($sx -= shift @sy + $bar) < 0); + $sx += 1e5 if $bar = (($sx -= shift @sy + $bar) < 0); } @sx; } @@ -195,7 +191,7 @@ sub main'bmul { #(num_str, num_str) return num_str for $y (@y) { $prod = $x * $y + $prod[$cty] + $car; $prod[$cty++] = - $prod - ($car = int($prod * (1/100000))) * 100000; + $prod - ($car = int($prod * 1e-5)) * 1e5; } $prod[$cty] += $car if $car; $x = shift @prod; @@ -218,15 +214,15 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str $srem = $y[0]; $sr = (shift @x ne shift @y) ? '-' : '+'; $car = $bar = $prd = 0; - if (($dd = int(100000/($y[$#y]+1))) != 1) { + if (($dd = int(1e5/($y[$#y]+1))) != 1) { for $x (@x) { $x = $x * $dd + $car; - $x -= ($car = int($x * (1/100000))) * 100000; + $x -= ($car = int($x * 1e-5)) * 1e5; } push(@x, $car); $car = 0; for $y (@y) { $y = $y * $dd + $car; - $y -= ($car = int($y * (1/100000))) * 100000; + $y -= ($car = int($y * 1e-5)) * 1e5; } } else { @@ -235,20 +231,20 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str @q = (); ($v2,$v1) = @y[$#y-1,$#y]; while ($#x > $#y) { ($u2,$u1,$u0) = @x[($#x-2)..$#x]; - $q = (($u0 == $v1) ? 99999 : int(($u0*100000+$u1)/$v1)); - --$q while ($v2*$q > ($u0*100000+$u1-$q*$v1)*100000+$u2); + $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1)); + --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2); if ($q) { ($car, $bar) = (0,0); for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) { $prd = $q * $y[$y] + $car; - $prd -= ($car = int($prd * (1/100000))) * 100000; - $x[$x] += 100000 if ($bar = (($x[$x] -= $prd + $bar) < 0)); + $prd -= ($car = int($prd * 1e-5)) * 1e5; + $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0)); } if ($x[$#x] < $car + $bar) { $car = 0; --$q; for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) { - $x[$x] -= 100000 - if ($car = (($x[$x] += $y[$y] + $car) > 100000)); + $x[$x] -= 1e5 + if ($car = (($x[$x] += $y[$y] + $car) > 1e5)); } } } @@ -259,7 +255,7 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str if ($dd != 1) { $car = 0; for $x (reverse @x) { - $prd = $car * 100000 + $x; + $prd = $car * 1e5 + $x; $car = $prd - ($tmp = int($prd / $dd)) * $dd; unshift(@d, $tmp); } diff --git a/lib/chat2.pl b/lib/chat2.pl index 916b975..662872c 100644 --- a/lib/chat2.pl +++ b/lib/chat2.pl @@ -108,6 +108,7 @@ sub open_proc { ## public die "Cannot exec @cmd: $!"; } close(TTY); + $PID{$next} = $pid; $next; # return symbol for switcharound } @@ -258,10 +259,15 @@ sub print { ## public ## like close $handle sub close { ## public + local($pid); if ($_[0] =~ /$nextpat/) { + $pid = $PID{$_[0]}; *S = shift; + } else { + $pid = $PID{$next}; } close(S); + waitpid($pid,0); if (defined $S{"needs_close"}) { # is it a listen socket? local(*NS) = $S{"needs_close"}; delete $S{"needs_close"}; diff --git a/lib/ctime.pl b/lib/ctime.pl index 988d05a..6000d29 100644 --- a/lib/ctime.pl +++ b/lib/ctime.pl @@ -3,7 +3,7 @@ ;# Waldemar Kebsch, Federal Republic of Germany, November 1988 ;# kebsch.pad@nixpbe.UUCP ;# Modified March 1990, Feb 1991 to properly handle timezones -;# $Id: ctime.pl,v 1.8 91/02/04 18:28:12 hakanson Exp $ +;# $RCSfile: ctime.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:38:06 $ ;# Marion Hakanson (hakanson@cse.ogi.edu) ;# Oregon Graduate Institute of Science and Technology ;# @@ -24,6 +24,7 @@ sub ctime { package ctime; local($time) = @_; + local($[) = 0; local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); # Determine what time zone is in effect. diff --git a/msdos/config.h b/msdos/config.h index d030c58..7131d63 100644 --- a/msdos/config.h +++ b/msdos/config.h @@ -79,8 +79,16 @@ /* HAS_BCOPY * This symbol, if defined, indicates that the bcopy routine is available * to copy blocks of memory. Otherwise you should probably use memcpy(). + * If neither is defined, roll your own. + */ +/* SAFE_BCOPY + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping copy blocks of bcopy. Otherwise you + * should probably use memmove() or memcpy(). If neither is defined, + * roll your own. */ /*#undef HAS_BCOPY /**/ +/*#undef SAFE_BCOPY /**/ /* HAS_BZERO * This symbol, if defined, indicates that the bzero routine is available @@ -243,6 +251,12 @@ #define index strchr /* cultural */ #define rindex strrchr /* differences? */ +/* HAS_ISASCII + * This symbol, if defined, indicates that the isascii routine is available + * to test characters for asciiness. + */ +#define HAS_ISASCII /**/ + /* HAS_KILLPG * This symbol, if defined, indicates that the killpg routine is available * to kill process groups. If unavailable, you probably should use kill @@ -267,7 +281,27 @@ * to copy blocks of memory. Otherwise you should probably use bcopy(). * If neither is defined, roll your own. */ +/* SAFE_MEMCPY + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping copy blocks of memory. Otherwise you + * should probably use memmove() or bcopy(). If neither is defined, + * roll your own. + */ #define HAS_MEMCPY /**/ +/*#undef SAFE_MEMCPY /**/ + +/* HAS_MEMMOVE + * This symbol, if defined, indicates that the memmove routine is available + * to move potentially overlapping blocks of memory. Otherwise you + * should use bcopy() or roll your own. + */ +/*#undef HAS_MEMMOVE /**/ + +/* HAS_MEMSET + * This symbol, if defined, indicates that the memset routine is available + * to set a block of memory to a character. If undefined, roll your own. + */ +#define HAS_MEMSET /**/ /* HAS_MKDIR * This symbol, if defined, indicates that the mkdir routine is available @@ -284,25 +318,25 @@ /* HAS_MSGCTL * This symbol, if defined, indicates that the msgctl() routine is - * available to stat symbolic links. + * available to control message passing. */ /*#undef HAS_MSGCTL /**/ /* HAS_MSGGET * This symbol, if defined, indicates that the msgget() routine is - * available to stat symbolic links. + * available to get messages. */ /*#undef HAS_MSGGET /**/ /* HAS_MSGRCV * This symbol, if defined, indicates that the msgrcv() routine is - * available to stat symbolic links. + * available to receive messages. */ /*#undef HAS_MSGRCV /**/ /* HAS_MSGSND * This symbol, if defined, indicates that the msgsnd() routine is - * available to stat symbolic links. + * available to send messages. */ /*#undef HAS_MSGSND /**/ @@ -337,6 +371,12 @@ */ #define HAS_RENAME /**/ +/* HAS_REWINDDIR + * This symbol, if defined, indicates that the rewindir routine is + * available to rewind directories. + */ +#define HAS_REWINDDIR /**/ + /* HAS_RMDIR * This symbol, if defined, indicates that the rmdir routine is available * to remove directories. Otherwise you should fork off a new process to @@ -344,6 +384,12 @@ */ #define HAS_RMDIR /**/ +/* HAS_SEEKDIR + * This symbol, if defined, indicates that the seekdir routine is + * available to seek into directories. + */ +#define HAS_SEEKDIR /**/ + /* HAS_SELECT * This symbol, if defined, indicates that the select() subroutine * exists. @@ -358,19 +404,19 @@ /* HAS_SEMCTL * This symbol, if defined, indicates that the semctl() routine is - * available to stat symbolic links. + * available to control semaphores. */ /*#undef HAS_SEMCTL /**/ /* HAS_SEMGET * This symbol, if defined, indicates that the semget() routine is - * available to stat symbolic links. + * available to get semaphores ids. */ /*#undef HAS_SEMGET /**/ /* HAS_SEMOP * This symbol, if defined, indicates that the semop() routine is - * available to stat symbolic links. + * available to perform semaphore operations. */ /*#undef HAS_SEMOP /**/ @@ -448,25 +494,31 @@ /* HAS_SHMAT * This symbol, if defined, indicates that the shmat() routine is - * available to stat symbolic links. + * available to attach a shared memory segment. + */ +/* VOID_SHMAT + * This symbol, if defined, indicates that the shmat() routine + * returns a pointer of type void*. */ /*#undef HAS_SHMAT /**/ +/*#undef VOIDSHMAT /**/ + /* HAS_SHMCTL * This symbol, if defined, indicates that the shmctl() routine is - * available to stat symbolic links. + * available to control a shared memory segment. */ /*#undef HAS_SHMCTL /**/ /* HAS_SHMDT * This symbol, if defined, indicates that the shmdt() routine is - * available to stat symbolic links. + * available to detach a shared memory segment. */ /*#undef HAS_SHMDT /**/ /* HAS_SHMGET * This symbol, if defined, indicates that the shmget() routine is - * available to stat symbolic links. + * available to get a shared memory segment id. */ /*#undef HAS_SHMGET /**/ @@ -528,6 +580,12 @@ */ /*#undef HAS_SYSCALL /**/ +/* HAS_TELLDIR + * This symbol, if defined, indicates that the telldir routine is + * available to tell your location in directories. + */ +#define HAS_TELLDIR /**/ + /* HAS_TRUNCATE * This symbol, if defined, indicates that the truncate routine is * available to truncate files. @@ -745,11 +803,17 @@ /*#undef I_MY_DIR /**/ /*#undef DIRNAMLEN /**/ +/* MYMALLOC + * This symbol, if defined, indicates that we're using our own malloc. + */ /* MALLOCPTRTYPE * This symbol defines the kind of ptr returned by malloc and realloc. */ +#define MYMALLOC /**/ + #define MALLOCPTRTYPE void /**/ + /* RANDBITS * This symbol contains the number of bits of random number the rand() * function produces. Usual values are 15, 16, and 31. @@ -758,7 +822,7 @@ /* SCRIPTDIR * This symbol holds the name of the directory in which the user wants - * to put publicly executable scripts for the package in question. It + * to keep publicly executable scripts for the package in question. It * is often a directory that is mounted across diverse architectures. */ #define SCRIPTDIR "C:/bin/perl" /**/ diff --git a/patchlevel.h b/patchlevel.h index 49ea5df..7c3da2c 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 21 +#define PATCHLEVEL 22 diff --git a/t/comp/cpp.t b/t/comp/cpp.t index 0e2b6fa..dca25d3 100644 --- a/t/comp/cpp.t +++ b/t/comp/cpp.t @@ -1,6 +1,18 @@ #!./perl -P -# $Header: cpp.t,v 4.0 91/03/20 01:50:05 lwall Locked $ +# $RCSfile: cpp.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:42:08 $ + +open(CONFIG,"../config.sh") || die; +while () { + if (/^cppstdin/) { + if (/^cppstdin='(.*cppstdin)'/ && ! -e $1) { + print "1..0\n"; + exit; # Can't test till after install, alas. + } + last; + } +} +close CONFIG; print "1..3\n"; diff --git a/usub/bsdcurses.mus b/usub/bsdcurses.mus index 48e2df7..9b0be3d 100644 --- a/usub/bsdcurses.mus +++ b/usub/bsdcurses.mus @@ -1,6 +1,9 @@ -/* $RCSfile: bsdcurses.mus,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:04:53 $ +/* $RCSfile: bsdcurses.mus,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:05:28 $ * * $Log: bsdcurses.mus,v $ + * Revision 4.0.1.2 92/06/08 16:05:28 lwall + * patch20: &getcap eventually dumped core in bsdcurses + * * Revision 4.0.1.1 91/11/05 19:04:53 lwall * initial checkin * @@ -476,9 +479,18 @@ END CASE int erasechar END -CASE char* getcap -I char* str -END + case US_getcap: + if (items != 1) + fatal("Usage: &getcap($str)"); + else { + char* retval; + char* str = (char*) str_get(st[1]); + char output[50], *outputp = output; + + retval = tgetstr(str, &outputp); + str_set(st[0], (char*) retval); + } + return sp; case US_getyx: if (items != 3) diff --git a/x2p/cflags.SH b/x2p/cflags.SH index 2f78e2c..db857c0 100644 --- a/x2p/cflags.SH +++ b/x2p/cflags.SH @@ -19,6 +19,7 @@ echo "Extracting cflags (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. +rm -f cflags $spitshell >cflags <