diff --git a/src/common/dconsole.c b/src/common/dconsole.c index aaa069d5f..5ae4ca44a 100644 --- a/src/common/dconsole.c +++ b/src/common/dconsole.c @@ -296,7 +296,7 @@ void initalloc(word codesize) tfatal("insufficient memory for block region", NULL); blkend = blkbase + abrsize; } - + void err_msg(n, v) int n; diff --git a/src/common/error.h b/src/common/error.h index 66320c8e5..2d77eea1b 100644 --- a/src/common/error.h +++ b/src/common/error.h @@ -70,7 +70,7 @@ nodeptr lval; __merr_errors++; nocode++; } - + /* * mapterm finds a printable string for the given token type * and value. @@ -96,7 +96,7 @@ nodeptr val; return "???"; } #endif /* SEPARATE_YYERROR */ - + /* * tfatal produces the translator error messages s1 and s2 (if nonnull). The * location of the error is found in tok_loc. @@ -131,7 +131,7 @@ void tfatal(char *s1, char *s2) __merr_errors++; nocode++; } - + /* * nfatal produces the error messages s1 and s2 (if nonnull), and associates * it with source location of node. @@ -152,7 +152,7 @@ char *s1, *s2; __merr_errors++; nocode++; } - + /* * twarn produces s1 and s2 (if nonnull) as translator warning messages. @@ -173,7 +173,7 @@ char *s1, *s2; #endif } - + /* * tsyserr is called for fatal errors. The message s is produced and the * translator exits. @@ -189,7 +189,7 @@ char *s; exit(EXIT_FAILURE); } - + /* * quit - immediate exit with error message */ @@ -199,7 +199,7 @@ char *msg; { quitf(msg,""); } - + /* * quitf - immediate exit with message format and argument */ diff --git a/src/common/filepart.c b/src/common/filepart.c index 716633a9e..c28e3e1df 100644 --- a/src/common/filepart.c +++ b/src/common/filepart.c @@ -60,7 +60,7 @@ static char *tryfile (char *buf, char *dir, char *name, char *extn); #ifndef PathSep #define PathSep " ;" #endif /* PathSep */ - + static char *last_vetted_path; static char *vetted_PathSep; void vet_the_PathSep(char *s) @@ -183,7 +183,7 @@ char *buf, *dir, *name, *extn; else return NULL; } - + /* * fparse - break a file name down into component parts. * Result is a pointer to a struct of static pointers good until the next call. @@ -245,7 +245,7 @@ char *s; return &fp; } - + /* * makename - make a file name, optionally substituting a new dir and/or ext */ @@ -269,7 +269,7 @@ char *dest, *d, *name, *e; return dest; } - + /* * smatch - case-insensitive string match - returns nonzero if they match */ diff --git a/src/common/ipp.c b/src/common/ipp.c index 2a4588c9f..bc1f9c238 100644 --- a/src/common/ipp.c +++ b/src/common/ipp.c @@ -116,7 +116,7 @@ char *lpath; /* LPATH for finding source files */ static int ifdepth; /* depth of $if nesting */ extern int __merr_errors, nocode; /* provided by icont, iconc */ - + /* * ppinit(fname, inclpath, m4) -- initialize preprocessor to read from fname. * @@ -239,7 +239,7 @@ void ppecho() while ((c = ppch()) != EOF) putchar(c); } - + /* * ppch() -- get preprocessed character. */ @@ -392,7 +392,7 @@ int ppch() } } } - + /* * rline(fp) -- read arbitrarily long line and return pointer. * @@ -446,7 +446,7 @@ FILE *fp; n = LINE_SIZE_INCR; } } - + /* * pushdef(d) -- insert definition into the input stream. */ @@ -484,7 +484,7 @@ long lno; bnxt = tbuf; bstop = blim = tbuf + strlen(tbuf); } - + /* * ppdir(s) -- handle preprocessing directive. * @@ -550,7 +550,7 @@ char *s; pfatal("explicit $error", s); /* issue msg with text */ return NULL; } - + /* * define(s) -- handle $define directive. */ @@ -600,7 +600,7 @@ char *s; dlookup(name, -1, (char *)NULL); return NULL; } - + /* * include(s) -- handle $include directive. */ @@ -658,7 +658,7 @@ char *s; pushline(curfile->fname, curfile->lno); return NULL; } - + /* * ifdef(s), ifndef(s) -- conditional processing if s is/isn't defined. */ @@ -722,7 +722,7 @@ char *s; ifdepth--; return NULL; } - + /* * skipcode(doelse,report) -- skip code to $else (doelse=1) or $endif (=0). * @@ -787,7 +787,7 @@ int doelse, report; * At EOF, just return; main loop will report unterminated $if. */ } - + /* * Token scanning functions. */ @@ -910,7 +910,7 @@ char *dst, *src; *dst = '\0'; return lim + 1; } - + /* * dlookup(name, len, val) look up entry in definition table. * diff --git a/src/common/long.c b/src/common/long.c index 49d65568e..308a80f5b 100644 --- a/src/common/long.c +++ b/src/common/long.c @@ -16,7 +16,7 @@ char *s; while(*s++) l++; return l; } - + /* Shell sort with some enhancements from Knuth.. */ void lqsort( base, nel, width, cmp ) @@ -48,7 +48,7 @@ int (*cmp)(); } } #endif /* IntBits == 16 */ - + /* * Write a long string in int-sized chunks. */ diff --git a/src/common/save.c b/src/common/save.c index 953be266e..f68850dad 100644 --- a/src/common/save.c +++ b/src/common/save.c @@ -6,7 +6,7 @@ #ifdef ExecImages - + /* * save(s) -- for generic BSD systems. */ @@ -62,7 +62,7 @@ int ef; return hdr.a_data; } #endif /* GenericBSD */ - + /* * save(s) -- for Sun Workstations. */ diff --git a/src/common/strtbl.c b/src/common/strtbl.c index 08c708c00..b6f4f75e6 100644 --- a/src/common/strtbl.c +++ b/src/common/strtbl.c @@ -124,7 +124,7 @@ struct str_buf *sbuf; sbuf->endimage = s2; sbuf->end = sbuf->strtimage + sbuf->size; } - + /* * spec_str - install a special string (null terminated) in the string table. */ @@ -153,7 +153,7 @@ char *s; str_tbl[h] = se; return s; } - + /* * str_install - find out if the string at the end of the buffer is in * the string table. If not, put it there. Return a pointer to the @@ -203,7 +203,7 @@ struct str_buf *sbuf; str_tbl[h] = se; return se->s; } - + /* * streq - compare s1 with s2 for len bytes, and return 1 for equal, * 0 for not equal. diff --git a/src/common/yylex.h b/src/common/yylex.h index 0e0dc38a1..29a8a26c0 100644 --- a/src/common/yylex.h +++ b/src/common/yylex.h @@ -43,7 +43,7 @@ struct node tok_loc = {0, NULL, 0, 0}; /* "model" node containing location of current token */ struct str_buf lex_sbuf; /* string buffer for lexical analyzer */ - + /* * yylex - find the next token in the input stream, and return its token * type and value to the parser. @@ -246,7 +246,7 @@ int yylex() return (t->t_type); } - + #ifdef MultipleRuns /* * yylexinit - initialize variables for multiple runs @@ -259,7 +259,7 @@ void yylexinit() cc = '\n'; } #endif /* MultipleRuns */ - + /* * getident - gather an identifier beginning with ac. The character * following identifier goes in cc. @@ -302,7 +302,7 @@ int *cc; return (struct toktab *)T_Ident; } } - + /* * findres - if the string just copied into the string space by getident * is a reserved word, return a pointer to its entry in the token table. @@ -333,7 +333,7 @@ static struct toktab *findres() } return NULL; } - + /* * bufcmp - compare a null terminated string to what is in the string buffer. */ @@ -351,7 +351,7 @@ char *s; else return 0; } - + /* * getnum - gather a numeric literal starting with ac and put the * character following the literal into *cc. @@ -445,7 +445,7 @@ int *cc; yylval = IntNode(yytext_install(&lex_sbuf)); return T_Int; } - + /* * getstring - gather a string literal starting with ac and place the * character following the literal in *cc. @@ -526,7 +526,7 @@ int *cc; return T_Cset; } } - + #if !defined(Iconc) /* @@ -551,7 +551,7 @@ static int ctlesc() #endif /* !EBCDIC */ } - + /* * octesc - translate an octal escape -- backslash followed by * one, two, or three octal digits. @@ -579,7 +579,7 @@ int ac; return ToEBCDIC[c & 0377]; #endif /* EBCDIC != 2 */ } - + /* * hexesc - translate a hexadecimal escape -- backslash-x * followed by one or two hexadecimal digits. @@ -617,7 +617,7 @@ static int hexesc() } #endif /* !Iconc */ - + /* * setlineno - set line number from #line comment, return following char. */ @@ -641,7 +641,7 @@ static int setlineno() } return c; } - + /* * setfilenm - set file name from #line comment, return following char. */ @@ -668,7 +668,7 @@ register int c; return c; } } - + /* * nextchar - return the next character in the input. * diff --git a/src/gdbm/getopt.c b/src/gdbm/getopt.c index 9a7fe191a..b47ec6f22 100644 --- a/src/gdbm/getopt.c +++ b/src/gdbm/getopt.c @@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ - + /* NOTE!!! AIX requires this to be the first thing in the file. Do not put ANYTHING before it! */ #if !defined (__GNUC__) && defined (_AIX) @@ -170,7 +170,7 @@ static enum { REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER } ordering; - + #ifdef __GNU_LIBRARY__ /* We want to avoid inclusion of string.h with non-GNU libraries because there are many ways it can cause trouble. @@ -211,7 +211,7 @@ my_bcopy (from, to, size) to[i] = from[i]; } #endif /* GNU C library. */ - + /* Handle permutation of arguments. */ /* Describe the part of ARGV that contains non-options that have @@ -251,7 +251,7 @@ exchange (argv) first_nonopt += (optind - last_nonopt); last_nonopt = optind; } - + /* Scan elements of ARGV (whose length is ARGC) for option characters given in OPTSTRING. @@ -655,7 +655,7 @@ getopt (argc, argv, optstring) } #endif /* _LIBC or not __GNU_LIBRARY__. */ - + #ifdef TEST /* Compile with -DTEST to make an executable for use in testing diff --git a/src/h/audio.h b/src/h/audio.h index 85faae80b..18bc77fb2 100644 --- a/src/h/audio.h +++ b/src/h/audio.h @@ -3,9 +3,9 @@ */ struct AudioFile{ - int doneflag; - char* fname; - }; + int doneflag; + char* fname; + }; typedef struct AudioFile AudioStruct; typedef struct AudioFile * AudioPtr; diff --git a/src/h/auto.in b/src/h/auto.in index a7613812e..1fdb18032 100644 --- a/src/h/auto.in +++ b/src/h/auto.in @@ -464,9 +464,9 @@ /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define to 1 if you have the ANSI C header files. */ diff --git a/src/h/bgiwin.h b/src/h/bgiwin.h index 53100e36b..07823e0bb 100644 --- a/src/h/bgiwin.h +++ b/src/h/bgiwin.h @@ -364,16 +364,15 @@ typedef struct { #define RECY(rec) (rec).top #define RECWIDTH(rec) (rec).right #define RECHEIGHT(rec) (rec).bottom -#define ROWTOY(wb, row) ((row - 1) * (LEADING(wb) + FHEIGHT(wb)) + \ - MARGIN + ASCENT(wb)) +#define ROWTOY(wb, row) ((row - 1) * (LEADING(wb) + FHEIGHT(wb)) + MARGIN + ASCENT(wb)) #define COLTOX(wb, col) ((col - 1) * FWIDTH(wb) + MARGIN) #define YTOROW(wb, y) (((y) - MARGIN) / (LEADING(wb) + FHEIGHT(wb)) + 1) #define XTOCOL(wb, x) (((x) - MARGIN) / FWIDTH(wb)) #define STDLOCALS(w) \ - wcp wc = (w)->context;\ - wsp ws = (w)->window; - + wcp wc = (w)->context;\ + wsp ws = (w)->window; + #define TEXTWIDTH(w,s,n) textWidth(w,s,n) /* * the bitmasks for the modifier keys @@ -383,7 +382,7 @@ typedef struct { #define ShiftMask (4 << 16) #define VirtKeyMask (8 << 16) -#define FS_SOLID SOLID_FILL -#define FS_STIPPLE EMPTY_FILL +#define FS_SOLID SOLID_FILL +#define FS_STIPPLE EMPTY_FILL #define stdwin 0 diff --git a/src/h/config.h b/src/h/config.h index 7e8a368ff..20ef568da 100644 --- a/src/h/config.h +++ b/src/h/config.h @@ -4,20 +4,20 @@ /* * System-specific definitions are in define.h - * update June 2017:: - * System-specific definitions are being handleded + * update June 2017:: + * System-specific definitions are being handleded * by the confure script. Some remaining definitions are * moved here so they are all in one place for all systems. - * Many of these options will be automated as well. + * Many of these options will be automated as well. */ /* * A number of symbols are defined here. Some are specific to individual * to operating systems. Examples are: * - * MSDOS MS-DOS for PCs - * UNIX any UNIX system; also set for BeOS - * VMS VMS for the VAX + * MSDOS MS-DOS for PCs + * UNIX any UNIX system; also set for BeOS + * VMS VMS for the VAX * * These are defined to be 1 or 0 depending on which operating system * the installation is being done under. They are all defined and only @@ -26,18 +26,18 @@ * There also are definitions of symbols for specific computers and * versions of operating systems. These include: * - * SUN code specific to the Sun Workstation - * MICROSOFT code specific to the Microsoft C compiler for MS-DOS + * SUN code specific to the Sun Workstation + * MICROSOFT code specific to the Microsoft C compiler for MS-DOS * * Other definitions may occur for different configurations. These include: * - * DeBug debugging code - * MultiProgram support for multiple programs under the interpreter + * DeBug debugging code + * MultiProgram support for multiple programs under the interpreter * * Other definitions perform configurations that are common to several * systems. An example is: * - * Double align reals at double-word boundaries + * Double align reals at double-word boundaries * */ @@ -50,10 +50,10 @@ */ #ifndef NoAuto #include "../h/auto.h" -#endif /* NoAuto */ +#endif /* NoAuto */ /* - * Avoid name conflicts with Icon by using unicon-specific names + * Avoid name conflicts with Icon by using unicon-specific names */ #ifdef UniconX #define UNICONX "uniconx" @@ -61,13 +61,13 @@ #define UNICONT "unicont" #define UNICONWT "wunicont" #define UNICONC "uniconc" -#else /* UNICONX */ +#else /* UNICONX */ #define UNICONX "iconx" #define UNICONWX "wiconx" #define UNICONT "icont" #define UNICONWT "wicont" #define UNICONC "iconc" -#endif /* UNICONX */ +#endif /* UNICONX */ #if Windows #define UNICONX_EXE UNICONX".exe" @@ -75,13 +75,13 @@ #define UNICONT_EXE UNICONT".exe" #define UNICONWT_EXE UNICONWT".exe" #define UNICONC_EXE UNICONC".exe" -#else /* NT */ +#else /* NT */ #define UNICONX_EXE UNICONX #define UNICONWX_EXE UNICONWX #define UNICONT_EXE UNICONT #define UNICONWT_EXE UNICONWT #define UNICONC_EXE UNICONC -#endif /* NT */ +#endif /* NT */ /* make SQL_LENORIND definition global for now*/ #define SQL_LENORIND SQLLEN @@ -92,7 +92,7 @@ #define NamedSemaphores #define INTMAIN #define PROFIL_CHAR_P -#endif /* MacOS */ +#endif /* MacOS */ #if SUN #define INTMAIN @@ -104,12 +104,12 @@ #define Messaging 1 #define PosixFns 1 #define NoVFork -#endif /* SUN */ +#endif /* SUN */ #if FreeBSD #define GenericBSD -#define BSD_4_4_LITE 1 /* This is new, for 4.4Lite specific stuff */ +#define BSD_4_4_LITE 1 /* This is new, for 4.4Lite specific stuff */ #define NEED_UTIME #define Messaging 1 @@ -124,7 +124,7 @@ #define HAVE_GETHOSTNAME 1 #define HAVE_GETPWUID 1 #define HAVE_GETUID 1 -#endif /* FreeBSD */ +#endif /* FreeBSD */ #if Windows @@ -179,17 +179,17 @@ #if defined(Messaging) && defined(OLD_NTGCC) #define ssize_t signed -#endif /* Messaging && OLD_NTGCC */ +#endif /* Messaging && OLD_NTGCC */ #define LoadFunc #define FieldTableCompression 1 -/* StackCheck seems to cause a crash when exiting through - * pressing the [x] close window button, turn it off for now +/* StackCheck seems to cause a crash when exiting through + * pressing the [x] close window button, turn it off for now */ #define NoStackCheck -#endif /* Windows */ +#endif /* Windows */ /* @@ -208,27 +208,27 @@ #ifndef PORT #define PORT 0 -#endif /* PORT */ +#endif /* PORT */ #ifndef MSDOS #define MSDOS 0 -#endif /* MSDOS */ +#endif /* MSDOS */ #ifndef MVS #define MVS 0 -#endif /* MVS */ +#endif /* MVS */ #ifndef UNIX #define UNIX 0 -#endif /* UNIX */ +#endif /* UNIX */ #ifndef VM #define VM 0 -#endif /* VM */ +#endif /* VM */ #ifndef VMS #define VMS 0 -#endif /* VMS */ +#endif /* VMS */ /* * The following definitions serve to cast common conditionals is @@ -242,11 +242,11 @@ #ifndef NoPosixFns #undef PosixFns #define PosixFns -#endif /* NoPosixFns */ +#endif /* NoPosixFns */ #ifdef PosixFns #define ReadDirectory -#endif /* PosixFns */ +#endif /* PosixFns */ /* * Execution monitoring is not supported under the compiler, @@ -260,19 +260,19 @@ #undef MultiProgram #undef NoMultiProgram #define NoMultiProgram -#else /* NoCoExpr */ +#else /* NoCoExpr */ #undef CoExpr #define CoExpr #ifndef NoNativeCoswitch #define NativeCoswitch - #endif /* NoNativeCoswitch */ -#endif /* NoCoExpr */ + #endif /* NoNativeCoswitch */ +#endif /* NoCoExpr */ #if COMPILER #undef MultiProgram #undef NoMultiProgram #define NoMultiProgram -#endif /* COMPILER */ +#endif /* COMPILER */ #ifdef NoMultiProgram #undef MultiProgram @@ -283,7 +283,7 @@ #else #undef MultiProgram #define MultiProgram -#endif /* NoMultiProgram */ +#endif /* NoMultiProgram */ #ifndef NoEventMon #undef EventMon @@ -294,8 +294,8 @@ #if defined(HAVE_LIBPTHREAD) && !defined(NoConcurrent) #undef Concurrent #define Concurrent 1 - #endif /* HAVE_LIBPTHREAD && !NoConcurrent */ -//#endif /* MultiProgram */ + #endif /* HAVE_LIBPTHREAD && !NoConcurrent */ +//#endif /* MultiProgram */ #if defined(Concurrent) && COMPILER #ifdef NoConcurrentCOMPILER @@ -310,33 +310,33 @@ #ifdef Concurrent #define PthreadCoswitch 1 - #define TSLIST + #define TSLIST /* * The default at present does not use __thread. - * To use __thread, uncomment the following line + * To use __thread, uncomment the following line * "#define HAVE_KEYWORD__THREAD" */ -#endif /* Concurrent */ +#endif /* Concurrent */ #ifndef NoINTMAIN #undef INTMAIN #define INTMAIN -#endif /* NoINTMAIN */ +#endif /* NoINTMAIN */ #ifndef NoMessaging #undef Messaging #define Messaging -#endif /* Messaging */ +#endif /* Messaging */ #ifndef NoStrInvoke #undef StrInvoke #define StrInvoke -#endif /* NoStrInvoke */ +#endif /* NoStrInvoke */ #ifndef NoLargeInts #undef LargeInts #define LargeInts -#endif /* NoLargeInts */ +#endif /* NoLargeInts */ #ifdef EventMon #undef MultiProgram @@ -344,8 +344,8 @@ #ifndef NoMonitoredTrappedVar #undef MonitoredTrappedVar #define MonitoredTrappedVar -#endif /* MonitoredTrappedVar */ -#endif /* EventMon */ +#endif /* MonitoredTrappedVar */ +#endif /* EventMon */ /* @@ -426,13 +426,13 @@ #define FAttrib 1 #ifndef NTConsole #define ConsoleWindow 1 - #endif /* NTConsole */ - #endif /* MSWindows */ + #endif /* NTConsole */ + #endif /* MSWindows */ #ifdef MacGraph #undef Graphics #define Graphics 1 - #endif /* MacGraph */ + #endif /* MacGraph */ #endif @@ -442,15 +442,15 @@ #if UNIX #undef HAVE_LIBXPM #define HAVE_LIBXPM - #endif /* UNIX */ - #endif /* NoXpmFormat */ + #endif /* UNIX */ + #endif /* NoXpmFormat */ #ifndef MSWindows #ifndef MacGraph #undef XWindows #define XWindows 1 - #endif /* MacGraph */ - #endif /* MSWindows */ + #endif /* MacGraph */ + #endif /* MSWindows */ #undef LineCodes #define LineCodes @@ -460,11 +460,11 @@ #ifndef NoIconify #define Iconify - #endif /* NoIconify */ + #endif /* NoIconify */ #ifndef ICONC_XLIB #define ICONC_XLIB "-L/usr/X11R6/lib -lX11" - #endif /* ICONC_XLIB */ + #endif /* ICONC_XLIB */ #if defined(ConsoleWindow) || (NT && !defined(Rttx) && !defined(NTConsole)) /* @@ -482,12 +482,12 @@ #endif -#endif /* Graphics */ +#endif /* Graphics */ #ifndef NoExternalFunctions #undef ExternalFunctions #define ExternalFunctions -#endif /* NoExternalFunctions */ +#endif /* NoExternalFunctions */ /* * EBCDIC == 0 corresponds to ASCII. @@ -496,7 +496,7 @@ */ #ifndef EBCDIC #define EBCDIC 0 -#endif /* EBCDIC */ +#endif /* EBCDIC */ /* * Other defaults. @@ -509,15 +509,15 @@ #define DeBugTrans #define DeBugLinker #define DeBugIconx -#endif /* DeBug */ +#endif /* DeBug */ #ifndef AllocType #define AllocType uword -#endif /* AllocType */ +#endif /* AllocType */ #ifndef MaxHdr #define MaxHdr 4096 -#endif /* MaxHdr */ +#endif /* MaxHdr */ #ifndef MaxPath #ifdef PATH_MAX @@ -525,23 +525,23 @@ #else #define MaxPath 1024 #endif -#endif /* MaxPath */ +#endif /* MaxPath */ #ifndef StackAlign #define StackAlign (SIZEOF_INT_P * 2) -#endif /* StackAlign */ +#endif /* StackAlign */ #ifndef WordBits #if Windows #define WordBits (SIZEOF_INT_P * 8) #else #define WordBits (SIZEOF_LONG_INT * 8) - #endif /* Windows */ -#endif /* WordBits */ + #endif /* Windows */ +#endif /* WordBits */ #ifndef IntBits #define IntBits (SIZEOF_INT * 8) -#endif /* IntBits */ +#endif /* IntBits */ #if (WordBits == 64) #define LINTFRMT "l" @@ -549,20 +549,20 @@ #if Windows #define MSWIN64 #define LongLongWord - #endif /* Windows */ + #endif /* Windows */ #ifndef OLD_NTGCC #define Double - #endif /* OLD_NTGCC */ + #endif /* OLD_NTGCC */ #else #define LINTFRMT "" #ifdef ARM #define Double - #endif /* ARM */ + #endif /* ARM */ #endif #ifndef SourceSuffix #define SourceSuffix ".icn" -#endif /* SourceSuffix */ +#endif /* SourceSuffix */ /* * Representations of directories. LocalDir is the "current working directory". @@ -574,7 +574,7 @@ #ifndef TargetDir #define TargetDir LocalDir -#endif /* TargetDir */ +#endif /* TargetDir */ /* * Features enabled by default under certain systems @@ -583,30 +583,30 @@ #ifndef Pipes #if UNIX || VMS #define Pipes - #endif /* UNIX || VMS */ -#endif /* Pipes */ + #endif /* UNIX || VMS */ +#endif /* Pipes */ #ifndef KeyboardFncs #if UNIX #ifndef NoKeyboardFncs - #define KeyboardFncs - #endif /* NoKeyboardFncs */ - #endif /* UNIX */ -#endif /* KeyboardFncs */ + #define KeyboardFncs + #endif /* NoKeyboardFncs */ + #endif /* UNIX */ +#endif /* KeyboardFncs */ #ifndef ReadDirectory #if UNIX #define ReadDirectory - #endif /* UNIX*/ -#endif /* ReadDirectory */ + #endif /* UNIX*/ +#endif /* ReadDirectory */ #ifndef Dbm #if UNIX #ifndef NoDbm #define Dbm 1 - #endif /* NoDbm */ - #endif /* UNIX */ -#endif /* Dbm */ + #endif /* NoDbm */ + #endif /* UNIX */ +#endif /* Dbm */ /* * Default sizing and such. @@ -616,7 +616,7 @@ #ifndef ByteBits #define ByteBits 8 -#endif /* ByteBits */ +#endif /* ByteBits */ /* * The following definitions assume ANSI C. @@ -630,11 +630,11 @@ */ #ifndef SigFncCast #define SigFncCast (void (*)(int)) -#endif /* SigFncCast */ +#endif /* SigFncCast */ #ifndef QSortFncCast #define QSortFncCast int (*)(const void *,const void *) -#endif /* QSortFncCast */ +#endif /* QSortFncCast */ /* * Customize output if not pre-defined. @@ -642,33 +642,33 @@ #if EBCDIC #define BackSlash "\xe0" -#else /* EBCDIC */ +#else /* EBCDIC */ #define BackSlash "\\" -#endif /* EBCDIC */ +#endif /* EBCDIC */ #ifndef WriteBinary #define WriteBinary "wb" -#endif /* WriteBinary */ +#endif /* WriteBinary */ #ifndef ReadBinary #define ReadBinary "rb" -#endif /* ReadBinary */ +#endif /* ReadBinary */ #ifndef ReadWriteBinary #define ReadWriteBinary "wb+" -#endif /* ReadWriteBinary */ +#endif /* ReadWriteBinary */ #ifndef ReadEndBinary #define ReadEndBinary "r+b" -#endif /* ReadEndBinary */ +#endif /* ReadEndBinary */ #ifndef WriteText #define WriteText "w" -#endif /* WriteText */ +#endif /* WriteText */ #ifndef ReadText #define ReadText "r" -#endif /* ReadText */ +#endif /* ReadText */ /* * The following code is operating-system dependent [@config.01]. @@ -678,13 +678,13 @@ #if PORT /* Probably nothing is needed. */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if VMS #define ExecSuffix ".exe" #define ObjSuffix ".obj" #define LibSuffix ".olb" -#endif /* VMS */ +#endif /* VMS */ #if MSDOS @@ -695,35 +695,35 @@ Deliberate Syntax Error #ifndef MICROSOFT #define MICROSOFT 0 - #endif /* MICROSOFT */ + #endif /* MICROSOFT */ #ifndef CSET2 #define CSET2 0 - #endif /* CSet/2 */ + #endif /* CSet/2 */ #ifndef CSET2V2 #define CSET2V2 0 - #endif /* CSet/2 version 2 */ + #endif /* CSet/2 version 2 */ #ifndef TURBO #define TURBO 0 - #endif /* TURBO */ + #endif /* TURBO */ #ifndef NT #define NT 0 - #endif /* NT */ + #endif /* NT */ -#endif /* MSDOS */ +#endif /* MSDOS */ #ifndef NoWildCards #if NT || MICROSOFT #define WildCards 1 - #else /* NT || ... */ + #else /* NT || ... */ #define WildCards 0 - #endif /* NT || ... */ -#else /* NoWildCards */ + #endif /* NT || ... */ +#else /* NoWildCards */ #define WildCards 0 -#endif /* NoWildCards */ +#endif /* NoWildCards */ /* * End of operating-system specific code. @@ -731,130 +731,130 @@ Deliberate Syntax Error #ifndef DiffPtrs #define DiffPtrs(p1,p2) (word)((p1)-(p2)) -#endif /* DiffPtrs */ +#endif /* DiffPtrs */ #ifndef AllocReg #define AllocReg(n) malloc((msize)n) -#endif /* AllocReg */ +#endif /* AllocReg */ #define MaxFileName MaxPath #ifndef RttSuffix #define RttSuffix ".r" -#endif /* RttSuffix */ +#endif /* RttSuffix */ #ifndef DBSuffix #define DBSuffix ".db" -#endif /* DBSuffix */ +#endif /* DBSuffix */ #ifndef PPInit #define PPInit "" -#endif /* PPInit */ +#endif /* PPInit */ #ifndef PPDirectives #define PPDirectives {"passthru", PpKeep}, -#endif /* PPDirectives */ +#endif /* PPDirectives */ #ifndef NoPseudoPty #define PseudoPty -#endif /* PseudoPty */ +#endif /* PseudoPty */ #ifndef NoArrays #ifdef Arrays #undef Arrays #endif #define Arrays 1 -#endif /* Arrays */ +#endif /* Arrays */ #if !defined(NoDescriptorDouble) && (WordBits==64) #define DescriptorDouble 1 -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ #ifndef NoPattern #define PatternType 1 -#endif /* PatternType */ +#endif /* PatternType */ #ifndef ExecSuffix #define ExecSuffix "" -#endif /* ExecSuffix */ +#endif /* ExecSuffix */ #ifndef CSuffix #define CSuffix ".c" -#endif /* CSuffix */ +#endif /* CSuffix */ #ifndef HSuffix #define HSuffix ".h" -#endif /* HSuffix */ +#endif /* HSuffix */ #ifndef ObjSuffix #define ObjSuffix ".o" -#endif /* ObjSuffix */ +#endif /* ObjSuffix */ #ifndef LibSuffix #define LibSuffix ".a" -#endif /* LibSuffix */ +#endif /* LibSuffix */ #ifndef CComp #define CComp "cc" -#endif /* CComp */ +#endif /* CComp */ #ifndef COpts #define COpts "" -#endif /* COpts */ +#endif /* COpts */ /* * Note, size of the hash table is a power of 2: */ #define IHSize 128 -#define IHasher(x) (((unsigned int)(uword)(x))&(IHSize-1)) +#define IHasher(x) (((unsigned int)(uword)(x))&(IHSize-1)) #if COMPILER /* * Code for the compiler. */ - #undef MultiProgram /* no way -- interpreter only */ - #undef EventMon /* presently not supported in the compiler */ - #undef MonitoredTrappedVar /* no way */ - #undef ExecImages /* interpreter only */ - #undef HAVE_IODBC /* ODBC interpreter only until dynamic */ - #undef ISQL /* records get added to the compiler */ - #undef OVLD /* operator overloading -- not supported */ + #undef MultiProgram /* no way -- interpreter only */ + #undef EventMon /* presently not supported in the compiler */ + #undef MonitoredTrappedVar /* no way */ + #undef ExecImages /* interpreter only */ + #undef HAVE_IODBC /* ODBC interpreter only until dynamic */ + #undef ISQL /* records get added to the compiler */ + #undef OVLD /* operator overloading -- not supported */ -#else /* COMPILER */ +#else /* COMPILER */ /* * Code for the interpreter. */ #ifndef IcodeSuffix #define IcodeSuffix "" - #endif /* IcodeSuffix */ + #endif /* IcodeSuffix */ #ifndef IcodeASuffix #define IcodeASuffix "" - #endif /* IcodeASuffix */ + #endif /* IcodeASuffix */ #ifndef U1Suffix #define U1Suffix ".u1" - #endif /* U1Suffix */ + #endif /* U1Suffix */ #ifndef U2Suffix #define U2Suffix ".u2" - #endif /* U2Suffix */ + #endif /* U2Suffix */ #ifndef USuffix #define USuffix ".u" - #endif /* USuffix */ + #endif /* USuffix */ -#endif /* COMPILER */ +#endif /* COMPILER */ #if UNIX #undef Header #define Header #undef ShellHeader #define ShellHeader -#endif /* UNIX */ +#endif /* UNIX */ /* * I don't care what autoconf says, some platforms (Solaris) have trouble @@ -867,98 +867,98 @@ Deliberate Syntax Error #if MSDOS && !NT #undef DirectExecution #define DirectExecution -#endif /* MSDOS && !NT */ +#endif /* MSDOS && !NT */ #ifdef Header #undef DirectExecution #define DirectExecution -#endif /* Header */ +#endif /* Header */ #ifdef PthreadCoswitch #define CoClean 1 -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ #if COMPILER #undef StackCheck #define NoStackCheck -#endif /* COMPILER */ +#endif /* COMPILER */ #ifndef Concurrent #ifndef NoStackCheck #define StackCheck 1 -#endif /* NoStackCheck */ -#endif /* Concurrent */ +#endif /* NoStackCheck */ +#endif /* Concurrent */ #ifdef NoLIBZ #undef HAVE_LIBZ #define HAVE_LIBZ 0 -#endif /* NoLIBZ */ +#endif /* NoLIBZ */ #ifdef NoJPEG #undef HAVE_LIBJPEG #define HAVE_LIBJPEG 0 -#endif /* NoJPEG */ +#endif /* NoJPEG */ #ifdef NoPNG #undef HAVE_LIBPNG #define HAVE_LIBPNG 0 -#endif /* NoPNG */ +#endif /* NoPNG */ #ifdef NoGL #undef HAVE_LIBGL #define HAVE_LIBGL 0 -#endif /* NoGL */ +#endif /* NoGL */ #ifdef NoODBC #undef HAVE_LIBIODBC #define HAVE_LIBIODBC 0 #define HAVE_LIBODBC 0 -#endif /* NoODBC */ +#endif /* NoODBC */ #ifdef NoProfil #undef HAVE_PROFIL #define HAVE_PROFIL 0 -#endif /* NoProfil */ +#endif /* NoProfil */ #ifndef HAVE_LIBZ #define HAVE_LIBZ 0 -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #if !HAVE_LIBZ && !defined(NTGCC) #ifdef HAVE_LIBPNG #undef HAVE_LIBPNG -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ #define HAVE_LIBPNG 0 -#endif /* !HAVE_LIBZ */ +#endif /* !HAVE_LIBZ */ #ifndef HAVE_LIBJPEG #define HAVE_LIBJPEG 0 -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #ifndef HAVE_LIBGL #define HAVE_LIBGL 0 -#endif /* HAVE_LIBGL */ +#endif /* HAVE_LIBGL */ #ifndef HAVE_LIBIODBC #define HAVE_LIBIODBC 0 -#endif /* HAVE_LIBIODBC */ +#endif /* HAVE_LIBIODBC */ #ifndef HAVE_LIBODBC #define HAVE_LIBODBC 0 -#endif /* HAVE_LIBODBC */ +#endif /* HAVE_LIBODBC */ #ifndef HAVE_FTGL #define HAVE_FTGL 0 -#endif /* HAVE_FTGL */ +#endif /* HAVE_FTGL */ #if HAVE_LIBGL #define Graphics3D 1 #define GraphicsGL 1 -#else /* HAVE_LIBGL */ +#else /* HAVE_LIBGL */ #if HAVE_FTGL #undef HAVE_FTGL #define HAVE_FTGL 0 -#endif /* HAVE_FTGL */ -#endif /* HAVE_LIBGL */ +#endif /* HAVE_FTGL */ +#endif /* HAVE_LIBGL */ #ifndef Arrays #undef Graphics3D @@ -967,27 +967,27 @@ Deliberate Syntax Error #ifndef Graphics #undef Graphics3D -#endif /* Graphics */ +#endif /* Graphics */ #if HAVE_LIBIODBC || HAVE_LIBODBC #define ISQL 1 -#endif /* HAVE_LIBIODBC */ +#endif /* HAVE_LIBIODBC */ #ifdef ISQL #ifndef SQL_LENORIND #ifdef MSWIN64 #define SQL_LENORIND SQLLEN -#else /* MSWIN64 */ +#else /* MSWIN64 */ #define SQL_LENORIND SQLINTEGER -#endif /* MSWIN64 */ +#endif /* MSWIN64 */ -#endif /* SQL_LENORIND */ -#endif /* ISQL */ +#endif /* SQL_LENORIND */ +#endif /* ISQL */ #ifndef NoLoadFunc #if HAVE_LIBDL #define LoadFunc -#endif /* HAVE_LIBDL */ +#endif /* HAVE_LIBDL */ #endif @@ -997,22 +997,22 @@ Deliberate Syntax Error * to avoid compiler warnings associated with 0-sized arrays. */ -#define Vsizeof(s) (sizeof(s) - sizeof(struct descrip)) +#define Vsizeof(s) (sizeof(s) - sizeof(struct descrip)) /* * Other sizeof macros: * - * Wsizeof(x) -- Size of x in words. - * Vwsizeof(x) -- Size of x in words, minus the size of a descriptor. Used + * Wsizeof(x) -- Size of x in words. + * Vwsizeof(x) -- Size of x in words, minus the size of a descriptor. Used * when structures have a potentially null list of descriptors * at their end. */ -#define Wsizeof(x) ((sizeof(x) + sizeof(word) - 1) / sizeof(word)) -#define Vwsizeof(x) ((sizeof(x) - sizeof(struct descrip) +\ - sizeof(word) - 1) / sizeof(word)) +#define Wsizeof(x) ((sizeof(x) + sizeof(word) - 1) / sizeof(word)) +#define Vwsizeof(x) ((sizeof(x) - sizeof(struct descrip) +\ + sizeof(word) - 1) / sizeof(word)) -#endif /* UNICON_CONFIG_H */ +#endif /* UNICON_CONFIG_H */ /* * Ensure configurations that are no longer supported cannot be built by accident. @@ -1021,8 +1021,8 @@ Deliberate Syntax Error #if defined(CRAY) || defined (CRAY_STACK) #error The CRAY configuration option is no longer supported (since 7 Mar 2024) -#endif /* CRAY */ +#endif /* CRAY */ #if defined(MACINTOSH) #error The MACINTOSH configuration option is no longer supported (since 7 Mar 2024) -#endif /* MACINTOSH */ +#endif /* MACINTOSH */ diff --git a/src/h/cpuconf.h b/src/h/cpuconf.h index 2a08e087b..7c0b146e5 100644 --- a/src/h/cpuconf.h +++ b/src/h/cpuconf.h @@ -5,8 +5,8 @@ */ #ifndef CStateSize - #define CStateSize 15 /* size of C state for co-expressions */ -#endif /* CStateSize */ + #define CStateSize 15 /* size of C state for co-expressions */ +#endif /* CStateSize */ /* * The following definitions depend on the sizes of ints and pointers. @@ -26,58 +26,58 @@ */ #if WordBits == 64 - + #ifndef MinLong #define MinLong ((word)0x8000000000000000) /* smallest long int */ #endif - + #ifndef MaxLong #define MaxLong ((word)0x7fffffffffffffff) /* largest long integer */ #endif - - #define MaxStrLen 037777777777777777777L /* maximum string length */ - + + #define MaxStrLen 037777777777777777777L /* maximum string length */ + #ifndef MaxNegInt #define MaxNegInt "-9223372036854775808" #endif - + #ifndef F_Nqual - #define F_Nqual 0x8000000000000000 /* set if NOT string qualifier*/ - #endif /* F_Nqual */ + #define F_Nqual 0x8000000000000000 /* set if NOT string qualifier*/ + #endif /* F_Nqual */ #ifndef F_Var - #define F_Var 0x4000000000000000 /* set if variable */ - #endif /* F_Var */ + #define F_Var 0x4000000000000000 /* set if variable */ + #endif /* F_Var */ #ifndef F_Ptr - #define F_Ptr 0x1000000000000000 /* set if value field is ptr */ - #endif /* F_Ptr */ + #define F_Ptr 0x1000000000000000 /* set if value field is ptr */ + #endif /* F_Ptr */ #ifndef F_Typecode - #define F_Typecode 0x2000000000000000 /* set if dword incls typecode*/ - #endif /* F_Typecode */ - -#endif /* WordBits == 64 */ + #define F_Typecode 0x2000000000000000 /* set if dword incls typecode*/ + #endif /* F_Typecode */ + +#endif /* WordBits == 64 */ /* * 32-bit words. */ #if WordBits == 32 - + #define MaxLong ((long int)017777777777L) /* largest long integer */ #define MinLong ((long int)020000000000L) /* smallest long integer */ - + #define MaxNegInt "-2147483648" - - #define MaxStrLen 0777777777 /* maximum string length */ - - #define F_Nqual 0x80000000 /* set if NOT string qualifier */ - #define F_Var 0x40000000 /* set if variable */ - #define F_Ptr 0x10000000 /* set if value field is pointer */ - #define F_Typecode 0x20000000 /* set if dword includes type code */ -#endif /* WordBits == 32 */ + #define MaxStrLen 0777777777 /* maximum string length */ + + #define F_Nqual 0x80000000 /* set if NOT string qualifier */ + #define F_Var 0x40000000 /* set if variable */ + #define F_Ptr 0x10000000 /* set if value field is pointer */ + #define F_Typecode 0x20000000 /* set if dword includes type code */ + +#endif /* WordBits == 32 */ /* * Values that depend on the number of bits in an int (not necessarily @@ -85,9 +85,9 @@ */ #if IntBits == 64 - #define LogIntBits 6 /* log of IntBits */ + #define LogIntBits 6 /* log of IntBits */ #define MaxUnsigned 01777777777777777777777L /* largest unsigned integer */ - #define MaxInt 0777777777777777777777L /* largest int */ + #define MaxInt 0777777777777777777777L /* largest int */ /* * Cset initialization and access macros. */ @@ -97,31 +97,31 @@ #define cset_display(w0,w1,w2,w3,w4,w5,w6,w7,w8,w9,wa,wb,wc,wd,we,wf) \ {fwd(w0,w1,w2,w3),fwd(w4,w5,w6,w7),fwd(w8,w9,wa,wb),fwd(wc,wd,we,wf)} #define Cset32(b,c) (*CsetPtr(b,c)>>(32*CsetOff((b)>>5))) /* 32b of cset */ -#endif /* IntBits == 64 */ +#endif /* IntBits == 64 */ #if IntBits == 32 - #define LogIntBits 5 /* log of IntBits */ - #define MaxUnsigned 037777777777 /* largest unsigned integer */ - #define MaxInt 017777777777 /* largest int */ + #define LogIntBits 5 /* log of IntBits */ + #define MaxUnsigned 037777777777 /* largest unsigned integer */ + #define MaxInt 017777777777 /* largest int */ /* * Cset initialization and access macros. */ - #define twd(w0,w1) (((w0)&0xffff) | (((unsigned)w1)<<16)) + #define twd(w0,w1) (((w0)&0xffff) | (((unsigned)w1)<<16)) #define cset_display(w0,w1,w2,w3,w4,w5,w6,w7,w8,w9,wa,wb,wc,wd,we,wf) \ {twd(w0,w1),twd(w2,w3),twd(w4,w5),twd(w6,w7), \ twd(w8,w9),twd(wa,wb),twd(wc,wd),twd(we,wf)} - #define Cset32(b,c) (*CsetPtr(b,c)) /* 32 bits of cset */ -#endif /* IntBits == 32 */ + #define Cset32(b,c) (*CsetPtr(b,c)) /* 32 bits of cset */ +#endif /* IntBits == 32 */ #if IntBits == 16 - #define LogIntBits 4 /* log of IntBits */ - #define MaxUnsigned ((unsigned int)0177777) /* largest unsigned integer */ - #define MaxInt 077777 /* largest int */ - + #define LogIntBits 4 /* log of IntBits */ + #define MaxUnsigned ((unsigned int)0177777) /* largest unsigned integer */ + #define MaxInt 077777 /* largest int */ + #ifndef MaxListSlots - #define MaxListSlots 8000 /* largest list-element block */ - #endif /* MaxListSlots */ - + #define MaxListSlots 8000 /* largest list-element block */ + #endif /* MaxListSlots */ + /* * Cset initialization and access macros. */ @@ -129,37 +129,37 @@ {w0,w1,w2,w3,w4,w5,w6,w7,w8,w9,wa,wb,wc,wd,we,wf} #define Cset32(b,c) (((unsigned long)(unsigned int)(*CsetPtr((b)+16,c))<<16) | \ ((unsigned long)(unsigned int)(*CsetPtr(b,c)))) /* 32 bits of cset */ -#endif /* IntBits == 16 */ +#endif /* IntBits == 16 */ #ifndef LogHuge - #define LogHuge 309 /* maximum base-10 exp+1 of real */ -#endif /* LogHuge */ + #define LogHuge 309 /* maximum base-10 exp+1 of real */ +#endif /* LogHuge */ #ifndef Big - #define Big 9007199254740992. /* larger than 2^53 lose precision */ -#endif /* Big */ + #define Big 9007199254740992. /* larger than 2^53 lose precision */ +#endif /* Big */ #ifndef Precision - #define Precision 16 /* digits in string from real */ -#endif /* Precision */ + #define Precision 16 /* digits in string from real */ +#endif /* Precision */ /* * Parameters that configure tables and sets: * - * HSlots Initial number of hash buckets; must be a power of 2. - * LogHSlots Log to the base 2 of HSlots. + * HSlots Initial number of hash buckets; must be a power of 2. + * LogHSlots Log to the base 2 of HSlots. * - * HSegs Maximum number of hash bin segments; the maximum number of - * hash bins is HSlots * 2 ^ (HSegs - 1). + * HSegs Maximum number of hash bin segments; the maximum number of + * hash bins is HSlots * 2 ^ (HSegs - 1). * - * If Hsegs is increased above 12, the arrays log2h[] and segsize[] - * in the runtime system will need modification. + * If Hsegs is increased above 12, the arrays log2h[] and segsize[] + * in the runtime system will need modification. * - * MaxHLoad Maximum loading factor; more hash bins are allocated when - * the average bin exceeds this many entries. + * MaxHLoad Maximum loading factor; more hash bins are allocated when + * the average bin exceeds this many entries. * - * MinHLoad Minimum loading factor; if a newly created table (e.g. via - * copy()) is more lightly loaded than this, bins are combined. + * MinHLoad Minimum loading factor; if a newly created table (e.g. via + * copy()) is more lightly loaded than this, bins are combined. * * Because splitting doubles the number of hash bins, and combining halves it, * MaxHLoad should be at least twice MinHLoad. @@ -168,23 +168,23 @@ #ifndef HSlots #define HSlots 16 #define LogHSlots 4 -#endif /* HSlots */ +#endif /* HSlots */ #if ((1 << LogHSlots) != HSlots) Deliberate Syntax Error -- HSlots and LogHSlots are inconsistent -#endif /* HSlots / LogHSlots consistency */ +#endif /* HSlots / LogHSlots consistency */ #ifndef HSegs - #define HSegs 18 -#endif /* HSegs */ + #define HSegs 18 +#endif /* HSegs */ #ifndef MinHLoad #define MinHLoad 1 -#endif /* MinHLoad */ +#endif /* MinHLoad */ #ifndef MaxHLoad #define MaxHLoad 5 -#endif /* MaxHLoad */ +#endif /* MaxHLoad */ /* * The number of bits in each base-B digit; the type DIGIT (unsigned int) @@ -199,10 +199,10 @@ * conversion from large integer to string because of its quadratic * complexity). */ -#define MaxDigits 30 +#define MaxDigits 30 /* - * Memory sizing. + * Memory sizing. */ /* @@ -211,18 +211,18 @@ */ #ifndef AlcMax #define AlcMax 250 -#endif /* AlcMax */ +#endif /* AlcMax */ /* * Maximum sized block that can be allocated (via malloc() or such). */ #ifndef MaxBlock #if IntBits == 16 - #define MaxBlock 65000 /* leaves room for malloc header */ - #else /* IntBits == 16 */ + #define MaxBlock 65000 /* leaves room for malloc header */ + #else /* IntBits == 16 */ #define MaxBlock MaxUnsigned - #endif /* IntBits == 16 */ -#endif /* MaxBlock */ + #endif /* IntBits == 16 */ +#endif /* MaxBlock */ /* * What follows is default memory sizing. Implementations with special @@ -231,83 +231,83 @@ #ifndef MaxStrSpace #if IntBits == 16 - #define MaxStrSpace 65000 /* size of the string space in bytes */ - #else /* IntBits == 16 */ - #define MaxStrSpace 500000 /* size of the string space in bytes */ - #endif /* IntBits == 16 */ -#endif /* MaxStrSpace */ + #define MaxStrSpace 65000 /* size of the string space in bytes */ + #else /* IntBits == 16 */ + #define MaxStrSpace 500000 /* size of the string space in bytes */ + #endif /* IntBits == 16 */ +#endif /* MaxStrSpace */ #ifndef MaxAbrSize #if IntBits == 16 - #define MaxAbrSize 65000 /* size of the block region in bytes */ - #else /* IntBits == 16 */ - #define MaxAbrSize 500000 /* size of the block region in bytes */ - #endif /* IntBits == 16 */ -#endif /* MaxAbrSize */ + #define MaxAbrSize 65000 /* size of the block region in bytes */ + #else /* IntBits == 16 */ + #define MaxAbrSize 500000 /* size of the block region in bytes */ + #endif /* IntBits == 16 */ +#endif /* MaxAbrSize */ #ifndef MStackSize - #define MStackSize 50000 /* size of the main stack in words */ -#endif /* MStackSize */ + #define MStackSize 50000 /* size of the main stack in words */ +#endif /* MStackSize */ #ifndef StackSize - #define StackSize 2000 /* words in co-expression stack */ -#endif /* StackSize */ + #define StackSize 2000 /* words in co-expression stack */ +#endif /* StackSize */ #ifndef QualLstSize - #define QualLstSize 5000 /* size of qualifier pointer region */ -#endif /* QualLstSize */ + #define QualLstSize 5000 /* size of qualifier pointer region */ +#endif /* QualLstSize */ #ifndef ActStkBlkEnts #ifdef CoExpr - #define ActStkBlkEnts 25 /* number of entries in an astkblk */ - #else /* CoExpr */ - #define ActStkBlkEnts 1 /* number of entries in an astkblk */ - #endif /* CoExpr */ -#endif /* ActStkBlkEnts */ + #define ActStkBlkEnts 25 /* number of entries in an astkblk */ + #else /* CoExpr */ + #define ActStkBlkEnts 1 /* number of entries in an astkblk */ + #endif /* CoExpr */ +#endif /* ActStkBlkEnts */ #ifndef RegionCushion - #define RegionCushion 20 /* % memory cushion to avoid thrashing*/ -#endif /* RegionCushion */ + #define RegionCushion 20 /* % memory cushion to avoid thrashing*/ +#endif /* RegionCushion */ #ifndef RegionGrowth - #define RegionGrowth 200 /* % region growth when full */ -#endif /* RegionGrowth */ + #define RegionGrowth 200 /* % region growth when full */ +#endif /* RegionGrowth */ /* * Minimum regions sizes (presently not used). */ #ifndef MinStatSize #ifdef CoExpr - #define MinStatSize 10240 /* size of the static region in bytes*/ - #else /* CoExpr */ - #define MinStatSize 1024 /* size of static region in bytes */ - #endif /* CoExpr */ -#endif /* MinStatSize */ + #define MinStatSize 10240 /* size of the static region in bytes*/ + #else /* CoExpr */ + #define MinStatSize 1024 /* size of static region in bytes */ + #endif /* CoExpr */ +#endif /* MinStatSize */ #ifndef MinStrSpace - #define MinStrSpace 5000 /* size of the string space in bytes */ -#endif /* MinStrSpace */ + #define MinStrSpace 5000 /* size of the string space in bytes */ +#endif /* MinStrSpace */ #ifndef MinAbrSize - #define MinAbrSize 5000 /* size of the block region in bytes */ -#endif /* MinAbrSize */ + #define MinAbrSize 5000 /* size of the block region in bytes */ +#endif /* MinAbrSize */ #ifndef MinMStackSize - #define MinMStackSize 2000 /* size of the main stack in words */ -#endif /* MinMStackSize */ + #define MinMStackSize 2000 /* size of the main stack in words */ +#endif /* MinMStackSize */ #ifndef MinStackSize - #define MinStackSize 1000 /* words in co-expression stack */ -#endif /* MinStackSize */ + #define MinStackSize 1000 /* words in co-expression stack */ +#endif /* MinStackSize */ #ifndef MinQualLstSize - #define MinQualLstSize 500 /* size of qualifier pointer region */ -#endif /* MinQualLstSize */ + #define MinQualLstSize 500 /* size of qualifier pointer region */ +#endif /* MinQualLstSize */ #ifndef GranSize - #define GranSize 64 /* storage allocation granule size */ -#endif /* GranSize */ + #define GranSize 64 /* storage allocation granule size */ +#endif /* GranSize */ #ifndef Sqlinc - #define Sqlinc 128*sizeof(dptr *) /* qualifier pointer list increment */ -#endif /* Sqlinc */ + #define Sqlinc 128*sizeof(dptr *) /* qualifier pointer list increment */ +#endif /* Sqlinc */ diff --git a/src/h/cstructs.h b/src/h/cstructs.h index 4f25a9c0f..0b418909b 100644 --- a/src/h/cstructs.h +++ b/src/h/cstructs.h @@ -6,18 +6,18 @@ /* * fileparts holds a file name broken down into parts. */ -struct fileparts { /* struct of file name parts */ - char *dir; /* directory */ - char *name; /* name */ - char *ext; /* extension */ +struct fileparts { /* struct of file name parts */ + char *dir; /* directory */ + char *name; /* name */ + char *ext; /* extension */ #if VMS char *version; -#endif /* VMS */ +#endif /* VMS */ #if MVS char *member; -#endif /* MVS */ +#endif /* MVS */ }; @@ -25,9 +25,9 @@ struct fileparts { /* struct of file name parts */ * xval - holds references to literal constants */ union xval { - word ival; /* integer */ - double rval; /* real */ - word sval; /* offset into string space of string */ + word ival; /* integer */ + double rval; /* real */ + word sval; /* offset into string space of string */ }; /* @@ -57,35 +57,35 @@ struct str_buf { /* * implement contains information about the implementation of an operation. */ -#define NoRsltSeq -1L /* no result sequence: {} */ +#define NoRsltSeq -1L /* no result sequence: {} */ #define UnbndSeq -2L /* unbounded result sequence: {*} */ -#define DoesRet 01 /* operation (or "body" function) returns */ -#define DoesFail 02 /* operation (or "body" function) fails */ -#define DoesSusp 04 /* operation (or "body" function) suspends */ +#define DoesRet 01 /* operation (or "body" function) returns */ +#define DoesFail 02 /* operation (or "body" function) fails */ +#define DoesSusp 04 /* operation (or "body" function) suspends */ #define DoesEFail 010 /* fails through error conversion */ -#define DoesFThru 020 /* only "body" functions can "fall through" */ +#define DoesFThru 020 /* only "body" functions can "fall through" */ struct implement { struct implement *blink; /* link for bucket chain in hash tables */ char oper_typ; /* 'K'=keyword, 'F'=function, 'O'=operator */ - char prefix[2]; /* prefix to make start of name unique */ - char *name; /* function/operator/keyword name */ - char *op; /* operator symbol (operators only) */ - int nargs; /* number of arguments operation requires */ + char prefix[2]; /* prefix to make start of name unique */ + char *name; /* function/operator/keyword name */ + char *op; /* operator symbol (operators only) */ + int nargs; /* number of arguments operation requires */ int *arg_flgs; /* array of arg flags: deref/underef, var len*/ - long min_result; /* minimum result sequence length */ - long max_result; /* maiximum result sequence length */ - int resume; /* flag - resumption after last result */ - int ret_flag; /* DoesRet, DoesFail, DoesSusp */ + long min_result; /* minimum result sequence length */ + long max_result; /* maiximum result sequence length */ + int resume; /* flag - resumption after last result */ + int ret_flag; /* DoesRet, DoesFail, DoesSusp */ int use_rslt; /* flag - explicitly uses result location */ - char *comment; /* description of operation */ - int ntnds; /* size of tnds array */ + char *comment; /* description of operation */ + int ntnds; /* size of tnds array */ struct tend_var *tnds; /* pointer to array of info about tended vars */ int nvars; /* size of vars array */ struct ord_var *vars; /* pointer to array of info about ordinary vars */ struct il_code *in_line; /* inline version of the operation */ - int iconc_flgs; /* flags for internal use by the compiler */ + int iconc_flgs; /* flags for internal use by the compiler */ }; /* @@ -108,7 +108,7 @@ struct implement { /* * Flags to indicate what types are returned from the function implementing - * a body. These are unsed in determining the calling conventions + * a body. These are unsed in determining the calling conventions * of the function. */ #define RetInt 1 /* body/function returns a C_integer */ @@ -233,7 +233,7 @@ struct il_c { char *s; struct il_c *next; }; - + /* * The parameter value of a run-time operation may be in one of several * different locations depending on what conversions have been done to it. @@ -266,26 +266,26 @@ struct il_c { * Information about an Icon type. */ struct icon_type { - char *id; /* name of type */ - int support_new; /* supports RTL "new" construct */ - int deref; /* dereferencing needs */ - int rtl_ret; /* kind of RTL return supported if any */ - char *typ; /* for variable: initial type */ - int num_comps; /* for aggregate: number of type components */ - int compnts; /* for aggregate: index of first component */ - char *abrv; /* abreviation used for type tracing */ - char *cap_id; /* name of type with first character capitalized */ + char *id; /* name of type */ + int support_new; /* supports RTL "new" construct */ + int deref; /* dereferencing needs */ + int rtl_ret; /* kind of RTL return supported if any */ + char *typ; /* for variable: initial type */ + int num_comps; /* for aggregate: number of type components */ + int compnts; /* for aggregate: index of first component */ + char *abrv; /* abreviation used for type tracing */ + char *cap_id; /* name of type with first character capitalized */ }; /* * Information about a component of an aggregate type. */ struct typ_compnt { - char *id; /* name of component */ - int n; /* position of component within type aggragate */ - int var; /* flag: this component is an Icon-level variable */ - int aggregate; /* index of type that owns the component */ - char *abrv; /* abreviation used for type tracing */ + char *id; /* name of component */ + int n; /* position of component within type aggragate */ + int var; /* flag: this component is an Icon-level variable */ + int aggregate; /* index of type that owns the component */ + char *abrv; /* abreviation used for type tracing */ }; extern int num_typs; /* number of types in table */ diff --git a/src/h/esctab.h b/src/h/esctab.h index 6e598a2ce..14e666c51 100644 --- a/src/h/esctab.h +++ b/src/h/esctab.h @@ -75,4 +75,4 @@ static char esctab[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff, }; -#endif /* EBCDIC */ +#endif /* EBCDIC */ diff --git a/src/h/fdefs.h b/src/h/fdefs.h index 8faeee656..1c3750abe 100644 --- a/src/h/fdefs.h +++ b/src/h/fdefs.h @@ -2,12 +2,12 @@ * Definitions of functions. */ -#undef exit /* may be defined under ConsoleWindow */ +#undef exit /* may be defined under ConsoleWindow */ #if defined(Audio) FncDef(PlayAudio,1) FncDef(StopAudio,1) -#endif /* Audio */ +#endif /* Audio */ #if defined(Audio) || defined(HAVE_VOICE) FncDefV(VAttrib) @@ -105,8 +105,8 @@ FncDefV(write) FncDefV(writes) #ifdef PatternType FncDef(pattern_match,2) /* ?? */ - FncDef(Any,1) - FncDef(Break,1) + FncDef(Any,1) + FncDef(Break,1) FncDef(NotAny,1) FncDef(Span,1) FncDef(Nspan,1) @@ -137,7 +137,7 @@ FncDefV(writes) FncDef(Tab,1) FncDef(Rtab,1) FncDef(pindex_image, 1) -#endif /* PatternType */ +#endif /* PatternType */ /* @@ -152,9 +152,9 @@ FncDefV(writes) #ifdef Graphics FncDefV(open) -#else /* Graphics */ +#else /* Graphics */ FncDef(open,3) -#endif /* Graphics */ +#endif /* Graphics */ #ifdef MultiProgram FncDef(display,3) @@ -162,33 +162,33 @@ FncDefV(writes) FncDef(proc,3) FncDef(variable,4) FncDef(istate,2) -#else /* MultiProgram */ +#else /* MultiProgram */ FncDef(display,2) FncDef(name,1) FncDef(proc,2) FncDef(variable,1) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * Dynamic loading. */ #ifdef LoadFunc FncDef(loadfunc,2) -#endif /* LoadFunc */ +#endif /* LoadFunc */ /* * Executable images. */ #ifdef ExecImages FncDef(save,1) -#endif /* ExecImages */ +#endif /* ExecImages */ /* * External functions. */ #ifdef ExternalFunctions FncDefV(callout) -#endif /* ExternalFunctions */ +#endif /* ExternalFunctions */ /* * Keyboard Functions @@ -197,7 +197,7 @@ FncDefV(writes) FncDef(getch,0) FncDef(getche,0) FncDef(kbhit,0) -#endif /* KeyboardFncs */ +#endif /* KeyboardFncs */ /* * The POSIX interface @@ -257,13 +257,13 @@ FncDef(syswrite,2) FncDef(send,2) FncDef(receive,1) FncDef(setenv,2) -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef PosixFns #ifdef Dbm FncDef(fetch,2) -#endif /* Dbm */ -#endif /* PosixFns */ +#endif /* Dbm */ +#endif /* PosixFns */ /* * Functions for MS-DOS. */ @@ -275,7 +275,7 @@ FncDef(fetch,2) FncDef(FreeSpace,1) FncDef(InPort,1) FncDef(OutPort,1) -#endif /* DosFncs */ +#endif /* DosFncs */ /* * Graphics functions. These are always defined; in virtual machines @@ -369,7 +369,7 @@ FncDef(fetch,2) FncDef(EvSend,3) FncDef(eventmask,2) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* SQL/ODBC database support */ #ifdef ISQL @@ -380,7 +380,7 @@ FncDef(fetch,2) FncDef(dbproduct,1) FncDef(sql,2) FncDef(dbtables,1) -#endif /* ISQL */ +#endif /* ISQL */ FncDefV(DrawTorus) FncDefV(DrawCube) @@ -419,4 +419,4 @@ FncDef(fetch,2) #ifdef HAVE_LIBCL FncDef(opencl, 1) -#endif /* HAVE_LIBCL */ +#endif /* HAVE_LIBCL */ diff --git a/src/h/feature.h b/src/h/feature.h index 74bf7aa15..06ee51339 100644 --- a/src/h/feature.h +++ b/src/h/feature.h @@ -7,124 +7,124 @@ * * For the macro call Feature(guard,symname,kwval) * the parameters are: - * guard for the compiler's runtime system, an expression that must - * evaluate as true for the feature to be included in &features - * symname predefined name in the preprocessor; "" if none - * kwval value produced by the &features keyword; 0 if none + * guard for the compiler's runtime system, an expression that must + * evaluate as true for the feature to be included in &features + * symname predefined name in the preprocessor; "" if none + * kwval value produced by the &features keyword; 0 if none * * The translator and compiler modify this list of predefined symbols * through calls to ppdef(). */ - Feature(1, "_V9", 0) /* Version 9 (unconditional) */ + Feature(1, "_V9", 0) /* Version 9 (unconditional) */ #if VM Feature(1, "_CMS", "CMS") -#endif /* VM */ +#endif /* VM */ #ifdef MacOS Feature(1, "_MACOS", "MacOS") -#endif /* MacOS */ +#endif /* MacOS */ #if MSDOS #if NT Feature(1, "_MS_WINDOWS_NT", "MS Windows NT") -#else /* NT */ +#else /* NT */ Feature(1, "_MSDOS", "MS-DOS") -#endif /* NT */ -#endif /* MSDOS */ +#endif /* NT */ +#endif /* MSDOS */ #if MVS Feature(1, "_MVS", "MVS") -#endif /* MVS */ +#endif /* MVS */ #if PORT Feature(1, "_PORT", "PORT") -#endif /* PORT */ +#endif /* PORT */ #if UNIX Feature(1, "_UNIX", "UNIX") -#endif /* VM */ +#endif /* VM */ #ifdef SUN Feature(1, "_SOLARIS", "Solaris") -#endif /* SUN */ +#endif /* SUN */ #ifdef PosixFns Feature(1, "_POSIX", "POSIX") -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Dbm Feature(1, "_DBM", "DBM") -#endif /* DBM */ +#endif /* DBM */ #if VMS Feature(1, "_VMS", "VMS") -#endif /* VMS */ +#endif /* VMS */ #if EBCDIC != 1 Feature(1, "_ASCII", "ASCII") -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ Feature(1, "_EBCDIC", "EBCDIC") -#endif /* EBCDIC */ +#endif /* EBCDIC */ #ifdef CoExpr Feature(1, "_CO_EXPRESSIONS", "co-expressions") -#endif /* CoExpr */ +#endif /* CoExpr */ #ifdef NativeCoswitch Feature(1, "_NATIVECOSWITCH", "native coswitch") -#endif /* NativeCoswitch */ +#endif /* NativeCoswitch */ #ifdef Concurrent #if ConcurrentCOMPILER Feature(1, "_CONCURRENT", "concurrent threads, compiler subset") -#else /* ConcurrentCOMPILER */ +#else /* ConcurrentCOMPILER */ Feature(1, "_CONCURRENT", "concurrent threads") -#endif /* ConcurrentCOMPILER */ -#endif /* CoExpr */ +#endif /* ConcurrentCOMPILER */ +#endif /* CoExpr */ #ifdef ConsoleWindow Feature(1, "_CONSOLE_WINDOW", "console window") -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef LoadFunc Feature(1, "_DYNAMIC_LOADING", "dynamic loading") -#endif /* LoadFunc */ +#endif /* LoadFunc */ Feature(1, "", "environment variables") #ifdef EventMon Feature(1, "_EVENT_MONITOR", "event monitoring") -#endif /* EventMon */ +#endif /* EventMon */ #ifdef ExternalFunctions Feature(1, "_EXTERNAL_FUNCTIONS", "external functions") -#endif /* ExternalFunctions */ +#endif /* ExternalFunctions */ #ifdef KeyboardFncs Feature(1, "_KEYBOARD_FUNCTIONS", "keyboard functions") -#endif /* KeyboardFncs */ +#endif /* KeyboardFncs */ #ifdef LargeInts Feature(largeints, "_LARGE_INTEGERS", "large integers") -#endif /* LargeInts */ +#endif /* LargeInts */ #ifdef MultiProgram Feature(1, "_MULTITASKING", "multiple programs") -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef PatternType Feature(1, "_PATTERNS", "pattern type") -#endif /* PatternType */ +#endif /* PatternType */ #ifdef Pipes Feature(1, "_PIPES", "pipes") -#endif /* Pipes */ +#endif /* Pipes */ #ifdef PseudoPty Feature(1, "_PTY", "pseudo terminals") -#endif /* PseudoPty */ +#endif /* PseudoPty */ Feature(1, "_SYSTEM_FUNCTION", "system function") @@ -134,62 +134,62 @@ #ifdef Graphics Feature(1, "_GRAPHICS", "graphics") -#endif /* Graphics */ +#endif /* Graphics */ #ifdef Graphics3D Feature(1, "_3D_GRAPHICS", "3D graphics") -#endif /* Graphics */ +#endif /* Graphics */ #ifdef GraphicsGL Feature(1, "_GL_GRAPHICS", "OpenGL graphics") -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #ifdef XWindows Feature(1, "_X_WINDOW_SYSTEM", "X Windows") -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows Feature(1, "_MS_WINDOWS", "MS Windows") #ifdef NT Feature(1, "_WIN32", "Win32") -#endif /* NT */ -#endif /* MSWindows */ +#endif /* NT */ +#endif /* MSWindows */ #ifdef DosFncs Feature(1, "_DOS_FUNCTIONS", "MS-DOS extensions") -#endif /* DosFncs */ +#endif /* DosFncs */ #if HAVE_LIBZ Feature(1, "_LIBZ_COMPRESSION", "libz file compression") -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #if HAVE_LIBJPEG Feature(1, "_JPEG", "JPEG images") -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #if HAVE_LIBPNG Feature(1, "_PNG", "PNG images") -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ #ifdef ISQL Feature(1, "_SQL", "SQL via ODBC") -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Audio Feature(1, "_AUDIO", "Audio") -#endif /* Audio */ +#endif /* Audio */ #ifdef HAVE_LIBSSL Feature(1, "_SSL", "secure sockets layer encryption") -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ #ifdef HAVE_VOICE Feature(1, "_VOIP", "Voice Over IP") -#endif /* HAVE_VOICE */ +#endif /* HAVE_VOICE */ #ifdef OVLD Feature(1, "_OVLD", "operator overloading") -#endif /* OVLD */ +#endif /* OVLD */ #ifdef DEVELOPMODE /* @@ -202,4 +202,4 @@ * are unchanged to avoid breaking existing usage. */ Feature(1, "_DEVMODE", "developer mode") -#endif /* DEVELOPMODE */ +#endif /* DEVELOPMODE */ diff --git a/src/h/filepat.h b/src/h/filepat.h index 2bf338b5d..e29f5e496 100644 --- a/src/h/filepat.h +++ b/src/h/filepat.h @@ -36,40 +36,40 @@ #include typedef struct _FINDFILE_TAG { - intptr_t handle; - struct _finddata_t fileinfo; + intptr_t handle; + struct _finddata_t fileinfo; } FINDDATA_T; -#define FINDFIRST(pattern, pfd) \ +#define FINDFIRST(pattern, pfd) \ ( ( (pfd)->handle = _findfirst ( (pattern), &(pfd)->fileinfo ) ) != -1L ) #define FINDNEXT(pfd) ( _findnext ( (pfd)->handle, &(pfd)->fileinfo ) != -1 ) -#define FILENAME(pfd) ( (pfd)->fileinfo.name ) -#define FINDCLOSE(pfd) _findclose( (pfd)->handle ) +#define FILENAME(pfd) ( (pfd)->fileinfo.name ) +#define FINDCLOSE(pfd) _findclose( (pfd)->handle ) + +#endif /* NT */ -#endif /* NT */ - #if MICROSOFT #include typedef struct _find_t FINDDATA_T; -#define FINDFIRST(pattern, pfd) (!_dos_findfirst ((pattern), _A_NORMAL, (pfd))) -#define FINDNEXT(pfd) ( !_dos_findnext ( (pfd) ) ) -#define FILENAME(pfd) ( (pfd)->name ) -#define FINDCLOSE(pfd) ( (void) 0 ) +#define FINDFIRST(pattern, pfd) (!_dos_findfirst ((pattern), _A_NORMAL, (pfd))) +#define FINDNEXT(pfd) ( !_dos_findnext ( (pfd) ) ) +#define FILENAME(pfd) ( (pfd)->name ) +#define FINDCLOSE(pfd) ( (void) 0 ) + +#endif /* MICROSOFT */ -#endif /* MICROSOFT */ - #if PORT Deliberate Syntax Error /* Give it some thought */ #endif /* PORT */ -#else /* WildCards */ +#else /* WildCards */ typedef struct _NotWild { char *name; } FINDDATA_T; -#define FINDFIRST(pattern, pfd) ((pfd)->name = (pattern)) -#define FINDNEXT(pfd) ( 0 ) -#define FILENAME(pfd) ( (pfd)->name ) -#define FINDCLOSE(pfd) ( (void) 0 ) +#define FINDFIRST(pattern, pfd) ((pfd)->name = (pattern)) +#define FINDNEXT(pfd) ( 0 ) +#define FILENAME(pfd) ( (pfd)->name ) +#define FINDCLOSE(pfd) ( (void) 0 ) -#endif /* WildCards */ +#endif /* WildCards */ #endif diff --git a/src/h/grammar.h b/src/h/grammar.h index 3ea061942..f885db704 100644 --- a/src/h/grammar.h +++ b/src/h/grammar.h @@ -8,286 +8,286 @@ * parserr.h, icont/tgrammar.c, iconc/cgrammar.c, and vtran/vtfiles/ident.c. */ -program : decls EOFX {Progend($1,$2);} ; +program : decls EOFX {Progend($1,$2);} ; -decls : ; - | decls decl ; +decls : ; + | decls decl ; -decl : record {Recdcl($1);} ; - | proc {Procdcl($1);} ; - | global {Globdcl($1);} ; - | link {Linkdcl($1);} ; +decl : record {Recdcl($1);} ; + | proc {Procdcl($1);} ; + | global {Globdcl($1);} ; + | link {Linkdcl($1);} ; | invocable {Invocdcl($1);} ; invocable : INVOCABLE invoclist {Invocable($1, $2);} ; invoclist : invocop; - | invoclist COMMA invocop {Invoclist($1,$2,$3);} ; + | invoclist COMMA invocop {Invoclist($1,$2,$3);} ; invocop : IDENT {Invocop1($1);} ; - | STRINGLIT {Invocop2($1);} ; - | STRINGLIT COLON INTLIT {Invocop3($1,$2,$3);} ; + | STRINGLIT {Invocop2($1);} ; + | STRINGLIT COLON INTLIT {Invocop3($1,$2,$3);} ; -link : LINK lnklist {Link($1, $2);} ; +link : LINK lnklist {Link($1, $2);} ; -lnklist : lnkfile ; - | lnklist COMMA lnkfile {Lnklist($1,$2,$3);} ; +lnklist : lnkfile ; + | lnklist COMMA lnkfile {Lnklist($1,$2,$3);} ; -lnkfile : IDENT {Lnkfile1($1);} ; - | STRINGLIT {Lnkfile2($1);} ; +lnkfile : IDENT {Lnkfile1($1);} ; + | STRINGLIT {Lnkfile2($1);} ; -global : GLOBAL {Global0($1);} idlist {Global1($1, $2, $3);} ; +global : GLOBAL {Global0($1);} idlist {Global1($1, $2, $3);} ; -record : RECORD IDENT {Record1($1,$2);} LPAREN fldlist RPAREN { - Record2($1,$2,$3,$4,$5,$6); - } ; +record : RECORD IDENT {Record1($1,$2);} LPAREN fldlist RPAREN { + Record2($1,$2,$3,$4,$5,$6); + } ; -fldlist : {Arglist1();} ; - | idlist {Arglist2($1);} ; +fldlist : {Arglist1();} ; + | idlist {Arglist2($1);} ; -proc : prochead SEMICOL locals initial procbody END { - Proc1($1,$2,$3,$4,$5,$6); - } ; +proc : prochead SEMICOL locals initial procbody END { + Proc1($1,$2,$3,$4,$5,$6); + } ; prochead: PROCEDURE IDENT {Prochead1($1,$2);} LPAREN arglist RPAREN { - Prochead2($1,$2,$3,$4,$5,$6); - } ; + Prochead2($1,$2,$3,$4,$5,$6); + } ; -arglist : {Arglist1();} ; - | idlist {Arglist2($1);} ; - | idlist LBRACK RBRACK {Arglist3($1,$2,$3);} ; +arglist : {Arglist1();} ; + | idlist {Arglist2($1);} ; + | idlist LBRACK RBRACK {Arglist3($1,$2,$3);} ; -idlist : IDENT { - Ident($1); - } ; - | idlist COMMA IDENT { - Idlist($1,$2,$3); - } ; +idlist : IDENT { + Ident($1); + } ; + | idlist COMMA IDENT { + Idlist($1,$2,$3); + } ; -locals : {Locals1();} ; - | locals retention idlist SEMICOL {Locals2($1,$2,$3,$4);} ; +locals : {Locals1();} ; + | locals retention idlist SEMICOL {Locals2($1,$2,$3,$4);} ; retention: LOCAL {Local($1);} ; - | STATIC {Static($1);} ; + | STATIC {Static($1);} ; -initial : {Initial1();} ; - | INITIAL expr SEMICOL {Initial2($1,$2,$3);} ; +initial : {Initial1();} ; + | INITIAL expr SEMICOL {Initial2($1,$2,$3);} ; procbody: {Procbody1();} ; - | nexpr SEMICOL procbody {Procbody2($1,$2,$3);} ; - -nexpr : {Nexpr();} ; - | expr ; - -expr : expr1a ; - | expr AND expr1a {Bamper($1,$2,$3);} ; - -expr1a : expr1 ; - | expr1a QMARK expr1 {Bques($1,$2,$3);} ; - -expr1 : expr2 ; - | expr2 SWAP expr1 {Bswap($1,$2,$3);} ; - | expr2 ASSIGN expr1 {Bassgn($1,$2,$3);} ; - | expr2 REVSWAP expr1 {Brswap($1,$2,$3);} ; - | expr2 REVASSIGN expr1 {Brassgn($1,$2,$3);} ; - | expr2 AUGCONCAT expr1 {Baugcat($1,$2,$3);} ; - | expr2 AUGLCONCAT expr1 {Bauglcat($1,$2,$3);} ; - | expr2 AUGDIFF expr1 {Bdiffa($1,$2,$3);} ; - | expr2 AUGUNION expr1 {Buniona($1,$2,$3);} ; - | expr2 AUGPLUS expr1 {Bplusa($1,$2,$3);} ; - | expr2 AUGMINUS expr1 {Bminusa($1,$2,$3);} ; - | expr2 AUGSTAR expr1 {Bstara($1,$2,$3);} ; - | expr2 AUGINTER expr1 {Bintera($1,$2,$3);} ; - | expr2 AUGSLASH expr1 {Bslasha($1,$2,$3);} ; - | expr2 AUGMOD expr1 {Bmoda($1,$2,$3);} ; - | expr2 AUGCARET expr1 {Bcareta($1,$2,$3);} ; - | expr2 AUGNMEQ expr1 {Baugeq($1,$2,$3);} ; - | expr2 AUGEQUIV expr1 {Baugeqv($1,$2,$3);} ; - | expr2 AUGNMGE expr1 {Baugge($1,$2,$3);} ; - | expr2 AUGNMGT expr1 {Bauggt($1,$2,$3);} ; - | expr2 AUGNMLE expr1 {Baugle($1,$2,$3);} ; - | expr2 AUGNMLT expr1 {Bauglt($1,$2,$3);} ; - | expr2 AUGNMNE expr1 {Baugne($1,$2,$3);} ; - | expr2 AUGNEQUIV expr1 {Baugneqv($1,$2,$3);} ; - | expr2 AUGSEQ expr1 {Baugseq($1,$2,$3);} ; - | expr2 AUGSGE expr1 {Baugsge($1,$2,$3);} ; - | expr2 AUGSGT expr1 {Baugsgt($1,$2,$3);} ; - | expr2 AUGSLE expr1 {Baugsle($1,$2,$3);} ; - | expr2 AUGSLT expr1 {Baugslt($1,$2,$3);} ; - | expr2 AUGSNE expr1 {Baugsne($1,$2,$3);} ; - | expr2 AUGQMARK expr1 {Baugques($1,$2,$3);} ; - | expr2 AUGAND expr1 {Baugamper($1,$2,$3);} ; - | expr2 AUGAT expr1 {Baugact($1,$2,$3);} ; - -expr2 : expr3 ; - | expr2 TO expr3 {To0($1,$2,$3);} ; - | expr2 TO expr3 BY expr3 {To1($1,$2,$3,$4,$5);} ; - -expr3 : expr4 ; - | expr4 BAR expr3 {Alt($1,$2,$3);} ; - -expr4 : expr5 ; - | expr4 SEQ expr5 {Bseq($1,$2,$3);} ; - | expr4 SGE expr5 {Bsge($1,$2,$3);} ; - | expr4 SGT expr5 {Bsgt($1,$2,$3);} ; - | expr4 SLE expr5 {Bsle($1,$2,$3);} ; - | expr4 SLT expr5 {Bslt($1,$2,$3);} ; - | expr4 SNE expr5 {Bsne($1,$2,$3);} ; - | expr4 NMEQ expr5 {Beq($1,$2,$3);} ; - | expr4 NMGE expr5 {Bge($1,$2,$3);} ; - | expr4 NMGT expr5 {Bgt($1,$2,$3);} ; - | expr4 NMLE expr5 {Ble($1,$2,$3);} ; - | expr4 NMLT expr5 {Blt($1,$2,$3);} ; - | expr4 NMNE expr5 {Bne($1,$2,$3);} ; - | expr4 EQUIV expr5 {Beqv($1,$2,$3);} ; - | expr4 NEQUIV expr5 {Bneqv($1,$2,$3);} ; - -expr5 : expr6 ; - | expr5 CONCAT expr6 {Bcat($1,$2,$3);} ; - | expr5 LCONCAT expr6 {Blcat($1,$2,$3);} ; - -expr6 : expr7 ; - | expr6 PLUS expr7 {Bplus($1,$2,$3);} ; - | expr6 DIFF expr7 {Bdiff($1,$2,$3);} ; - | expr6 UNION expr7 {Bunion($1,$2,$3);} ; - | expr6 MINUS expr7 {Bminus($1,$2,$3);} ; - -expr7 : expr8 ; - | expr7 STAR expr8 {Bstar($1,$2,$3);} ; - | expr7 INTER expr8 {Binter($1,$2,$3);} ; - | expr7 SLASH expr8 {Bslash($1,$2,$3);} ; - | expr7 MOD expr8 {Bmod($1,$2,$3);} ; - -expr8 : expr9 ; - | postfixthreadop ; - | expr9 CARET expr8 {Bcaret($1,$2,$3);} ; + | nexpr SEMICOL procbody {Procbody2($1,$2,$3);} ; + +nexpr : {Nexpr();} ; + | expr ; + +expr : expr1a ; + | expr AND expr1a {Bamper($1,$2,$3);} ; + +expr1a : expr1 ; + | expr1a QMARK expr1 {Bques($1,$2,$3);} ; + +expr1 : expr2 ; + | expr2 SWAP expr1 {Bswap($1,$2,$3);} ; + | expr2 ASSIGN expr1 {Bassgn($1,$2,$3);} ; + | expr2 REVSWAP expr1 {Brswap($1,$2,$3);} ; + | expr2 REVASSIGN expr1 {Brassgn($1,$2,$3);} ; + | expr2 AUGCONCAT expr1 {Baugcat($1,$2,$3);} ; + | expr2 AUGLCONCAT expr1 {Bauglcat($1,$2,$3);} ; + | expr2 AUGDIFF expr1 {Bdiffa($1,$2,$3);} ; + | expr2 AUGUNION expr1 {Buniona($1,$2,$3);} ; + | expr2 AUGPLUS expr1 {Bplusa($1,$2,$3);} ; + | expr2 AUGMINUS expr1 {Bminusa($1,$2,$3);} ; + | expr2 AUGSTAR expr1 {Bstara($1,$2,$3);} ; + | expr2 AUGINTER expr1 {Bintera($1,$2,$3);} ; + | expr2 AUGSLASH expr1 {Bslasha($1,$2,$3);} ; + | expr2 AUGMOD expr1 {Bmoda($1,$2,$3);} ; + | expr2 AUGCARET expr1 {Bcareta($1,$2,$3);} ; + | expr2 AUGNMEQ expr1 {Baugeq($1,$2,$3);} ; + | expr2 AUGEQUIV expr1 {Baugeqv($1,$2,$3);} ; + | expr2 AUGNMGE expr1 {Baugge($1,$2,$3);} ; + | expr2 AUGNMGT expr1 {Bauggt($1,$2,$3);} ; + | expr2 AUGNMLE expr1 {Baugle($1,$2,$3);} ; + | expr2 AUGNMLT expr1 {Bauglt($1,$2,$3);} ; + | expr2 AUGNMNE expr1 {Baugne($1,$2,$3);} ; + | expr2 AUGNEQUIV expr1 {Baugneqv($1,$2,$3);} ; + | expr2 AUGSEQ expr1 {Baugseq($1,$2,$3);} ; + | expr2 AUGSGE expr1 {Baugsge($1,$2,$3);} ; + | expr2 AUGSGT expr1 {Baugsgt($1,$2,$3);} ; + | expr2 AUGSLE expr1 {Baugsle($1,$2,$3);} ; + | expr2 AUGSLT expr1 {Baugslt($1,$2,$3);} ; + | expr2 AUGSNE expr1 {Baugsne($1,$2,$3);} ; + | expr2 AUGQMARK expr1 {Baugques($1,$2,$3);} ; + | expr2 AUGAND expr1 {Baugamper($1,$2,$3);} ; + | expr2 AUGAT expr1 {Baugact($1,$2,$3);} ; + +expr2 : expr3 ; + | expr2 TO expr3 {To0($1,$2,$3);} ; + | expr2 TO expr3 BY expr3 {To1($1,$2,$3,$4,$5);} ; + +expr3 : expr4 ; + | expr4 BAR expr3 {Alt($1,$2,$3);} ; + +expr4 : expr5 ; + | expr4 SEQ expr5 {Bseq($1,$2,$3);} ; + | expr4 SGE expr5 {Bsge($1,$2,$3);} ; + | expr4 SGT expr5 {Bsgt($1,$2,$3);} ; + | expr4 SLE expr5 {Bsle($1,$2,$3);} ; + | expr4 SLT expr5 {Bslt($1,$2,$3);} ; + | expr4 SNE expr5 {Bsne($1,$2,$3);} ; + | expr4 NMEQ expr5 {Beq($1,$2,$3);} ; + | expr4 NMGE expr5 {Bge($1,$2,$3);} ; + | expr4 NMGT expr5 {Bgt($1,$2,$3);} ; + | expr4 NMLE expr5 {Ble($1,$2,$3);} ; + | expr4 NMLT expr5 {Blt($1,$2,$3);} ; + | expr4 NMNE expr5 {Bne($1,$2,$3);} ; + | expr4 EQUIV expr5 {Beqv($1,$2,$3);} ; + | expr4 NEQUIV expr5 {Bneqv($1,$2,$3);} ; + +expr5 : expr6 ; + | expr5 CONCAT expr6 {Bcat($1,$2,$3);} ; + | expr5 LCONCAT expr6 {Blcat($1,$2,$3);} ; + +expr6 : expr7 ; + | expr6 PLUS expr7 {Bplus($1,$2,$3);} ; + | expr6 DIFF expr7 {Bdiff($1,$2,$3);} ; + | expr6 UNION expr7 {Bunion($1,$2,$3);} ; + | expr6 MINUS expr7 {Bminus($1,$2,$3);} ; + +expr7 : expr8 ; + | expr7 STAR expr8 {Bstar($1,$2,$3);} ; + | expr7 INTER expr8 {Binter($1,$2,$3);} ; + | expr7 SLASH expr8 {Bslash($1,$2,$3);} ; + | expr7 MOD expr8 {Bmod($1,$2,$3);} ; + +expr8 : expr9 ; + | postfixthreadop ; + | expr9 CARET expr8 {Bcaret($1,$2,$3);} ; postfixthreadop: - expr9 SND { Bsnd($1,$2,EmptyNode);} ; - | expr9 SNDBK { Bsndbk($1,$2,EmptyNode);} ; - | expr9 RCV { Brcv($1,$2,EmptyNode);} ; - | expr9 RCVBK { Brcvbk($1,$2,EmptyNode);} ; - -expr9 : expr10 ; - | expr9 BACKSLASH expr10 {Blim($1,$2,$3);} ; - | expr9 AT expr10 {Bact($1,$2,$3);}; - | expr9 SND expr10 {Bsnd($1,$2,$3);}; - | expr9 SNDBK expr10 {Bsndbk($1,$2,$3);}; - | expr9 RCV expr10 {Brcv($1,$2,$3);}; - | expr9 RCVBK expr10 {Brcvbk($1,$2,$3);}; - | expr9 BANG expr10 {Apply($1,$2,$3);}; - -expr10 : expr11 ; - | AT expr10 {Uat($1,$2);} ; - | SND expr10 {Bsnd(EmptyNode,$1,$2);} ; - | SNDBK expr10 {Bsndbk(EmptyNode,$1,$2);} ; - | RCV expr10 {Brcv(EmptyNode,$1,$2);} ; - | RCVBK expr10 {Brcvbk(EmptyNode,$1,$2);} ; - | NOT expr10 {Unot($1,$2);} ; - | BAR expr10 {Ubar($1,$2);} ; - | CONCAT expr10 {Uconcat($1,$2);} ; - | LCONCAT expr10 {Ulconcat($1,$2);} ; - | DOT expr10 {Udot($1,$2);} ; - | BANG expr10 {Ubang($1,$2);} ; - | DIFF expr10 {Udiff($1,$2);} ; - | PLUS expr10 {Uplus($1,$2);} ; - | STAR expr10 {Ustar($1,$2);} ; - | SLASH expr10 {Uslash($1,$2);} ; - | CARET expr10 {Ucaret($1,$2);} ; - | INTER expr10 {Uinter($1,$2);} ; - | TILDE expr10 {Utilde($1,$2);} ; - | MINUS expr10 {Uminus($1,$2);} ; - | NMEQ expr10 {Unumeq($1,$2);} ; - | NMNE expr10 {Unumne($1,$2);} ; - | SEQ expr10 {Ulexeq($1,$2);} ; - | SNE expr10 {Ulexne($1,$2);} ; - | EQUIV expr10 {Uequiv($1,$2);} ; - | UNION expr10 {Uunion($1,$2);} ; - | QMARK expr10 {Uqmark($1,$2);} ; - | NEQUIV expr10 {Unotequiv($1,$2);} ; - | BACKSLASH expr10 {Ubackslash($1,$2);} ; - -expr11 : literal ; - | section ; - | return ; - | if ; - | case ; - | while ; - | until ; - | every ; - | repeat ; - | RCV { Brcv(EmptyNode,$1,EmptyNode); }; - | RCVBK { Brcvbk(EmptyNode,$1,EmptyNode); }; - | SND { Bsnd(EmptyNode,$1,EmptyNode); }; - | SNDBK { Bsndbk(EmptyNode,$1,EmptyNode); }; - | CREATE expr {Create($1,$2);} ; - | IDENT {Var($1);} ; - | NEXT {Next($1);} ; - | BREAK nexpr {Break($1,$2);} ; - | LPAREN exprlist RPAREN {Paren($1,$2,$3);} ; - | LBRACE compound RBRACE {Brace($1,$2,$3);} ; - | LBRACK exprlist RBRACK {Brack($1,$2,$3);} ; - | expr11 LBRACK exprlist RBRACK {Subscript($1,$2,$3,$4);} ; - | expr11 LBRACE RBRACE {Pdco0($1,$2,$3);} ; - | expr11 LBRACE pdcolist RBRACE {Pdco1($1,$2,$3,$4);} ; - | expr11 LPAREN exprlist RPAREN {Invoke($1,$2,$3,$4);} ; - | expr11 DOT IDENT {Field($1,$2,$3);} ; - | AND FAIL {Kfail($1,$2);} ; - | AND IDENT {Keyword($1,$2);} ; - - -while : WHILE expr {While0($1,$2);} ; - | WHILE expr DO expr {While1($1,$2,$3,$4);} ; - -until : UNTIL expr {Until0($1,$2);} ; - | UNTIL expr DO expr {Until1($1,$2,$3,$4);} ; - -every : EVERY expr {Every0($1,$2);} ; - | EVERY expr DO expr {Every1($1,$2,$3,$4);} ; - -repeat : REPEAT expr {Repeat($1,$2);} ; - -return : FAIL {Fail($1);} ; - | RETURN nexpr {Return($1,$2);} ; - | SUSPEND nexpr {Suspend0($1,$2);} ; + expr9 SND { Bsnd($1,$2,EmptyNode);} ; + | expr9 SNDBK { Bsndbk($1,$2,EmptyNode);} ; + | expr9 RCV { Brcv($1,$2,EmptyNode);} ; + | expr9 RCVBK { Brcvbk($1,$2,EmptyNode);} ; + +expr9 : expr10 ; + | expr9 BACKSLASH expr10 {Blim($1,$2,$3);} ; + | expr9 AT expr10 {Bact($1,$2,$3);}; + | expr9 SND expr10 {Bsnd($1,$2,$3);}; + | expr9 SNDBK expr10 {Bsndbk($1,$2,$3);}; + | expr9 RCV expr10 {Brcv($1,$2,$3);}; + | expr9 RCVBK expr10 {Brcvbk($1,$2,$3);}; + | expr9 BANG expr10 {Apply($1,$2,$3);}; + +expr10 : expr11 ; + | AT expr10 {Uat($1,$2);} ; + | SND expr10 {Bsnd(EmptyNode,$1,$2);} ; + | SNDBK expr10 {Bsndbk(EmptyNode,$1,$2);} ; + | RCV expr10 {Brcv(EmptyNode,$1,$2);} ; + | RCVBK expr10 {Brcvbk(EmptyNode,$1,$2);} ; + | NOT expr10 {Unot($1,$2);} ; + | BAR expr10 {Ubar($1,$2);} ; + | CONCAT expr10 {Uconcat($1,$2);} ; + | LCONCAT expr10 {Ulconcat($1,$2);} ; + | DOT expr10 {Udot($1,$2);} ; + | BANG expr10 {Ubang($1,$2);} ; + | DIFF expr10 {Udiff($1,$2);} ; + | PLUS expr10 {Uplus($1,$2);} ; + | STAR expr10 {Ustar($1,$2);} ; + | SLASH expr10 {Uslash($1,$2);} ; + | CARET expr10 {Ucaret($1,$2);} ; + | INTER expr10 {Uinter($1,$2);} ; + | TILDE expr10 {Utilde($1,$2);} ; + | MINUS expr10 {Uminus($1,$2);} ; + | NMEQ expr10 {Unumeq($1,$2);} ; + | NMNE expr10 {Unumne($1,$2);} ; + | SEQ expr10 {Ulexeq($1,$2);} ; + | SNE expr10 {Ulexne($1,$2);} ; + | EQUIV expr10 {Uequiv($1,$2);} ; + | UNION expr10 {Uunion($1,$2);} ; + | QMARK expr10 {Uqmark($1,$2);} ; + | NEQUIV expr10 {Unotequiv($1,$2);} ; + | BACKSLASH expr10 {Ubackslash($1,$2);} ; + +expr11 : literal ; + | section ; + | return ; + | if ; + | case ; + | while ; + | until ; + | every ; + | repeat ; + | RCV { Brcv(EmptyNode,$1,EmptyNode); }; + | RCVBK { Brcvbk(EmptyNode,$1,EmptyNode); }; + | SND { Bsnd(EmptyNode,$1,EmptyNode); }; + | SNDBK { Bsndbk(EmptyNode,$1,EmptyNode); }; + | CREATE expr {Create($1,$2);} ; + | IDENT {Var($1);} ; + | NEXT {Next($1);} ; + | BREAK nexpr {Break($1,$2);} ; + | LPAREN exprlist RPAREN {Paren($1,$2,$3);} ; + | LBRACE compound RBRACE {Brace($1,$2,$3);} ; + | LBRACK exprlist RBRACK {Brack($1,$2,$3);} ; + | expr11 LBRACK exprlist RBRACK {Subscript($1,$2,$3,$4);} ; + | expr11 LBRACE RBRACE {Pdco0($1,$2,$3);} ; + | expr11 LBRACE pdcolist RBRACE {Pdco1($1,$2,$3,$4);} ; + | expr11 LPAREN exprlist RPAREN {Invoke($1,$2,$3,$4);} ; + | expr11 DOT IDENT {Field($1,$2,$3);} ; + | AND FAIL {Kfail($1,$2);} ; + | AND IDENT {Keyword($1,$2);} ; + + +while : WHILE expr {While0($1,$2);} ; + | WHILE expr DO expr {While1($1,$2,$3,$4);} ; + +until : UNTIL expr {Until0($1,$2);} ; + | UNTIL expr DO expr {Until1($1,$2,$3,$4);} ; + +every : EVERY expr {Every0($1,$2);} ; + | EVERY expr DO expr {Every1($1,$2,$3,$4);} ; + +repeat : REPEAT expr {Repeat($1,$2);} ; + +return : FAIL {Fail($1);} ; + | RETURN nexpr {Return($1,$2);} ; + | SUSPEND nexpr {Suspend0($1,$2);} ; | SUSPEND expr DO expr {Suspend1($1,$2,$3,$4);}; -if : IF expr THEN expr {If0($1,$2,$3,$4);} ; - | IF expr THEN expr ELSE expr {If1($1,$2,$3,$4,$5,$6);} ; +if : IF expr THEN expr {If0($1,$2,$3,$4);} ; + | IF expr THEN expr ELSE expr {If1($1,$2,$3,$4,$5,$6);} ; -case : CASE expr OF_T LBRACE caselist RBRACE {Case($1,$2,$3,$4,$5,$6);} ; +case : CASE expr OF_T LBRACE caselist RBRACE {Case($1,$2,$3,$4,$5,$6);} ; caselist: cclause ; - | caselist SEMICOL cclause {Caselist($1,$2,$3);} ; + | caselist SEMICOL cclause {Caselist($1,$2,$3);} ; -cclause : DEFAULT COLON expr {Cclause0($1,$2,$3);} ; - | expr COLON expr {Cclause1($1,$2,$3);} ; +cclause : DEFAULT COLON expr {Cclause0($1,$2,$3);} ; + | expr COLON expr {Cclause1($1,$2,$3);} ; exprlist: nexpr {Elst0($1);} - | exprlist COMMA nexpr {Elst1($1,$2,$3);} ; + | exprlist COMMA nexpr {Elst1($1,$2,$3);} ; pdcolist: nexpr { - Pdcolist0($1); - } ; - | pdcolist COMMA nexpr { - Pdcolist1($1,$2,$3); - } ; + Pdcolist0($1); + } ; + | pdcolist COMMA nexpr { + Pdcolist1($1,$2,$3); + } ; -literal : INTLIT {Iliter($1);} ; - | REALLIT {Rliter($1);} ; - | STRINGLIT {Sliter($1);} ; - | CSETLIT {Cliter($1);} ; +literal : INTLIT {Iliter($1);} ; + | REALLIT {Rliter($1);} ; + | STRINGLIT {Sliter($1);} ; + | CSETLIT {Cliter($1);} ; -section : expr11 LBRACK expr sectop expr RBRACK {Section($1,$2,$3,$4,$5,$6);} ; +section : expr11 LBRACK expr sectop expr RBRACK {Section($1,$2,$3,$4,$5,$6);} ; -sectop : COLON {Colon($1);} ; - | PCOLON {Pcolon($1);} ; - | MCOLON {Mcolon($1);} ; +sectop : COLON {Colon($1);} ; + | PCOLON {Pcolon($1);} ; + | MCOLON {Mcolon($1);} ; compound: nexpr ; - | nexpr SEMICOL compound {Compound($1,$2,$3);} ; + | nexpr SEMICOL compound {Compound($1,$2,$3);} ; -program : error decls EOFX ; -proc : prochead error procbody END ; -expr : error ; +program : error decls EOFX ; +proc : prochead error procbody END ; +expr : error ; diff --git a/src/h/graphics.h b/src/h/graphics.h index 4834391a6..8347f1c26 100644 --- a/src/h/graphics.h +++ b/src/h/graphics.h @@ -2,26 +2,26 @@ * graphics.h - macros and types used in Icon's graphics interface. */ -#define MAXDISPLAYNAME 128 +#define MAXDISPLAYNAME 128 #ifdef MacGraph #include "::h:macgraph.h" -#endif /* MacGraph */ +#endif /* MacGraph */ #ifdef XWindows #include "../h/xwin.h" -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows #include "../h/mswin.h" -#endif /* MSWindows */ +#endif /* MSWindows */ #if Graphics3D || GraphicsGL #if HAVE_LIBGL #include "../h/opengl.h" -#else /* HAVE_LIBGL */ +#else /* HAVE_LIBGL */ #include "../h/direct3d.h" -#endif /* HAVE_LIBGL */ +#endif /* HAVE_LIBGL */ /* * # of POLL_INTERVAL intervals for determining OpenGL 2D graphics refresh rate @@ -29,115 +29,115 @@ */ #define FLUSH_POLL_INTERVAL 10 -#define REDRAW_CUBE 0x010 -#define REDRAW_CYLINDER 0x020 -#define REDRAW_DISK 0x030 -#define REDRAW_LINE 0x040 -#define REDRAW_POINT 0x050 -#define REDRAW_POLYGON 0x060 -#define REDRAW_SEGMENT 0x070 -#define REDRAW_SPHERE 0x080 -#define REDRAW_TORUS 0x090 -#define REDRAW_FG 0x0A0 -#define REDRAW_FILLPOLYGON 0x0B0 -#define REDRAW_IDENTITY 0x0C0 -#define REDRAW_MATRIXMODE 0x0D0 -#define REDRAW_POPMATRIX 0x0E0 -#define REDRAW_PUSHMATRIX 0x0F0 -#define REDRAW_ROTATE 0x100 -#define REDRAW_SCALE 0x110 -#define REDRAW_TEXTURE 0x120 -#define REDRAW_TEXCOORD 0x130 -#define REDRAW_TRANSLATE 0x140 -#define REDRAW_DIM 0x150 -#define REDRAW_LINEWIDTH 0x160 -#define REDRAW_TEXMODE 0x170 -#define REDRAW_FONT3D 0x180 -#define REDRAW_DRAWSTRING3D 0x190 -#define REDRAW_MARK 0x1A0 -#define REDRAW_ENDMARK 0x1B0 -#define REDRAW_MESHMODE 0x1C0 -#define REDRAW_PICK 0x1D0 -#define REDRAW_MULTMATRIX 0x1E0 -#define REDRAW_NORMALS 0x1F0 -#define REDRAW_NORMODE 0x200 -#define REDRAW_SLICES 0x210 -#define REDRAW_RINGS 0x220 +#define REDRAW_CUBE 0x010 +#define REDRAW_CYLINDER 0x020 +#define REDRAW_DISK 0x030 +#define REDRAW_LINE 0x040 +#define REDRAW_POINT 0x050 +#define REDRAW_POLYGON 0x060 +#define REDRAW_SEGMENT 0x070 +#define REDRAW_SPHERE 0x080 +#define REDRAW_TORUS 0x090 +#define REDRAW_FG 0x0A0 +#define REDRAW_FILLPOLYGON 0x0B0 +#define REDRAW_IDENTITY 0x0C0 +#define REDRAW_MATRIXMODE 0x0D0 +#define REDRAW_POPMATRIX 0x0E0 +#define REDRAW_PUSHMATRIX 0x0F0 +#define REDRAW_ROTATE 0x100 +#define REDRAW_SCALE 0x110 +#define REDRAW_TEXTURE 0x120 +#define REDRAW_TEXCOORD 0x130 +#define REDRAW_TRANSLATE 0x140 +#define REDRAW_DIM 0x150 +#define REDRAW_LINEWIDTH 0x160 +#define REDRAW_TEXMODE 0x170 +#define REDRAW_FONT3D 0x180 +#define REDRAW_DRAWSTRING3D 0x190 +#define REDRAW_MARK 0x1A0 +#define REDRAW_ENDMARK 0x1B0 +#define REDRAW_MESHMODE 0x1C0 +#define REDRAW_PICK 0x1D0 +#define REDRAW_MULTMATRIX 0x1E0 +#define REDRAW_NORMALS 0x1F0 +#define REDRAW_NORMODE 0x200 +#define REDRAW_SLICES 0x210 +#define REDRAW_RINGS 0x220 /* aliases for better comprehension */ -#define GL3D_CUBE REDRAW_CUBE -#define GL3D_CYLINDER REDRAW_CYLINDER -#define GL3D_DISK REDRAW_DISK -#define GL3D_SPHERE REDRAW_SPHERE -#define GL3D_TORUS REDRAW_TORUS -#define GL3D_IDENTITY REDRAW_IDENTITY -#define GL3D_MATRIXMODE REDRAW_MATRIXMODE -#define GL3D_POPMATRIX REDRAW_POPMATRIX -#define GL3D_PUSHMATRIX REDRAW_PUSHMATRIX -#define GL3D_ROTATE REDRAW_ROTATE -#define GL3D_SCALE REDRAW_SCALE -#define GL3D_TEXTURE REDRAW_TEXTURE -#define GL3D_TRANSLATE REDRAW_TRANSLATE -#define GL3D_FONT REDRAW_FONT3D -#define GL3D_DRAWSTRING REDRAW_DRAWSTRING3D -#define GL3D_MARK REDRAW_MARK -#define GL3D_ENDMARK REDRAW_ENDMARK -#define GL3D_MESHMODE REDRAW_MESHMODE - -#endif /* Graphics3D || GraphicsGL */ +#define GL3D_CUBE REDRAW_CUBE +#define GL3D_CYLINDER REDRAW_CYLINDER +#define GL3D_DISK REDRAW_DISK +#define GL3D_SPHERE REDRAW_SPHERE +#define GL3D_TORUS REDRAW_TORUS +#define GL3D_IDENTITY REDRAW_IDENTITY +#define GL3D_MATRIXMODE REDRAW_MATRIXMODE +#define GL3D_POPMATRIX REDRAW_POPMATRIX +#define GL3D_PUSHMATRIX REDRAW_PUSHMATRIX +#define GL3D_ROTATE REDRAW_ROTATE +#define GL3D_SCALE REDRAW_SCALE +#define GL3D_TEXTURE REDRAW_TEXTURE +#define GL3D_TRANSLATE REDRAW_TRANSLATE +#define GL3D_FONT REDRAW_FONT3D +#define GL3D_DRAWSTRING REDRAW_DRAWSTRING3D +#define GL3D_MARK REDRAW_MARK +#define GL3D_ENDMARK REDRAW_ENDMARK +#define GL3D_MESHMODE REDRAW_MESHMODE + +#endif /* Graphics3D || GraphicsGL */ #ifndef MAXXOBJS #define MAXXOBJS 256 -#endif /* MAXXOBJS */ +#endif /* MAXXOBJS */ #ifndef DMAXCOLORS #define DMAXCOLORS 256 -#endif /* DMAXCOLORS */ +#endif /* DMAXCOLORS */ #ifndef MAXCOLORNAME #define MAXCOLORNAME 40 -#endif /* MAXCOLORNAME */ +#endif /* MAXCOLORNAME */ #ifndef MAXFONTWORD #define MAXFONTWORD 40 -#endif /* MAXFONTWORD */ +#endif /* MAXFONTWORD */ #define DEFAULTFONTSIZE 14 -#define FONTATT_SPACING 0x01000000 -#define FONTFLAG_MONO 0x00000001 -#define FONTFLAG_PROPORTIONAL 0x00000002 - -#define FONTATT_SERIF 0x02000000 -#define FONTFLAG_SANS 0x00000004 -#define FONTFLAG_SERIF 0x00000008 - -#define FONTATT_SLANT 0x04000000 -#define FONTFLAG_ROMAN 0x00000010 -#define FONTFLAG_ITALIC 0x00000020 -#define FONTFLAG_OBLIQUE 0x00000040 - -#define FONTATT_WEIGHT 0x08000000 -#define FONTFLAG_LIGHT 0x00000100 -#define FONTFLAG_MEDIUM 0x00000200 -#define FONTFLAG_DEMI 0x00000400 -#define FONTFLAG_BOLD 0x00000800 - -#define FONTATT_WIDTH 0x10000000 -#define FONTFLAG_CONDENSED 0x00001000 -#define FONTFLAG_NARROW 0x00002000 -#define FONTFLAG_NORMAL 0x00004000 -#define FONTFLAG_WIDE 0x00008000 -#define FONTFLAG_EXTENDED 0x00010000 - -#define FONTATT_CHARSET 0x20000000 -#define FONTFLAG_LATIN1 0x00020000 -#define FONTFLAG_LATIN2 0x00040000 -#define FONTFLAG_CYRILLIC 0x00080000 -#define FONTFLAG_ARABIC 0x00100000 -#define FONTFLAG_GREEK 0x00200000 -#define FONTFLAG_HEBREW 0x00400000 -#define FONTFLAG_LATIN6 0x00800000 +#define FONTATT_SPACING 0x01000000 +#define FONTFLAG_MONO 0x00000001 +#define FONTFLAG_PROPORTIONAL 0x00000002 + +#define FONTATT_SERIF 0x02000000 +#define FONTFLAG_SANS 0x00000004 +#define FONTFLAG_SERIF 0x00000008 + +#define FONTATT_SLANT 0x04000000 +#define FONTFLAG_ROMAN 0x00000010 +#define FONTFLAG_ITALIC 0x00000020 +#define FONTFLAG_OBLIQUE 0x00000040 + +#define FONTATT_WEIGHT 0x08000000 +#define FONTFLAG_LIGHT 0x00000100 +#define FONTFLAG_MEDIUM 0x00000200 +#define FONTFLAG_DEMI 0x00000400 +#define FONTFLAG_BOLD 0x00000800 + +#define FONTATT_WIDTH 0x10000000 +#define FONTFLAG_CONDENSED 0x00001000 +#define FONTFLAG_NARROW 0x00002000 +#define FONTFLAG_NORMAL 0x00004000 +#define FONTFLAG_WIDE 0x00008000 +#define FONTFLAG_EXTENDED 0x00010000 + +#define FONTATT_CHARSET 0x20000000 +#define FONTFLAG_LATIN1 0x00020000 +#define FONTFLAG_LATIN2 0x00040000 +#define FONTFLAG_CYRILLIC 0x00080000 +#define FONTFLAG_ARABIC 0x00100000 +#define FONTFLAG_GREEK 0x00200000 +#define FONTFLAG_HEBREW 0x00400000 +#define FONTFLAG_LATIN6 0x00800000 #define FONT_OUTLINE 0x00000001 #define FONT_POLYGON 0x00000002 @@ -175,10 +175,10 @@ #define ISCURSORONW(ws) ((ws->bits) & 2) /* bit 4 is available */ #define ISREVERSE(w) ((w)->context->bits & 8) -#define ISXORREVERSE(w) ((w)->context->bits & 16) +#define ISXORREVERSE(w) ((w)->context->bits & 16) #define ISXORREVERSEW(w) ((w)->bits & 16) -#define ISCLOSED(w) ((w)->window->bits & 64) -#define ISRESIZABLE(w) ((w)->window->bits & 128) +#define ISCLOSED(w) ((w)->window->bits & 64) +#define ISRESIZABLE(w) ((w)->window->bits & 128) #define ISEXPOSED(w) ((w)->window->bits & 256) #define ISCEOLON(w) ((w)->window->bits & 512) #define ISECHOON(w) ((w)->window->bits & 1024) @@ -187,8 +187,8 @@ /* bit 4 is available */ #define SETREVERSE(w) ((w)->context->bits |= 8) #define SETXORREVERSE(w) ((w)->context->bits |= 16) -#define SETCLOSED(w) ((w)->window->bits |= 64) -#define SETRESIZABLE(w) ((w)->window->bits |= 128) +#define SETCLOSED(w) ((w)->window->bits |= 64) +#define SETRESIZABLE(w) ((w)->window->bits |= 128) #define SETEXPOSED(w) ((w)->window->bits |= 256) #define SETCEOLON(w) ((w)->window->bits |= 512) #define SETECHOON(w) ((w)->window->bits |= 1024) @@ -197,8 +197,8 @@ /* bit 4 is available */ #define CLRREVERSE(w) ((w)->context->bits &= ~8) #define CLRXORREVERSE(w) ((w)->context->bits &= ~16) -#define CLRCLOSED(w) ((w)->window->bits &= ~64) -#define CLRRESIZABLE(w) ((w)->window->bits &= ~128) +#define CLRCLOSED(w) ((w)->window->bits &= ~64) +#define CLRRESIZABLE(w) ((w)->window->bits &= ~128) #define CLREXPOSED(w) ((w)->window->bits &= ~256) #define CLRCEOLON(w) ((w)->window->bits &= ~512) #define CLRECHOON(w) ((w)->window->bits &= ~1024) @@ -207,19 +207,19 @@ #define ISZOMBIE(w) ((w)->window->bits & 1) #define SETZOMBIE(w) ((w)->window->bits |= 1) #define CLRZOMBIE(w) ((w)->window->bits &= ~1) -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows #define ISTOBEHIDDEN(ws) ((ws)->bits & 4096) #define SETTOBEHIDDEN(ws) ((ws)->bits |= 4096) #define CLRTOBEHIDDEN(ws) ((ws)->bits &= ~4096) -#endif /* MSWindows */ +#endif /* MSWindows */ #define ISTITLEBAR(ws) ((ws)->bits & 8192) #define SETTITLEBAR(ws) ((ws)->bits |= 8192) #define CLRTITLEBAR(ws) ((ws)->bits &= ~8192) - + /* * Window Resources * Icon "Resources" are a layer on top of the window system resources, @@ -229,14 +229,14 @@ * into internal window system structures. */ - + /* * Fonts are allocated within displays. */ typedef struct _wfont { - int refcount; - int serial; /* serial # */ + int refcount; + int serial; /* serial # */ struct _wfont *previous, *next; char type; int size; @@ -245,49 +245,49 @@ typedef struct _wfont { short fontNum; Style fontStyle; int fontSize; - FontInfo fInfo; /* I-173 */ -#endif /* MacGraph */ + FontInfo fInfo; /* I-173 */ +#endif /* MacGraph */ #ifdef XWindows - char * name; /* name for WAttrib and fontsearch */ + char * name; /* name for WAttrib and fontsearch */ int ascent; /* font dimensions */ int descent; - int height; + int height; int maxwidth; /* max width of one char */ #ifdef HAVE_XFT XftFont * fsp; -#else /* HAVE_XFT */ - XFontStruct * fsp; /* X font pointer */ -#endif /* HAVE_XFT */ -#endif /* XWindows */ +#else /* HAVE_XFT */ + XFontStruct * fsp; /* X font pointer */ +#endif /* HAVE_XFT */ +#endif /* XWindows */ #ifdef MSWindows - char *name; /* name for WAttrib and fontsearch */ - HFONT font; - LONG ascent; - LONG descent; - LONG charwidth; - LONG height; -#endif /* MSWindows */ + char *name; /* name for WAttrib and fontsearch */ + HFONT font; + LONG ascent; + LONG descent; + LONG charwidth; + LONG height; +#endif /* MSWindows */ #ifdef GraphicsGL #if HAVE_LIBFREETYPE - FT_Library library; - FT_Face face; -#endif /* HAVE_LIBFREETYPE */ + FT_Library library; + FT_Face face; +#endif /* HAVE_LIBFREETYPE */ struct fontsymbol chars[256]; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ } wfont, *wfp; /* * These structures and definitions are used for colors and images. */ typedef struct { - long red, green, blue; /* color components, linear 0 - 65535*/ + long red, green, blue; /* color components, linear 0 - 65535*/ } LinearColor; -struct palentry { /* entry for one palette member */ - LinearColor clr; /* RGB value of color */ - char used; /* nonzero if char is used */ - char valid; /* nonzero if entry is valid & opaque */ - char transpt; /* nonzero if char is transparent */ +struct palentry { /* entry for one palette member */ + LinearColor clr; /* RGB value of color */ + char used; /* nonzero if char is used */ + char valid; /* nonzero if entry is valid & opaque */ + char transpt; /* nonzero if char is transparent */ }; /* @@ -296,34 +296,34 @@ struct palentry { /* entry for one palette member */ #define UCOLOR_RGB 1 #define UCOLOR_BGR 2 -struct imgdata { /* image loaded from a file */ - int width, height; /* image dimensions */ +struct imgdata { /* image loaded from a file */ + int width, height; /* image dimensions */ int format; int is_bottom_up; - struct palentry *paltbl; /* pointer to palette table */ - unsigned char *data; /* pointer to image data */ + struct palentry *paltbl; /* pointer to palette table */ + unsigned char *data; /* pointer to image data */ }; struct imgmem { int x, y, width, height; #ifdef GraphicsGL unsigned short *pixmap; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #ifdef XWindows XImage *im; -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows COLORREF *crp; -#endif /* MSWindows */ +#endif /* MSWindows */ }; -#define TCH1 '~' /* usual transparent character */ -#define TCH2 0377 /* alternate transparent character */ -#define PCH1 ' ' /* punctuation character */ -#define PCH2 ',' /* punctuation character */ +#define TCH1 '~' /* usual transparent character */ +#define TCH2 0377 /* alternate transparent character */ +#define PCH1 ' ' /* punctuation character */ +#define PCH2 ',' /* punctuation character */ -#ifdef MacGraph +#ifdef MacGraph typedef struct _wctype { Pattern bkPat; Pattern fillPat; @@ -339,7 +339,7 @@ typedef struct _wctype { RGBColor fgColor; RGBColor bgColor; } ContextType, *ContextPtrType; -#endif /* MacGraph */ +#endif /* MacGraph */ /* @@ -351,83 +351,83 @@ typedef struct _wctype { #define INITTEXTURENUM 64 typedef struct _wtexture { - int refcount; - int serial; /* serial # */ + int refcount; + int serial; /* serial # */ int width, height; struct _wbinding *w; struct _wtexture *previous, *next; - int textype; /* 1 = file, 2 = window (descrip), 3 = string*/ + int textype; /* 1 = file, 2 = window (descrip), 3 = string*/ struct descrip d; - struct { /* if type = 1, we store file attributes */ + struct { /* if type = 1, we store file attributes */ int size; int timestamp; } fattr; #if HAVE_LIBGL GLubyte *tex; - GLuint texName; /* GL texture name*/ + GLuint texName; /* GL texture name*/ #endif } wtexture, *wtp; -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * Displays are maintained in a global list in rwinrsc.r. */ typedef struct _wdisplay { - int refcount; - int serial; /* serial # */ - int numFonts; + int refcount; + int serial; /* serial # */ + int numFonts; #ifdef MSWindows - char name[MAXDISPLAYNAME]; -#endif /* MSWindows*/ + char name[MAXDISPLAYNAME]; +#endif /* MSWindows*/ #ifdef XWindows - char name[MAXDISPLAYNAME]; - Display * display; - GC icongc; - Colormap cmap; + char name[MAXDISPLAYNAME]; + Display * display; + GC icongc; + Colormap cmap; #ifdef GraphicsGL - int nConfigs; - GLXFBConfig *configs; + int nConfigs; + GLXFBConfig *configs; XVisualInfo *vis; - GLXContext sharedCtx; /* shared context for texture sharing */ - GLXContext currCtx; /* keeps track of current context */ -#endif /* GraphicsGL */ + GLXContext sharedCtx; /* shared context for texture sharing */ + GLXContext currCtx; /* keeps track of current context */ +#endif /* GraphicsGL */ #ifdef HAVE_XFT XFontStruct *xfont; -#endif /* HAVE_XFT */ - Cursor cursors[NUMCURSORSYMS]; - int numColors; /* allocated color info */ - int sizColors; /* # elements of alloc. color array */ - struct wcolor *colors; - int screen; - wfp fonts; - int buckets[16384]; /* hash table for quicker lookups */ -#endif /* XWindows */ +#endif /* HAVE_XFT */ + Cursor cursors[NUMCURSORSYMS]; + int numColors; /* allocated color info */ + int sizColors; /* # elements of alloc. color array */ + struct wcolor *colors; + int screen; + wfp fonts; + int buckets[16384]; /* hash table for quicker lookups */ +#endif /* XWindows */ #ifdef GraphicsGL - unsigned int stdPatTexIds[16]; /* array of std pattern texture ids */ + unsigned int stdPatTexIds[16]; /* array of std pattern texture ids */ unsigned int *texIds; unsigned int numTexIds; unsigned int maxTexIds; - wfp glfonts; /* For OpenGL & X11 to live happily together */ - int numMclrs; - int muteIdCount; + wfp glfonts; /* For OpenGL & X11 to live happily together */ + int numMclrs; + int muteIdCount; struct color *mclrs; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #ifdef Graphics3D - int ntextures; /* # textures actually used */ - int nalced; /* number allocated */ + int ntextures; /* # textures actually used */ + int nalced; /* number allocated */ wtp stex; int maxstex; -#endif /* Graphics3D */ - double gamma; +#endif /* Graphics3D */ + double gamma; struct _wdisplay *previous, *next; } *wdp; @@ -438,87 +438,87 @@ typedef struct _wdisplay { * Contexts are allocated out of a global array in rwinrsrc.c. */ typedef struct _wcontext { - int refcount; - int serial; /* serial # */ + int refcount; + int serial; /* serial # */ struct _wcontext *previous, *next; - int clipx, clipy, clipw, cliph; - char *patternname; - wfp font; - int dx, dy; - int fillstyle; - int drawop; - int rgbmode; /* 0=auto, 1=24, 2=48, 3=norm */ - double gamma; /* gamma correction value */ - int bits; /* context bits */ + int clipx, clipy, clipw, cliph; + char *patternname; + wfp font; + int dx, dy; + int fillstyle; + int drawop; + int rgbmode; /* 0=auto, 1=24, 2=48, 3=norm */ + double gamma; /* gamma correction value */ + int bits; /* context bits */ #ifdef GraphicsGL struct color glfg, glbg; - int reverse; - double alpha; - int linestyle; - int linewidth; - int leading; /* inter-line leading */ -#endif /* GraphicsGL */ + int reverse; + double alpha; + int linestyle; + int linewidth; + int leading; /* inter-line leading */ +#endif /* GraphicsGL */ #ifdef MacGraph ContextPtrType contextPtr; -#endif /* MacGraph */ - wdp display; +#endif /* MacGraph */ + wdp display; #ifdef XWindows - GC gc; /* X graphics context */ - int fg, bg; + GC gc; /* X graphics context */ + int fg, bg; #ifndef GraphicsGL - int linestyle; - int linewidth; - int leading; /* inter-line leading */ -#endif /* GraphicsGL */ -#endif /* XWindows */ + int linestyle; + int linewidth; + int leading; /* inter-line leading */ +#endif /* GraphicsGL */ +#endif /* XWindows */ #ifdef MSWindows - LOGPEN pen; - LOGPEN bgpen; - LOGBRUSH brush; - LOGBRUSH bgbrush; + LOGPEN pen; + LOGPEN bgpen; + LOGBRUSH brush; + LOGBRUSH bgbrush; HRGN cliprgn; - HBITMAP pattern; - SysColor fg, bg; - char *fgname, *bgname; + HBITMAP pattern; + SysColor fg, bg; + char *fgname, *bgname; #ifdef GraphicsGL - int bkmode; -#else /* GraphicsGL */ - int leading, bkmode; -#endif /* GraphicsGL */ -#endif /* MSWindows*/ + int bkmode; +#else /* GraphicsGL */ + int leading, bkmode; +#endif /* GraphicsGL */ +#endif /* MSWindows*/ #ifdef Graphics3D - int dim; /* # of coordinates per vertex */ - int rendermode; /* flag for 3D windows */ - char buffermode; /* 3D buffering flag */ - char meshmode; /* fillpolygon mesh mode */ + int dim; /* # of coordinates per vertex */ + int rendermode; /* flag for 3D windows */ + char buffermode; /* 3D buffering flag */ + char meshmode; /* fillpolygon mesh mode */ - int slices; /* slices and rings for level of */ - int rings; /* detail sphere etal to be drawn */ + int slices; /* slices and rings for level of */ + int rings; /* detail sphere etal to be drawn */ /* selection parameters */ int selectionenabled; /* selection is enabled */ - int selectionrendermode; /* selection code should be executed */ - int selectionavailablename; /* what int code to use for OpenGL name */ - char ** selectionnamelist; /* all of the current used names */ - int selectionnamecount; /* how many - used so far */ - int selectionnamelistsize; /* current available size */ - int app_use_selection3D; /* the application uses 3D selection */ - - struct b_realarray *normals; /* vertex normals data */ - - int normode; /* normals on, off or auto */ + int selectionrendermode; /* selection code should be executed */ + int selectionavailablename; /* what int code to use for OpenGL name */ + char ** selectionnamelist; /* all of the current used names */ + int selectionnamecount; /* how many - used so far */ + int selectionnamelistsize; /* current available size */ + int app_use_selection3D; /* the application uses 3D selection */ + + struct b_realarray *normals; /* vertex normals data */ + + int normode; /* normals on, off or auto */ int numnormals; /* # of normals used */ - + int autogen; /* flag to automatically generate texture coordinate */ int texmode; /* textures on or off */ int numtexcoords; /* # of texture coordinates used */ struct b_realarray *texcoords; /* texture coordinates */ - - int curtexture; /* subscript of current texture */ -#endif /* Graphics3D */ + + int curtexture; /* subscript of current texture */ +#endif /* Graphics3D */ } wcontext, *wcp; /* @@ -530,23 +530,23 @@ typedef struct _wcontext { #define CHILD_SCROLLBAR 1 #define CHILD_EDIT 2 typedef struct childcontrol { - int type; /* what kind of control? */ - HWND win; /* child window handle */ + int type; /* what kind of control? */ + HWND win; /* child window handle */ HFONT font; - char *id; /* child window string id */ + char *id; /* child window string id */ } childcontrol; -#endif /* MSWindows */ +#endif /* MSWindows */ /* * */ -#define REAL_WSTATE 1 -#define SUBWIN_WSTATE 2 -#define TEXTURE_WSTATE 4 +#define REAL_WSTATE 1 +#define SUBWIN_WSTATE 2 +#define TEXTURE_WSTATE 4 -#define CHILD_WIN2D 1 -#define CHILD_WIN3D 2 +#define CHILD_WIN2D 1 +#define CHILD_WIN3D 2 #define CHILD_WINTEXTURE 3 #define TEXTURE_RECORD 1 @@ -560,42 +560,42 @@ typedef struct childcontrol { * first WMAXCOLORS colors they allocate, and deallocate them on clearscreen. */ typedef struct _wstate { - int refcount; /* reference count */ - int serial; /* serial # */ + int refcount; /* reference count */ + int serial; /* serial # */ struct _wstate *previous, *next; #ifdef Graphics3D int type; int texindex; - double eyeupx, eyeupy, eyeupz; /* eye up vector */ + double eyeupx, eyeupy, eyeupz; /* eye up vector */ double eyedirx, eyediry, eyedirz; /* eye direction vector */ double eyeposx, eyeposy, eyeposz; /* eye position */ - double fov; /* field of view angle */ -#endif /* Graphics3D */ - - int inputmask; /* user input mask */ - int pixheight; /* backing pixmap height, in pixels */ - int pixwidth; /* pixmap width, in pixels */ - char *windowlabel; /* window label */ - char *iconimage; /* icon pixmap file name */ - char *iconlabel; /* icon label */ - struct imgdata initimage; /* initial image data */ - struct imgdata initicon; /* initial icon image data */ - int y, x; /* current cursor location, in pixels*/ - int pointery,pointerx; /* current mouse location, in pixels */ - int posy, posx; /* desired upper lefthand corner */ - int real_posx, real_posy; /* real (canvas=normal) position */ - unsigned int height; /* window height, in pixels */ - unsigned int width; /* window width, in pixels */ - unsigned int minheight; /* minimum window height, in pixels */ - unsigned int minwidth; /* minimum window width, in pixels */ - int bits; /* window bits */ - int theCursor; /* index into cursor table */ - word timestamp; /* last event time stamp */ - char eventQueue[EQUEUELEN]; /* queue of cooked-mode keystrokes */ - int eQfront, eQback; - char *cursorname; - struct descrip filep, listp; /* icon values for this window */ + double fov; /* field of view angle */ +#endif /* Graphics3D */ + + int inputmask; /* user input mask */ + int pixheight; /* backing pixmap height, in pixels */ + int pixwidth; /* pixmap width, in pixels */ + char *windowlabel; /* window label */ + char *iconimage; /* icon pixmap file name */ + char *iconlabel; /* icon label */ + struct imgdata initimage; /* initial image data */ + struct imgdata initicon; /* initial icon image data */ + int y, x; /* current cursor location, in pixels*/ + int pointery,pointerx; /* current mouse location, in pixels */ + int posy, posx; /* desired upper lefthand corner */ + int real_posx, real_posy; /* real (canvas=normal) position */ + unsigned int height; /* window height, in pixels */ + unsigned int width; /* window width, in pixels */ + unsigned int minheight; /* minimum window height, in pixels */ + unsigned int minwidth; /* minimum window width, in pixels */ + int bits; /* window bits */ + int theCursor; /* index into cursor table */ + word timestamp; /* last event time stamp */ + char eventQueue[EQUEUELEN]; /* queue of cooked-mode keystrokes */ + int eQfront, eQback; + char *cursorname; + struct descrip filep, listp; /* icon values for this window */ struct wbind_list *children; struct _wbinding *parent; #ifdef MacGraph @@ -610,83 +610,83 @@ typedef struct _wstate { Rect GWorldRect; Boolean lockOK; Boolean visible; -#endif /* MacGraph */ - wdp display; +#endif /* MacGraph */ + wdp display; #ifdef GraphicsGL #ifdef XWindows - GLXContext ctx; /* context for "gl" windows */ - GLXPbuffer pbuf; /* offscreen render surface */ -#endif /* XWindows */ + GLXContext ctx; /* context for "gl" windows */ + GLXPbuffer pbuf; /* offscreen render surface */ +#endif /* XWindows */ #ifdef MSWindows HGLRC ctx; -#endif /* MSWindows */ - - struct _wcontext wcrender, wcdef; /* render & default/init contexts */ - int lastwcserial; /* remembers the last context used */ - unsigned char updateRC; /* render context flag, default:0 */ - unsigned char initAttrs; /* initialize attribs falg, default:0 */ - unsigned char resize; /* window resize flag */ - unsigned char is_gl; /* flag for coexisting with Xlib */ +#endif /* MSWindows */ + + struct _wcontext wcrender, wcdef; /* render & default/init contexts */ + int lastwcserial; /* remembers the last context used */ + unsigned char updateRC; /* render context flag, default:0 */ + unsigned char initAttrs; /* initialize attribs falg, default:0 */ + unsigned char resize; /* window resize flag */ + unsigned char is_gl; /* flag for coexisting with Xlib */ unsigned char dx_flag, dy_flag; - unsigned char stencil_mask; /* bitmask for stencil buffer */ - int rendermode; /* 2D/3D rendering attrib */ - int projection; /* viewing volume projection attrib */ - double camwidth; /* viewing volume cam width attrib */ -#endif /* GraphicsGL */ + unsigned char stencil_mask; /* bitmask for stencil buffer */ + int rendermode; /* 2D/3D rendering attrib */ + int projection; /* viewing volume projection attrib */ + double camwidth; /* viewing volume cam width attrib */ +#endif /* GraphicsGL */ #ifdef XWindows - Window win; /* X window */ - Pixmap pix; /* current screen state */ - Pixmap initialPix; /* an initial image to display */ - Window iconwin; /* icon window */ - Pixmap iconpix; /* icon pixmap */ - Visual *vis; + Window win; /* X window */ + Pixmap pix; /* current screen state */ + Pixmap initialPix; /* an initial image to display */ + Window iconwin; /* icon window */ + Pixmap iconpix; /* icon pixmap */ + Visual *vis; #ifdef HAVE_XFT XftDraw *winDraw,*pixDraw; -#endif /* HAVE_XFT */ - int normalx, normaly; /* pos to remember when maximized */ - int normalw, normalh; /* size to remember when maximized */ - int numColors; /* allocated (used) color info */ - int sizColors; /* malloced size of theColors */ - short *theColors; /* indices into display color table */ - int numiColors; /* allocated color info for the icon */ - int siziColors; /* malloced size of iconColors */ - short *iconColors; /* indices into display color table */ +#endif /* HAVE_XFT */ + int normalx, normaly; /* pos to remember when maximized */ + int normalw, normalh; /* size to remember when maximized */ + int numColors; /* allocated (used) color info */ + int sizColors; /* malloced size of theColors */ + short *theColors; /* indices into display color table */ + int numiColors; /* allocated color info for the icon */ + int siziColors; /* malloced size of iconColors */ + short *iconColors; /* indices into display color table */ char *selectiondata; - int iconic; /* window state; icon, window or root*/ - int iconx, icony; /* location of icon */ - unsigned int iconw, iconh; /* width and height of icon */ - long wmhintflags; /* window manager hints */ -#endif /* XWindows */ + int iconic; /* window state; icon, window or root*/ + int iconx, icony; /* location of icon */ + unsigned int iconw, iconh; /* width and height of icon */ + long wmhintflags; /* window manager hints */ +#endif /* XWindows */ #ifdef MSWindows - HWND win; /* client window */ - HWND iconwin; /* client window when iconic */ - HBITMAP pix; /* backing bitmap */ - HBITMAP iconpix; /* backing bitmap */ - HBITMAP initialPix; /* backing bitmap */ - HBITMAP theOldPix; - int hasCaret; - HCURSOR curcursor; - HCURSOR savedcursor; - HMENU menuBar; - int nmMapElems; + HWND win; /* client window */ + HWND iconwin; /* client window when iconic */ + HBITMAP pix; /* backing bitmap */ + HBITMAP iconpix; /* backing bitmap */ + HBITMAP initialPix; /* backing bitmap */ + HBITMAP theOldPix; + int hasCaret; + HCURSOR curcursor; + HCURSOR savedcursor; + HMENU menuBar; + int nmMapElems; char ** menuMap; - HWND focusChild; + HWND focusChild; int nChildren; childcontrol *child; -#endif /* MSWindows */ +#endif /* MSWindows */ #ifdef Graphics3D int is_3D; /* flag for 3D windows */ struct descrip funclist; /* descriptor to hold list of 3d functions */ -#endif /* Graphics3D */ -#ifdef GraphicsGL +#endif /* Graphics3D */ +#ifdef GraphicsGL struct descrip funclist2d; /* descriptor to hold list of 2d functions */ unsigned char redraw_flag; unsigned char busy_flag; - unsigned char buffermode; -#endif /* GraphicsGL */ + unsigned char buffermode; +#endif /* GraphicsGL */ int no; /* new field added for child windows */ } wstate, *wsp; @@ -709,90 +709,90 @@ struct wbind_list { }; #ifdef MacGraph -typedef struct +typedef struct { - Boolean wasDown; - uword when; - Point where; - int whichButton; - int modKey; + Boolean wasDown; + uword when; + Point where; + int whichButton; + int modKey; wsp ws; } MouseInfoType; -#endif /* MacGraph */ +#endif /* MacGraph */ + - /* * Gamma Correction value to compensate for nonlinear monitor color response */ #ifndef GammaCorrection #define GammaCorrection 2.5 -#endif /* GammaCorrection */ +#endif /* GammaCorrection */ /* * Attributes */ -#define A_ASCENT 1 -#define A_BG 2 -#define A_CANVAS 3 -#define A_CEOL 4 -#define A_CLIPH 5 -#define A_CLIPW 6 -#define A_CLIPX 7 -#define A_CLIPY 8 -#define A_COL 9 -#define A_COLUMNS 10 -#define A_CURSOR 11 -#define A_DEPTH 12 -#define A_DESCENT 13 -#define A_DISPLAY 14 -#define A_DISPLAYHEIGHT 15 -#define A_DISPLAYWIDTH 16 -#define A_DRAWOP 17 -#define A_DX 18 -#define A_DY 19 -#define A_ECHO 20 -#define A_FG 21 -#define A_FHEIGHT 22 -#define A_FILLSTYLE 23 -#define A_FONT 24 -#define A_FWIDTH 25 -#define A_GAMMA 26 -#define A_GEOMETRY 27 -#define A_HEIGHT 28 -#define A_ICONIC 29 +#define A_ASCENT 1 +#define A_BG 2 +#define A_CANVAS 3 +#define A_CEOL 4 +#define A_CLIPH 5 +#define A_CLIPW 6 +#define A_CLIPX 7 +#define A_CLIPY 8 +#define A_COL 9 +#define A_COLUMNS 10 +#define A_CURSOR 11 +#define A_DEPTH 12 +#define A_DESCENT 13 +#define A_DISPLAY 14 +#define A_DISPLAYHEIGHT 15 +#define A_DISPLAYWIDTH 16 +#define A_DRAWOP 17 +#define A_DX 18 +#define A_DY 19 +#define A_ECHO 20 +#define A_FG 21 +#define A_FHEIGHT 22 +#define A_FILLSTYLE 23 +#define A_FONT 24 +#define A_FWIDTH 25 +#define A_GAMMA 26 +#define A_GEOMETRY 27 +#define A_HEIGHT 28 +#define A_ICONIC 29 #define A_ICONIMAGE 30 -#define A_ICONLABEL 31 -#define A_ICONPOS 32 -#define A_IMAGE 33 -#define A_INPUTMASK 34 -#define A_LABEL 35 -#define A_LEADING 36 -#define A_LINES 37 -#define A_LINESTYLE 38 -#define A_LINEWIDTH 39 -#define A_PATTERN 40 -#define A_POINTERCOL 41 -#define A_POINTERROW 42 -#define A_POINTERX 43 -#define A_POINTERY 44 -#define A_POINTER 45 -#define A_POS 46 -#define A_POSX 47 -#define A_POSY 48 -#define A_RESIZE 49 -#define A_REVERSE 50 -#define A_RGBMODE 51 -#define A_ROW 52 -#define A_ROWS 53 -#define A_SIZE 54 -#define A_VISUAL 55 -#define A_WIDTH 56 +#define A_ICONLABEL 31 +#define A_ICONPOS 32 +#define A_IMAGE 33 +#define A_INPUTMASK 34 +#define A_LABEL 35 +#define A_LEADING 36 +#define A_LINES 37 +#define A_LINESTYLE 38 +#define A_LINEWIDTH 39 +#define A_PATTERN 40 +#define A_POINTERCOL 41 +#define A_POINTERROW 42 +#define A_POINTERX 43 +#define A_POINTERY 44 +#define A_POINTER 45 +#define A_POS 46 +#define A_POSX 47 +#define A_POSY 48 +#define A_RESIZE 49 +#define A_REVERSE 50 +#define A_RGBMODE 51 +#define A_ROW 52 +#define A_ROWS 53 +#define A_SIZE 54 +#define A_VISUAL 55 +#define A_WIDTH 56 #define A_WINDOWLABEL 57 -#define A_X 58 -#define A_Y 59 -#define A_SELECTION 60 +#define A_X 58 +#define A_Y 59 +#define A_SELECTION 60 /* 3D attributes */ #define A_DIM 61 @@ -816,19 +816,19 @@ typedef struct #define A_TITLEBAR 78 #define A_BUFFERMODE 79 #define A_MESHMODE 80 -#define A_SLICES 81 -#define A_RINGS 82 -#define A_PICK 83 +#define A_SLICES 81 +#define A_RINGS 82 +#define A_PICK 83 #define A_NORMODE 84 -#define A_FOV 85 -#define A_GLVERSION 86 -#define A_GLVENDOR 87 -#define A_GLRENDERER 88 -#define A_ALPHA 89 -#define A_RENDERMODE 90 -#define A_PROJECTION 91 -#define A_CAMWIDTH 92 - -#define NUMATTRIBS 92 - -#define XICONSLEEP 20 /* milliseconds */ +#define A_FOV 85 +#define A_GLVERSION 86 +#define A_GLVENDOR 87 +#define A_GLRENDERER 88 +#define A_ALPHA 89 +#define A_RENDERMODE 90 +#define A_PROJECTION 91 +#define A_CAMWIDTH 92 + +#define NUMATTRIBS 92 + +#define XICONSLEEP 20 /* milliseconds */ diff --git a/src/h/grttin.h b/src/h/grttin.h index 4fbae318d..94cc9fa77 100644 --- a/src/h/grttin.h +++ b/src/h/grttin.h @@ -10,7 +10,7 @@ #ifndef NoTypeDefs #include "../h/typedefs.h" -#endif /* NoTypeDefs */ +#endif /* NoTypeDefs */ /* * Macros that must be expanded by rtt. @@ -25,7 +25,7 @@ int O##nm(nargs,cargp) int nargs; register dptr cargp; -#enddef /* LibDcl */ +#enddef /* LibDcl */ /* * Error exit from non top-level routines. Set tentative values for @@ -39,7 +39,7 @@ t_have_val = 1; return ret_val; } while (0) -#enddef /* ReturnErrVal */ +#enddef /* ReturnErrVal */ #begdef ReturnErrNum(err_num, ret_val) do { @@ -48,13 +48,13 @@ t_have_val = 0; return ret_val; } while (0) -#enddef /* ReturnErrNum */ +#enddef /* ReturnErrNum */ /* * Code expansions for exits from C code for top-level routines. */ -#define Fail return A_Resume -#define Return return A_Continue +#define Fail return A_Resume +#define Return return A_Continue /* * RunErr encapsulates a call to the function err_msg, followed @@ -87,13 +87,13 @@ else if (!Testb((word)ToAscii(event), mycurpstate->eventmask)) break; MakeInt(value, &(mycurpstate->parent->eventval)); if (!is:null(mycurpstate->valuemask) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; exint; actparent(event); entint; } while (0) -#enddef /* RealEVVal */ +#enddef /* RealEVVal */ #begdef RealEVValD(dp,event,exint,entint) do { @@ -101,13 +101,13 @@ else if (!Testb((word)ToAscii(event), mycurpstate->eventmask)) break; mycurpstate->parent->eventval = *(dp); if ((!is:null(mycurpstate->valuemask)) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; /* exint; */ actparent(event); /* entint; */ } while (0) -#enddef /* RealEVValD */ +#enddef /* RealEVValD */ /* extended version of EVVal, allows for save/restore in add'n to rsp */ @@ -118,17 +118,17 @@ else if (!Testb((word)ToAscii(event), mycurpstate->eventmask)) break; MakeInt(value, &(mycurpstate->parent->eventval)); if (!is:null(mycurpstate->valuemask) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; preact; ExInterp_sp; actparent(event); EntInterp_sp; postact; } while (0) -#enddef /* EVValEx */ +#enddef /* EVValEx */ -/* +/* This workaround was introduced to fix a bug where lastop was getting trashed. A proper fix was done by moving lastop to be part of the coexpr struct. Should be removed if no longer needed. @@ -140,27 +140,27 @@ else if (!Testb((word)ToAscii(event), mycurpstate->eventmask)) break; mycurpstate->parent->eventval = *(dp); if ((!is:null(mycurpstate->valuemask)) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; preact; ExInterp_sp; actparent(event); EntInterp_sp; postact; } while (0) -#enddef /* RealEVValD */ +#enddef /* RealEVValD */ #begdef EVVal(value,event) #if event RealEVVal(value,event,/*noop*/,/*noop*/) #endif -#enddef /* EVVal */ +#enddef /* EVVal */ #begdef EVValD(dp,event) #if event RealEVValD(dp,event,/*noop*/,/*noop*/) #endif -#enddef /* EVValD */ +#enddef /* EVValD */ #begdef EVValS(ipcopnd,event) /* Syntax events */ #if event @@ -169,8 +169,8 @@ if (is:null(mycurpstate->eventmask)) break; else if (!Testb((word)ToAscii(event), mycurpstate->eventmask)) break; if (!is:null(mycurpstate->valuemask) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; scode = hitsyntax(ipcopnd); if (scode == 0) break; @@ -178,7 +178,7 @@ actparent(event); } while (0) #endif -#enddef /* EVValS */ +#enddef /* EVValS */ #begdef EVValX(bp,event) #if event @@ -189,12 +189,12 @@ parent->eventval.dword = D_Coexpr; BlkLoc(parent->eventval) = (union block *)(bp); if (!is:null(mycurpstate->valuemask) && - (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) - break; + (invaluemask(mycurpstate, event, &(mycurpstate->parent->eventval)) != Succeeded)) + break; actparent(event); } while (0) #endif -#enddef /* EVValX */ +#enddef /* EVValX */ #begdef EVVar(dp, e) #if e @@ -202,7 +202,7 @@ if (!is:null(mycurpstate->eventmask) && Testb((word)ToAscii(e), mycurpstate->eventmask)) { EVVariable(dp, e); - } + } } while(0) #endif #enddef @@ -212,7 +212,7 @@ #if event { RealEVVal(value,event,ExInterp_sp,EntInterp_sp); } #endif -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #enddef #begdef InterpEVValD(dp,event) @@ -220,18 +220,18 @@ #if event { RealEVValD(dp,event,ExInterp_sp,EntInterp_sp); } #endif -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #enddef /* - * Macro for Syntax Monitoring - */ + * Macro for Syntax Monitoring + */ #begdef InterpEVValS(ipcopnd,event) #if !ConcurrentCOMPILER #if event { ExInterp_sp; EVValS(ipcopnd,event); EntInterp_sp; } #endif -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #enddef /* @@ -245,7 +245,7 @@ EVValD(&eventdesc, code); } while (0) #endif -#enddef /* Desc_EVValD */ +#enddef /* Desc_EVValD */ typedef int pid_t; @@ -256,24 +256,24 @@ typedef int clock_t, time_t, fd_set; #if WildCards typedef int FINDDATA_T; -#endif /* WildCards */ +#endif /* WildCards */ #ifdef ReadDirectory typedef int DIR; -#endif /* ReadDirectory */ +#endif /* ReadDirectory */ #ifdef Messaging typedef int size_t; typedef long time_t; -#endif /* Messaging */ +#endif /* Messaging */ #ifdef FAttrib typedef unsigned long mode_t; -#endif /* FAttrib */ +#endif /* FAttrib */ #if HAVE_LIBZ typedef int gzFile; -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #ifdef Messaging typedef int MFile; @@ -294,15 +294,15 @@ typedef int LPSOCKADDR; #if 1 typedef int MEMORYSTATUSEX; #endif -#endif /* NT */ +#endif /* NT */ #if HAVE_LIBJPEG typedef int j_common_ptr, JSAMPARRAY, JSAMPROW; -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #if HAVE_LIBPNG -typedef int png_uint_32, png_bytep, png_bytepp, png_color_16p, png_structp, png_infop; -#endif /* HAVE_LIBPNG */ +typedef int png_uint_32, png_bytep, png_bytepp, png_color_16p, png_structp, png_infop; +#endif /* HAVE_LIBPNG */ #ifdef PosixFns typedef int SOCKET; @@ -315,19 +315,19 @@ struct timeval { }; typedef int time_t; typedef int DIR; -#endif /* PosixFns */ +#endif /* PosixFns */ #if HAVE_LIBSSL typedef int SSL_CTX, SSL; -#endif /* LIBSSL */ +#endif /* LIBSSL */ #ifdef Concurrent typedef int pthread_key_t, sigset_t; -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef HAVE_LIBCL typedef int cl_uint, cl_platform_id, cl_device_id; -#endif /* HAVE_LIBCL */ +#endif /* HAVE_LIBCL */ #ifdef Dbm typedef int DBM; @@ -335,7 +335,7 @@ typedef struct { char *dptr; int dsize; } datum; -#endif /* Dbm */ +#endif /* Dbm */ #ifdef ISQL /* ODBC */ typedef int LPSTR, HENV, HDBC, HSTMT, ISQLFile, PTR, SQLPOINTER; @@ -343,7 +343,7 @@ typedef struct { typedef int SQLUSMALLINT, SQLSMALLINT, SQLHSTMT; typedef int SQLUINTEGER, SQLRETURN, RETCODE, SQLLEN, SQLULEN; typedef int SQLHBDC, SQLHENV, SQLCHAR, SQLINTEGER, SQLLEN; /* 3.0 */ -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Audio typedef int AudioStruct, AudioPtr, AudioFile; @@ -355,22 +355,22 @@ typedef int SQLUINTEGER, SQLRETURN, RETCODE, SQLLEN, SQLULEN; typedef int pthread_t, pthread_mutex_t, pthread_attr_t; typedef int ALfloat, ALuint, ALint, ALenum, ALvoid, ALboolean, ALsizei; typedef int ALubyte, ALchar; -#endif /* HAVE_LIBOPENAL */ -#endif /* Audio */ +#endif /* HAVE_LIBOPENAL */ +#endif /* Audio */ #if HAVE_OGG typedef int OggVorbis_File, vorbis_info; -#endif /* HAVE_OGG */ +#endif /* HAVE_OGG */ #ifdef HAVE_VOICE typedef int VSESSION, PVSESSION; -#endif /* HAVE_VOICE */ +#endif /* HAVE_VOICE */ #if defined(HAVE_LIBPTHREAD) typedef int pthread_t, pthread_attr_t, pthread_cond_t; typedef int pthread_rwlock_t, sem_t; typedef int pthread_mutex_t, pthread_mutexattr_t; -#endif /* HAVE_LIBPTHREAD */ +#endif /* HAVE_LIBPTHREAD */ # if defined(Graphics) || defined(PosixFns) typedef int stringint, inst; @@ -391,8 +391,8 @@ typedef int va_list, siptr; #ifdef HAVE_LIBFREETYPE typedef int FT_Library, FT_Face, FT_CharMap, FT_GlyphSlot, FT_Bitmap; typedef int FT_Matrix, FT_Vector; - #endif /* HAVE_LIBFREETYPE */ - #endif /* GraphicsGL */ + #endif /* HAVE_LIBFREETYPE */ + #endif /* GraphicsGL */ #ifdef MacGraph typedef int Str255, Point, StandardFileReply, SFTypeList, Ptr, PixMap; @@ -401,7 +401,7 @@ typedef int va_list, siptr; typedef int PaletteHandle, BitMap, RgnHandle, QDErr, GWorldPtr; typedef int GrafPtr, GDHandle, PixMapHandle, OSType, FInfo; typedef int IOParam, DialogPtr, ControlHandle, StringHandle, Size; - #endif /* MacGraph */ + #endif /* MacGraph */ #ifdef XWindows typedef int Atom, Time, XSelectionEvent, XErrorEvent, XErrorHandler; @@ -411,8 +411,8 @@ typedef int va_list, siptr; typedef int Colormap, XVisualInfo; typedef int *Display, Cursor, GC, Window, Pixmap, Visual, KeySym; typedef int WidgetClass, XImage, XpmAttributes, XSetWindowAttributes; - #endif /* XWindows */ - + #endif /* XWindows */ + #ifdef MSWindows typedef int clock_t, jmp_buf, MINMAXINFO, OSVERSIONINFO, BOOL_CALLBACK; typedef int int_PASCAL, LRESULT_CALLBACK, MSG, BYTE, WORD; @@ -428,32 +428,32 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; #ifdef FAttrib typedef unsigned long mode_t; typedef int HFILE, OFSTRUCT, FILETIME, SYSTEMTIME; - #endif /* FAttrib */ - #endif /* MSWindows */ - + #endif /* FAttrib */ + #endif /* MSWindows */ + /* * Convenience macros to make up for RTL's long-windedness. */ #begdef CnvShortInt(desc, s, max, min, type) - { - C_integer tmp; - if (!cnv:C_integer(desc,tmp) || tmp > max || tmp < min) - runerr(101,desc); - s = (type) tmp; - } - #enddef /* CnvShortInt */ + { + C_integer tmp; + if (!cnv:C_integer(desc,tmp) || tmp > max || tmp < min) + runerr(101,desc); + s = (type) tmp; + } + #enddef /* CnvShortInt */ #define CnvCShort(desc, s) CnvShortInt(desc, s, 0x7FFF, -0x8000, short) #define CnvCUShort(desc, s) CnvShortInt(desc, s, 0xFFFF, 0, unsigned short) - + #define CnvCInteger(d,i) \ if (!cnv:C_integer(d,i)) runerr(101,d); - + #define DefCInteger(d,default,i) \ if (!def:C_integer(d,default,i)) runerr(101,d); - + #define CnvString(din,dout) \ if (!cnv:string(din,dout)) runerr(103,din); - + #define CnvTmpString(din,dout) \ if (!cnv:tmp_string(din,dout)) runerr(103,din); @@ -469,111 +469,111 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; #begdef OptWindow(w) if (argc>warg && is:file(argv[warg])) { if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); + runerr(140,argv[warg]); if ((BlkD(argv[warg],File)->status & (Fs_Read|Fs_Write)) == 0) - fail; + fail; (w) = BlkD(argv[warg],File)->fd.wb; #ifdef ConsoleWindow - checkOpenConsole((FILE *)(w), NULL); -#endif /* ConsoleWindow */ + checkOpenConsole((FILE *)(w), NULL); +#endif /* ConsoleWindow */ if (ISCLOSED(w)) - fail; + fail; warg++; } else { if (!(is:file(kywd_xwin[XKey_Window]) && - (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) - runerr(140,kywd_xwin[XKey_Window]); + (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) + runerr(140,kywd_xwin[XKey_Window]); if (!(BlkD(kywd_xwin[XKey_Window],File)->status & (Fs_Read|Fs_Write))) - fail; + fail; (w) = (wbp)BlkD(kywd_xwin[XKey_Window],File)->fd.fp; if (ISCLOSED(w)) - fail; + fail; } - #enddef /* OptWindow */ - + #enddef /* OptWindow */ + #begdef OptTexWindow(w) #ifdef Graphics3D if (argc>warg && is:record(argv[warg])) { - /* set a boolean flag, use a texture */ - is_texture=TEXTURE_RECORD; - /* Get the Window from Texture record */ - w = BlkD(BlkD(argv[warg],Record)->fields[3],File)->fd.wb; + /* set a boolean flag, use a texture */ + is_texture=TEXTURE_RECORD; + /* Get the Window from Texture record */ + w = BlkD(BlkD(argv[warg],Record)->fields[3],File)->fd.wb; /* Pull out the texture handler */ - texhandle = IntVal(BlkD(argv[warg],Record)->fields[2]); - /* get the context from the window binding */ - warg++; + texhandle = IntVal(BlkD(argv[warg],Record)->fields[2]); + /* get the context from the window binding */ + warg++; } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (argc>warg && is:file(argv[warg])) { if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); + runerr(140,argv[warg]); if ((BlkD(argv[warg],File)->status & (Fs_Read|Fs_Write)) == 0) - fail; + fail; (w) = BlkD(argv[warg],File)->fd.wb; #ifdef ConsoleWindow - checkOpenConsole((FILE *)(w), NULL); -#endif /* ConsoleWindow */ + checkOpenConsole((FILE *)(w), NULL); +#endif /* ConsoleWindow */ if (ISCLOSED(w)) - fail; + fail; warg++; #ifdef Graphics3D - /* set a boolean flag, use a texture */ - if (w->window->type == TEXTURE_WSTATE){ - is_texture=TEXTURE_WINDOW; - texhandle = w->window->texindex; - } -#endif /* Graphics3D */ + /* set a boolean flag, use a texture */ + if (w->window->type == TEXTURE_WSTATE){ + is_texture=TEXTURE_WINDOW; + texhandle = w->window->texindex; + } +#endif /* Graphics3D */ } else { if (!(is:file(kywd_xwin[XKey_Window]) && - (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) - runerr(140,kywd_xwin[XKey_Window]); + (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) + runerr(140,kywd_xwin[XKey_Window]); if (!(BlkD(kywd_xwin[XKey_Window],File)->status & (Fs_Read|Fs_Write))) - fail; + fail; (w) = (wbp)BlkD(kywd_xwin[XKey_Window],File)->fd.fp; if (ISCLOSED(w)) - fail; + fail; #ifdef Graphics3D - /* set a boolean flag, use a texture */ - if (w->window->type == TEXTURE_WSTATE){ - is_texture=TEXTURE_WINDOW; - texhandle = w->window->texindex; - } -#endif /* Graphics3D */ + /* set a boolean flag, use a texture */ + if (w->window->type == TEXTURE_WSTATE){ + is_texture=TEXTURE_WINDOW; + texhandle = w->window->texindex; + } +#endif /* Graphics3D */ } #enddef /* OptTexWindow */ #begdef ReturnWindow if (!warg) return kywd_xwin[XKey_Window]; else return argv[0] - #enddef /* ReturnWindow */ - + #enddef /* ReturnWindow */ + #begdef CheckArgMultiple(mult) { if ((argc-warg) % (mult)) runerr(146); n = (argc-warg)/mult; if (!n) runerr(146); } - #enddef /* CheckArgMultiple */ + #enddef /* CheckArgMultiple */ /* - * make sure the window is 3D, issue a runtime error if it is not + * make sure the window is 3D, issue a runtime error if it is not */ - #begdef EnsureWindow3D(w) + #begdef EnsureWindow3D(w) { if (w->context->rendermode == UGL2D) { if (warg == 0) - runerr(150, kywd_xwin[XKey_Window]); + runerr(150, kywd_xwin[XKey_Window]); else - runerr(150, argv[0]); + runerr(150, argv[0]); } } #enddef - -#endif /* Graphics */ + +#endif /* Graphics */ /* * GRFX_ALLOC* family of macros used for static allocations. @@ -587,8 +587,8 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; if (var == NULL) ReturnErrNum(305, NULL); var->refcount = 1; } while(0) -#enddef /* GRFX_ALLOC */ - +#enddef /* GRFX_ALLOC */ + #begdef GRFX_LINK(var, chain) do { var->next = chain; @@ -596,8 +596,8 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; if (chain) chain->previous = var; chain = var; } while(0) -#enddef /* GRFX_LINK */ - +#enddef /* GRFX_LINK */ + #begdef GRFX_UNLINK(var, chain) do { if (var->previous) var->previous->next = var->next; @@ -605,7 +605,7 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; if (var->next) var->next->previous = var->previous; free(var); } while(0) -#enddef /* GRFX_UNLINK */ +#enddef /* GRFX_UNLINK */ #ifdef Graphics3D typedef int GLdouble, GLint, GLfloat, GLsizei, Status, GLboolean, GLenum; @@ -615,7 +615,7 @@ typedef int LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS, MCIDEVICEID; #ifdef MSWindows typedef int HGLRC, PIXELFORMATDESCRIPTOR; #endif -#endif /* Graphics3D */ +#endif /* Graphics3D */ #begdef MissingFunc(funcname) "an unavailable function" diff --git a/src/h/gsupport.h b/src/h/gsupport.h index 8842f5032..7739725c3 100644 --- a/src/h/gsupport.h +++ b/src/h/gsupport.h @@ -1,5 +1,5 @@ /* - * Group of include files for translators, etc. + * Group of include files for translators, etc. */ #include "../h/define.h" @@ -7,11 +7,11 @@ #if CSET2V2 #include -#endif /* CSet/2 ver 2 */ +#endif /* CSet/2 ver 2 */ -#if !VMS && !UNIX && !Windows /* don't need path.h */ +#if !VMS && !UNIX && !Windows /* don't need path.h */ #include "../h/path.h" -#endif /* !VMS && !UNIX */ +#endif /* !VMS && !UNIX */ #include "../h/sys.h" #include "../h/typedefs.h" @@ -21,7 +21,7 @@ #ifdef HAVE_GETADDRINFO #undef HAVE_GETADDRINFO -#endif +#endif #if NT && defined(ConsoleWindow) #include "../h/rmacros.h" @@ -29,12 +29,12 @@ #include "../h/graphics.h" #include "../h/rexterns.h" #include "../h/rproto.h" -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef IconcLogAllocations extern void * _alloc(unsigned int, char *, int); #define alloc(n) (_alloc((n),__FILE__,__LINE__)) -#endif /* IconcLogAllocations */ +#endif /* IconcLogAllocations */ /* squelch redef of "OF" and "Type" - avoid gcc warning */ #ifdef OF diff --git a/src/h/header.h b/src/h/header.h index 2210375a9..4ab469923 100644 --- a/src/h/header.h +++ b/src/h/header.h @@ -3,29 +3,29 @@ * an icode file after the start-up program. */ struct header { - word hsize; /* size of interpreter code */ - word trace; /* initial value of &trace */ + word hsize; /* size of interpreter code */ + word trace; /* initial value of &trace */ word Records; - word Ftab; /* location of record/field table */ - word Fnames; /* location of names of fields */ - word Globals; /* location of global variables */ - word Gnames; /* location of names of globals */ - word Statics; /* location of static variables */ - word Strcons; /* location of identifier table */ - word Filenms; /* location of ipc/file name table */ + word Ftab; /* location of record/field table */ + word Fnames; /* location of names of fields */ + word Globals; /* location of global variables */ + word Gnames; /* location of names of globals */ + word Statics; /* location of static variables */ + word Strcons; /* location of identifier table */ + word Filenms; /* location of ipc/file name table */ - word linenums; /* location of ipc/line number table */ - word config[16]; /* icode version */ + word linenums; /* location of ipc/line number table */ + word config[16]; /* icode version */ #ifdef OVLD word OPTab; #endif #ifdef FieldTableCompression - short FtabWidth; /* width of field table entries, 1 | 2 | 4 */ - short FoffWidth; /* width of field offset entries, 1 | 2 | 4 */ - word Nfields; /* number of field names */ - word Fo; /* The start of the Fo array */ - word Bm; /* The start of the Bm array */ -#endif /* FieldTableCompression */ + short FtabWidth; /* width of field table entries, 1 | 2 | 4 */ + short FoffWidth; /* width of field offset entries, 1 | 2 | 4 */ + word Nfields; /* number of field names */ + word Fo; /* The start of the Fo array */ + word Bm; /* The start of the Bm array */ +#endif /* FieldTableCompression */ }; diff --git a/src/h/lexdef.h b/src/h/lexdef.h index 83a721ed8..a3a37bac3 100644 --- a/src/h/lexdef.h +++ b/src/h/lexdef.h @@ -5,30 +5,30 @@ /* * Miscellaneous globals. */ -extern int yychar; /* parser's current input token type */ -extern int yynerrs; /* number of errors in parse */ -extern int nocode; /* true to suppress code generation */ +extern int yychar; /* parser's current input token type */ +extern int yynerrs; /* number of errors in parse */ +extern int nocode; /* true to suppress code generation */ -extern int in_line; /* current line number in input */ -extern int incol; /* current column number in input */ -extern int peekc; /* one character look-ahead */ -extern FILE *srcfile; /* current input file */ +extern int in_line; /* current line number in input */ +extern int incol; /* current column number in input */ +extern int peekc; /* one character look-ahead */ +extern FILE *srcfile; /* current input file */ -extern int __merr_errors; /* total fatal errors */ +extern int __merr_errors; /* total fatal errors */ /* * Token table structure. */ struct toktab { - char *t_word; /* token */ - int t_type; /* token type returned by yylex */ - int t_flags; /* flags for semicolon insertion */ + char *t_word; /* token */ + int t_type; /* token type returned by yylex */ + int t_flags; /* flags for semicolon insertion */ }; -extern struct toktab toktab[]; /* token table */ +extern struct toktab toktab[]; /* token table */ -extern struct toktab *restab[]; /* reserved word index */ +extern struct toktab *restab[]; /* reserved word index */ /* * On some platforms, the translator ends up including runtime system @@ -40,19 +40,19 @@ extern struct toktab *restab[]; /* reserved word index */ #undef T_String #undef T_Cset -#define T_Ident &toktab[0] -#define T_Int &toktab[1] -#define T_Real &toktab[2] -#define T_String &toktab[3] -#define T_Cset &toktab[4] -#define T_Eof &toktab[5] +#define T_Ident &toktab[0] +#define T_Int &toktab[1] +#define T_Real &toktab[2] +#define T_String &toktab[3] +#define T_Cset &toktab[4] +#define T_Eof &toktab[5] /* * t_flags values for token table. */ -#define Beginner 1 /* token can follow a semicolon */ -#define Ender 2 /* token can precede a semicolon */ +#define Beginner 1 /* token can follow a semicolon */ +#define Ender 2 /* token can precede a semicolon */ /* * optab contains token information along with pointers to implementation @@ -63,7 +63,7 @@ extern struct toktab *restab[]; /* reserved word index */ struct optab { struct toktab tok; /* token information for the operator symbol */ - int expected; /* what is expected in data base: Unary/Binary */ + int expected; /* what is expected in data base: Unary/Binary */ struct implement *unary; /* data base entry for unary version */ struct implement *binary; /* data base entry for binary version */ }; @@ -78,9 +78,9 @@ extern int minus_loc; /* index in optab of subtraction */ * Miscellaneous. */ -#define isoctal(c) ((c)>='0'&&(c)<='7') /* macro to test for octal digit */ -#define NextChar nextchar() /* macro to get next character */ -#define PushChar(c) peekc=(c) /* macro to push back a character */ +#define isoctal(c) ((c)>='0'&&(c)<='7') /* macro to test for octal digit */ +#define NextChar nextchar() /* macro to get next character */ +#define PushChar(c) peekc=(c) /* macro to push back a character */ -#define Comment '#' /* comment beginner */ -#define Escape '\\' /* string literal escape character */ +#define Comment '#' /* comment beginner */ +#define Escape '\\' /* string literal escape character */ diff --git a/src/h/macgraph.h b/src/h/macgraph.h index d4c562c7a..4b17d66d2 100644 --- a/src/h/macgraph.h +++ b/src/h/macgraph.h @@ -55,7 +55,7 @@ #define STDLOCALS(wb) wcp wc=(wb)->context;\ wsp ws=(wb)->window;\ WindowPtr stdwin=ws->theWindow - + #define ICONFILENAME(wb) ((wb)->window->iconimage) #define ICONLABEL(wb) ((wb)->window->iconlabel) #define WINDOWLABEL(wb) ((wb)->window->windowlabel) @@ -100,7 +100,7 @@ TextMode((c)->txMode);\ TextSize((c)->txSize);\ SpaceExtra((c)->spExtra) - + #define SETCONTEXTDEFAULT(c) memcpy(&((c)->bkPat),&qd.white,sizeof(Pattern));\ memcpy(&((c)->fillPat),&qd.black,sizeof(Pattern));\ (c)->pnLoc.h=0;(c)->pnLoc.v=0;\ @@ -123,7 +123,7 @@ SetGWorld((ws)->offScreenGWorld,nil);\ (ws)->offScreenPMHandle=GetGWorldPixMap((ws)->offScreenGWorld);\ (ws)->lockOK=LockPixels((ws)->offScreenPMHandle) - + #define GWORLD2WINDOW(ws) (ws)->sourceRect=(ws)->theWindow->portRect;\ (ws)->sourceRect.bottom=(ws)->theWindow->portRect.bottom;\ (ws)->sourceRect.right=(ws)->theWindow->portRect.right;\ @@ -146,7 +146,7 @@ (ws)->eQback = (ws)->eQfront;\ }\ } - + #define EVQUEEMPTY(ws) (BlkLoc((ws)->listp)->list.size == 0) /* @@ -154,7 +154,7 @@ */ #ifndef MACGRAPH_H #define MACGRAPH_H - + #define ControlMask (1 << 16) #define Mod1Mask (2 << 16) #define ShiftMask (4 << 16) @@ -165,7 +165,7 @@ * exception: XTOCOL as defined is 0-based, because that's what its * clients seem to need. */ - + #define MARGIN 0 #define ROWTOY(wb,row) ((row-1) * LEADING(wb) + ASCENT(wb) + MARGIN) @@ -176,29 +176,29 @@ /* * typedef & structs */ - + typedef struct { long x, y; long width, height; long angle1, angle2; } XArc; - + typedef struct { long x,y; } XPoint; - -typedef struct + +typedef struct { long x1, y1; long x2, y2; } XSegment; - + typedef struct { long x, y; long width, height; } XRectangle; -#endif /* MACGRAPH_H */ +#endif /* MACGRAPH_H */ diff --git a/src/h/monitor.h b/src/h/monitor.h index 681a9c962..30692d618 100644 --- a/src/h/monitor.h +++ b/src/h/monitor.h @@ -16,147 +16,147 @@ */ #if defined(EventMon) || defined(E_Lrgint) #undef E_Lrgint -#define E_Lrgint '\114' /* Large integer allocation */ +#define E_Lrgint '\114' /* Large integer allocation */ #else #define E_Lrgint 0 #endif #if defined(EventMon) || defined(E_Real) #undef E_Real -#define E_Real '\144' /* Real allocation */ +#define E_Real '\144' /* Real allocation */ #else #define E_Real 0 #endif #if defined(EventMon) || defined(E_Cset) #undef E_Cset -#define E_Cset '\145' /* Cset allocation */ +#define E_Cset '\145' /* Cset allocation */ #else #define E_Cset 0 #endif #if defined(EventMon) || defined(E_File) #undef E_File -#define E_File '\147' /* File allocation */ +#define E_File '\147' /* File allocation */ #else #define E_File 0 #endif #if defined(EventMon) || defined(E_Record) #undef E_Record -#define E_Record '\150' /* Record allocation */ +#define E_Record '\150' /* Record allocation */ #else #define E_Record 0 #endif #if defined(EventMon) || defined(E_Tvsubs) #undef E_Tvsubs -#define E_Tvsubs '\151' /* Substring tv allocation */ +#define E_Tvsubs '\151' /* Substring tv allocation */ #else #define E_Tvsubs 0 #endif #if defined(EventMon) || defined(E_External) #undef E_External -#define E_External '\152' /* External allocation */ +#define E_External '\152' /* External allocation */ #else #define E_External 0 #endif #if defined(EventMon) || defined(E_List) #undef E_List -#define E_List '\153' /* List allocation */ +#define E_List '\153' /* List allocation */ #else #define E_List 0 #endif #if defined(EventMon) || defined(E_Lelem) #undef E_Lelem -#define E_Lelem '\155' /* List element allocation */ +#define E_Lelem '\155' /* List element allocation */ #else #define E_Lelem 0 #endif #if defined(EventMon) || defined(E_Table) #undef E_Table -#define E_Table '\156' /* Table allocation */ +#define E_Table '\156' /* Table allocation */ #else #define E_Table 0 #endif #if defined(EventMon) || defined(E_Telem) #undef E_Telem -#define E_Telem '\157' /* Table element allocation */ +#define E_Telem '\157' /* Table element allocation */ #else #define E_Telem 0 #endif #if defined(EventMon) || defined(E_Tvtbl) #undef E_Tvtbl -#define E_Tvtbl '\160' /* Table-element tv allocation */ +#define E_Tvtbl '\160' /* Table-element tv allocation */ #else #define E_Tvtbl 0 #endif #if defined(EventMon) || defined(E_Set) #undef E_Set -#define E_Set '\161' /* Set allocation */ +#define E_Set '\161' /* Set allocation */ #else #define E_Set 0 #endif #if defined(EventMon) || defined(E_Selem) #undef E_Selem -#define E_Selem '\164' /* Set element allocation */ +#define E_Selem '\164' /* Set element allocation */ #else #define E_Selem 0 #endif #if defined(EventMon) || defined(E_Slots) #undef E_Slots -#define E_Slots '\167' /* Hash header allocation */ +#define E_Slots '\167' /* Hash header allocation */ #else #define E_Slots 0 #endif #if defined(EventMon) || defined(E_CoCreate) #undef E_CoCreate -#define E_CoCreate '\177' /* Co-expression creation */ +#define E_CoCreate '\177' /* Co-expression creation */ #else #define E_CoCreate 0 #endif #if defined(EventMon) || defined(E_Coexpr) #undef E_Coexpr -#define E_Coexpr '\170' /* Co-expression allocation */ +#define E_Coexpr '\170' /* Co-expression allocation */ #else #define E_Coexpr 0 #endif #if defined(EventMon) || defined(E_Refresh) #undef E_Refresh -#define E_Refresh '\171' /* Refresh allocation */ +#define E_Refresh '\171' /* Refresh allocation */ #else #define E_Refresh 0 #endif #if defined(EventMon) || defined(E_Alien) #undef E_Alien -#define E_Alien '\172' /* Alien allocation */ +#define E_Alien '\172' /* Alien allocation */ #else #define E_Alien 0 #endif #if defined(EventMon) || defined(E_Free) #undef E_Free -#define E_Free '\132' /* Free region */ +#define E_Free '\132' /* Free region */ #else #define E_Free 0 #endif #if defined(EventMon) || defined(E_String) #undef E_String -#define E_String '\163' /* String allocation */ +#define E_String '\163' /* String allocation */ #else #define E_String 0 #endif @@ -167,14 +167,14 @@ */ #if defined(EventMon) || defined(E_BlkDeAlc) #undef E_BlkDeAlc -#define E_BlkDeAlc '\055' /* Block deallocation */ +#define E_BlkDeAlc '\055' /* Block deallocation */ #else #define E_BlkDeAlc 0 #endif #if defined(EventMon) || defined(E_StrDeAlc) #undef E_StrDeAlc -#define E_StrDeAlc '\176' /* String deallocation */ +#define E_StrDeAlc '\176' /* String deallocation */ #else #define E_StrDeAlc 0 #endif @@ -186,42 +186,42 @@ */ #if defined(EventMon) || defined(E_Integer) #undef E_Integer -#define E_Integer '\100' /* Integer value pseudo-event */ +#define E_Integer '\100' /* Integer value pseudo-event */ #else #define E_Integer 0 #endif #if defined(EventMon) || defined(E_Null) #undef E_Null -#define E_Null '\044' /* Null value pseudo-event */ +#define E_Null '\044' /* Null value pseudo-event */ #else #define E_Null 0 #endif #if defined(EventMon) || defined(E_Proc) #undef E_Proc -#define E_Proc '\045' /* Procedure value pseudo-event */ +#define E_Proc '\045' /* Procedure value pseudo-event */ #else #define E_Proc 0 #endif #if defined(EventMon) || defined(E_Kywdint) #undef E_Kywdint -#define E_Kywdint '\136' /* Integer keyword value pseudo-event */ +#define E_Kywdint '\136' /* Integer keyword value pseudo-event */ #else #define E_Kywdint 0 #endif #if defined(EventMon) || defined(E_Kywdpos) #undef E_Kywdpos -#define E_Kywdpos '\046' /* Position value pseudo-event */ +#define E_Kywdpos '\046' /* Position value pseudo-event */ #else #define E_Kywdpos 0 #endif #if defined(EventMon) || defined(E_Kywdsubj) #undef E_Kywdsubj -#define E_Kywdsubj '\052' /* Subject value pseudo-event */ +#define E_Kywdsubj '\052' /* Subject value pseudo-event */ #else #define E_Kywdsubj 0 #endif @@ -236,7 +236,7 @@ */ #if defined(EventMon) || defined(E_Tick) #undef E_Tick -#define E_Tick '\270' /* Clock tick */ +#define E_Tick '\270' /* Clock tick */ #else #define E_Tick 0 #endif @@ -248,14 +248,14 @@ */ #if defined(EventMon) || defined(E_Loc) #undef E_Loc -#define E_Loc '\273' /* Location change */ +#define E_Loc '\273' /* Location change */ #else #define E_Loc 0 #endif #if defined(EventMon) || defined(E_Line) #undef E_Line -#define E_Line '\274' /* Line change */ +#define E_Line '\274' /* Line change */ #else #define E_Line 0 #endif @@ -266,14 +266,14 @@ */ #if defined(EventMon) || defined(E_Opcode) #undef E_Opcode -#define E_Opcode '\240' /* Virtual-machine instruction */ +#define E_Opcode '\240' /* Virtual-machine instruction */ #else #define E_Opcode 0 #endif #if defined(EventMon) || defined(E_Operand) #undef E_Operand -#define E_Operand '\241' /* Virtual-machine Operand*/ +#define E_Operand '\241' /* Virtual-machine Operand*/ #else #define E_Operand 0 #endif @@ -284,35 +284,35 @@ */ #if defined(EventMon) || defined(E_Aconv) #undef E_Aconv -#define E_Aconv '\111' /* Conversion attempt */ +#define E_Aconv '\111' /* Conversion attempt */ #else #define E_Aconv 0 #endif #if defined(EventMon) || defined(E_Tconv) #undef E_Tconv -#define E_Tconv '\113' /* Conversion target */ +#define E_Tconv '\113' /* Conversion target */ #else #define E_Tconv 0 #endif #if defined(EventMon) || defined(E_Nconv) #undef E_Nconv -#define E_Nconv '\116' /* Conversion not needed */ +#define E_Nconv '\116' /* Conversion not needed */ #else #define E_Nconv 0 #endif #if defined(EventMon) || defined(E_Sconv) #undef E_Sconv -#define E_Sconv '\121' /* Conversion success */ +#define E_Sconv '\121' /* Conversion success */ #else #define E_Sconv 0 #endif #if defined(EventMon) || defined(E_Fconv) #undef E_Fconv -#define E_Fconv '\112' /* Conversion failure */ +#define E_Fconv '\112' /* Conversion failure */ #else #define E_Fconv 0 #endif @@ -323,231 +323,231 @@ */ #if defined(EventMon) || defined(E_Lbang) #undef E_Lbang -#define E_Lbang '\301' /* List generation */ +#define E_Lbang '\301' /* List generation */ #else #define E_Lbang 0 #endif #if defined(EventMon) || defined(E_Lcreate) #undef E_Lcreate -#define E_Lcreate '\302' /* List creation */ +#define E_Lcreate '\302' /* List creation */ #else #define E_Lcreate 0 #endif #if defined(EventMon) || defined(E_Lget) #undef E_Lget -#define E_Lget '\356' /* List get/pop -- only E_Lget used */ +#define E_Lget '\356' /* List get/pop -- only E_Lget used */ #else #define E_Lget 0 #endif #if defined(EventMon) || defined(E_Lpop) #undef E_Lpop -#define E_Lpop '\356' /* List get/pop */ +#define E_Lpop '\356' /* List get/pop */ #else #define E_Lpop 0 #endif #if defined(EventMon) || defined(E_Lpull) #undef E_Lpull -#define E_Lpull '\304' /* List pull */ +#define E_Lpull '\304' /* List pull */ #else #define E_Lpull 0 #endif #if defined(EventMon) || defined(E_Lpush) #undef E_Lpush -#define E_Lpush '\305' /* List push */ +#define E_Lpush '\305' /* List push */ #else #define E_Lpush 0 #endif #if defined(EventMon) || defined(E_Lput) #undef E_Lput -#define E_Lput '\306' /* List put */ +#define E_Lput '\306' /* List put */ #else #define E_Lput 0 #endif #if defined(EventMon) || defined(E_Lrand) #undef E_Lrand -#define E_Lrand '\307' /* List random reference */ +#define E_Lrand '\307' /* List random reference */ #else #define E_Lrand 0 #endif #if defined(EventMon) || defined(E_Lref) #undef E_Lref -#define E_Lref '\310' /* List reference */ +#define E_Lref '\310' /* List reference */ #else #define E_Lref 0 #endif #if defined(EventMon) || defined(E_Lsub) #undef E_Lsub -#define E_Lsub '\311' /* List subscript */ +#define E_Lsub '\311' /* List subscript */ #else #define E_Lsub 0 #endif #if defined(EventMon) || defined(E_Ldelete) #undef E_Ldelete -#define E_Ldelete '\357' /* List delete */ +#define E_Ldelete '\357' /* List delete */ #else #define E_Ldelete 0 #endif #if defined(EventMon) || defined(E_Rbang) #undef E_Rbang -#define E_Rbang '\312' /* Record generation */ +#define E_Rbang '\312' /* Record generation */ #else #define E_Rbang 0 #endif #if defined(EventMon) || defined(E_Rcreate) #undef E_Rcreate -#define E_Rcreate '\313' /* Record creation */ +#define E_Rcreate '\313' /* Record creation */ #else #define E_Rcreate 0 #endif #if defined(EventMon) || defined(E_Rrand) #undef E_Rrand -#define E_Rrand '\314' /* Record random reference */ +#define E_Rrand '\314' /* Record random reference */ #else #define E_Rrand 0 #endif #if defined(EventMon) || defined(E_Rref) #undef E_Rref -#define E_Rref '\315' /* Record reference */ +#define E_Rref '\315' /* Record reference */ #else #define E_Rref 0 #endif #if defined(EventMon) || defined(E_Rsub) #undef E_Rsub -#define E_Rsub '\316' /* Record subscript */ +#define E_Rsub '\316' /* Record subscript */ #else #define E_Rsub 0 #endif #if defined(EventMon) || defined(E_Sbang) #undef E_Sbang -#define E_Sbang '\317' /* Set generation */ +#define E_Sbang '\317' /* Set generation */ #else #define E_Sbang 0 #endif #if defined(EventMon) || defined(E_Screate) #undef E_Screate -#define E_Screate '\320' /* Set creation */ +#define E_Screate '\320' /* Set creation */ #else #define E_Screate 0 #endif #if defined(EventMon) || defined(E_Sdelete) #undef E_Sdelete -#define E_Sdelete '\321' /* Set deletion */ +#define E_Sdelete '\321' /* Set deletion */ #else #define E_Sdelete 0 #endif #if defined(EventMon) || defined(E_Sinsert) #undef E_Sinsert -#define E_Sinsert '\322' /* Set insertion */ +#define E_Sinsert '\322' /* Set insertion */ #else #define E_Sinsert 0 #endif #if defined(EventMon) || defined(E_Smember) #undef E_Smember -#define E_Smember '\323' /* Set membership */ +#define E_Smember '\323' /* Set membership */ #else #define E_Smember 0 #endif #if defined(EventMon) || defined(E_Srand) #undef E_Srand -#define E_Srand '\336' /* Set random reference */ +#define E_Srand '\336' /* Set random reference */ #else #define E_Srand 0 #endif #if defined(EventMon) || defined(E_Sval) #undef E_Sval -#define E_Sval '\324' /* Set value */ +#define E_Sval '\324' /* Set value */ #else #define E_Sval 0 #endif #if defined(EventMon) || defined(E_Tbang) #undef E_Tbang -#define E_Tbang '\325' /* Table generation */ +#define E_Tbang '\325' /* Table generation */ #else #define E_Tbang 0 #endif #if defined(EventMon) || defined(E_Tcreate) #undef E_Tcreate -#define E_Tcreate '\326' /* Table creation */ +#define E_Tcreate '\326' /* Table creation */ #else #define E_Tcreate 0 #endif #if defined(EventMon) || defined(E_Tdelete) #undef E_Tdelete -#define E_Tdelete '\327' /* Table deletion */ +#define E_Tdelete '\327' /* Table deletion */ #else #define E_Tdelete 0 #endif #if defined(EventMon) || defined(E_Tinsert) #undef E_Tinsert -#define E_Tinsert '\330' /* Table insertion */ +#define E_Tinsert '\330' /* Table insertion */ #else #define E_Tinsert 0 #endif #if defined(EventMon) || defined(E_Tkey) #undef E_Tkey -#define E_Tkey '\331' /* Table key generation */ +#define E_Tkey '\331' /* Table key generation */ #else #define E_Tkey 0 #endif #if defined(EventMon) || defined(E_Tmember) #undef E_Tmember -#define E_Tmember '\332' /* Table membership */ +#define E_Tmember '\332' /* Table membership */ #else #define E_Tmember 0 #endif #if defined(EventMon) || defined(E_Trand) #undef E_Trand -#define E_Trand '\337' /* Table random reference */ +#define E_Trand '\337' /* Table random reference */ #else #define E_Trand 0 #endif #if defined(EventMon) || defined(E_Tref) #undef E_Tref -#define E_Tref '\333' /* Table reference */ +#define E_Tref '\333' /* Table reference */ #else #define E_Tref 0 #endif #if defined(EventMon) || defined(E_Tsub) #undef E_Tsub -#define E_Tsub '\334' /* Table subscript */ +#define E_Tsub '\334' /* Table subscript */ #else #define E_Tsub 0 #endif #if defined(EventMon) || defined(E_Tval) #undef E_Tval -#define E_Tval '\335' /* Table value */ +#define E_Tval '\335' /* Table value */ #else #define E_Tval 0 #endif @@ -559,42 +559,42 @@ #if defined(EventMon) || defined(E_Snew) #undef E_Snew -#define E_Snew '\340' /* Scanning environment creation */ +#define E_Snew '\340' /* Scanning environment creation */ #else #define E_Snew 0 #endif #if defined(EventMon) || defined(E_Sfail) #undef E_Sfail -#define E_Sfail '\341' /* Scanning failure */ +#define E_Sfail '\341' /* Scanning failure */ #else #define E_Sfail 0 #endif #if defined(EventMon) || defined(E_Ssusp) #undef E_Ssusp -#define E_Ssusp '\266' /* Scanning suspension */ +#define E_Ssusp '\266' /* Scanning suspension */ #else #define E_Ssusp 0 #endif #if defined(EventMon) || defined(E_Sresum) #undef E_Sresum -#define E_Sresum '\267' /* Scanning resumption */ +#define E_Sresum '\267' /* Scanning resumption */ #else #define E_Sresum 0 #endif #if defined(EventMon) || defined(E_Srem) #undef E_Srem -#define E_Srem '\344' /* Scanning environment removal */ +#define E_Srem '\344' /* Scanning environment removal */ #else #define E_Srem 0 #endif #if defined(EventMon) || defined(E_Spos) #undef E_Spos -#define E_Spos '\346' /* Scanning position */ +#define E_Spos '\346' /* Scanning position */ #else #define E_Spos 0 #endif @@ -606,21 +606,21 @@ #if defined(EventMon) || defined(E_Assign) #undef E_Assign -#define E_Assign '\347' /* Assignment */ +#define E_Assign '\347' /* Assignment */ #else #define E_Assign 0 #endif #if defined(EventMon) || defined(E_Value) #undef E_Value -#define E_Value '\350' /* Value assigned */ +#define E_Value '\350' /* Value assigned */ #else #define E_Value 0 #endif #if defined(EventMon) || defined(E_Deref) #undef E_Deref -#define E_Deref '\363' /* Dereference */ +#define E_Deref '\363' /* Dereference */ #else #define E_Deref 0 #endif @@ -633,7 +633,7 @@ #if defined(EventMon) || defined(E_Ssasgn) #undef E_Ssasgn -#define E_Ssasgn '\354' /* Sub-string assignment */ +#define E_Ssasgn '\354' /* Sub-string assignment */ #else #define E_Ssasgn 0 #endif @@ -645,28 +645,28 @@ #if defined(EventMon) || defined(E_Intcall) #undef E_Intcall -#define E_Intcall '\275' /* interpreter call */ +#define E_Intcall '\275' /* interpreter call */ #else #define E_Intcall 0 #endif #if defined(EventMon) || defined(E_Intret) #undef E_Intret -#define E_Intret '\276' /* interpreter return */ +#define E_Intret '\276' /* interpreter return */ #else #define E_Intret 0 #endif #if defined(EventMon) || defined(E_Stack) #undef E_Stack -#define E_Stack '\272' /* stack depth */ +#define E_Stack '\272' /* stack depth */ #else #define E_Stack 0 #endif #if defined(EventMon) || defined(E_Cstack) #undef E_Cstack -#define E_Cstack '\271' /* C stack depth */ +#define E_Cstack '\271' /* C stack depth */ #else #define E_Cstack 0 #endif @@ -676,56 +676,56 @@ */ #if defined(EventMon) || defined(E_Ecall) #undef E_Ecall -#define E_Ecall '\143' /* Call of operation */ +#define E_Ecall '\143' /* Call of operation */ #else #define E_Ecall 0 #endif #if defined(EventMon) || defined(E_Efail) #undef E_Efail -#define E_Efail '\251' /* Failure from expression */ +#define E_Efail '\251' /* Failure from expression */ #else #define E_Efail 0 #endif #if defined(EventMon) || defined(E_Bsusp) #undef E_Bsusp -#define E_Bsusp '\250' /* Suspension from operation */ +#define E_Bsusp '\250' /* Suspension from operation */ #else #define E_Bsusp 0 #endif #if defined(EventMon) || defined(E_Esusp) #undef E_Esusp -#define E_Esusp '\141' /* Suspension from alternation */ +#define E_Esusp '\141' /* Suspension from alternation */ #else #define E_Esusp 0 #endif #if defined(EventMon) || defined(E_Lsusp) #undef E_Lsusp -#define E_Lsusp '\154' /* Suspension from limitation */ +#define E_Lsusp '\154' /* Suspension from limitation */ #else #define E_Lsusp 0 #endif #if defined(EventMon) || defined(E_Eresum) #undef E_Eresum -#define E_Eresum '\236' /* Resumption of expression */ +#define E_Eresum '\236' /* Resumption of expression */ #else #define E_Eresum 0 #endif #if defined(EventMon) || defined(E_Erem) #undef E_Erem -#define E_Erem '\237' /* Removal of a suspended generator */ +#define E_Erem '\237' /* Removal of a suspended generator */ #else #define E_Erem 0 #endif #if defined(EventMon) || defined(E_Syntax) #undef E_Esyntax -#define E_Syntax '\242' /* Source code syntax change */ +#define E_Syntax '\242' /* Source code syntax change */ #else #define E_Syntax 0 #endif @@ -736,21 +736,21 @@ #if defined(EventMon) || defined(E_Coact) #undef E_Coact -#define E_Coact '\101' /* Co-expression activation */ +#define E_Coact '\101' /* Co-expression activation */ #else #define E_Coact 0 #endif #if defined(EventMon) || defined(E_Coret) #undef E_Coret -#define E_Coret '\102' /* Co-expression return */ +#define E_Coret '\102' /* Co-expression return */ #else #define E_Coret 0 #endif #if defined(EventMon) || defined(E_Cofail) #undef E_Cofail -#define E_Cofail '\104' /* Co-expression failure */ +#define E_Cofail '\104' /* Co-expression failure */ #else #define E_Cofail 0 #endif @@ -762,42 +762,42 @@ #if defined(EventMon) || defined(E_Pcall) #undef E_Pcall -#define E_Pcall '\103' /* Procedure call */ +#define E_Pcall '\103' /* Procedure call */ #else #define E_Pcall 0 #endif #if defined(EventMon) || defined(E_Pfail) #undef E_Pfail -#define E_Pfail '\246' /* Procedure failure */ +#define E_Pfail '\246' /* Procedure failure */ #else #define E_Pfail 0 #endif #if defined(EventMon) || defined(E_Pret) #undef E_Pret -#define E_Pret '\245' /* Procedure return */ +#define E_Pret '\245' /* Procedure return */ #else #define E_Pret 0 #endif #if defined(EventMon) || defined(E_Psusp) #undef E_Psusp -#define E_Psusp '\243' /* Procedure suspension */ +#define E_Psusp '\243' /* Procedure suspension */ #else #define E_Psusp 0 #endif #if defined(EventMon) || defined(E_Presum) #undef E_Presum -#define E_Presum '\244' /* Procedure resumption */ +#define E_Presum '\244' /* Procedure resumption */ #else #define E_Presum 0 #endif #if defined(EventMon) || defined(E_Prem) #undef E_Prem -#define E_Prem '\247' /* Suspended procedure removal */ +#define E_Prem '\247' /* Suspended procedure removal */ #else #define E_Prem 0 #endif @@ -805,42 +805,42 @@ #if defined(EventMon) || defined(E_Fcall) #undef E_Fcall -#define E_Fcall '\252' /* Function call */ +#define E_Fcall '\252' /* Function call */ #else #define E_Fcall 0 #endif #if defined(EventMon) || defined(E_Ffail) #undef E_Ffail -#define E_Ffail '\256' /* Function failure */ +#define E_Ffail '\256' /* Function failure */ #else #define E_Ffail 0 #endif #if defined(EventMon) || defined(E_Fret) #undef E_Fret -#define E_Fret '\255' /* Function return */ +#define E_Fret '\255' /* Function return */ #else #define E_Fret 0 #endif #if defined(EventMon) || defined(E_Fsusp) #undef E_Fsusp -#define E_Fsusp '\253' /* Function suspension */ +#define E_Fsusp '\253' /* Function suspension */ #else #define E_Fsusp 0 #endif #if defined(EventMon) || defined(E_Fresum) #undef E_Fresum -#define E_Fresum '\254' /* Function resumption */ +#define E_Fresum '\254' /* Function resumption */ #else #define E_Fresum 0 #endif #if defined(EventMon) || defined(E_Frem) #undef E_Frem -#define E_Frem '\257' /* Function suspension removal */ +#define E_Frem '\257' /* Function suspension removal */ #else #define E_Frem 0 #endif @@ -848,42 +848,42 @@ #if defined(EventMon) || defined(E_Ocall) #undef E_Ocall -#define E_Ocall '\260' /* Operator call */ +#define E_Ocall '\260' /* Operator call */ #else #define E_Ocall 0 #endif #if defined(EventMon) || defined(E_Ofail) #undef E_Ofail -#define E_Ofail '\262' /* Operator failure */ +#define E_Ofail '\262' /* Operator failure */ #else #define E_Ofail 0 #endif #if defined(EventMon) || defined(E_Oret) #undef E_Oret -#define E_Oret '\261' /* Operator return */ +#define E_Oret '\261' /* Operator return */ #else #define E_Oret 0 #endif #if defined(EventMon) || defined(E_Osusp) #undef E_Osusp -#define E_Osusp '\263' /* Operator suspension */ +#define E_Osusp '\263' /* Operator suspension */ #else #define E_Osusp 0 #endif #if defined(EventMon) || defined(E_Oresum) #undef E_Oresum -#define E_Oresum '\264' /* Operator resumption */ +#define E_Oresum '\264' /* Operator resumption */ #else #define E_Oresum 0 #endif #if defined(EventMon) || defined(E_Orem) #undef E_Orem -#define E_Orem '\265' /* Operator suspension removal */ +#define E_Orem '\265' /* Operator suspension removal */ #else #define E_Orem 0 #endif @@ -895,28 +895,28 @@ #if defined(EventMon) || defined(E_Collect) #undef E_Collect -#define E_Collect '\107' /* Garbage collection */ +#define E_Collect '\107' /* Garbage collection */ #else #define E_Collect 0 #endif #if defined(EventMon) || defined(E_EndCollect) #undef E_EndCollect -#define E_EndCollect '\360' /* End of garbage collection */ +#define E_EndCollect '\360' /* End of garbage collection */ #else #define E_EndCollect 0 #endif #if defined(EventMon) || defined(E_TenureString) #undef E_TenureString -#define E_TenureString '\361' /* Tenure a string region */ +#define E_TenureString '\361' /* Tenure a string region */ #else #define E_TenureString 0 #endif #if defined(EventMon) || defined(E_TenureBlock) #undef E_TenureBlock -#define E_TenureBlock '\362' /* Tenure a block region */ +#define E_TenureBlock '\362' /* Tenure a block region */ #else #define E_TenureBlock 0 #endif @@ -927,14 +927,14 @@ */ #if defined(EventMon) || defined(E_Error) #undef E_Error -#define E_Error '\105' /* Run-time error */ +#define E_Error '\105' /* Run-time error */ #else #define E_Error 0 #endif #if defined(EventMon) || defined(E_Exit) #undef E_Exit -#define E_Exit '\130' /* Program exit */ +#define E_Exit '\130' /* Program exit */ #else #define E_Exit 0 #endif @@ -945,35 +945,35 @@ */ #if defined(EventMon) || defined(E_MXevent) #undef E_MXevent -#define E_MXevent '\370' /* monitor input event */ +#define E_MXevent '\370' /* monitor input event */ #else #define E_MXevent 0 #endif #if defined(EventMon) || defined(E_Literal) #undef E_Literal -#define E_Literal '\277' +#define E_Literal '\277' #else #define E_Literal 0 #endif #if defined(EventMon) || defined(E_Signal) #undef E_Signal -#define E_Signal '\300' +#define E_Signal '\300' #else #define E_Signal 0 #endif #if defined(EventMon) || defined(E_Pattern) #undef E_Pattern -#define E_Pattern '\060' +#define E_Pattern '\060' #else #define E_Pattern 0 #endif #if defined(EventMon) || defined(E_Pelem) #undef E_Pelem -#define E_Pelem '\061' +#define E_Pelem '\061' #else #define E_Pelem 0 #endif @@ -1086,38 +1086,38 @@ /* unused pool. how many event codes are unused? DON'T USE 000. - Decimal + Decimal 000 001 002 003 004 005 006 007 010 011 012 013 014 015 016 017 -020 021 022 023 024 025 026 027 16 +020 021 022 023 024 025 026 027 16 030 031 032 033 034 035 036 037 - blank line for readability -040 041 042 043 047 32 + blank line for readability +040 041 042 043 047 32 050 051 053 054 056 057 075 076 077 -------------------------------- blank line for readability - 106 64 +------------------------------- blank line for readability + 106 64 110 115 117 120 122 123 124 125 126 127 131 133 134 135 137 -------------------------------- blank line for readability -140 142 146 96 - - 162 165 166 - -------------------------------- blank line for readability -200 201 202 203 204 205 206 207 128 SPECIAL SECTION. From 128-191 -210 211 212 213 214 215 216 217 RESERVED FOR interp() stuff. -220 221 222 223 224 225 226 227 144 +------------------------------- blank line for readability +140 142 146 96 + + 162 165 166 + +------------------------------- blank line for readability +200 201 202 203 204 205 206 207 128 SPECIAL SECTION. From 128-191 +210 211 212 213 214 215 216 217 RESERVED FOR interp() stuff. +220 221 222 223 224 225 226 227 144 230 231 232 233 234 235 -------------------------------- blank line for readability - 160 SPECIAL SECTION. From 128-191 - RESERVED FOR interp() stuff. +------------------------------- blank line for readability + 160 SPECIAL SECTION. From 128-191 + RESERVED FOR interp() stuff. ------------------------------- - 303 192 + 303 192 diff --git a/src/h/mproto.h b/src/h/mproto.h index 43e543d16..c2d8bd4ea 100644 --- a/src/h/mproto.h +++ b/src/h/mproto.h @@ -2,68 +2,68 @@ * mproto.h -- prototypes for functions common to several modules. */ -pointer alloc (unsigned int n); -unsigned short *bitvect (char *image, int len); -void clear_sbuf (struct str_buf *sbuf); -int cmp_pre (char *pre1, char *pre2); -void cset_init (FILE *f, unsigned short *bv); -void db_chstr (char *s1, char *s2); -void db_close (void); -void db_code (struct implement *ip); -void db_dscrd (struct implement *ip); -void db_err1 (int fatal, char *s1); -void db_err2 (int fatal, char *s1, char *s2); +pointer alloc (unsigned int n); +unsigned short *bitvect (char *image, int len); +void clear_sbuf (struct str_buf *sbuf); +int cmp_pre (char *pre1, char *pre2); +void cset_init (FILE *f, unsigned short *bv); +void db_chstr (char *s1, char *s2); +void db_close (void); +void db_code (struct implement *ip); +void db_dscrd (struct implement *ip); +void db_err1 (int fatal, char *s1); +void db_err2 (int fatal, char *s1, char *s2); struct implement *db_ilkup (char *id, struct implement **tbl); struct implement *db_impl (int oper_typ); -int db_open (char *s, char **lrgintflg); -char *db_string (void); -int db_tbl (char *section, struct implement **tbl); +int db_open (char *s, char **lrgintflg); +char *db_string (void); +int db_tbl (char *section, struct implement **tbl); char *findonpath(char *name, char *buf, size_t len); struct fileparts *fparse(char *s); -void free_stbl (void); -void id_comment (FILE *f); -void init_sbuf (struct str_buf *sbuf); -void init_str (void); -long longwrite (char *s,long len,FILE *file); -char *makename (char *dest,char *d,char *name,char *e); -long millisec (void); -struct il_code *new_il (int il_type, int size); -void new_sbuf (struct str_buf *sbuf); -void nxt_pre (char *pre, char *nxt, int n); -char *pathfind (char *buf, char *path, char *name, char *extn); -int ppch (void); -void ppdef (char *name, char *value); -void ppecho (void); -int ppinit (char *fname, char *inclpath, int m4flag); -int prt_i_str (FILE *f, char *s, int len); -int redirerr (char *p); -char *salloc (char *s); -int smatch (char *s,char *t); -char *spec_str (char *s); -char *str_install (struct str_buf *sbuf); -int tonum (int c); -void lear_sbuf (struct str_buf *sbuf); +void free_stbl (void); +void id_comment (FILE *f); +void init_sbuf (struct str_buf *sbuf); +void init_str (void); +long longwrite (char *s,long len,FILE *file); +char *makename (char *dest,char *d,char *name,char *e); +long millisec (void); +struct il_code *new_il (int il_type, int size); +void new_sbuf (struct str_buf *sbuf); +void nxt_pre (char *pre, char *nxt, int n); +char *pathfind (char *buf, char *path, char *name, char *extn); +int ppch (void); +void ppdef (char *name, char *value); +void ppecho (void); +int ppinit (char *fname, char *inclpath, int m4flag); +int prt_i_str (FILE *f, char *s, int len); +int redirerr (char *p); +char *salloc (char *s); +int smatch (char *s,char *t); +char *spec_str (char *s); +char *str_install (struct str_buf *sbuf); +int tonum (int c); +void lear_sbuf (struct str_buf *sbuf); #ifdef ConsoleWindow int Consolefprintf(FILE *file, const char *format, ...); int Consoleprintf(const char *format, ...); int Consoleputc(int c, FILE *file); int Consolefflush(FILE *file); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifndef SysOpt - int getopt (int argc, char * const argv[], const char *optstring); -#endif /* NoSysOpt */ + int getopt (int argc, char * const argv[], const char *optstring); +#endif /* NoSysOpt */ #if IntBits == 16 - long lstrlen (char *s); - void lqsort (char *base, int nel, int width, int (*cmp)()); -#endif /* IntBits == 16 */ + long lstrlen (char *s); + void lqsort (char *base, int nel, int width, int (*cmp)()); +#endif /* IntBits == 16 */ #define NewStruct(type)\ (struct type *)alloc((unsigned int) sizeof (struct type)) -char *relfile (char *prog, char *mod); +char *relfile (char *prog, char *mod); #if UNIX - FILE *pathOpen (char *fname, char*mode); + FILE *pathOpen (char *fname, char*mode); #endif diff --git a/src/h/mswin.h b/src/h/mswin.h index 6cb39a931..465db3c10 100644 --- a/src/h/mswin.h +++ b/src/h/mswin.h @@ -2,23 +2,23 @@ * mswin.h - macros and types used in the MS Windows graphics interface. */ -#define DRAWOP_AND R2_MASKPEN -#define DRAWOP_ANDINVERTED R2_MASKNOTPEN -#define DRAWOP_ANDREVERSE R2_NOTMASKPEN -#define DRAWOP_CLEAR R2_BLACK -#define DRAWOP_COPY R2_COPYPEN -#define DRAWOP_COPYINVERTED R2_NOTCOPYPEN -#define DRAWOP_EQUIV R2_NOTXORPEN -#define DRAWOP_INVERT R2_NOT -#define DRAWOP_NAND R2_MASKNOTPEN -#define DRAWOP_NOOP R2_NOP -#define DRAWOP_NOR R2_MERGENOTPEN -#define DRAWOP_OR R2_MERGEPEN -#define DRAWOP_ORINVERTED R2_MERGEPENNOT -#define DRAWOP_ORREVERSE R2_NOTMERGEPEN -#define DRAWOP_REVERSE R2_USER1 -#define DRAWOP_SET R2_WHITE -#define DRAWOP_XOR R2_XORPEN +#define DRAWOP_AND R2_MASKPEN +#define DRAWOP_ANDINVERTED R2_MASKNOTPEN +#define DRAWOP_ANDREVERSE R2_NOTMASKPEN +#define DRAWOP_CLEAR R2_BLACK +#define DRAWOP_COPY R2_COPYPEN +#define DRAWOP_COPYINVERTED R2_NOTCOPYPEN +#define DRAWOP_EQUIV R2_NOTXORPEN +#define DRAWOP_INVERT R2_NOT +#define DRAWOP_NAND R2_MASKNOTPEN +#define DRAWOP_NOOP R2_NOP +#define DRAWOP_NOR R2_MERGENOTPEN +#define DRAWOP_OR R2_MERGEPEN +#define DRAWOP_ORINVERTED R2_MERGEPENNOT +#define DRAWOP_ORREVERSE R2_NOTMERGEPEN +#define DRAWOP_REVERSE R2_USER1 +#define DRAWOP_SET R2_WHITE +#define DRAWOP_XOR R2_XORPEN #define TEXTWIDTH(w,s,n) textWidth(w, s, n) #define SCREENDEPTH(w) getdepth(w) @@ -137,15 +137,15 @@ #define CLR_SHARED 0 #define CLR_MUTABLE 1 -#define MAXCOLORNAME 40 +#define MAXCOLORNAME 40 /* * color structure, inspired by X code (xwin.h) */ typedef struct wcolor { - int refcount; - char name[6+MAXCOLORNAME]; /* name for WAttrib & WColor reads */ - SysColor c; - int type; /* CLR_SHARED or CLR_MUTABLE */ + int refcount; + char name[6+MAXCOLORNAME]; /* name for WAttrib & WColor reads */ + SysColor c; + int type; /* CLR_SHARED or CLR_MUTABLE */ } *wclrp; /* @@ -183,8 +183,8 @@ typedef struct { #define BORDERWIDTH (GetSystemMetrics(SM_CXBORDER)) /* 1 */ #define BORDERHEIGHT (GetSystemMetrics(SM_CYBORDER)) /* 1 */ #define TITLEHEIGHT (GetSystemMetrics(SM_CYCAPTION)) /* 20 */ -#define FRAMEWIDTH (GetSystemMetrics(SM_CXFRAME)) /* 4 */ -#define FRAMEHEIGHT (GetSystemMetrics(SM_CYFRAME)) /* 4 */ +#define FRAMEWIDTH (GetSystemMetrics(SM_CXFRAME)) /* 4 */ +#define FRAMEHEIGHT (GetSystemMetrics(SM_CYFRAME)) /* 4 */ #define STDLOCALS(w) \ wcp wc = (w)->context;\ diff --git a/src/h/mygramma.h b/src/h/mygramma.h index 819f5ffd0..518fcaf4a 100644 --- a/src/h/mygramma.h +++ b/src/h/mygramma.h @@ -8,270 +8,270 @@ * parserr.h, icont/tgrammar.c, iconc/cgrammar.c, and vtran/vtfiles/ident.c. */ -program : decls EOFX {Progend($1,$2);} ; +program : decls EOFX {Progend($1,$2);} ; -decls : ; - | decls decl ; +decls : ; + | decls decl ; -decl : record {Recdcl($1);} ; - | proc {Procdcl($1);} ; - | global {Globdcl($1);} ; - | link {Linkdcl($1);} ; +decl : record {Recdcl($1);} ; + | proc {Procdcl($1);} ; + | global {Globdcl($1);} ; + | link {Linkdcl($1);} ; | invocable {Invocdcl($1);} ; invocable : INVOCABLE invoclist {Invocable($1, $2);} ; invoclist : invocop; - | invoclist COMMA invocop {Invoclist($1,$2,$3);} ; + | invoclist COMMA invocop {Invoclist($1,$2,$3);} ; invocop : IDENT {Invocop1($1);} ; - | STRINGLIT {Invocop2($1);} ; - | STRINGLIT COLON INTLIT {Invocop3($1,$2,$3);} ; + | STRINGLIT {Invocop2($1);} ; + | STRINGLIT COLON INTLIT {Invocop3($1,$2,$3);} ; -link : LINK lnklist {Link($1, $2);} ; +link : LINK lnklist {Link($1, $2);} ; -lnklist : lnkfile ; - | lnklist COMMA lnkfile {Lnklist($1,$2,$3);} ; +lnklist : lnkfile ; + | lnklist COMMA lnkfile {Lnklist($1,$2,$3);} ; -lnkfile : IDENT {Lnkfile1($1);} ; - | STRINGLIT {Lnkfile2($1);} ; +lnkfile : IDENT {Lnkfile1($1);} ; + | STRINGLIT {Lnkfile2($1);} ; -global : GLOBAL {Global0($1);} idlist {Global1($1, $2, $3);} ; +global : GLOBAL {Global0($1);} idlist {Global1($1, $2, $3);} ; -record : RECORD IDENT {Record1($1,$2);} LPAREN fldlist RPAREN { - Record2($1,$2,$3,$4,$5,$6); - } ; +record : RECORD IDENT {Record1($1,$2);} LPAREN fldlist RPAREN { + Record2($1,$2,$3,$4,$5,$6); + } ; -fldlist : {Arglist1();} ; - | idlist {Arglist2($1);} ; +fldlist : {Arglist1();} ; + | idlist {Arglist2($1);} ; -proc : prochead SEMICOL locals initial procbody END { - Proc1($1,$2,$3,$4,$5,$6); - } ; +proc : prochead SEMICOL locals initial procbody END { + Proc1($1,$2,$3,$4,$5,$6); + } ; prochead: PROCEDURE IDENT {Prochead1($1,$2);} LPAREN arglist RPAREN { - Prochead2($1,$2,$3,$4,$5,$6); - } - | IDENT {Prochead1(0,$1);} LPAREN arglist RPAREN { - Prochead2(0,$1,$2,$3,$4,$5); - } ; + Prochead2($1,$2,$3,$4,$5,$6); + } + | IDENT {Prochead1(0,$1);} LPAREN arglist RPAREN { + Prochead2(0,$1,$2,$3,$4,$5); + } ; -arglist : {Arglist1();} ; - | idlist {Arglist2($1);} ; - | idlist LBRACK RBRACK {Arglist3($1,$2,$3);} ; +arglist : {Arglist1();} ; + | idlist {Arglist2($1);} ; + | idlist LBRACK RBRACK {Arglist3($1,$2,$3);} ; -idlist : IDENT { - Ident($1); - } ; - | idlist COMMA IDENT { - Idlist($1,$2,$3); - } ; +idlist : IDENT { + Ident($1); + } ; + | idlist COMMA IDENT { + Idlist($1,$2,$3); + } ; -locals : {Locals1();} ; - | locals retention idlist SEMICOL {Locals2($1,$2,$3,$4);} ; +locals : {Locals1();} ; + | locals retention idlist SEMICOL {Locals2($1,$2,$3,$4);} ; retention: LOCAL {Local($1);} ; - | STATIC {Static($1);} ; + | STATIC {Static($1);} ; -initial : {Initial1();} ; - | INITIAL expr SEMICOL {Initial2($1,$2,$3);} ; +initial : {Initial1();} ; + | INITIAL expr SEMICOL {Initial2($1,$2,$3);} ; procbody: {Procbody1();} ; - | nexpr SEMICOL procbody {Procbody2($1,$2,$3);} ; - -nexpr : {Nexpr();} ; - | expr ; - -expr : expr1a ; - | expr AND expr1a {Bamper($1,$2,$3);} ; - -expr1a : expr1 ; - | expr1a QMARK expr1 {Bques($1,$2,$3);} ; - -expr1 : expr2 ; - | expr2 SWAP expr1 {Bswap($1,$2,$3);} ; - | expr2 ASSIGN expr1 {Bassgn($1,$2,$3);} ; - | expr2 REVSWAP expr1 {Brswap($1,$2,$3);} ; - | expr2 REVASSIGN expr1 {Brassgn($1,$2,$3);} ; - | expr2 AUGCONCAT expr1 {Baugcat($1,$2,$3);} ; - | expr2 AUGLCONCAT expr1 {Bauglcat($1,$2,$3);} ; - | expr2 AUGDIFF expr1 {Bdiffa($1,$2,$3);} ; - | expr2 AUGUNION expr1 {Buniona($1,$2,$3);} ; - | expr2 AUGPLUS expr1 {Bplusa($1,$2,$3);} ; - | expr2 AUGMINUS expr1 {Bminusa($1,$2,$3);} ; - | expr2 AUGSTAR expr1 {Bstara($1,$2,$3);} ; - | expr2 AUGINTER expr1 {Bintera($1,$2,$3);} ; - | expr2 AUGSLASH expr1 {Bslasha($1,$2,$3);} ; - | expr2 AUGMOD expr1 {Bmoda($1,$2,$3);} ; - | expr2 AUGCARET expr1 {Bcareta($1,$2,$3);} ; - | expr2 AUGNMEQ expr1 {Baugeq($1,$2,$3);} ; - | expr2 AUGEQUIV expr1 {Baugeqv($1,$2,$3);} ; - | expr2 AUGNMGE expr1 {Baugge($1,$2,$3);} ; - | expr2 AUGNMGT expr1 {Bauggt($1,$2,$3);} ; - | expr2 AUGNMLE expr1 {Baugle($1,$2,$3);} ; - | expr2 AUGNMLT expr1 {Bauglt($1,$2,$3);} ; - | expr2 AUGNMNE expr1 {Baugne($1,$2,$3);} ; - | expr2 AUGNEQUIV expr1 {Baugneqv($1,$2,$3);} ; - | expr2 AUGSEQ expr1 {Baugseq($1,$2,$3);} ; - | expr2 AUGSGE expr1 {Baugsge($1,$2,$3);} ; - | expr2 AUGSGT expr1 {Baugsgt($1,$2,$3);} ; - | expr2 AUGSLE expr1 {Baugsle($1,$2,$3);} ; - | expr2 AUGSLT expr1 {Baugslt($1,$2,$3);} ; - | expr2 AUGSNE expr1 {Baugsne($1,$2,$3);} ; - | expr2 AUGQMARK expr1 {Baugques($1,$2,$3);} ; - | expr2 AUGAND expr1 {Baugamper($1,$2,$3);} ; - | expr2 AUGAT expr1 {Baugact($1,$2,$3);} ; - -expr2 : expr3 ; - | expr2 TO expr3 {To0($1,$2,$3);} ; - | expr2 TO expr3 BY expr3 {To1($1,$2,$3,$4,$5);} ; - -expr3 : expr4 ; - | expr4 BAR expr3 {Alt($1,$2,$3);} ; - -expr4 : expr5 ; - | expr4 SEQ expr5 {Bseq($1,$2,$3);} ; - | expr4 SGE expr5 {Bsge($1,$2,$3);} ; - | expr4 SGT expr5 {Bsgt($1,$2,$3);} ; - | expr4 SLE expr5 {Bsle($1,$2,$3);} ; - | expr4 SLT expr5 {Bslt($1,$2,$3);} ; - | expr4 SNE expr5 {Bsne($1,$2,$3);} ; - | expr4 NMEQ expr5 {Beq($1,$2,$3);} ; - | expr4 NMGE expr5 {Bge($1,$2,$3);} ; - | expr4 NMGT expr5 {Bgt($1,$2,$3);} ; - | expr4 NMLE expr5 {Ble($1,$2,$3);} ; - | expr4 NMLT expr5 {Blt($1,$2,$3);} ; - | expr4 NMNE expr5 {Bne($1,$2,$3);} ; - | expr4 EQUIV expr5 {Beqv($1,$2,$3);} ; - | expr4 NEQUIV expr5 {Bneqv($1,$2,$3);} ; - -expr5 : expr6 ; - | expr5 CONCAT expr6 {Bcat($1,$2,$3);} ; - | expr5 LCONCAT expr6 {Blcat($1,$2,$3);} ; - -expr6 : expr7 ; - | expr6 PLUS expr7 {Bplus($1,$2,$3);} ; - | expr6 DIFF expr7 {Bdiff($1,$2,$3);} ; - | expr6 UNION expr7 {Bunion($1,$2,$3);} ; - | expr6 MINUS expr7 {Bminus($1,$2,$3);} ; - -expr7 : expr8 ; - | expr7 STAR expr8 {Bstar($1,$2,$3);} ; - | expr7 INTER expr8 {Binter($1,$2,$3);} ; - | expr7 SLASH expr8 {Bslash($1,$2,$3);} ; - | expr7 MOD expr8 {Bmod($1,$2,$3);} ; - -expr8 : expr9 ; - | expr9 CARET expr8 {Bcaret($1,$2,$3);} ; - -expr9 : expr10 ; - | expr9 BACKSLASH expr10 {Blim($1,$2,$3);} ; - | expr9 AT expr10 {Bact($1,$2,$3);}; - | expr9 BANG expr10 {Apply($1,$2,$3);}; - -expr10 : expr11 ; - | AT expr10 {Uat($1,$2);} ; - | NOT expr10 {Unot($1,$2);} ; - | BAR expr10 {Ubar($1,$2);} ; - | CONCAT expr10 {Uconcat($1,$2);} ; - | LCONCAT expr10 {Ulconcat($1,$2);} ; - | DOT expr10 {Udot($1,$2);} ; - | BANG expr10 {Ubang($1,$2);} ; - | DIFF expr10 {Udiff($1,$2);} ; - | PLUS expr10 {Uplus($1,$2);} ; - | STAR expr10 {Ustar($1,$2);} ; - | SLASH expr10 {Uslash($1,$2);} ; - | CARET expr10 {Ucaret($1,$2);} ; - | INTER expr10 {Uinter($1,$2);} ; - | TILDE expr10 {Utilde($1,$2);} ; - | MINUS expr10 {Uminus($1,$2);} ; - | NMEQ expr10 {Unumeq($1,$2);} ; - | NMNE expr10 {Unumne($1,$2);} ; - | SEQ expr10 {Ulexeq($1,$2);} ; - | SNE expr10 {Ulexne($1,$2);} ; - | EQUIV expr10 {Uequiv($1,$2);} ; - | UNION expr10 {Uunion($1,$2);} ; - | QMARK expr10 {Uqmark($1,$2);} ; - | NEQUIV expr10 {Unotequiv($1,$2);} ; - | BACKSLASH expr10 {Ubackslash($1,$2);} ; - -expr11 : literal ; - | section ; - | return ; - | if ; - | case ; - | while ; - | until ; - | every ; - | repeat ; - | CREATE expr {Create($1,$2);} ; - | IDENT {Var($1);} ; - | NEXT {Next($1);} ; - | BREAK nexpr {Break($1,$2);} ; - | LPAREN exprlist RPAREN {Paren($1,$2,$3);} ; - | LBRACE compound RBRACE {Brace($1,$2,$3);} ; - | LBRACK exprlist RBRACK {Brack($1,$2,$3);} ; - | expr11 LBRACK exprlist RBRACK {Subscript($1,$2,$3,$4);} ; - | expr11 LBRACE RBRACE {Pdco0($1,$2,$3);} ; - | expr11 LBRACE pdcolist RBRACE {Pdco1($1,$2,$3,$4);} ; - | expr11 LPAREN exprlist RPAREN {Invoke($1,$2,$3,$4);} ; - | expr11 DOT IDENT {Field($1,$2,$3);} ; - | AND FAIL {Kfail($1,$2);} ; - | AND IDENT {Keyword($1,$2);} ; - -while : WHILE expr {While0($1,$2);} ; - | WHILE expr DO expr {While1($1,$2,$3,$4);} ; - -until : UNTIL expr {Until0($1,$2);} ; - | UNTIL expr DO expr {Until1($1,$2,$3,$4);} ; - -every : EVERY expr {Every0($1,$2);} ; - | EVERY expr DO expr {Every1($1,$2,$3,$4);} ; - -repeat : REPEAT expr {Repeat($1,$2);} ; - -return : FAIL {Fail($1);} ; - | RETURN nexpr {Return($1,$2);} ; - | SUSPEND nexpr {Suspend0($1,$2);} ; + | nexpr SEMICOL procbody {Procbody2($1,$2,$3);} ; + +nexpr : {Nexpr();} ; + | expr ; + +expr : expr1a ; + | expr AND expr1a {Bamper($1,$2,$3);} ; + +expr1a : expr1 ; + | expr1a QMARK expr1 {Bques($1,$2,$3);} ; + +expr1 : expr2 ; + | expr2 SWAP expr1 {Bswap($1,$2,$3);} ; + | expr2 ASSIGN expr1 {Bassgn($1,$2,$3);} ; + | expr2 REVSWAP expr1 {Brswap($1,$2,$3);} ; + | expr2 REVASSIGN expr1 {Brassgn($1,$2,$3);} ; + | expr2 AUGCONCAT expr1 {Baugcat($1,$2,$3);} ; + | expr2 AUGLCONCAT expr1 {Bauglcat($1,$2,$3);} ; + | expr2 AUGDIFF expr1 {Bdiffa($1,$2,$3);} ; + | expr2 AUGUNION expr1 {Buniona($1,$2,$3);} ; + | expr2 AUGPLUS expr1 {Bplusa($1,$2,$3);} ; + | expr2 AUGMINUS expr1 {Bminusa($1,$2,$3);} ; + | expr2 AUGSTAR expr1 {Bstara($1,$2,$3);} ; + | expr2 AUGINTER expr1 {Bintera($1,$2,$3);} ; + | expr2 AUGSLASH expr1 {Bslasha($1,$2,$3);} ; + | expr2 AUGMOD expr1 {Bmoda($1,$2,$3);} ; + | expr2 AUGCARET expr1 {Bcareta($1,$2,$3);} ; + | expr2 AUGNMEQ expr1 {Baugeq($1,$2,$3);} ; + | expr2 AUGEQUIV expr1 {Baugeqv($1,$2,$3);} ; + | expr2 AUGNMGE expr1 {Baugge($1,$2,$3);} ; + | expr2 AUGNMGT expr1 {Bauggt($1,$2,$3);} ; + | expr2 AUGNMLE expr1 {Baugle($1,$2,$3);} ; + | expr2 AUGNMLT expr1 {Bauglt($1,$2,$3);} ; + | expr2 AUGNMNE expr1 {Baugne($1,$2,$3);} ; + | expr2 AUGNEQUIV expr1 {Baugneqv($1,$2,$3);} ; + | expr2 AUGSEQ expr1 {Baugseq($1,$2,$3);} ; + | expr2 AUGSGE expr1 {Baugsge($1,$2,$3);} ; + | expr2 AUGSGT expr1 {Baugsgt($1,$2,$3);} ; + | expr2 AUGSLE expr1 {Baugsle($1,$2,$3);} ; + | expr2 AUGSLT expr1 {Baugslt($1,$2,$3);} ; + | expr2 AUGSNE expr1 {Baugsne($1,$2,$3);} ; + | expr2 AUGQMARK expr1 {Baugques($1,$2,$3);} ; + | expr2 AUGAND expr1 {Baugamper($1,$2,$3);} ; + | expr2 AUGAT expr1 {Baugact($1,$2,$3);} ; + +expr2 : expr3 ; + | expr2 TO expr3 {To0($1,$2,$3);} ; + | expr2 TO expr3 BY expr3 {To1($1,$2,$3,$4,$5);} ; + +expr3 : expr4 ; + | expr4 BAR expr3 {Alt($1,$2,$3);} ; + +expr4 : expr5 ; + | expr4 SEQ expr5 {Bseq($1,$2,$3);} ; + | expr4 SGE expr5 {Bsge($1,$2,$3);} ; + | expr4 SGT expr5 {Bsgt($1,$2,$3);} ; + | expr4 SLE expr5 {Bsle($1,$2,$3);} ; + | expr4 SLT expr5 {Bslt($1,$2,$3);} ; + | expr4 SNE expr5 {Bsne($1,$2,$3);} ; + | expr4 NMEQ expr5 {Beq($1,$2,$3);} ; + | expr4 NMGE expr5 {Bge($1,$2,$3);} ; + | expr4 NMGT expr5 {Bgt($1,$2,$3);} ; + | expr4 NMLE expr5 {Ble($1,$2,$3);} ; + | expr4 NMLT expr5 {Blt($1,$2,$3);} ; + | expr4 NMNE expr5 {Bne($1,$2,$3);} ; + | expr4 EQUIV expr5 {Beqv($1,$2,$3);} ; + | expr4 NEQUIV expr5 {Bneqv($1,$2,$3);} ; + +expr5 : expr6 ; + | expr5 CONCAT expr6 {Bcat($1,$2,$3);} ; + | expr5 LCONCAT expr6 {Blcat($1,$2,$3);} ; + +expr6 : expr7 ; + | expr6 PLUS expr7 {Bplus($1,$2,$3);} ; + | expr6 DIFF expr7 {Bdiff($1,$2,$3);} ; + | expr6 UNION expr7 {Bunion($1,$2,$3);} ; + | expr6 MINUS expr7 {Bminus($1,$2,$3);} ; + +expr7 : expr8 ; + | expr7 STAR expr8 {Bstar($1,$2,$3);} ; + | expr7 INTER expr8 {Binter($1,$2,$3);} ; + | expr7 SLASH expr8 {Bslash($1,$2,$3);} ; + | expr7 MOD expr8 {Bmod($1,$2,$3);} ; + +expr8 : expr9 ; + | expr9 CARET expr8 {Bcaret($1,$2,$3);} ; + +expr9 : expr10 ; + | expr9 BACKSLASH expr10 {Blim($1,$2,$3);} ; + | expr9 AT expr10 {Bact($1,$2,$3);}; + | expr9 BANG expr10 {Apply($1,$2,$3);}; + +expr10 : expr11 ; + | AT expr10 {Uat($1,$2);} ; + | NOT expr10 {Unot($1,$2);} ; + | BAR expr10 {Ubar($1,$2);} ; + | CONCAT expr10 {Uconcat($1,$2);} ; + | LCONCAT expr10 {Ulconcat($1,$2);} ; + | DOT expr10 {Udot($1,$2);} ; + | BANG expr10 {Ubang($1,$2);} ; + | DIFF expr10 {Udiff($1,$2);} ; + | PLUS expr10 {Uplus($1,$2);} ; + | STAR expr10 {Ustar($1,$2);} ; + | SLASH expr10 {Uslash($1,$2);} ; + | CARET expr10 {Ucaret($1,$2);} ; + | INTER expr10 {Uinter($1,$2);} ; + | TILDE expr10 {Utilde($1,$2);} ; + | MINUS expr10 {Uminus($1,$2);} ; + | NMEQ expr10 {Unumeq($1,$2);} ; + | NMNE expr10 {Unumne($1,$2);} ; + | SEQ expr10 {Ulexeq($1,$2);} ; + | SNE expr10 {Ulexne($1,$2);} ; + | EQUIV expr10 {Uequiv($1,$2);} ; + | UNION expr10 {Uunion($1,$2);} ; + | QMARK expr10 {Uqmark($1,$2);} ; + | NEQUIV expr10 {Unotequiv($1,$2);} ; + | BACKSLASH expr10 {Ubackslash($1,$2);} ; + +expr11 : literal ; + | section ; + | return ; + | if ; + | case ; + | while ; + | until ; + | every ; + | repeat ; + | CREATE expr {Create($1,$2);} ; + | IDENT {Var($1);} ; + | NEXT {Next($1);} ; + | BREAK nexpr {Break($1,$2);} ; + | LPAREN exprlist RPAREN {Paren($1,$2,$3);} ; + | LBRACE compound RBRACE {Brace($1,$2,$3);} ; + | LBRACK exprlist RBRACK {Brack($1,$2,$3);} ; + | expr11 LBRACK exprlist RBRACK {Subscript($1,$2,$3,$4);} ; + | expr11 LBRACE RBRACE {Pdco0($1,$2,$3);} ; + | expr11 LBRACE pdcolist RBRACE {Pdco1($1,$2,$3,$4);} ; + | expr11 LPAREN exprlist RPAREN {Invoke($1,$2,$3,$4);} ; + | expr11 DOT IDENT {Field($1,$2,$3);} ; + | AND FAIL {Kfail($1,$2);} ; + | AND IDENT {Keyword($1,$2);} ; + +while : WHILE expr {While0($1,$2);} ; + | WHILE expr DO expr {While1($1,$2,$3,$4);} ; + +until : UNTIL expr {Until0($1,$2);} ; + | UNTIL expr DO expr {Until1($1,$2,$3,$4);} ; + +every : EVERY expr {Every0($1,$2);} ; + | EVERY expr DO expr {Every1($1,$2,$3,$4);} ; + +repeat : REPEAT expr {Repeat($1,$2);} ; + +return : FAIL {Fail($1);} ; + | RETURN nexpr {Return($1,$2);} ; + | SUSPEND nexpr {Suspend0($1,$2);} ; | SUSPEND expr DO expr {Suspend1($1,$2,$3,$4);}; -if : IF expr THEN expr {If0($1,$2,$3,$4);} ; - | IF expr THEN expr ELSE expr {If1($1,$2,$3,$4,$5,$6);} ; +if : IF expr THEN expr {If0($1,$2,$3,$4);} ; + | IF expr THEN expr ELSE expr {If1($1,$2,$3,$4,$5,$6);} ; -case : CASE expr OF LBRACE caselist RBRACE {Case($1,$2,$3,$4,$5,$6);} ; +case : CASE expr OF LBRACE caselist RBRACE {Case($1,$2,$3,$4,$5,$6);} ; caselist: cclause ; - | caselist SEMICOL cclause {Caselist($1,$2,$3);} ; + | caselist SEMICOL cclause {Caselist($1,$2,$3);} ; -cclause : DEFAULT COLON expr {Cclause0($1,$2,$3);} ; - | expr COLON expr {Cclause1($1,$2,$3);} ; +cclause : DEFAULT COLON expr {Cclause0($1,$2,$3);} ; + | expr COLON expr {Cclause1($1,$2,$3);} ; exprlist: nexpr {Elst0($1);} - | exprlist COMMA nexpr {Elst1($1,$2,$3);} ; + | exprlist COMMA nexpr {Elst1($1,$2,$3);} ; pdcolist: nexpr { - Pdcolist0($1); - } ; - | pdcolist COMMA nexpr { - Pdcolist1($1,$2,$3); - } ; + Pdcolist0($1); + } ; + | pdcolist COMMA nexpr { + Pdcolist1($1,$2,$3); + } ; -literal : INTLIT {Iliter($1);} ; - | REALLIT {Rliter($1);} ; - | STRINGLIT {Sliter($1);} ; - | CSETLIT {Cliter($1);} ; +literal : INTLIT {Iliter($1);} ; + | REALLIT {Rliter($1);} ; + | STRINGLIT {Sliter($1);} ; + | CSETLIT {Cliter($1);} ; -section : expr11 LBRACK expr sectop expr RBRACK {Section($1,$2,$3,$4,$5,$6);} ; +section : expr11 LBRACK expr sectop expr RBRACK {Section($1,$2,$3,$4,$5,$6);} ; -sectop : COLON {Colon($1);} ; - | PCOLON {Pcolon($1);} ; - | MCOLON {Mcolon($1);} ; +sectop : COLON {Colon($1);} ; + | PCOLON {Pcolon($1);} ; + | MCOLON {Mcolon($1);} ; compound: nexpr ; - | nexpr SEMICOL compound {Compound($1,$2,$3);} ; + | nexpr SEMICOL compound {Compound($1,$2,$3);} ; -program : error decls EOFX ; -proc : prochead error procbody END ; -expr : error ; +program : error decls EOFX ; +proc : prochead error procbody END ; +expr : error ; diff --git a/src/h/opdefs.h b/src/h/opdefs.h index a6f4f302f..cd11e1f74 100644 --- a/src/h/opdefs.h +++ b/src/h/opdefs.h @@ -7,101 +7,101 @@ * but it'll have to do until we think of another way to do this. (It's * always been thus.) */ -#define Op_Asgn 1 -#define Op_Bang 2 -#define Op_Cat 3 -#define Op_Compl 4 -#define Op_Diff 5 -#define Op_Div 6 -#define Op_Eqv 7 -#define Op_Inter 8 -#define Op_Lconcat 9 -#define Op_Lexeq 10 -#define Op_Lexge 11 -#define Op_Lexgt 12 -#define Op_Lexle 13 -#define Op_Lexlt 14 -#define Op_Lexne 15 -#define Op_Minus 16 -#define Op_Mod 17 -#define Op_Mult 18 -#define Op_Neg 19 -#define Op_Neqv 20 -#define Op_Nonnull 21 -#define Op_Null 22 -#define Op_Number 23 -#define Op_Numeq 24 -#define Op_Numge 25 -#define Op_Numgt 26 -#define Op_Numle 27 -#define Op_Numlt 28 -#define Op_Numne 29 -#define Op_Plus 30 -#define Op_Power 31 -#define Op_Random 32 -#define Op_Rasgn 33 -#define Op_Rcv 34 -#define Op_RcvBk 35 -#define Op_Refresh 36 -#define Op_Rswap 37 -#define Op_Sect 38 -#define Op_Snd 39 -#define Op_SndBk 40 -#define Op_Size 41 -#define Op_Subsc 42 -#define Op_Swap 43 -#define Op_Tabmat 44 -#define Op_Toby 45 -#define Op_Unions 46 -#define Op_Value 47 +#define Op_Asgn 1 +#define Op_Bang 2 +#define Op_Cat 3 +#define Op_Compl 4 +#define Op_Diff 5 +#define Op_Div 6 +#define Op_Eqv 7 +#define Op_Inter 8 +#define Op_Lconcat 9 +#define Op_Lexeq 10 +#define Op_Lexge 11 +#define Op_Lexgt 12 +#define Op_Lexle 13 +#define Op_Lexlt 14 +#define Op_Lexne 15 +#define Op_Minus 16 +#define Op_Mod 17 +#define Op_Mult 18 +#define Op_Neg 19 +#define Op_Neqv 20 +#define Op_Nonnull 21 +#define Op_Null 22 +#define Op_Number 23 +#define Op_Numeq 24 +#define Op_Numge 25 +#define Op_Numgt 26 +#define Op_Numle 27 +#define Op_Numlt 28 +#define Op_Numne 29 +#define Op_Plus 30 +#define Op_Power 31 +#define Op_Random 32 +#define Op_Rasgn 33 +#define Op_Rcv 34 +#define Op_RcvBk 35 +#define Op_Refresh 36 +#define Op_Rswap 37 +#define Op_Sect 38 +#define Op_Snd 39 +#define Op_SndBk 40 +#define Op_Size 41 +#define Op_Subsc 42 +#define Op_Swap 43 +#define Op_Tabmat 44 +#define Op_Toby 45 +#define Op_Unions 46 +#define Op_Value 47 /* * Other instructions. */ -#define Op_Bscan 117 -#define Op_Ccase 118 -#define Op_Chfail 119 -#define Op_Coact 120 -#define Op_Cofail 48 -#define Op_Coret 49 -#define Op_Create 50 -#define Op_Cset 51 -#define Op_Dup 52 -#define Op_Efail 53 -#define Op_EInit 116 -#define Op_Eret 54 -#define Op_Escan 55 -#define Op_Esusp 56 -#define Op_Field 57 -#define Op_Goto 58 -#define Op_Init 59 -#define Op_Int 60 -#define Op_Invoke 61 -#define Op_Keywd 62 -#define Op_Limit 63 -#define Op_Line 64 -#define Op_Llist 65 -#define Op_Lsusp 66 -#define Op_Mark 67 -#define Op_Pfail 68 -#define Op_Pnull 69 -#define Op_Pop 70 -#define Op_Pret 71 -#define Op_Psusp 72 -#define Op_Push1 73 -#define Op_Pushn1 74 -#define Op_Real 75 -#define Op_Sdup 76 -#define Op_Str 77 -#define Op_Unmark 78 -#define Op_Var 80 -#define Op_Arg 81 -#define Op_Static 82 -#define Op_Local 83 -#define Op_Global 84 -#define Op_Mark0 85 -#define Op_Quit 86 -#define Op_Tally 88 -#define Op_Apply 89 +#define Op_Bscan 117 +#define Op_Ccase 118 +#define Op_Chfail 119 +#define Op_Coact 120 +#define Op_Cofail 48 +#define Op_Coret 49 +#define Op_Create 50 +#define Op_Cset 51 +#define Op_Dup 52 +#define Op_Efail 53 +#define Op_EInit 116 +#define Op_Eret 54 +#define Op_Escan 55 +#define Op_Esusp 56 +#define Op_Field 57 +#define Op_Goto 58 +#define Op_Init 59 +#define Op_Int 60 +#define Op_Invoke 61 +#define Op_Keywd 62 +#define Op_Limit 63 +#define Op_Line 64 +#define Op_Llist 65 +#define Op_Lsusp 66 +#define Op_Mark 67 +#define Op_Pfail 68 +#define Op_Pnull 69 +#define Op_Pop 70 +#define Op_Pret 71 +#define Op_Psusp 72 +#define Op_Push1 73 +#define Op_Pushn1 74 +#define Op_Real 75 +#define Op_Sdup 76 +#define Op_Str 77 +#define Op_Unmark 78 +#define Op_Var 80 +#define Op_Arg 81 +#define Op_Static 82 +#define Op_Local 83 +#define Op_Global 84 +#define Op_Mark0 85 +#define Op_Quit 86 +#define Op_Tally 88 +#define Op_Apply 89 /* @@ -110,41 +110,41 @@ * that initially compute a location relative to locations not known until * the icode file is loaded. */ -#define Op_Acset 90 -#define Op_Areal 91 -#define Op_Astr 92 -#define Op_Aglobal 93 -#define Op_Astatic 94 -#define Op_Agoto 95 -#define Op_Amark 96 +#define Op_Acset 90 +#define Op_Areal 91 +#define Op_Astr 92 +#define Op_Aglobal 93 +#define Op_Astatic 94 +#define Op_Agoto 95 +#define Op_Amark 96 -#define Op_Noop 98 +#define Op_Noop 98 -#define Op_Colm 108 /* column number */ +#define Op_Colm 108 /* column number */ /* * Declarations and such -- used by the linker but not the run-time system. */ -#define Op_Proc 101 -#define Op_Declend 102 -#define Op_End 103 -#define Op_Link 104 -#define Op_Version 105 -#define Op_Con 106 -#define Op_Filen 107 +#define Op_Proc 101 +#define Op_Declend 102 +#define Op_End 103 +#define Op_Link 104 +#define Op_Version 105 +#define Op_Con 106 +#define Op_Filen 107 /* * Global symbol table declarations. */ -#define Op_Record 105 -#define Op_Impl 106 -#define Op_Error 107 -#define Op_Trace 108 -#define Op_Lab 109 -#define Op_Invocable 110 +#define Op_Record 105 +#define Op_Impl 106 +#define Op_Error 107 +#define Op_Trace 108 +#define Op_Lab 109 +#define Op_Invocable 110 /* * Extra instructions added for calling Icon from C (used by Posix functions) @@ -153,7 +153,7 @@ #define Op_Copyd 111 #define Op_Trapret 112 #define Op_Trapfail 113 -#endif /* PosixFns */ +#endif /* PosixFns */ #define Op_Synt 114 /* syntax code used by the linker */ #define Op_Uid 115 /* Universal Identifier for .u files */ diff --git a/src/h/opengl.h b/src/h/opengl.h index 5b2535cef..5c5ff4872 100644 --- a/src/h/opengl.h +++ b/src/h/opengl.h @@ -7,16 +7,16 @@ #ifdef GL2D_DEBUG #define glprintf(s, ...) printf(stderr,s, ##__VA_ARGS__) -#else /* GL2D_DEBUG */ -#define glprintf(s, ...) -#endif /* GL2D_DEBUG */ +#else /* GL2D_DEBUG */ +#define glprintf(s, ...) +#endif /* GL2D_DEBUG */ /* Definitions for attribute buffermode */ -#define UGL_IMMEDIATE 1 -#define UGL_BUFFERED 0 +#define UGL_IMMEDIATE 1 +#define UGL_BUFFERED 0 /* Legacy definitons */ -#define IMMEDIATE3D UGL_IMMEDIATE -#define BUFFERED3D UGL_BUFFERED +#define IMMEDIATE3D UGL_IMMEDIATE +#define BUFFERED3D UGL_BUFFERED /* @@ -34,8 +34,8 @@ #define U3D_POLYGON GL_POLYGON #define U2D_LINE_LOOP GL_LINE_LOOP -#define U2D_LINE_STRIP GL_LINE_STRIP -#define U2D_POLYGON GL_POLYGON +#define U2D_LINE_STRIP GL_LINE_STRIP +#define U2D_POLYGON GL_POLYGON /* * texture modes. @@ -47,69 +47,69 @@ /* * Graphical primitive IDs */ -#define GL2D_BLIMAGE 9000 -#define GL2D_FILLPOLYGON 9001 -#define GL2D_DRAWPOLYGON 9002 -#define GL2D_DRAWSEGMENT 9003 -#define GL2D_DRAWLINE 9004 -#define GL2D_DRAWPOINT 9005 -#define GL2D_DRAWCIRCLE 9006 -#define GL2D_FILLCIRCLE 9007 -#define GL2D_DRAWARC 9008 -#define GL2D_FILLARC 9009 -#define GL2D_DRAWRECTANGLE 9010 -#define GL2D_FILLRECTANGLE 9011 -#define GL2D_COPYAREA 9012 -#define GL2D_ERASEAREA 9013 -#define GL2D_STRIMAGE 9014 -#define GL2D_READIMAGE 9015 -#define GL2D_DRAWSTRING 9016 -#define GL2D_WWRITE 9017 - -/* +#define GL2D_BLIMAGE 9000 +#define GL2D_FILLPOLYGON 9001 +#define GL2D_DRAWPOLYGON 9002 +#define GL2D_DRAWSEGMENT 9003 +#define GL2D_DRAWLINE 9004 +#define GL2D_DRAWPOINT 9005 +#define GL2D_DRAWCIRCLE 9006 +#define GL2D_FILLCIRCLE 9007 +#define GL2D_DRAWARC 9008 +#define GL2D_FILLARC 9009 +#define GL2D_DRAWRECTANGLE 9010 +#define GL2D_FILLRECTANGLE 9011 +#define GL2D_COPYAREA 9012 +#define GL2D_ERASEAREA 9013 +#define GL2D_STRIMAGE 9014 +#define GL2D_READIMAGE 9015 +#define GL2D_DRAWSTRING 9016 +#define GL2D_WWRITE 9017 + +/* * Attribute primitive IDs */ /* colors */ -#define GL2D_FG 9050 -#define GL2D_BG 9051 -#define GL2D_REVERSE 9052 -#define GL2D_GAMMA 9053 -#define GL2D_DRAWOP 9054 +#define GL2D_FG 9050 +#define GL2D_BG 9051 +#define GL2D_REVERSE 9052 +#define GL2D_GAMMA 9053 +#define GL2D_DRAWOP 9054 /* fonts */ -#define GL2D_FONT 9055 -#define GL2D_LEADING 9056 +#define GL2D_FONT 9055 +#define GL2D_LEADING 9056 /* lines/fills */ -#define GL2D_LINEWIDTH 9057 -#define GL2D_LINESTYLE 9058 -#define GL2D_FILLSTYLE 9059 -#define GL2D_PATTERN 9060 +#define GL2D_LINEWIDTH 9057 +#define GL2D_LINESTYLE 9058 +#define GL2D_FILLSTYLE 9059 +#define GL2D_PATTERN 9060 /* positioning */ -#define GL2D_CLIP 9061 -#define GL2D_DX 9062 -#define GL2D_DY 9063 +#define GL2D_CLIP 9061 +#define GL2D_DX 9062 +#define GL2D_DY 9063 /* * line styles */ -#define GL2D_LINE_SOLID 0 -#define GL2D_LINE_DASHED 1 -#define GL2D_LINE_STRIPED 2 +#define GL2D_LINE_SOLID 0 +#define GL2D_LINE_DASHED 1 +#define GL2D_LINE_STRIPED 2 /* * fill styles */ -#define GL2D_FILL_SOLID 0 -#define GL2D_FILL_TEXTURED 1 -#define GL2D_FILL_MASKED 2 +#define GL2D_FILL_SOLID 0 +#define GL2D_FILL_TEXTURED 1 +#define GL2D_FILL_MASKED 2 /* - * drawops + * drawops */ -#define GL2D_DRAWOP_COPY GL_COPY -#define GL2D_DRAWOP_REVERSE GL_XOR +#define GL2D_DRAWOP_COPY GL_COPY +#define GL2D_DRAWOP_REVERSE GL_XOR /* @@ -123,10 +123,10 @@ typedef struct color { char name[6+MAXCOLORNAME]; unsigned short r, g, b, a; /* for referencing a mutable color (negative) */ - int id; + int id; #ifdef XWindows unsigned long c; /* X11 color handle */ -#endif /* XWindows */ +#endif /* XWindows */ struct color *prev, *next; } *clrp; @@ -136,7 +136,7 @@ typedef struct color { struct fontsymbol { unsigned char *pixmap; int width, height; - int advance, top_bearing, left_bearing; + int advance, top_bearing, left_bearing; unsigned int texid, index; }; @@ -161,7 +161,7 @@ struct fontsymbol { wd->currCtx = NULL;\ } while(0) -#endif /* XWindows */ +#endif /* XWindows */ /* * TODO: Make MSWindows version check for redundant state changes @@ -175,7 +175,7 @@ struct fontsymbol { } while(0) #define UnbindCurrent(wd) -#endif /* MSWindows */ +#endif /* MSWindows */ #define FlushWindow(w) do {\ if ((w)->window->buffermode == UGL_BUFFERED)\ @@ -201,8 +201,8 @@ struct fontsymbol { } while(0) /* - * General OpenGL error checker that handles nothing. - * Currently for debugging + * General OpenGL error checker that handles nothing. + * Currently for debugging */ #define CheckGLError(func) do {\ unsigned int err;\ @@ -220,7 +220,7 @@ struct fontsymbol { if (!errcount) {\ delete_first_tex(wd, (wd)->numTexIds/2);\ glTexImage2D(target,level,internalfmt,width,height,border,format,\ - type,data);\ + type,data);\ }\ /* if failed already, then let it die */\ else return retval;\ @@ -231,13 +231,13 @@ struct fontsymbol { /* * There is a floating error in gpxtest.icn for procedure copying - * It is happening before the entire hidden + * It is happening before the entire hidden * window's contents are copied to the main window. * TODO: find the error to make sure it doesn't become - * a future problem. Reminder: set a breakpoint at + * a future problem. Reminder: set a breakpoint at * gl_copyArea or copyarea2d to find it. * - * The error is incorrectly diagnosed to be a result of + * The error is incorrectly diagnosed to be a result of * glBindTexture, but uncommenting the while loop shows * it to be true. */ @@ -277,9 +277,9 @@ struct fontsymbol { glDrawBuffer(GL_FRONT);\ }\ } while(0) -#else /* XWindows */ +#else /* XWindows */ #define ApplyBuffermode(w, mode) -#endif /* XWindows */ +#endif /* XWindows */ /* @@ -310,7 +310,7 @@ struct fontsymbol { /* * glStencilFunc() with a mask of 0 lets the stencil test pass regardless - * of what values are in the stencil buffer. Otherwise, it will only let + * of what values are in the stencil buffer. Otherwise, it will only let * pixels that are equal to the bits in {mask} pass the stencil test. */ #define SetStencilFunc(w, mask) \ @@ -321,7 +321,7 @@ struct fontsymbol { * Miscellaneous */ #define POLY_COMPLEX 1 /* self-intersecting "convex" */ -#define POLY_CONVEX 2 +#define POLY_CONVEX 2 #define POLY_NONCONVEX 3 /* @@ -347,7 +347,7 @@ struct fontsymbol { (buf)[1] = g;\ (buf)[2] = b;\ } while(0) - + #define AssignBGR(buf, r, g, b) do {\ (buf)[0] = b;\ (buf)[1] = g;\ @@ -369,7 +369,7 @@ struct fontsymbol { /* * Helper macro for getting 2d record constructors * - * rec_structor2d() could return NULL if the program runs out of memory. + * rec_structor2d() could return NULL if the program runs out of memory. * If it returns NULL with memory to spare, it would be a syserr(). */ #define Get2dRecordConstr(constr, code) do {\ @@ -551,7 +551,7 @@ struct fontsymbol { /* * Viewing volume definitions - */ + */ //#define CWIDTH 0.25 //#define CNEAR 0.25 //#define CFAR 50000.0 @@ -567,8 +567,8 @@ struct fontsymbol { #define HALF_CHEIGHT(w) (CHEIGHT(w)/2.0) /* Projection definitons */ -#define UGL_PERSPECTIVE 0 -#define UGL_ORTHOGONAL 1 +#define UGL_PERSPECTIVE 0 +#define UGL_ORTHOGONAL 1 #define UGLProj(w) do {\ wsp ws = (w)->window;\ @@ -603,7 +603,7 @@ struct fontsymbol { } while(0) /* - * Adds dx/dy back in via render context. + * Adds dx/dy back in via render context. * Uses rectargs() logic like RemoveDxDy() */ #define AddDxDy(win, x, y, w, h) do {\ @@ -616,7 +616,7 @@ struct fontsymbol { } while(0) /* - * For translating from pixel (Unicon) to world (OpenGL) coordinates. + * For translating from pixel (Unicon) to world (OpenGL) coordinates. * In relation to the camera, the center of the window is (0,0) in world * coordinates. */ @@ -630,7 +630,7 @@ struct fontsymbol { * * Any pixel rendering operations must use GLWORLDCOORD_*(). * - * Any line rendering operations that use OpenGL defined primitives + * Any line rendering operations that use OpenGL defined primitives * (GL_POLYGON, GL_LINES, etc) must use GLWORLDCOORD_RENDER*(). * OpenGL renders lines with the diamond rule. GLWORLDCOORD_RENDER_*() offsets * the pixel value by 0.5 so that it starts in the center of a pixel. @@ -643,7 +643,7 @@ struct fontsymbol { #define GLWORLDCOORD_RENDER_Y(w, py) \ ((PIXH(w)-(py+0.5))*CLIPH(w)/(double)PIXH(w)-CLIPH(w)/2.0) -/* +/* * For translating radius in pixels to that of the world coordinate system. * * The transformation must keep the correct arc-to-window-dimension @@ -653,13 +653,13 @@ struct fontsymbol { #define GLRADIUS_Y(w, pr) ((pr)/PIXH(w)*CLIPH(w)) /* - * Sets a color {struct color}. + * Sets a color {struct color}. * * Whenever a color is set, set the X11 color handle to -1 (default). * * Should the colorname include alpha? */ -#ifdef XWindows +#ifdef XWindows #define SetColor(clr, red, green, blue, alpha, index) do {\ sprintf((clr).name,"%ld,%ld,%ld",(long)red,(long)green,(long)blue);\ (clr).r = red;\ @@ -677,7 +677,7 @@ struct fontsymbol { (clr).c = -1;\ /*(clr).pixel = -1;*/\ } while(0) -#else /* XWindows */ +#else /* XWindows */ #define SetColor(clr, red, green, blue, alpha, index) do {\ sprintf((clr).name,"%ld,%ld,%ld",(long)red,(long)green,(long)blue);\ (clr).r = red;\ @@ -686,12 +686,12 @@ struct fontsymbol { (clr).a = alpha;\ (clr).id = index;\ } while(0) -#endif /* XWindows */ +#endif /* XWindows */ /* * Gets a color from type {struct color}. Works whether {color} * is mutable or not. If it is mutable and it cannot be found, - * set the color to black (talk to Dr. J about this). + * set the color to black (talk to Dr. J about this). * * The returned color values are unsigned short (US). */ @@ -793,13 +793,13 @@ struct fontsymbol { #define UCToGLF(uchar) (GLfloat) ((uchar)/255.0) /* - * For gamma encode/decode color operations. - * + * For gamma encode/decode color operations. + * * Unicon color values are in linear color units. All computer screens * convert from linear units to sRGB units by using the value gamma. Thus, * The Unicon color values (linear) are converted to sRGB space and given * to OpenGL (which has no notion of gamma correction, unless using ver. 4+). - * + * * Encoding transforms from linear-to-sRGB space. * Decoding transforms from sRGB-to-linear space. * Assume that gamma has no effect on transparency (alpha). @@ -835,7 +835,7 @@ struct fontsymbol { /* * Decodes gamma correction in the form of (unsigned short). Converts - * to a float to perform correction and converts back to (unsigned + * to a float to perform correction and converts back to (unsigned * short). */ #define DecodeGammaUS(ushort, gamma) \ @@ -862,7 +862,7 @@ struct fontsymbol { /* * Sets the color specified by {color} to sRGB space with gamma as the - * "foreground" (current OpenGL) color. + * "foreground" (current OpenGL) color. * {color} must be an array of unsigned short of size 4. */ #define SetColorState(color, gamma) do {\ @@ -877,7 +877,7 @@ struct fontsymbol { #define BG 0 /* - * Gets a context color (fg or bg) depending on the reverse attribute + * Gets a context color (fg or bg) depending on the reverse attribute */ #define GetContextColorUS(w, is_fg, r, g, b, a) do {\ wcp wcr = &((w)->window->wcrender);\ @@ -914,8 +914,8 @@ struct fontsymbol { /* * This macro sets the OpenGL color state based on {w}'s render context's * reverse and gamma attributes. {Drawop} is specified. {is_fg} specifies - * whether the render context's fg or bg color is the desired drawing - * color. + * whether the render context's fg or bg color is the desired drawing + * color. */ #define SetDrawopColorState(w, drawop, is_fg) do {\ wsp ws = (w)->window;\ @@ -944,8 +944,8 @@ struct fontsymbol { SetColorState(color, wcr->gamma);\ } while(0) -/* - * Clear screen to either the fg or bg color. +/* + * Clear screen to either the fg or bg color. * Accounts for gamma and reverse. */ #define ClearScreenToColor(w, is_fg) do {\ @@ -960,10 +960,10 @@ struct fontsymbol { } while(0) /* - * Rendering macros + * Rendering macros */ -/* +/* * The RenderRealarray*() family of macros are for rendering geometric * primitives */ @@ -1034,8 +1034,8 @@ struct fontsymbol { /* * For the following *Render*Rect() macros: - * (x1, y1) specifies the top left corner and (x2, y2) specifies the bottom - * right corner. The rectangles are rendered to be front facing + * (x1, y1) specifies the top left corner and (x2, y2) specifies the bottom + * right corner. The rectangles are rendered to be front facing * (counterclockwise). * These macros are used for rendering image primitives */ @@ -1154,26 +1154,26 @@ struct fontsymbol { /* * Structures - */ + */ /* * For OpenGL, colors need not be allocated. Colors are defined with - * RGBA values only. Use clamped doubles (0.0 - 1.0) for RGBA since + * RGBA values only. Use clamped doubles (0.0 - 1.0) for RGBA since * they are more representative to how colors are interpreted by machines. * - * Negative (id) values indicate a mutable color, otherwise not mutable. - */ + * Negative (id) values indicate a mutable color, otherwise not mutable. + */ /* * Get font size values in terms of pixels (px). Returns integer value. - * These macros should only be used on a face whose size has been + * These macros should only be used on a face whose size has been * initialized. * * ascender and descender are in 26.6 fixed point units... or not. * may be in ems * * As a design note, why don't we just unify these font macros - * by using the ascent, descent, maxwidth, and height fields in + * by using the ascent, descent, maxwidth, and height fields in * struct _wfont? */ #if HAVE_LIBFREETYPE @@ -1188,13 +1188,13 @@ struct fontsymbol { #define FT_FWIDTH(face) (int)((face)->size->metrics.max_advance >> 6) #define FT_FHEIGHT(face) \ (int)(((face)->size->metrics.ascender-(face)->size->metrics.descender) >> 6) -#else /* HAVE_LIBFREETYPE */ +#else /* HAVE_LIBFREETYPE */ /* placeholders for MSWin and OSX until implemented */ #define FT_ASCENT(face) 1 #define FT_DESCENT(face) 1 #define FT_FWIDTH(face) 1 #define FT_FHEIGHT(face) 1 -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ /* * Macors check for {wc->font->face} for legacy 3D subwindow support. @@ -1210,20 +1210,20 @@ struct fontsymbol { #define GL_FHEIGHT(w) \ ((w)->context->font->face ? FT_FHEIGHT((w)->context->font->face) : 0) -#else /* HAVE_LIBFREETYPE */ +#else /* HAVE_LIBFREETYPE */ #define GL_ASCENT(w) ((w)->context->font->ascent) #define GL_DESCENT(w) ((w)->context->font->descent) /* Once this implementation gets ported to Windows, unify maxwidth/charwidth */ #ifdef XWindows #define GL_FWIDTH(w) ((w)->context->font->maxwidth) -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows #define GL_FWIDTH(w) ((w)->context->font->charwidth) -#endif /* MSWindows */ +#endif /* MSWindows */ #define GL_FHEIGHT(w) ((w)->context->font->height) -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ #define GL_LEADING(w) ((w)->context->leading) @@ -1240,7 +1240,7 @@ struct fontsymbol { ((w)->context->font->face ? (!GL_FWIDTH(w) ? (x) : ((x) / GL_FWIDTH(w))) : 0) #define GL_MAXDESCENDER(w) ((w)->context->font->face ? GL_DESCENT(w) : 0) -#else /* HAVE_LIBFREETYPE */ +#else /* HAVE_LIBFREETYPE */ #define GL_ROWTOY(w,row) \ ((w)->context->font ? ((row-1) * GL_LEADING(w) + GL_ASCENT(w)) : 0) @@ -1253,9 +1253,9 @@ struct fontsymbol { ((w)->context->font ? (!GL_FWIDTH(w) ? (x) : ((x) / GL_FWIDTH(w))) : 0) #define GL_MAXDESCENDER(w) ((w)->context->font ? GL_DESCENT(w) : 0) -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ -/* +/* * compute text pixel width */ #define GL_TEXTWIDTH(w, s, len) drawstringhelper(w, 0, 0, 0, s, len, 0, 0) diff --git a/src/h/parserr.h b/src/h/parserr.h index 9ce76dc40..9917b496e 100644 --- a/src/h/parserr.h +++ b/src/h/parserr.h @@ -9,8 +9,8 @@ #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wunused-variable" static struct errmsg { - int e_state; /* parser state number */ - char *e_mesg; /* message text */ + int e_state; /* parser state number */ + char *e_mesg; /* message text */ } errtab[] = { 0, "invalid declaration", diff --git a/src/h/posix.h b/src/h/posix.h index 46cb08494..dc0022a30 100644 --- a/src/h/posix.h +++ b/src/h/posix.h @@ -28,7 +28,7 @@ #include #include #include -#endif /* UNIX */ +#endif /* UNIX */ #ifdef NT @@ -47,15 +47,15 @@ #define NAME_MAX FILENAME_MAX #ifdef PATH_MAX #undef PATH_MAX -#endif /* PATH_MAX */ +#endif /* PATH_MAX */ #define PATH_MAX FILENAME_MAX -#define MAXHOSTNAMELEN 256 -#else /* NT */ +#define MAXHOSTNAMELEN 256 +#else /* NT */ #ifndef NAME_MAX #define NAME_MAX _POSIX_NAME_MAX -#endif /* not defined NAME_MAX */ +#endif /* not defined NAME_MAX */ #define SOCKET int -#endif /* NT */ +#endif /* NT */ #if defined(SUN) || defined(HP) || defined(IRIS4D) #include @@ -66,14 +66,14 @@ extern char *sys_errlist[]; #ifndef UX10 #ifndef NAME_MAX #define NAME_MAX 1024 -#endif /* NAME_MAX */ +#endif /* NAME_MAX */ #endif #ifdef SYSV #define bcopy(a, b, n) memcopy(b, a, n) #endif -#endif /* SUN || HP */ +#endif /* SUN || HP */ #ifdef HP #define FASYNC O_SYNC @@ -94,11 +94,11 @@ extern stringint signalnames[]; #ifdef IRIS4D #include #include -#endif /* IRIS4D */ +#endif /* IRIS4D */ #ifdef NT extern WORD wVersionRequested; extern WSADATA wsaData; extern int werr; extern int WINSOCK_INITIAL; -#endif /* NT */ +#endif /* NT */ diff --git a/src/h/proto.h b/src/h/proto.h index 3c712e742..11dddf6d5 100644 --- a/src/h/proto.h +++ b/src/h/proto.h @@ -9,13 +9,13 @@ #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS #if MICROSOFT || TURBO || NT #include - #endif /* MICROSOFT || TURBO ... */ -#endif /* MSDOS */ + #endif /* MICROSOFT || TURBO ... */ +#endif /* MSDOS */ /* * End of operating-system specific code. @@ -32,4 +32,4 @@ #define sbrk lsbrk #define strlen lstrlen #define qsort lqsort -#endif /* IntBits == 16 */ +#endif /* IntBits == 16 */ diff --git a/src/h/rexterns.h b/src/h/rexterns.h index d9d29029e..14c64d29f 100644 --- a/src/h/rexterns.h +++ b/src/h/rexterns.h @@ -9,22 +9,22 @@ extern TRuntime_Status rt_status; extern struct b_proc *op_tbl; /* operators available for string invocation */ extern int op_tbl_sz; /* number of operators in op_tbl */ -extern int debug_info; /* flag: debugging information is available */ -extern int err_conv; /* flag: error conversion is supported */ -extern int dodump; /* termination dump */ -extern int line_info; /* flag: line information is available */ -extern char *file_name; /* source file for current execution point */ +extern int debug_info; /* flag: debugging information is available */ +extern int err_conv; /* flag: error conversion is supported */ +extern int dodump; /* termination dump */ +extern int line_info; /* flag: line information is available */ +extern char *file_name; /* source file for current execution point */ #ifndef MultiProgram -extern int line_num; /* line number for current execution point */ -#endif /* MultiProgram */ +extern int line_num; /* line number for current execution point */ +#endif /* MultiProgram */ extern unsigned char allchars[];/* array for making one-character strings */ -extern char *blkname[]; /* print names for block types. */ -extern char *currend; /* current end of memory region */ -extern dptr *quallist; /* start of qualifier list */ -extern int bsizes[]; /* sizes of blocks */ -extern int firstd[]; /* offset (words) of first descrip. */ -extern uword segsize[]; /* size of hash bucket segment */ +extern char *blkname[]; /* print names for block types. */ +extern char *currend; /* current end of memory region */ +extern dptr *quallist; /* start of qualifier list */ +extern int bsizes[]; /* sizes of blocks */ +extern int firstd[]; /* offset (words) of first descrip. */ +extern uword segsize[]; /* size of hash bucket segment */ extern struct b_coexpr *stklist;/* base of co-expression stack list */ extern struct b_cset blankcs; /* ' ' */ @@ -36,44 +36,44 @@ extern struct b_cset k_ucase; /* &ucase */ extern struct b_cset k_letters; /* &letters */ extern struct b_cset k_ascii; /* &ascii */ extern struct b_cset k_cset; /* &cset */ -extern struct descrip blank; /* blank */ -extern struct descrip emptystr; /* empty string */ +extern struct descrip blank; /* blank */ +extern struct descrip emptystr; /* empty string */ extern struct descrip kywd_dmp; /* descriptor for &dump */ -extern struct descrip nullptr; /* descriptor with null block pointer */ -extern struct descrip lcase; /* lowercase string */ -extern struct descrip letr; /* letter "r" */ +extern struct descrip nullptr; /* descriptor with null block pointer */ +extern struct descrip lcase; /* lowercase string */ +extern struct descrip letr; /* letter "r" */ #ifndef Concurrent -extern struct descrip maps2; /* second argument to map() */ -extern struct descrip maps3; /* third argument to map() */ +extern struct descrip maps2; /* second argument to map() */ +extern struct descrip maps3; /* third argument to map() */ #endif /* Concurrent */ -extern struct descrip nulldesc; /* null value */ -extern struct descrip onedesc; /* one */ -extern struct descrip ucase; /* uppercase string */ -extern struct descrip zerodesc; /* zero */ +extern struct descrip nulldesc; /* null value */ +extern struct descrip onedesc; /* one */ +extern struct descrip ucase; /* uppercase string */ +extern struct descrip zerodesc; /* zero */ -extern word mstksize; /* size of main stack in words */ -extern word stksize; /* size of co-expression stacks in words */ -extern word qualsize; /* size of string qualifier list */ -extern word memcushion; /* memory region cushion factor */ -extern word memgrowth; /* memory region growth factor */ +extern word mstksize; /* size of main stack in words */ +extern word stksize; /* size of co-expression stacks in words */ +extern word qualsize; /* size of string qualifier list */ +extern word memcushion; /* memory region cushion factor */ +extern word memgrowth; /* memory region growth factor */ #ifdef DescripAmpAllocated extern struct descrip stattotal;/* cumulative total of all static allocations */ extern int blktotalIncrFlag; -#else /* DescripAmpAllocated */ -extern uword stattotal; /* cumulative total of all static allocations */ -#endif /* DescripAmpAllocated */ - /* N.B. not currently set */ +#else /* DescripAmpAllocated */ +extern uword stattotal; /* cumulative total of all static allocations */ +#endif /* DescripAmpAllocated */ + /* N.B. not currently set */ #ifdef HAVE_LIBPTHREAD extern pthread_rwlock_t __environ_lock; -#endif /*HAVE_LIBPTHREAD && !SUN */ - +#endif /*HAVE_LIBPTHREAD && !SUN */ + #ifndef Concurrent extern struct tend_desc *tend; /* chain of tended descriptors */ -#endif /* Concurrent */ +#endif /* Concurrent */ extern int num_cpu_cores; @@ -90,10 +90,10 @@ extern int NARthreads; extern pthread_cond_t **condvars; extern word* condvarsmtxs; -extern word ncondvars; -extern word maxcondvars; +extern word ncondvars; +extern word maxcondvars; -extern int is_concurrent; +extern int is_concurrent; extern struct threadstate *global_curtstate; #ifndef HAVE_KEYWORD__THREAD @@ -115,7 +115,7 @@ extern word intern_list_ser; extern int improbable; #endif /* ConcurrentCOMPILER */ -#endif /* Concurrent */ +#endif /* Concurrent */ /* * Externals that are conditional on features. @@ -127,28 +127,28 @@ extern int improbable; #endif #ifdef FncTrace - extern struct descrip kywd_ftrc; /* descriptor for &ftrace */ -#endif /* FncTrace */ + extern struct descrip kywd_ftrc; /* descriptor for &ftrace */ +#endif /* FncTrace */ #if defined(Polling) && !defined(Concurrent) extern int pollctr; -#endif /* Polling && !Concurrent */ +#endif /* Polling && !Concurrent */ extern char typech[]; extern word oldsum; -extern struct descrip csetdesc; /* cset descriptor */ -extern struct descrip eventdesc; /* event descriptor */ +extern struct descrip csetdesc; /* cset descriptor */ +extern struct descrip eventdesc; /* event descriptor */ extern struct b_iproc mt_llist; -extern struct descrip rzerodesc; /* real descriptor */ -extern struct b_real realzero; /* real zero block */ +extern struct descrip rzerodesc; /* real descriptor */ +extern struct b_real realzero; /* real zero block */ #ifdef DosFncs extern char *zptr; -#endif /* DosFncs */ +#endif /* DosFncs */ #if EBCDIC == 2 extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */ -#endif /* EBCDIC == 2 */ +#endif /* EBCDIC == 2 */ extern struct region rootstring; extern struct region rootblock; @@ -160,79 +160,79 @@ extern struct b_real realzero; /* real zero block */ extern struct region *curstring; extern struct region *curblock; #if !ConcurrentCOMPILER - extern dptr glbl_argp; /* argument pointer */ - extern struct descrip value_tmp; /* list argument to Op_Apply */ - extern struct descrip k_current; /* ¤t */ - extern struct descrip k_errortext; /* &errortext */ - extern int have_errval; /* &errorvalue has a legal value */ - extern int k_errornumber; /* value of &errornumber */ - extern int t_errornumber; /* tentative k_errornumber value */ - extern int t_have_val; /* tentative have_errval flag */ - extern struct descrip k_errorvalue; /* value of &errorvalue */ - extern int k_level; /* &level */ - extern struct descrip k_subject; /* &subject */ - extern struct descrip kywd_pos; /* descriptor for &pos */ + extern dptr glbl_argp; /* argument pointer */ + extern struct descrip value_tmp; /* list argument to Op_Apply */ + extern struct descrip k_current; /* ¤t */ + extern struct descrip k_errortext; /* &errortext */ + extern int have_errval; /* &errorvalue has a legal value */ + extern int k_errornumber; /* value of &errornumber */ + extern int t_errornumber; /* tentative k_errornumber value */ + extern int t_have_val; /* tentative have_errval flag */ + extern struct descrip k_errorvalue; /* value of &errorvalue */ + extern int k_level; /* &level */ + extern struct descrip k_subject; /* &subject */ + extern struct descrip kywd_pos; /* descriptor for &pos */ #ifdef PatternType extern int k_patindex; /* index for pattern element */ -#endif /* Pattern Type */ - extern struct descrip kywd_ran; /* descriptor for &random */ - extern struct descrip t_errorvalue; /* tentative k_errorvalue value */ +#endif /* Pattern Type */ + extern struct descrip kywd_ran; /* descriptor for &random */ + extern struct descrip t_errorvalue; /* tentative k_errorvalue value */ #ifdef DescripAmpAllocated - extern struct descrip blktotal; /* cumul total of all block allocs */ - extern struct descrip strtotal; /* cumul total of all string allocs */ -#else /* DescripAmpAllocated */ - extern uword blktotal; /* cumul total of all block allocs */ - extern uword strtotal; /* cumul total of all string allocs */ -#endif /* DescripAmpAllocated */ -#endif /* ConcurrentCOMPILER */ - extern struct b_file k_errout; /* value of &errout */ - extern struct b_file k_input; /* value of &input */ - extern struct b_file k_output; /* value of &output */ - extern struct descrip kywd_err; /* &error */ - extern struct descrip kywd_prog; /* descriptor for &prog */ - extern struct descrip kywd_trc; /* descriptor for &trace */ - extern struct descrip k_eventcode; /* &eventcode */ - extern struct descrip k_eventsource; /* &eventsource */ - extern struct descrip k_eventvalue; /* &eventvalue */ - extern struct descrip k_main; /* value of &main */ - - extern word coll_tot; /* total number of collections */ - extern word coll_stat; /* collections from static reqests */ - extern word coll_str; /* collections from string requests */ - extern word coll_blk; /* collections from block requests */ - extern dptr globals; /* start of global variables */ - extern dptr eglobals; /* end of global variables */ - extern dptr gnames; /* start of global variable names */ - extern dptr egnames; /* end of global variable names */ - extern dptr estatics; /* end of static variables */ - - extern int n_globals; /* number of global variables */ - extern int n_statics; /* number of static variables */ - extern struct b_coexpr *mainhead; /* &main */ + extern struct descrip blktotal; /* cumul total of all block allocs */ + extern struct descrip strtotal; /* cumul total of all string allocs */ +#else /* DescripAmpAllocated */ + extern uword blktotal; /* cumul total of all block allocs */ + extern uword strtotal; /* cumul total of all string allocs */ +#endif /* DescripAmpAllocated */ +#endif /* ConcurrentCOMPILER */ + extern struct b_file k_errout; /* value of &errout */ + extern struct b_file k_input; /* value of &input */ + extern struct b_file k_output; /* value of &output */ + extern struct descrip kywd_err; /* &error */ + extern struct descrip kywd_prog; /* descriptor for &prog */ + extern struct descrip kywd_trc; /* descriptor for &trace */ + extern struct descrip k_eventcode; /* &eventcode */ + extern struct descrip k_eventsource; /* &eventsource */ + extern struct descrip k_eventvalue; /* &eventvalue */ + extern struct descrip k_main; /* value of &main */ + + extern word coll_tot; /* total number of collections */ + extern word coll_stat; /* collections from static reqests */ + extern word coll_str; /* collections from string requests */ + extern word coll_blk; /* collections from block requests */ + extern dptr globals; /* start of global variables */ + extern dptr eglobals; /* end of global variables */ + extern dptr gnames; /* start of global variable names */ + extern dptr egnames; /* end of global variable names */ + extern dptr estatics; /* end of static variables */ + + extern int n_globals; /* number of global variables */ + extern int n_statics; /* number of static variables */ + extern struct b_coexpr *mainhead; /* &main */ extern int longest_dr; extern struct b_proc_list **dr_arrays; #ifdef PosixFns extern struct descrip amperErrno; -#endif /* PosixFns */ -#endif /* MultiProgram */ +#endif /* PosixFns */ +#endif /* MultiProgram */ #ifdef Concurrent #ifdef HAVE_KEYWORD__THREAD /* * HAVE_KEYWORD__THREAD should be detected by autoconf (and isn't yet). */ - extern __thread struct threadstate roottstate; + extern __thread struct threadstate roottstate; extern __thread struct threadstate *curtstate; - #else /* HAVE_KEYWORD__THREAD */ + #else /* HAVE_KEYWORD__THREAD */ + extern struct threadstate roottstate; + #endif /* HAVE_KEYWORD__THREAD */ +#else /* Concurrent */ extern struct threadstate roottstate; - #endif /* HAVE_KEYWORD__THREAD */ -#else /* Concurrent */ - extern struct threadstate roottstate; extern struct threadstate *curtstate; -#endif /* Concurrent */ +#endif /* Concurrent */ /* * Externals that differ between compiler and interpreter. @@ -242,84 +242,84 @@ extern struct descrip amperErrno; * External declarations for the interpreter. */ #ifndef Concurrent - extern struct pf_marker *pfp; /* Procedure frame pointer */ - extern struct ef_marker *efp; /* Expression frame pointer */ - extern struct gf_marker *gfp; /* Generator frame pointer */ - extern inst ipc; /* Interpreter program counter */ + extern struct pf_marker *pfp; /* Procedure frame pointer */ + extern struct ef_marker *efp; /* Expression frame pointer */ + extern struct gf_marker *gfp; /* Generator frame pointer */ + extern inst ipc; /* Interpreter program counter */ extern inst oldipc; /* the previous ipc, fix returned line zero */ - extern word *sp; /* Stack pointer */ - extern int ilevel; - extern word *stack; /* interpreter stack base */ - extern word *stackend; /* end of evaluation stack */ -#endif /* !Concurrent */ -#endif /* !COMPILER */ + extern word *sp; /* Stack pointer */ + extern int ilevel; + extern word *stack; /* interpreter stack base */ + extern word *stackend; /* end of evaluation stack */ +#endif /* !Concurrent */ +#endif /* !COMPILER */ #if !COMPILER || ConcurrentCOMPILER extern struct pstrnm pntab[]; extern int pnsize; - + /*probably Thread Safe*/ #ifdef ExecImages - extern int dumped; /* the interpreter has been dumped */ - #endif /* ExecImages */ -#endif /* !COMPILER || ConcurrentCOMPILER */ + extern int dumped; /* the interpreter has been dumped */ + #endif /* ExecImages */ +#endif /* !COMPILER || ConcurrentCOMPILER */ #if defined(MultiProgram) extern struct progstate *curpstate; extern struct progstate rootpstate; - #endif /* MultiProgram */ + #endif /* MultiProgram */ #if !COMPILER #ifdef MultiProgram - extern int noMTevents; /* no MT events during GC */ + extern int noMTevents; /* no MT events during GC */ #ifdef Concurrent extern pthread_mutex_t mutex_noMTevents; - #endif /* Concurrent */ - - #else /* MultiProgram */ - extern char *code; /* start of icode */ - extern char *ecode; /* end of icode */ - extern char *endcode; /* end of icode? */ - extern struct ipc_line *ilines; /* start of line # table */ - extern struct ipc_line *elines; /* end of line # table */ - extern struct ipc_fname *filenms; /* start of file name table */ + #endif /* Concurrent */ + + #else /* MultiProgram */ + extern char *code; /* start of icode */ + extern char *ecode; /* end of icode */ + extern char *endcode; /* end of icode? */ + extern struct ipc_line *ilines; /* start of line # table */ + extern struct ipc_line *elines; /* end of line # table */ + extern struct ipc_fname *filenms; /* start of file name table */ extern struct ipc_fname *efilenms;/* end of file name table */ - extern dptr statics; /* start of static variables */ - extern char *strcons; /* start of the string constants */ - extern dptr fnames; /* field names */ - extern dptr efnames; /* end of field names */ + extern dptr statics; /* start of static variables */ + extern char *strcons; /* start of the string constants */ + extern dptr fnames; /* field names */ + extern dptr efnames; /* end of field names */ extern word *records; - extern int *ftabp; /* field table pointer */ + extern int *ftabp; /* field table pointer */ #ifdef FieldTableCompression extern word ftabwidth, foffwidth; extern unsigned char *ftabcp; extern short *ftabsp; - #endif /* FieldTableCompression */ + #endif /* FieldTableCompression */ extern dptr xargp; extern word xnargs; extern dptr field_argp; - + extern word lastop; - #endif /* MultiProgram */ + #endif /* MultiProgram */ extern struct b_proc *stubrec; - -#else /* !COMPILER */ + +#else /* !COMPILER */ #if ConcurrentCOMPILER extern pthread_mutex_t mutex_noMTevents; #endif /* ConcurrentCOMPILER */ - extern struct descrip statics[]; /* array of static variables */ - extern struct b_proc *builtins[]; /* pointers to builtin functions */ - extern int noerrbuf; /* error buffering */ + extern struct descrip statics[]; /* array of static variables */ + extern struct b_proc *builtins[]; /* pointers to builtin functions */ + extern int noerrbuf; /* error buffering */ #if !ConcurrentCOMPILER - extern struct p_frame *pfp; /* procedure frame pointer */ -#endif /* ConcurrentCOMPILER */ - extern struct descrip trashcan; /* dummy descriptor, never read */ - extern int largeints; /* flag: large integers supported */ + extern struct p_frame *pfp; /* procedure frame pointer */ +#endif /* ConcurrentCOMPILER */ + extern struct descrip trashcan; /* dummy descriptor, never read */ + extern int largeints; /* flag: large integers supported */ -#endif /* COMPILER */ +#endif /* COMPILER */ extern stringint attribs[], drawops[]; @@ -327,14 +327,14 @@ extern stringint attribs[], drawops[]; * graphics */ #ifdef Graphics - + extern wbp wbndngs; extern wcp wcntxts; extern wsp wstates; extern int GraphicsLeft, GraphicsUp, GraphicsRight, GraphicsDown; extern int GraphicsHome, GraphicsPrior, GraphicsNext, GraphicsEnd; extern int win_highwater, canvas_serial, context_serial; - extern clock_t starttime; /* start time in milliseconds */ + extern clock_t starttime; /* start time in milliseconds */ #ifndef MultiProgram extern struct descrip kywd_xwin[]; @@ -346,24 +346,24 @@ extern stringint attribs[], drawops[]; extern struct descrip amperY; extern struct descrip amperInterval; extern uword xmod_control, xmod_shift, xmod_meta; - #endif /* MultiProgram */ + #endif /* MultiProgram */ #ifdef XWindows extern struct _wdisplay * wdsplys; extern stringint cursorsyms[]; - #endif /* XWindows */ + #endif /* XWindows */ #ifdef MSWindows extern HINSTANCE mswinInstance; extern int ncmdShow; - #endif /* MSWindows */ + #endif /* MSWindows */ extern unsigned long ConsoleFlags; #ifdef ConsoleWindow extern FILE *ConsoleBinding; extern char ConsoleStringBuf[]; extern char *ConsoleStringBufPtr; - #endif /* ConsoleWindow */ + #endif /* ConsoleWindow */ #ifdef Graphics3D extern struct descrip gl_torus; @@ -382,24 +382,24 @@ extern stringint attribs[], drawops[]; extern stringint redraw3Dnames[]; #ifndef MultiProgram extern struct descrip amperPick; - #endif /* MultiProgram */ + #endif /* MultiProgram */ extern wfont gfont; extern wfont *start_font, *end_font, *curr_font; -#endif /* Graphics3D */ +#endif /* Graphics3D */ -#endif /* Graphics */ +#endif /* Graphics */ #ifdef PosixFns extern struct descrip posix_lock, posix_timeval, posix_stat, posix_message, posix_passwd, posix_group, posix_servent, posix_hostent, posix_rusage; extern dptr timeval_constr; -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Messaging extern int M_open_timeout; -#endif /* Messaging */ +#endif /* Messaging */ /* patchable globals */ extern char patchpath[]; @@ -410,15 +410,15 @@ extern FILE *flog; #ifdef PatternType extern struct b_pelem EOP; -#endif /* PatternType */ +#endif /* PatternType */ #if NT extern struct b_cons *LstTmpFiles; -#endif /* NT */ +#endif /* NT */ #ifdef Audio extern int isPlaying; -#endif /* Audio */ +#endif /* Audio */ #ifdef VerifyHeap extern long vrfy; diff --git a/src/h/rmacros.h b/src/h/rmacros.h index d869e06c9..47f19fcc6 100644 --- a/src/h/rmacros.h +++ b/src/h/rmacros.h @@ -12,35 +12,35 @@ */ #define BitOffMask (IntBits-1) -#define CsetSize (256/IntBits) /* number of ints to hold 256 cset - * bits. Use (256/IntBits)+1 if - * 256 % IntBits != 0 */ -#define MinListSlots 8 /* number of elements in an expansion - * list element block */ - -#define MaxCvtLen 257 /* largest string in conversions; the extra - * one is for a terminating null */ -#define MaxReadStr 512 /* largest string to read() in one piece */ +#define CsetSize (256/IntBits) /* number of ints to hold 256 cset + * bits. Use (256/IntBits)+1 if + * 256 % IntBits != 0 */ +#define MinListSlots 8 /* number of elements in an expansion + * list element block */ + +#define MaxCvtLen 257 /* largest string in conversions; the extra + * one is for a terminating null */ +#define MaxReadStr 512 /* largest string to read() in one piece */ #if IntBits==16 -#define MaxIn 32767 /* largest number of bytes to read() at once */ +#define MaxIn 32767 /* largest number of bytes to read() at once */ #else -#define MaxIn ((10*1024*1024)-1) /* max # of bytes to reads() at once */ +#define MaxIn ((10*1024*1024)-1) /* max # of bytes to reads() at once */ #endif -#define RandA 1103515245 /* random seed multiplier */ -#define RandC 453816694 /* random seed additive constant */ -#define RanScale 4.65661286e-10 /* random scale factor = 1/(2^31-1) */ +#define RandA 1103515245 /* random seed multiplier */ +#define RandC 453816694 /* random seed additive constant */ +#define RanScale 4.65661286e-10 /* random scale factor = 1/(2^31-1) */ #define Pi 3.14159265358979323846264338327950288419716939937511 /* * File status flags in status field of file blocks. */ -#define Fs_Read 01 /* read access */ -#define Fs_Write 02 /* write access */ -#define Fs_Create 04 /* file created on open */ -#define Fs_Append 010 /* append mode */ -#define Fs_Pipe 020 /* reading or writing on a pipe */ - /* see also: BPipe down below */ +#define Fs_Read 01 /* read access */ +#define Fs_Write 02 /* write access */ +#define Fs_Create 04 /* file created on open */ +#define Fs_Append 010 /* append mode */ +#define Fs_Pipe 020 /* reading or writing on a pipe */ + /* see also: BPipe down below */ /* 040 this bit is now available */ @@ -48,77 +48,77 @@ #define Fs_Writing 0200 /* last file operation was write */ /*#ifdef Graphics*/ - #define Fs_Window 0400 /* reading/writing on a window */ -/*#endif */ /* Graphics */ - -#define Fs_Untrans 01000 /* untranslated mode file */ -#define Fs_Directory 02000 /* reading a directory */ + #define Fs_Window 0400 /* reading/writing on a window */ +/*#endif */ /* Graphics */ + +#define Fs_Untrans 01000 /* untranslated mode file */ +#define Fs_Directory 02000 /* reading a directory */ #ifdef Dbm - #define Fs_Dbm 04000 /* a dbm file */ -#endif /* Dbm */ + #define Fs_Dbm 04000 /* a dbm file */ +#endif /* Dbm */ #ifdef PosixFns #define Fs_Socket 010000 #define Fs_Buff 020000 #define Fs_Unbuf 040000 #define Fs_Listen 0100000 - #define Fs_BPipe 0200000 /* bidirectional pipe */ + #define Fs_BPipe 0200000 /* bidirectional pipe */ #if HAVE_LIBSSL #define Fs_Encrypt 0200000000 /* encrypted sockets */ #endif -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef ISQL #define Fs_ODBC 0400000 #define RC_SUCCESSFUL(rc) (rc==SQL_SUCCESS || rc==SQL_SUCCESS_WITH_INFO) #define RC_NOTSUCCESSFUL(rc) (!(RC_SUCCESSFUL(rc))) -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Messaging #define Fs_Messaging 01000000 - #define Fs_Verify 02000000 + #define Fs_Verify 02000000 #endif /* Messaging */ /*#ifdef Graphics3D*/ - #define Fs_Window3D 04000000 /* reading/writing on a window */ -/*#endif*/ /* Graphics3D */ + #define Fs_Window3D 04000000 /* reading/writing on a window */ +/*#endif*/ /* Graphics3D */ #if HAVE_LIBZ - #define Fs_Compress 010000000 /* reading/writing compressed file */ -#endif /* HAVE_LIBZ */ + #define Fs_Compress 010000000 /* reading/writing compressed file */ +#endif /* HAVE_LIBZ */ #ifdef HAVE_VOICE - #define Fs_Voice 020000000 /* voice/audio connection */ -#endif /* HAVE_VOICE */ + #define Fs_Voice 020000000 /* voice/audio connection */ +#endif /* HAVE_VOICE */ #ifdef PseudoPty - #define Fs_Pty 040000000 /* pty */ + #define Fs_Pty 040000000 /* pty */ #endif -#ifdef GraphicsGL - #define Fs_WinGL2D 0100000000 /* for OpenGL 2D window */ -#endif /* GraphicsGL */ +#ifdef GraphicsGL + #define Fs_WinGL2D 0100000000 /* for OpenGL 2D window */ +#endif /* GraphicsGL */ /* * Thread status flags in status field of coexpr blocks. * Ts_Native can only be Ts_Sync. Ts_Posix may be Sync or Async. */ -#define Ts_Main 01 /* This is the main co-expression */ -#define Ts_Thread 02 /* This is a thread */ -#define Ts_Attached 04 /* OS-level thread attached to this ce */ +#define Ts_Main 01 /* This is the main co-expression */ +#define Ts_Thread 02 /* This is a thread */ +#define Ts_Attached 04 /* OS-level thread attached to this ce */ -#define Ts_Async 010 /* asynchronous (concurrent) thread */ +#define Ts_Async 010 /* asynchronous (concurrent) thread */ #define Ts_Actived 020 /* activated at least once */ #define Ts_Active 040 /* someone activated me */ #define Ts_WTinbox 0100 /* waiting on inbox Q */ #define Ts_WToutbox 0200 /* waiting on outbox Q */ -#define Ts_Posix 0400 /* POSIX (pthread-based) coexpression */ +#define Ts_Posix 0400 /* POSIX (pthread-based) coexpression */ -#define Ts_SoftThread 01000 /* soft thread */ +#define Ts_SoftThread 01000 /* soft thread */ #define SET_FLAG(X,F) (X) |= (F) #define UNSET_FLAG(X,F) (X) &= ~(F) @@ -136,19 +136,19 @@ /*#ifdef Graphics*/ #define XKey_Window 0 #define XKey_Fg 1 - + #ifndef SHORT #define SHORT int - #endif /* SHORT */ + #endif /* SHORT */ #ifndef LONG #define LONG int - #endif /* LONG */ - + #endif /* LONG */ + /* * Perform a "C" return, not processed by RTT */ #define VanquishReturn(s) return s; -/*#endif*/ /* Graphics */ +/*#endif*/ /* Graphics */ /* * Codes returned by runtime support routines. @@ -160,39 +160,39 @@ * Error has been renamed RunError. */ -#define Less -1 -#define Equal 0 -#define Greater 1 +#define Less -1 +#define Equal 0 +#define Greater 1 -#define CvtFail -2 -#define Cvt -3 -#define NoCvt -4 -#define Failed -5 -#define Defaulted -6 -#define Succeeded -7 -#define RunError -8 +#define CvtFail -2 +#define Cvt -3 +#define NoCvt -4 +#define Failed -5 +#define Defaulted -6 +#define Succeeded -7 +#define RunError -8 -#define GlobalName 0 -#define StaticName 1 -#define ParamName 2 -#define LocalName 3 +#define GlobalName 0 +#define StaticName 1 +#define ParamName 2 +#define LocalName 3 #undef ToAscii #undef FromAscii #if EBCDIC == 2 #define ToAscii(e) (FromEBCDIC[e]) #define FromAscii(e) (ToEBCDIC[e]) -#else /* EBCDIC == 2 */ +#else /* EBCDIC == 2 */ #define ToAscii(e) (e) #define FromAscii(e) (e) -#endif /* EBCDIC == 2 */ +#endif /* EBCDIC == 2 */ /* * Pointer to block. */ -#define BlkLoc(d) ((d).vword.bptr) +#define BlkLoc(d) ((d).vword.bptr) -#define BlkMask(d) ((struct b_mask *)((d).vword.bptr)) +#define BlkMask(d) ((struct b_mask *)((d).vword.bptr)) /* * Block reference macros. This abstraction of the act of dereferencing a @@ -208,7 +208,7 @@ #define Blk(p,u) (&((p)->u)) #define BlkPH(p,u,s) ((p)->u.s) #define BlkPE(p,u,s) ((p)->u.s) -#else /* !DebugHeap */ +#else /* !DebugHeap */ /* * Debug Heap macros. These add runtime checks to catch (most) @@ -239,47 +239,47 @@ #define BlkPH(p,u,f) BlkPA(p,u,Set,Table,f) #define BlkPE(p,u,f) BlkPA(p,u,Selem,Telem,f) -#endif /* DebugHeap */ +#endif /* DebugHeap */ /* * Check for null-valued descriptor. */ -#define ChkNull(d) ((d).dword==D_Null) +#define ChkNull(d) ((d).dword==D_Null) /* * Check for equivalent descriptors. */ -#define EqlDesc(d1,d2) ((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2)) +#define EqlDesc(d1,d2) ((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2)) /* * Integer value. */ -#define IntVal(d) ((d).vword.integr) +#define IntVal(d) ((d).vword.integr) /* * Offset from top of block to value of variable. */ -#define Offset(d) ((d).dword & OffsetMask) +#define Offset(d) ((d).dword & OffsetMask) /* * Check for pointer. */ -#define Pointer(d) ((d).dword & F_Ptr) +#define Pointer(d) ((d).dword & F_Ptr) /* * Check for qualifier. */ -#define Qual(d) (!((d).dword & F_Nqual)) +#define Qual(d) (!((d).dword & F_Nqual)) /* * Length of string. */ -#define StrLen(q) ((q).dword) +#define StrLen(q) ((q).dword) /* * Location of first character of string. */ -#define StrLoc(q) ((q).vword.sptr) +#define StrLoc(q) ((q).vword.sptr) /* * Assign a C string to a descriptor. Assume it is reasonable to use the @@ -291,20 +291,20 @@ * Type of descriptor. */ #ifdef DebugHeap -#define Type(d) (int)((((d).dword & F_Typecode) ? ((int)((d).dword & TypeMask)) : (heaperr("descriptor type error",BlkLoc(d),(d).dword), -1))) -#else /* DebugHeap */ +#define Type(d) (int)((((d).dword & F_Typecode) ? ((int)((d).dword & TypeMask)) : (heaperr("descriptor type error",BlkLoc(d),(d).dword), -1))) +#else /* DebugHeap */ #define Type(d) (int)((d).dword & TypeMask) -#endif /* DebugHeap */ +#endif /* DebugHeap */ /* * Check for variable. */ -#define Var(d) ((d).dword & F_Var) +#define Var(d) ((d).dword & F_Var) /* * Location of the value of a variable. */ -#define VarLoc(d) ((d).vword.descptr) +#define VarLoc(d) ((d).vword.descptr) /* * Important note: The code that follows is not strictly legal C. @@ -322,36 +322,36 @@ #define InRange(p1,p2,p3) ((uword)(p2) >= (uword)(p1) && (uword)(p2) < (uword)(p3)) /* - * Get floating-point number from real block. * Get floating-point number into res from real block dp. + * Get floating-point number from real block. * Get floating-point number into res from real block dp. * If Double is defined, the value may be misaligned. */ #ifdef Double #ifdef DescriptorDouble #define GetReal(dp,res) *((struct size_dbl *)&(res)) =\ *((struct size_dbl *)&((dp)->vword.realval)) -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ #ifdef DebugHeap #define GetReal(dp,res) (BlkD(*dp, Real), *((struct size_dbl *)&(res)) =\ *((struct size_dbl *)&(BlkLoc(*dp)->Real.realval))) -#else /* DebugHeap */ +#else /* DebugHeap */ #define GetReal(dp,res) *((struct size_dbl *)&(res)) =\ *((struct size_dbl *)&((BlkLoc(*dp)->Real.realval))) -#endif /* DebugHeap */ -#endif /* DescriptorDouble */ +#endif /* DebugHeap */ +#endif /* DescriptorDouble */ -#else /* Double */ +#else /* Double */ #ifdef DescriptorDouble - #define GetReal(dp,res) res = dp->vword.realval -#else /* DescriptorDouble */ - #define GetReal(dp,res) res = BlkD(*dp,Real)->realval -#endif /* DescriptorDouble */ -#endif /* Double */ + #define GetReal(dp,res) res = dp->vword.realval +#else /* DescriptorDouble */ + #define GetReal(dp,res) res = BlkD(*dp,Real)->realval +#endif /* DescriptorDouble */ +#endif /* Double */ #ifdef DescriptorDouble - #define RealVal(d) (d).vword.realval -#else /* DescriptorDouble */ - #define RealVal(d) BlkLoc(d)->Real.realval -#endif /* DescriptorDouble */ + #define RealVal(d) (d).vword.realval +#else /* DescriptorDouble */ + #define RealVal(d) BlkLoc(d)->Real.realval +#endif /* DescriptorDouble */ /* @@ -388,22 +388,22 @@ * characters. Icon's use of "line feed" is really "new line" in * C terms. */ - #define LineFeed '\n' /* if really "line feed", that's 37 */ + #define LineFeed '\n' /* if really "line feed", that's 37 */ #define CarriageReturn '\r' -#else /* EBCDIC */ +#else /* EBCDIC */ #define LineFeed 10 #define CarriageReturn 13 - #define tonum(c) (isdigit(c) ? (c - '0') : ((c & 037) + 9)) -#endif /* EBCDIC */ + #define tonum(c) (isdigit(c) ? (c - '0') : ((c & 037) + 9)) +#endif /* EBCDIC */ /* * Construct an integer descriptor. */ -#define MakeInt(i,dp) do { \ - (dp)->dword = D_Integer; \ +#define MakeInt(i,dp) do { \ + (dp)->dword = D_Integer; \ IntVal(*dp) = (word)(i); \ - } while (0) + } while (0) /* * Construct a real descriptor. dword set after vword so that we don't @@ -414,35 +414,35 @@ (dp)->vword.realval = r;\ (dp)->dword = D_Real;\ } while(0) -#else /* !DescriptorDouble */ +#else /* !DescriptorDouble */ #define MakeRealAlc(r,dp) do { \ BlkLoc(*dp) = (union block *)alcreal(r); \ (dp)->dword = D_Real; \ } while(0) -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ /* * Construct a string descriptor. */ #define MakeStr(s,len,dp) do { \ - StrLoc(*dp) = (s); \ + StrLoc(*dp) = (s); \ StrLen(*dp) = (len); \ - } while (0) + } while (0) /* * Offset in word of cset bit. */ -#define CsetOff(b) ((b) & BitOffMask) +#define CsetOff(b) ((b) & BitOffMask) /* * Set bit b in cset c. */ -#define Setb(b,c) (*CsetPtr(b,c) |= (1u << CsetOff(b))) +#define Setb(b,c) (*CsetPtr(b,c) |= (1u << CsetOff(b))) /* * Test bit b in cset c. */ -#define Testb(b,c) ((*CsetPtr(b,c) >> CsetOff(b)) & 1u) +#define Testb(b,c) ((*CsetPtr(b,c) >> CsetOff(b)) & 1u) /* * Check whether a set or table needs resizing. @@ -456,14 +456,14 @@ /* * Definitions and declarations used for storage management. */ -#define F_Mark 0100000 /* bit for marking blocks */ +#define F_Mark 0100000 /* bit for marking blocks */ /* * Argument values for the built-in Icon user function "collect()". */ -#define Static 1 /* collection is for static region */ -#define Strings 2 /* collection is for strings */ -#define Blocks 3 /* collection is for blocks */ +#define Static 1 /* collection is for static region */ +#define Strings 2 /* collection is for strings */ +#define Blocks 3 /* collection is for blocks */ /* * Get type of block pointed at by x. @@ -477,138 +477,138 @@ * block contains the size. */ #define BlkSize(x) (bsizes[*(word *)x & ~F_Mark] ? \ - bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1)) + bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1)) /* * Here are the events we support (in addition to keyboard characters) */ -#define MOUSELEFT (-1) -#define MOUSEMID (-2) -#define MOUSERIGHT (-3) -#define MOUSELEFTUP (-4) -#define MOUSEMIDUP (-5) -#define MOUSERIGHTUP (-6) -#define MOUSELEFTDRAG (-7) -#define MOUSEMIDDRAG (-8) -#define MOUSERIGHTDRAG (-9) -#define RESIZED (-10) +#define MOUSELEFT (-1) +#define MOUSEMID (-2) +#define MOUSERIGHT (-3) +#define MOUSELEFTUP (-4) +#define MOUSEMIDUP (-5) +#define MOUSERIGHTUP (-6) +#define MOUSELEFTDRAG (-7) +#define MOUSEMIDDRAG (-8) +#define MOUSERIGHTDRAG (-9) +#define RESIZED (-10) #define WINDOWCLOSED (-11) #define MOUSEMOVED (-12) -#define SCROLLUP (-13) -#define SCROLLDOWN (-14) -#define LASTEVENTCODE SCROLLDOWN +#define SCROLLUP (-13) +#define SCROLLDOWN (-14) +#define LASTEVENTCODE SCROLLDOWN /* * Type codes (descriptors and blocks). */ -#define T_String -1 /* string -- for reference; not used */ -#define T_Null 0 /* null value */ -#define T_Integer 1 /* integer */ +#define T_String -1 /* string -- for reference; not used */ +#define T_Null 0 /* null value */ +#define T_Integer 1 /* integer */ #ifdef LargeInts - #define T_Lrgint 2 /* long integer */ -#endif /* LargeInts */ - -#define T_Real 3 /* real number */ -#define T_Cset 4 /* cset */ -#define T_File 5 /* file */ -#define T_Proc 6 /* procedure */ -#define T_Record 7 /* record */ -#define T_List 8 /* list header */ -#define T_Lelem 9 /* list element */ -#define T_Set 10 /* set header */ -#define T_Selem 11 /* set element */ -#define T_Table 12 /* table header */ -#define T_Telem 13 /* table element */ -#define T_Tvtbl 14 /* table element trapped variable */ -#define T_Slots 15 /* set/table hash slots */ -#define T_Tvsubs 16 /* substring trapped variable */ -#define T_Refresh 17 /* refresh block */ -#define T_Coexpr 18 /* co-expression */ -#define T_External 19 /* external block */ -#define T_Kywdint 20 /* integer keyword */ -#define T_Kywdpos 21 /* keyword &pos */ -#define T_Kywdsubj 22 /* keyword &subject */ -#define T_Kywdwin 23 /* keyword &window */ -#define T_Kywdstr 24 /* string keyword */ -#define T_Kywdevent 25 /* keyword &eventsource, etc. */ + #define T_Lrgint 2 /* long integer */ +#endif /* LargeInts */ + +#define T_Real 3 /* real number */ +#define T_Cset 4 /* cset */ +#define T_File 5 /* file */ +#define T_Proc 6 /* procedure */ +#define T_Record 7 /* record */ +#define T_List 8 /* list header */ +#define T_Lelem 9 /* list element */ +#define T_Set 10 /* set header */ +#define T_Selem 11 /* set element */ +#define T_Table 12 /* table header */ +#define T_Telem 13 /* table element */ +#define T_Tvtbl 14 /* table element trapped variable */ +#define T_Slots 15 /* set/table hash slots */ +#define T_Tvsubs 16 /* substring trapped variable */ +#define T_Refresh 17 /* refresh block */ +#define T_Coexpr 18 /* co-expression */ +#define T_External 19 /* external block */ +#define T_Kywdint 20 /* integer keyword */ +#define T_Kywdpos 21 /* keyword &pos */ +#define T_Kywdsubj 22 /* keyword &subject */ +#define T_Kywdwin 23 /* keyword &window */ +#define T_Kywdstr 24 /* string keyword */ +#define T_Kywdevent 25 /* keyword &eventsource, etc. */ #ifdef PatternType -#define T_Pattern 26 /* pattern header */ -#define T_Pelem 27 /* pattern element */ -#endif /* PatternType */ +#define T_Pattern 26 /* pattern header */ +#define T_Pelem 27 /* pattern element */ +#endif /* PatternType */ #define T_Tvmonitored 28 /* Monitored trapped variable */ -#define T_Intarray 29 /* integer array */ -#define T_Realarray 30 /* real array */ -#define T_Cons 31 /* generic link list element */ +#define T_Intarray 29 /* integer array */ +#define T_Realarray 30 /* real array */ +#define T_Cons 31 /* generic link list element */ -#define MaxType 31 /* maximum type number */ +#define MaxType 31 /* maximum type number */ /* * Definitions for keywords. */ -#define k_pos kywd_pos.vword.integr /* value of &pos */ -#define k_random kywd_ran.vword.integr /* value of &random */ -#define k_trace kywd_trc.vword.integr /* value of &trace */ -#define k_dump kywd_dmp.vword.integr /* value of &dump */ +#define k_pos kywd_pos.vword.integr /* value of &pos */ +#define k_random kywd_ran.vword.integr /* value of &random */ +#define k_trace kywd_trc.vword.integr /* value of &trace */ +#define k_dump kywd_dmp.vword.integr /* value of &dump */ #ifdef FncTrace - #define k_ftrace kywd_ftrc.vword.integr /* value of &ftrace */ -#endif /* FncTrace */ + #define k_ftrace kywd_ftrc.vword.integr /* value of &ftrace */ +#endif /* FncTrace */ /* * Descriptor types and flags. */ -#define D_Null ((word)(T_Null | D_Typecode)) -#define D_Integer ((word)(T_Integer | D_Typecode)) +#define D_Null ((word)(T_Null | D_Typecode)) +#define D_Integer ((word)(T_Integer | D_Typecode)) #ifdef LargeInts - #define D_Lrgint ((word)(T_Lrgint | D_Typecode | F_Ptr)) -#endif /* LargeInts */ + #define D_Lrgint ((word)(T_Lrgint | D_Typecode | F_Ptr)) +#endif /* LargeInts */ #ifdef DescriptorDouble -#define D_Real ((word)(T_Real | D_Typecode)) -#else /* DescriptorDouble */ -#define D_Real ((word)(T_Real | D_Typecode | F_Ptr)) -#endif /* DescriptorDouble */ -#define D_Cset ((word)(T_Cset | D_Typecode | F_Ptr)) -#define D_File ((word)(T_File | D_Typecode | F_Ptr)) -#define D_Proc ((word)(T_Proc | D_Typecode | F_Ptr)) -#define D_List ((word)(T_List | D_Typecode | F_Ptr)) -#define D_Lelem ((word)(T_Lelem | D_Typecode | F_Ptr)) -#define D_Table ((word)(T_Table | D_Typecode | F_Ptr)) -#define D_Telem ((word)(T_Telem | D_Typecode | F_Ptr)) -#define D_Set ((word)(T_Set | D_Typecode | F_Ptr)) -#define D_Selem ((word)(T_Selem | D_Typecode | F_Ptr)) -#define D_Record ((word)(T_Record | D_Typecode | F_Ptr)) -#define D_Tvsubs ((word)(T_Tvsubs | D_Typecode | F_Ptr | F_Var)) -#define D_Tvtbl ((word)(T_Tvtbl | D_Typecode | F_Ptr | F_Var)) -#define D_Tvmonitored ((word)(T_Tvmonitored | D_Typecode | F_Ptr | F_Var)) -#define D_Kywdint ((word)(T_Kywdint | D_Typecode | F_Ptr | F_Var)) -#define D_Kywdpos ((word)(T_Kywdpos | D_Typecode | F_Ptr | F_Var)) -#define D_Kywdsubj ((word)(T_Kywdsubj | D_Typecode | F_Ptr | F_Var)) -#define D_Refresh ((word)(T_Refresh | D_Typecode | F_Ptr)) -#define D_Coexpr ((word)(T_Coexpr | D_Typecode | F_Ptr)) -#define D_External ((word)(T_External | D_Typecode | F_Ptr)) -#define D_Slots ((word)(T_Slots | D_Typecode | F_Ptr)) -#define D_Kywdwin ((word)(T_Kywdwin | D_Typecode | F_Ptr | F_Var)) -#define D_Kywdstr ((word)(T_Kywdstr | D_Typecode | F_Ptr | F_Var)) -#define D_Kywdevent ((word)(T_Kywdevent | D_Typecode | F_Ptr | F_Var)) +#define D_Real ((word)(T_Real | D_Typecode)) +#else /* DescriptorDouble */ +#define D_Real ((word)(T_Real | D_Typecode | F_Ptr)) +#endif /* DescriptorDouble */ +#define D_Cset ((word)(T_Cset | D_Typecode | F_Ptr)) +#define D_File ((word)(T_File | D_Typecode | F_Ptr)) +#define D_Proc ((word)(T_Proc | D_Typecode | F_Ptr)) +#define D_List ((word)(T_List | D_Typecode | F_Ptr)) +#define D_Lelem ((word)(T_Lelem | D_Typecode | F_Ptr)) +#define D_Table ((word)(T_Table | D_Typecode | F_Ptr)) +#define D_Telem ((word)(T_Telem | D_Typecode | F_Ptr)) +#define D_Set ((word)(T_Set | D_Typecode | F_Ptr)) +#define D_Selem ((word)(T_Selem | D_Typecode | F_Ptr)) +#define D_Record ((word)(T_Record | D_Typecode | F_Ptr)) +#define D_Tvsubs ((word)(T_Tvsubs | D_Typecode | F_Ptr | F_Var)) +#define D_Tvtbl ((word)(T_Tvtbl | D_Typecode | F_Ptr | F_Var)) +#define D_Tvmonitored ((word)(T_Tvmonitored | D_Typecode | F_Ptr | F_Var)) +#define D_Kywdint ((word)(T_Kywdint | D_Typecode | F_Ptr | F_Var)) +#define D_Kywdpos ((word)(T_Kywdpos | D_Typecode | F_Ptr | F_Var)) +#define D_Kywdsubj ((word)(T_Kywdsubj | D_Typecode | F_Ptr | F_Var)) +#define D_Refresh ((word)(T_Refresh | D_Typecode | F_Ptr)) +#define D_Coexpr ((word)(T_Coexpr | D_Typecode | F_Ptr)) +#define D_External ((word)(T_External | D_Typecode | F_Ptr)) +#define D_Slots ((word)(T_Slots | D_Typecode | F_Ptr)) +#define D_Kywdwin ((word)(T_Kywdwin | D_Typecode | F_Ptr | F_Var)) +#define D_Kywdstr ((word)(T_Kywdstr | D_Typecode | F_Ptr | F_Var)) +#define D_Kywdevent ((word)(T_Kywdevent | D_Typecode | F_Ptr | F_Var)) #ifdef PatternType -#define D_Pattern ((word)(T_Pattern | D_Typecode | F_Ptr)) -#define D_Pelem ((word)(T_Pelem | D_Typecode | F_Ptr)) -#endif /* PatternType */ -#define D_Intarray ((word)(T_Intarray | D_Typecode | F_Ptr)) -#define D_Realarray ((word)(T_Realarray | D_Typecode | F_Ptr)) +#define D_Pattern ((word)(T_Pattern | D_Typecode | F_Ptr)) +#define D_Pelem ((word)(T_Pelem | D_Typecode | F_Ptr)) +#endif /* PatternType */ +#define D_Intarray ((word)(T_Intarray | D_Typecode | F_Ptr)) +#define D_Realarray ((word)(T_Realarray | D_Typecode | F_Ptr)) -#define D_Var ((word)(F_Var | F_Nqual | F_Ptr)) -#define D_Typecode ((word)(F_Nqual | F_Typecode)) +#define D_Var ((word)(F_Var | F_Nqual | F_Ptr)) +#define D_Typecode ((word)(F_Nqual | F_Typecode)) -#define TypeMask 63 /* type mask */ -#define OffsetMask (~(D_Var)) /* offset mask for variables */ +#define TypeMask 63 /* type mask */ +#define OffsetMask (~(D_Var)) /* offset mask for variables */ /* * "In place" dereferencing. The 2nd version generates no E_Deref event; @@ -655,22 +655,22 @@ #define CE_CEQUEUE_SIZE 64 /* used in fmath.r, log() */ - #define lastbase (curtstate->Lastbase) - #define divisor (curtstate->Divisor) + #define lastbase (curtstate->Lastbase) + #define divisor (curtstate->Divisor) /* used in fstr.r, map() */ - #define maptab (curtstate->Maptab) - #define maps2 (curtstate->Maps2) - #define maps3 (curtstate->Maps3) - + #define maptab (curtstate->Maptab) + #define maps2 (curtstate->Maps2) + #define maps3 (curtstate->Maps3) + /* used in rposix.r */ - #define callproc (curtstate->Callproc) - #define callproc_ibuf (curtstate->Callproc_Ibuf) + #define callproc (curtstate->Callproc) + #define callproc_ibuf (curtstate->Callproc_Ibuf) - #define pollctr (curtstate->Pollctr) + #define pollctr (curtstate->Pollctr) - #define curtstring (curtstate->Curstring) - #define curtblock (curtstate->Curblock) + #define curtstring (curtstate->Curstring) + #define curtblock (curtstate->Curblock) #define TURN_ON_CONCURRENT() do if (!is_concurrent) { \ @@ -693,14 +693,14 @@ #define GET_CURTSTATE() struct threadstate *curtstate = \ global_curtstate? global_curtstate: \ (struct threadstate *) pthread_getspecific(tstate_key); - + #define CURTSTATE_CE() struct b_coexpr *curtstate_ce = curtstate->c; #ifdef NativeCoswitch #define SYNC_CURTSTATE_CE() if (curtstate->c != curtstate_ce) curtstate_ce = curtstate->c; -#else /* NativeCoswitch */ +#else /* NativeCoswitch */ #define SYNC_CURTSTATE_CE() -#endif /* NativeCoswitch */ +#endif /* NativeCoswitch */ #define CURTSTATE() GET_CURTSTATE(); #define CURTSTATE_AND_CE() GET_CURTSTATE(); CURTSTATE_CE(); @@ -714,10 +714,10 @@ #define RTTCURTSTATARG #if ConcurrentCOMPILER #define CURTSTATVAR() CURTSTATE() -#else /* ConcurrentCOMPILER */ +#else /* ConcurrentCOMPILER */ #define CURTSTATVAR() -#endif /* ConcurrentCOMPILER */ -#endif /* TSTATARG */ +#endif /* ConcurrentCOMPILER */ +#endif /* TSTATARG */ /*#endif*/ #define ssize (curtstate->Curstring->size) @@ -730,7 +730,7 @@ #define blkend (curtstate->Curblock->end) #define blkfree (curtstate->Curblock->free) -#else /* Concurrent */ +#else /* Concurrent */ #define CURTSTATE() #define CURTSTATE_CE() @@ -751,10 +751,10 @@ #define blkbase (curblock->base) #define blkend (curblock->end) #define blkfree (curblock->free) -#endif /* Concurrent */ +#endif /* Concurrent */ #if COMPILER -#if ConcurrentCOMPILER +#if ConcurrentCOMPILER /* * ConcurrentCOMPILER claims to avoid threads hanging by periodically * answering thread_call's from within Poll(). This should probably @@ -767,191 +767,191 @@ if (thread_call){ \ thread_control(TC_ANSWERCALL);}\ }while (0) - #else /* Graphics */ + #else /* Graphics */ #define Poll() do{ \ if (thread_call){ \ thread_control(TC_ANSWERCALL);\ }\ } while (0) -#endif /* Graphics */ +#endif /* Graphics */ #else /* ConcurrentCOMPILER */ #ifdef Graphics #define Poll() if (!pollctr--) pollctr = pollevent() - #else /* Graphics */ + #else /* Graphics */ #define Poll() - #endif /* Graphics */ + #endif /* Graphics */ #endif /* ConcurrentCOMPILER */ - -#else /* COMPILER */ - + +#else /* COMPILER */ + /* * Definitions for the interpreter. */ - + /* * Codes returned by invoke to indicate action. */ - #define I_Builtin 201 /* A built-in routine is to be invoked */ - #define I_Fail 202 /* goal-directed evaluation failed */ - #define I_Continue 203 /* Continue execution in the interp loop */ - #define I_Vararg 204 /* A function with a variable number of args */ - + #define I_Builtin 201 /* A built-in routine is to be invoked */ + #define I_Fail 202 /* goal-directed evaluation failed */ + #define I_Continue 203 /* Continue execution in the interp loop */ + #define I_Vararg 204 /* A function with a variable number of args */ + /* * Generator types. */ - #define G_Csusp 1 - #define G_Esusp 2 - #define G_Psusp 3 - #define G_Fsusp 4 - #define G_Osusp 5 - + #define G_Csusp 1 + #define G_Esusp 2 + #define G_Psusp 3 + #define G_Fsusp 4 + #define G_Osusp 5 + /* * Evaluation stack overflow margin */ #define PerilDelta 100 - + /* * Macro definitions related to descriptors. */ - + /* * The following code is operating-system dependent [@rt.01]. Define * PushAval for computers that store longs and pointers differently. */ - + #if PORT #define PushAVal(x) PushVal(x) Deliberate Syntax Error - #endif /* PORT */ - + #endif /* PORT */ + #if MVS || UNIX || VM || VMS #define PushAVal(x) PushVal(x) - #endif /* MVS ... VMS */ - + #endif /* MVS ... VMS */ + #if MSDOS #define PushAVal(x) {sp++; \ - stkword.stkadr = (char *)(x); \ - *sp = stkword.stkint;} - #endif /* MSDOS */ - + stkword.stkadr = (char *)(x); \ + *sp = stkword.stkint;} + #endif /* MSDOS */ + /* * End of operating-system specific code. */ - + /* * Macros for pushing values on the interpreter stack. */ - + /* * Push descriptor. */ - #define PushDesc(d) {*++sp = ((d).dword); sp++;*sp =((d).vword.integr);} - + #define PushDesc(d) {*++sp = ((d).dword); sp++;*sp =((d).vword.integr);} + /* * Push null-valued descriptor. */ - #define PushNull {*++sp = D_Null; sp++; *sp = 0;} - + #define PushNull {*++sp = D_Null; sp++; *sp = 0;} + /* * Push word. */ - #define PushVal(v) {*++sp = (word)(v);} - + #define PushVal(v) {*++sp = (word)(v);} + /* * Macros related to function and operator definition. */ - + /* * Procedure block for a function. */ - + #if VMS #define FncBlock(f,nargs,deref) \ - struct b_iproc Cat(B,f) = {\ - T_Proc,\ - Vsizeof(struct b_proc),\ - Cat(Y,f),\ - nargs,\ - -1,\ - deref, 0,\ - {sizeof(Lit(f))-1,Lit(f)}}; - #else /* VMS */ + struct b_iproc Cat(B,f) = {\ + T_Proc,\ + Vsizeof(struct b_proc),\ + Cat(Y,f),\ + nargs,\ + -1,\ + deref, 0,\ + {sizeof(Lit(f))-1,Lit(f)}}; + #else /* VMS */ #define FncBlock(f,nargs,deref) \ - struct b_iproc Cat(B,f) = {\ - T_Proc,\ - Vsizeof(struct b_proc),\ - Cat(Z,f),\ - nargs,\ - -1,\ - deref, 0,\ - {sizeof(Lit(f))-1,Lit(f)}}; - #endif /* VMS */ - + struct b_iproc Cat(B,f) = {\ + T_Proc,\ + Vsizeof(struct b_proc),\ + Cat(Z,f),\ + nargs,\ + -1,\ + deref, 0,\ + {sizeof(Lit(f))-1,Lit(f)}}; + #endif /* VMS */ + /* * Procedure block for an operator. */ #define OpBlock(f,nargs,sname,xtrargs)\ - struct b_iproc Cat(B,f) = {\ - T_Proc,\ - Vsizeof(struct b_proc),\ - Cat(O,f),\ - nargs,\ - -1,\ - xtrargs,\ - 0,\ - {sizeof(sname)-1,sname}}; - + struct b_iproc Cat(B,f) = {\ + T_Proc,\ + Vsizeof(struct b_proc),\ + Cat(O,f),\ + nargs,\ + -1,\ + xtrargs,\ + 0,\ + {sizeof(sname)-1,sname}}; + /* * Operator declaration. */ #define OpDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(cargp) register dptr cargp; - + /* * Operator declaration with extra working argument. */ #define OpDclE(nm,n,pn) OpBlock(nm,-n,pn,0) Cat(O,nm)(cargp) register dptr cargp; - + /* * Agent routine declaration. */ #define AgtDcl(nm) Cat(A,nm)(cargp) register dptr cargp; - + /* * Macros to access Icon arguments in C functions. */ - + /* * n-th argument. */ - #define Arg(n) (cargp[n]) - + #define Arg(n) (cargp[n]) + /* * Type field of n-th argument. */ - #define ArgType(n) (cargp[n].dword) - + #define ArgType(n) (cargp[n].dword) + /* * Value field of n-th argument. */ - #define ArgVal(n) (cargp[n].vword.integr) - + #define ArgVal(n) (cargp[n].vword.integr) + /* * Specific arguments. */ - #define Arg0 (cargp[0]) - #define Arg1 (cargp[1]) - #define Arg2 (cargp[2]) - #define Arg3 (cargp[3]) - #define Arg4 (cargp[4]) - #define Arg5 (cargp[5]) - #define Arg6 (cargp[6]) - #define Arg7 (cargp[7]) - #define Arg8 (cargp[8]) - + #define Arg0 (cargp[0]) + #define Arg1 (cargp[1]) + #define Arg2 (cargp[2]) + #define Arg3 (cargp[3]) + #define Arg4 (cargp[4]) + #define Arg5 (cargp[5]) + #define Arg6 (cargp[6]) + #define Arg7 (cargp[7]) + #define Arg8 (cargp[8]) + /* * Miscellaneous macro definitions. */ - + #ifdef MultiProgram #define handlers (curpstate->Handlers) #define kywd_err (curpstate->Kywd_err) @@ -974,7 +974,7 @@ #define fosp (curpstate->Fosp) #define fo (curpstate->Fo) #define bm (curpstate->Bm) - #endif /* FieldTableCompression */ + #endif /* FieldTableCompression */ #define fnames (curpstate->Fnames) #define efnames (curpstate->Efnames) #define globals (curpstate->Globals) @@ -991,7 +991,7 @@ #define ilines (curpstate->Ilines) #define elines (curpstate->Elines) #define current_line_ptr (curpstate->Current_line_ptr) - + /*#ifdef Graphics*/ #define amperX (curpstate->AmperX) #define amperY (curpstate->AmperY) @@ -1006,21 +1006,21 @@ #define xmod_control (curpstate->Xmod_Control) #define xmod_shift (curpstate->Xmod_Shift) #define xmod_meta (curpstate->Xmod_Meta) - #ifdef Graphics3D + #ifdef Graphics3D #define amperPick (curpstate->AmperPick) - #endif /* Graphics3D */ -/*#endif*/ /* Graphics */ - + #endif /* Graphics3D */ +/*#endif*/ /* Graphics */ + #define coexp_ser (curpstate->Coexp_ser) #define list_ser (curpstate->List_ser) #define intern_list_ser (curpstate->Intern_list_ser) #ifdef PatternType #define pat_ser (curpstate->Pat_ser) -#endif /* PatternType */ +#endif /* PatternType */ #define set_ser (curpstate->Set_ser) #define table_ser (curpstate->Table_ser) -#endif /* MultiProgram */ -#endif /* COMPILER */ +#endif /* MultiProgram */ +#endif /* COMPILER */ #ifdef MultiProgram #define curstring (curpstate->stringregion) @@ -1039,8 +1039,8 @@ /* thread local*/ #define lastop (curtstate->Lastop) #define lastopnd (curtstate->Lastopnd) -#endif /* Concurrent */ -#endif /* MultiProgram */ +#endif /* Concurrent */ +#endif /* MultiProgram */ #ifdef MultiProgram #define field_argp (curtstate->Field_argp) @@ -1051,10 +1051,10 @@ #endif #define line_num (curtstate->Line_num) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if defined(MultiProgram) || ConcurrentCOMPILER - #define glbl_argp (curtstate->Glbl_argp) + #define glbl_argp (curtstate->Glbl_argp) #define kywd_pos (curtstate->Kywd_pos) #define k_subject (curtstate->ksub) @@ -1089,19 +1089,19 @@ #define ilevel (curtstate_ce->es_ilevel) #define eret_tmp (curtstate->Eret_tmp) -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ #ifndef StackCheck #define stack (curtstate->Stack) #define stackend (curtstate->Stackend) -#endif /* StackCheck */ +#endif /* StackCheck */ #ifdef PosixFns #define savedbuf (curtstate->Savedbuf) #define nsaved (curtstate->Nsaved) -#endif /* PosixFns */ - -#endif /* Concurrent */ +#endif /* PosixFns */ + +#endif /* Concurrent */ #if !ConcurrentCOMPILER #define k_main (curpstate->K_main) @@ -1111,39 +1111,39 @@ #define longest_dr (curpstate->Longest_dr) #define dr_arrays (curpstate->Dr_arrays) - + #ifdef Arrays #define cprealarray (curpstate->Cprealarray) #define cpintarray (curpstate->Cpintarray) -#endif /* Arrays */ - #define cplist (curpstate->Cplist) - #define cpset (curpstate->Cpset) - #define cptable (curpstate->Cptable) - #define EVStrAlc (curpstate->EVstralc) - #define interp (curpstate->Interp) - #define cnv_cset (curpstate->Cnvcset) - #define cnv_int (curpstate->Cnvint) - #define cnv_real (curpstate->Cnvreal) - #define cnv_str (curpstate->Cnvstr) - #define cnv_tcset (curpstate->Cnvtcset) - #define cnv_tstr (curpstate->Cnvtstr) - #define deref (curpstate->Deref) - #define alcbignum (curpstate->Alcbignum) - #define alccset (curpstate->Alccset) - #define alcfile (curpstate->Alcfile) - #define alchash (curpstate->Alchash) +#endif /* Arrays */ + #define cplist (curpstate->Cplist) + #define cpset (curpstate->Cpset) + #define cptable (curpstate->Cptable) + #define EVStrAlc (curpstate->EVstralc) + #define interp (curpstate->Interp) + #define cnv_cset (curpstate->Cnvcset) + #define cnv_int (curpstate->Cnvint) + #define cnv_real (curpstate->Cnvreal) + #define cnv_str (curpstate->Cnvstr) + #define cnv_tcset (curpstate->Cnvtcset) + #define cnv_tstr (curpstate->Cnvtstr) + #define deref (curpstate->Deref) + #define alcbignum (curpstate->Alcbignum) + #define alccset (curpstate->Alccset) + #define alcfile (curpstate->Alcfile) + #define alchash (curpstate->Alchash) #define alcsegment (curpstate->Alcsegment) #ifdef PatternType #define alcpattern (curpstate->Alcpattern) #define alcpelem (curpstate->Alcpelem) #define cnv_pattern (curpstate->Cnvpattern) #define internal_match (curpstate->Internalmatch) -#endif /* PatternType */ +#endif /* PatternType */ #define alclist_raw (curpstate->Alclist_raw) - #define alclist (curpstate->Alclist) - #define alclstb (curpstate->Alclstb) - #define alcreal (curpstate->Alcreal) - #define alcrecd (curpstate->Alcrecd) + #define alclist (curpstate->Alclist) + #define alclstb (curpstate->Alclstb) + #define alcreal (curpstate->Alcreal) + #define alcrecd (curpstate->Alcrecd) #define alcrefresh (curpstate->Alcrefresh) #define alcselem (curpstate->Alcselem) #define alcstr (curpstate->Alcstr) @@ -1152,21 +1152,21 @@ #define alctvtbl (curpstate->Alctvtbl) #define deallocate (curpstate->Deallocate) #define reserve (curpstate->Reserve) -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ #ifdef Concurrent #if !ConcurrentCOMPILER #define ENTERPSTATE(p) if (((p)!=NULL)) { curpstate = (p); } -#endif /* ConcurrentCOMPILER */ -#else /* Concurrent */ +#endif /* ConcurrentCOMPILER */ +#else /* Concurrent */ #define ENTERPSTATE(p) if (((p)!=NULL)) { curpstate = (p); curtstate=p->tstate;} -#endif /* Concurrent */ +#endif /* Concurrent */ -#else /* MultiProgram */ +#else /* MultiProgram */ #define ENTERPSTATE(p) -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - #if COMPILER || !defined(MultiProgram) #define EVStrAlc(n) #endif @@ -1175,55 +1175,55 @@ * Constants controlling expression evaluation. */ #if COMPILER - #define A_Resume -1 /* expression failed: resume a generator */ - #define A_Continue -2 /* expression returned: continue execution */ - #define A_FallThru -3 /* body function: fell through end of code */ - #define A_Coact 1 /* co-expression activation */ - #define A_Coret 2 /* co-expression return */ - #define A_Cofail 3 /* co-expression failure */ -#else /* COMPILER */ - #define A_Resume 1 /* routine failed */ - #define A_Pret_uw 2 /* interp unwind for Op_Pret */ - #define A_Unmark_uw 3 /* interp unwind for Op_Unmark */ - #define A_Pfail_uw 4 /* interp unwind for Op_Pfail */ - #define A_Lsusp_uw 5 /* interp unwind for Op_Lsusp */ - #define A_Eret_uw 6 /* interp unwind for Op_Eret */ - #define A_Continue 7 /* routine returned */ - #define A_Coact 8 /* co-expression activated */ - #define A_Coret 9 /* co-expression returned */ - #define A_Cofail 10 /* co-expression failed */ + #define A_Resume -1 /* expression failed: resume a generator */ + #define A_Continue -2 /* expression returned: continue execution */ + #define A_FallThru -3 /* body function: fell through end of code */ + #define A_Coact 1 /* co-expression activation */ + #define A_Coret 2 /* co-expression return */ + #define A_Cofail 3 /* co-expression failure */ +#else /* COMPILER */ + #define A_Resume 1 /* routine failed */ + #define A_Pret_uw 2 /* interp unwind for Op_Pret */ + #define A_Unmark_uw 3 /* interp unwind for Op_Unmark */ + #define A_Pfail_uw 4 /* interp unwind for Op_Pfail */ + #define A_Lsusp_uw 5 /* interp unwind for Op_Lsusp */ + #define A_Eret_uw 6 /* interp unwind for Op_Eret */ + #define A_Continue 7 /* routine returned */ + #define A_Coact 8 /* co-expression activated */ + #define A_Coret 9 /* co-expression returned */ + #define A_Cofail 10 /* co-expression failed */ #ifdef MultiProgram - #define A_MTEvent 11 /* multiProgram event */ - #endif /* MultiProgram */ + #define A_MTEvent 11 /* multiProgram event */ + #endif /* MultiProgram */ #ifdef PosixFns - #define A_Trapret 12 /* Return from stub */ - #define A_Trapfail 13 /* Fail from stub */ - #endif /* PosixFns */ + #define A_Trapret 12 /* Return from stub */ + #define A_Trapfail 13 /* Fail from stub */ + #endif /* PosixFns */ #ifdef SoftThreads - #define A_Coschedule 14 /* co-expression schedule */ - #endif /* SoftThreads */ -#endif /* COMPILER */ + #define A_Coschedule 14 /* co-expression schedule */ + #endif /* SoftThreads */ +#endif /* COMPILER */ #ifdef SoftThreads #define SOFT_THREADS_SIZE 16 #define SOFT_THREADS_TSLICE 500 -#endif /* SoftThreads */ +#endif /* SoftThreads */ /* * Address of word containing cset bit b (c is a struct descrip of type Cset). */ -#define CsetPtr(b,c) (BlkD(c,Cset)->bits + (((b)&0377) >> LogIntBits)) +#define CsetPtr(b,c) (BlkD(c,Cset)->bits + (((b)&0377) >> LogIntBits)) #if MSDOS #define ptr2word(x) (uword)x #define word2ptr(x) ((char *)x) -#endif /* MSDOS */ +#endif /* MSDOS */ #if NT #ifndef S_ISDIR #define S_ISDIR(mod) ((mod) & _S_IFDIR) -#endif /* no S_ISDIR */ -#endif /* NT */ +#endif /* no S_ISDIR */ +#endif /* NT */ #ifdef ISQL /* ODBC support */ @@ -1231,7 +1231,7 @@ * Icon/ODBC error codes */ #define ODBC_ERR_SZ 19 - + #define NOT_ODBC_FILE_ERR 1100 #define FREE_STMT_ERR 1101 #define DISCONNECT_ERR 1102 @@ -1252,10 +1252,10 @@ #define TOO_MANY_KEYS_ERR 1117 #define KEY_MISSING_ERR 1118 -#endif /* ISQL */ +#endif /* ISQL */ -/* +/* * flags for ConsoleFlags */ /* I/O redirection flags */ @@ -1265,8 +1265,8 @@ #define OutputToBuf 8 #define SEM_WAIT(semptr) while (sem_wait(semptr) != 0 ) { \ - if (errno==EINVAL) syserr("invalid semaphore"); \ - else if (errno != EINTR) {perror("sem_wait()"); syserr("sem_wait error");} } + if (errno==EINVAL) syserr("invalid semaphore"); \ + else if (errno != EINTR) {perror("sem_wait()"); syserr("sem_wait error");} } #ifndef NamedSemaphores #define SEM_CLOSE(sem_s) sem_destroy(sem_s) @@ -1274,119 +1274,119 @@ #define SEM_CLOSE(sem_s) sem_close(sem_s) #endif /* NamedSemaphores */ -#define FUNC_MUTEX_LOCK 1 -#define FUNC_MUTEX_TRYLOCK 2 -#define FUNC_MUTEX_UNLOCK 3 -#define FUNC_MUTEX_INIT 4 -#define FUNC_MUTEX_DESTROY 5 -#define FUNC_COND_WAIT 6 -#define FUNC_COND_INIT 7 -#define FUNC_COND_DESTROY 8 -#define FUNC_COND_TIMEDWAIT 9 -#define FUNC_COND_SIGNAL 10 -#define FUNC_THREAD_CREATE 11 -#define FUNC_THREAD_JOIN 12 -#define FUNC_SEM_OPEN 13 -#define FUNC_SEM_INIT 14 +#define FUNC_MUTEX_LOCK 1 +#define FUNC_MUTEX_TRYLOCK 2 +#define FUNC_MUTEX_UNLOCK 3 +#define FUNC_MUTEX_INIT 4 +#define FUNC_MUTEX_DESTROY 5 +#define FUNC_COND_WAIT 6 +#define FUNC_COND_INIT 7 +#define FUNC_COND_DESTROY 8 +#define FUNC_COND_TIMEDWAIT 9 +#define FUNC_COND_SIGNAL 10 +#define FUNC_THREAD_CREATE 11 +#define FUNC_THREAD_JOIN 12 +#define FUNC_SEM_OPEN 13 +#define FUNC_SEM_INIT 14 #ifdef PthreadCoswitch -#define THREAD_CREATE(cp, t_stksize, msg) \ - do { \ - int retval; \ - if (t_stksize){ \ - pthread_attr_t attr; \ - pthread_attr_init(&attr); \ - pthread_attr_setstacksize(&attr, t_stksize); \ - retval = pthread_create(&cp->thread, &attr, nctramp, cp); \ - } \ - else \ - retval = pthread_create(&cp->thread, NULL, nctramp, cp); \ - if (retval) handle_thread_error(retval, FUNC_THREAD_CREATE, msg); \ +#define THREAD_CREATE(cp, t_stksize, msg) \ + do { \ + int retval; \ + if (t_stksize){ \ + pthread_attr_t attr; \ + pthread_attr_init(&attr); \ + pthread_attr_setstacksize(&attr, t_stksize); \ + retval = pthread_create(&cp->thread, &attr, nctramp, cp); \ + } \ + else \ + retval = pthread_create(&cp->thread, NULL, nctramp, cp); \ + if (retval) handle_thread_error(retval, FUNC_THREAD_CREATE, msg); \ } while (0) -#define THREAD_JOIN( thrd, opt ) do { int retval; \ - if ((retval=pthread_join(thrd, opt)) != 0) \ - handle_thread_error(retval, FUNC_THREAD_JOIN, NULL); \ +#define THREAD_JOIN( thrd, opt ) do { int retval; \ + if ((retval=pthread_join(thrd, opt)) != 0) \ + handle_thread_error(retval, FUNC_THREAD_JOIN, NULL); \ } while (0) -#define CREATE_CE_THREAD(cp, t_stksize, msg) do { \ - THREAD_CREATE(cp, t_stksize, msg); \ - cp->alive = 1; \ - cp->have_thread = 1; \ - SET_FLAG(cp->status, Ts_Attached); \ - SET_FLAG(cp->status, Ts_Posix); \ - /*if (!(nstat & Ts_Sync ))pthread_detach(&new->thread);*/ \ +#define CREATE_CE_THREAD(cp, t_stksize, msg) do { \ + THREAD_CREATE(cp, t_stksize, msg); \ + cp->alive = 1; \ + cp->have_thread = 1; \ + SET_FLAG(cp->status, Ts_Attached); \ + SET_FLAG(cp->status, Ts_Posix); \ + /*if (!(nstat & Ts_Sync ))pthread_detach(&new->thread);*/ \ } while (0) #else /* PthreadCoswitch */ #define THREAD_CREATE(cp, t_stksize, msg) #define THREAD_JOIN(thrd, opt) -#define CREATE_CE_THREAD(cp, t_stksize, msg) +#define CREATE_CE_THREAD(cp, t_stksize, msg) #endif /* PthreadCoswitch */ #ifdef Concurrent - #define MTX_OP_ASTR 0 - #define MTX_OP_AREAL 1 - #define MTX_OP_ACSET 2 - #define MTX_OP_ASTATIC 3 - #define MTX_OP_AGLOBAL 4 - #define MTX_OP_AMARK 5 - #define MTX_OP_AGOTO 6 - - #define MTX_LIST_SER 7 - #define MTX_COEXP_SER 8 - #define MTX_SET_SER 9 - #define MTX_TABLE_SER 10 - #define MTX_PAT_SER 11 - - #define MTX_STRHEAP 12 - #define MTX_BLKHEAP 13 - - #define MTX_TLS_CHAIN 14 - - #define MTX_CURFILE_HANDLE 15 - - #define MTX_SEGVTRAP_N 16 - - #define MTX_DR_TBL 17 - - #define MTX_SOCK_MAP 18 - - #define MTX_THREADCONTROL 19 - #define MTX_NARTHREADS 20 - #define MTX_COND_TC 21 - - #define MTX_HANDLERS 22 - - #define MTX_ALCNUM 23 - - #define MTX_PUBLICSTRHEAP 24 - #define MTX_PUBLICBLKHEAP 25 - - #define MTX_ROOT_FILEPIDS 26 - + #define MTX_OP_ASTR 0 + #define MTX_OP_AREAL 1 + #define MTX_OP_ACSET 2 + #define MTX_OP_ASTATIC 3 + #define MTX_OP_AGLOBAL 4 + #define MTX_OP_AMARK 5 + #define MTX_OP_AGOTO 6 + + #define MTX_LIST_SER 7 + #define MTX_COEXP_SER 8 + #define MTX_SET_SER 9 + #define MTX_TABLE_SER 10 + #define MTX_PAT_SER 11 + + #define MTX_STRHEAP 12 + #define MTX_BLKHEAP 13 + + #define MTX_TLS_CHAIN 14 + + #define MTX_CURFILE_HANDLE 15 + + #define MTX_SEGVTRAP_N 16 + + #define MTX_DR_TBL 17 + + #define MTX_SOCK_MAP 18 + + #define MTX_THREADCONTROL 19 + #define MTX_NARTHREADS 20 + #define MTX_COND_TC 21 + + #define MTX_HANDLERS 22 + + #define MTX_ALCNUM 23 + + #define MTX_PUBLICSTRHEAP 24 + #define MTX_PUBLICBLKHEAP 25 + + #define MTX_ROOT_FILEPIDS 26 + #define MTX_PATIMG_FUNCARR 27 - - #define MTX_STKLIST 28 - #define MTX_POLLEVENT 29 - #define MTX_RECID 30 - - #define MTX_NOMTEVENTS 31 - #define MTX_MUTEXES 32 - #define MTX_CONDVARS 33 + #define MTX_STKLIST 28 + #define MTX_POLLEVENT 29 + #define MTX_RECID 30 - #define MTX_STRINGTOTAL 34 - #define MTX_BLOCKTOTAL 35 - #define MTX_COLL 36 + #define MTX_NOMTEVENTS 31 + + #define MTX_MUTEXES 32 + #define MTX_CONDVARS 33 + + #define MTX_STRINGTOTAL 34 + #define MTX_BLOCKTOTAL 35 + #define MTX_COLL 36 /* This should be the last mutex, becasue it has special initialization*/ - #define MTX_INITIAL 37 + #define MTX_INITIAL 37 + - /* total is: */ - #define NUM_STATIC_MUTEXES 38 + #define NUM_STATIC_MUTEXES 38 /* used by wait4GC function*/ @@ -1405,176 +1405,176 @@ * error tracing. */ -#define MUTEX_LOCK( mtx, msg) \ - do \ - if (is_concurrent) { \ - int __rv; \ - if ((__rv=pthread_mutex_lock(&(mtx))) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_LOCK, msg); \ - } \ +#define MUTEX_LOCK( mtx, msg) \ + do \ + if (is_concurrent) { \ + int __rv; \ + if ((__rv=pthread_mutex_lock(&(mtx))) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_LOCK, msg); \ + } \ while (0) -#define MUTEX_UNLOCK( mtx, msg) \ - do \ - if (is_concurrent) { \ - int __rv; \ - if ((__rv=pthread_mutex_unlock(&(mtx))) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_UNLOCK, msg); \ - } \ +#define MUTEX_UNLOCK( mtx, msg) \ + do \ + if (is_concurrent) { \ + int __rv; \ + if ((__rv=pthread_mutex_unlock(&(mtx))) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_UNLOCK, msg); \ + } \ while (0) -#define MUTEX_TRYLOCK(mtx, isbusy, msg) \ - do \ - if (is_concurrent) { \ - if ((isbusy=pthread_mutex_trylock(&(mtx))) != 0) { \ - if (isbusy != EBUSY){ \ - handle_thread_error(isbusy, FUNC_MUTEX_TRYLOCK, msg); \ - isbusy = 0; \ - } \ - } \ - } else isbusy = 0; \ +#define MUTEX_TRYLOCK(mtx, isbusy, msg) \ + do \ + if (is_concurrent) { \ + if ((isbusy=pthread_mutex_trylock(&(mtx))) != 0) { \ + if (isbusy != EBUSY){ \ + handle_thread_error(isbusy, FUNC_MUTEX_TRYLOCK, msg); \ + isbusy = 0; \ + } \ + } \ + } else isbusy = 0; \ while (0) -#define MUTEX_INIT( mtx, attr ) \ - do { int __rv; \ - if ((__rv=pthread_mutex_init(&(mtx), attr)) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_INIT, NULL); \ +#define MUTEX_INIT( mtx, attr ) \ + do { int __rv; \ + if ((__rv=pthread_mutex_init(&(mtx), attr)) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_INIT, NULL); \ } while (0) /* * Lock mutex mutexes[mtx]. */ - -#define MUTEX_INITID( mtx, attr ) \ - do { \ - int __rv; \ - mutexes[mtx] = malloc(sizeof(pthread_mutex_t)); \ - if ((__rv=pthread_mutex_init(mutexes[mtx], attr)) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_INIT, NULL); \ + +#define MUTEX_INITID( mtx, attr ) \ + do { \ + int __rv; \ + mutexes[mtx] = malloc(sizeof(pthread_mutex_t)); \ + if ((__rv=pthread_mutex_init(mutexes[mtx], attr)) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_INIT, NULL); \ } while (0) #define MUTEXID(mtx) mutexes[mtx] //BASIC: don't define __rv or check is_concurrent, enclosing code will do it -#define MUTEX_LOCKID_BASIC(mtx) \ - if ((__rv=pthread_mutex_lock(mutexes[mtx])) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_LOCK, NULL); - -#define MUTEX_UNLOCKID_BASIC(mtx) \ - if ((__rv=pthread_mutex_unlock(mutexes[mtx])) != 0) \ - handle_thread_error(__rv, FUNC_MUTEX_UNLOCK, NULL); - - -#define MUTEX_TRYLOCKID_BASIC(mtx, isbusy) \ - if ((isbusy=pthread_mutex_trylock(mutexes[mtx])) != 0) { \ - if (isbusy != EBUSY){ \ - handle_thread_error(isbusy, FUNC_MUTEX_TRYLOCK, NULL); \ - isbusy = 0; \ - } \ +#define MUTEX_LOCKID_BASIC(mtx) \ + if ((__rv=pthread_mutex_lock(mutexes[mtx])) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_LOCK, NULL); + +#define MUTEX_UNLOCKID_BASIC(mtx) \ + if ((__rv=pthread_mutex_unlock(mutexes[mtx])) != 0) \ + handle_thread_error(__rv, FUNC_MUTEX_UNLOCK, NULL); + + +#define MUTEX_TRYLOCKID_BASIC(mtx, isbusy) \ + if ((isbusy=pthread_mutex_trylock(mutexes[mtx])) != 0) { \ + if (isbusy != EBUSY){ \ + handle_thread_error(isbusy, FUNC_MUTEX_TRYLOCK, NULL); \ + isbusy = 0; \ + } \ } - + // AWLAYS: Always lock the mutex, don't check is_concurrent -#define MUTEX_LOCKID_ALWAYS(mtx) \ - do { \ - int __rv; \ - MUTEX_LOCKID_BASIC(mtx) \ +#define MUTEX_LOCKID_ALWAYS(mtx) \ + do { \ + int __rv; \ + MUTEX_LOCKID_BASIC(mtx) \ } while (0) -#define MUTEX_UNLOCKID_ALWAYS(mtx) \ - do { \ - int __rv; \ - MUTEX_UNLOCKID_BASIC(mtx); \ +#define MUTEX_UNLOCKID_ALWAYS(mtx) \ + do { \ + int __rv; \ + MUTEX_UNLOCKID_BASIC(mtx); \ } while (0) #define MUTEX_LOCKID(mtx) do if ( is_concurrent ) MUTEX_LOCKID_ALWAYS(mtx); while (0) #define MUTEX_UNLOCKID(mtx) do if ( is_concurrent ) MUTEX_UNLOCKID_ALWAYS(mtx); while (0) -#define MUTEX_TRYLOCKID(mtx, isbusy) \ - do \ - if (is_concurrent) { \ - MUTEX_TRYLOCKID_BASIC(mtx, isbusy) \ - } else isbusy = 0; \ +#define MUTEX_TRYLOCKID(mtx, isbusy) \ + do \ + if (is_concurrent) { \ + MUTEX_TRYLOCKID_BASIC(mtx, isbusy) \ + } else isbusy = 0; \ while (0) #define INC_LOCKID(x, mtx) do {MUTEX_LOCKID(mtx); x++; MUTEX_UNLOCKID(mtx);} while (0) #define DEC_LOCKID(x, mtx) do {MUTEX_LOCKID(mtx); x--; MUTEX_UNLOCKID(mtx);} while (0) -#define INC_NARTHREADS_CONTROLLED_BASIC \ - MUTEX_LOCKID_BASIC(MTX_THREADCONTROL); \ - MUTEX_LOCKID_BASIC(MTX_NARTHREADS); \ - NARthreads++; \ - MUTEX_UNLOCKID_BASIC(MTX_NARTHREADS); \ - MUTEX_UNLOCKID_BASIC(MTX_THREADCONTROL); - -#define INC_NARTHREADS_CONTROLLED_ALWAYS \ - do { \ - int __rv; \ - INC_NARTHREADS_CONTROLLED_BASIC; \ +#define INC_NARTHREADS_CONTROLLED_BASIC \ + MUTEX_LOCKID_BASIC(MTX_THREADCONTROL); \ + MUTEX_LOCKID_BASIC(MTX_NARTHREADS); \ + NARthreads++; \ + MUTEX_UNLOCKID_BASIC(MTX_NARTHREADS); \ + MUTEX_UNLOCKID_BASIC(MTX_THREADCONTROL); + +#define INC_NARTHREADS_CONTROLLED_ALWAYS \ + do { \ + int __rv; \ + INC_NARTHREADS_CONTROLLED_BASIC; \ } while (0) - -#define INC_NARTHREADS_CONTROLLED \ - do \ - if (is_concurrent) { \ - int __rv; \ - INC_NARTHREADS_CONTROLLED_BASIC; \ - } \ - else \ - NARthreads++; \ + +#define INC_NARTHREADS_CONTROLLED \ + do \ + if (is_concurrent) { \ + int __rv; \ + INC_NARTHREADS_CONTROLLED_BASIC; \ + } \ + else \ + NARthreads++; \ while (0) -#define DEC_NARTHREADS_BASIC \ - MUTEX_LOCKID_BASIC(MTX_NARTHREADS); \ - NARthreads--; \ - MUTEX_UNLOCKID_BASIC(MTX_NARTHREADS); +#define DEC_NARTHREADS_BASIC \ + MUTEX_LOCKID_BASIC(MTX_NARTHREADS); \ + NARthreads--; \ + MUTEX_UNLOCKID_BASIC(MTX_NARTHREADS); -#define DEC_NARTHREADS_ALWAYS \ - do { \ - int __rv; \ - DEC_NARTHREADS_BASIC; \ +#define DEC_NARTHREADS_ALWAYS \ + do { \ + int __rv; \ + DEC_NARTHREADS_BASIC; \ } while (0) - - -#define DEC_NARTHREADS \ - do { \ - if (is_concurrent) { \ - int __rv; \ - DEC_NARTHREADS_BASIC; \ - } \ - else \ - NARthreads--; \ + + +#define DEC_NARTHREADS \ + do { \ + if (is_concurrent) { \ + int __rv; \ + DEC_NARTHREADS_BASIC; \ + } \ + else \ + NARthreads--; \ } while (0) -#define MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx) \ - do { \ - int __rv; \ - MUTEX_TRYLOCKID_BASIC(mtx, __rv); \ - if (__rv==EBUSY){ \ - DEC_NARTHREADS_BASIC; \ - MUTEX_LOCKID_BASIC(mtx); \ - INC_NARTHREADS_CONTROLLED_BASIC; \ - } \ +#define MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx) \ + do { \ + int __rv; \ + MUTEX_TRYLOCKID_BASIC(mtx, __rv); \ + if (__rv==EBUSY){ \ + DEC_NARTHREADS_BASIC; \ + MUTEX_LOCKID_BASIC(mtx); \ + INC_NARTHREADS_CONTROLLED_BASIC; \ + } \ } while (0) - -#define MUTEX_LOCKID_CONTROLLED(mtx) \ - do \ - if (is_concurrent) \ - MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx); \ + +#define MUTEX_LOCKID_CONTROLLED(mtx) \ + do \ + if (is_concurrent) \ + MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx); \ while (0) -#define MUTEX_LOCK_CONTROLLED(mtx, msg) \ - do { \ - if (is_concurrent) { \ - MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx) \ - int __rv; \ - MUTEX_TRYLOCK(mtx, __rv, msg); \ - if (__rv==EBUSY){ \ - DEC_NARTHREADS_BASIC; \ - MUTEX_LOCK(mtx, msg); \ - INC_NARTHREADS_CONTROLLED_BASIC; \ - } \ - } \ +#define MUTEX_LOCK_CONTROLLED(mtx, msg) \ + do { \ + if (is_concurrent) { \ + MUTEX_LOCKID_CONTROLLED_ALWAYS(mtx) \ + int __rv; \ + MUTEX_TRYLOCK(mtx, __rv, msg); \ + if (__rv==EBUSY){ \ + DEC_NARTHREADS_BASIC; \ + MUTEX_LOCK(mtx, msg); \ + INC_NARTHREADS_CONTROLLED_BASIC; \ + } \ + } \ } while (0) /********** block macros *************/ @@ -1606,26 +1606,26 @@ MUTEX_TRYLOCKID(bp->mutexid, isbusy) -#define C_PUT_PROTECTED(L, v) \ - do { \ - MUTEX_LOCKBLK(BlkD(L, List)); \ - c_put(&L, &v); MUTEX_UNLOCKBLK(BlkD(L, List)); \ +#define C_PUT_PROTECTED(L, v) \ + do { \ + MUTEX_LOCKBLK(BlkD(L, List)); \ + c_put(&L, &v); MUTEX_UNLOCKBLK(BlkD(L, List)); \ } while (0) -#define MUTEX_INITBLK(bp) \ - do { \ - if (!bp->shared){ \ - bp->mutexid = get_mutex(&rmtx_attr); \ - bp->shared = 1; \ - } \ +#define MUTEX_INITBLK(bp) \ + do { \ + if (!bp->shared){ \ + bp->mutexid = get_mutex(&rmtx_attr); \ + bp->shared = 1; \ + } \ } while (0) -#define MUTEX_INITBLKID(bp, mtx) \ - do { \ - if (!bp->shared){ \ - bp->mutexid = mtx; \ - bp->shared = 1; \ - } \ +#define MUTEX_INITBLKID(bp, mtx) \ + do { \ + if (!bp->shared){ \ + bp->mutexid = mtx; \ + bp->shared = 1; \ + } \ } while (0) #define MUTEX_GETBLK(bp) mutexes[bp->mutexid] @@ -1633,34 +1633,34 @@ #define CV_GETULLTBLK(bp) condvars[bp->cvfull] #define CV_GETULLTBLK(bp) condvars[bp->cvfull] -#define CV_INITBLK(bp) \ - do { \ - MUTEX_INITBLK(bp); \ - bp->cvfull = get_cv(bp->mutexid); \ - bp->cvempty = get_cv(bp->mutexid); \ - bp->full = 0; \ - bp->empty = 0; \ - bp->max = 1024; \ +#define CV_INITBLK(bp) \ + do { \ + MUTEX_INITBLK(bp); \ + bp->cvfull = get_cv(bp->mutexid); \ + bp->cvempty = get_cv(bp->mutexid); \ + bp->full = 0; \ + bp->empty = 0; \ + bp->max = 1024; \ } while (0) -#define CV_WAIT_ON_EXPR(expr, cv, mtxid) \ +#define CV_WAIT_ON_EXPR(expr, cv, mtxid) \ while (expr) pthread_cond_wait(cv, MUTEXID(mtxid)); -#define CV_WAIT(cv, mtxid) \ - do { \ - int __rv; \ - if ((__rv=pthread_cond_wait(cv, MUTEXID(mtxid)))<0 ){ \ - fprintf(stderr, "condition variable wait failure %d\n", __rv); \ - exit(-1); \ - } \ +#define CV_WAIT(cv, mtxid) \ + do { \ + int __rv; \ + if ((__rv=pthread_cond_wait(cv, MUTEXID(mtxid)))<0 ){ \ + fprintf(stderr, "condition variable wait failure %d\n", __rv); \ + exit(-1); \ + } \ } while (0) -#define CV_INIT(cv, msg) \ - do{ \ - int __rv; \ - if ((__rv=pthread_cond_init(cv, NULL))<0 ){ \ - handle_thread_error(__rv, FUNC_COND_INIT, msg); \ - } \ +#define CV_INIT(cv, msg) \ + do{ \ + int __rv; \ + if ((__rv=pthread_cond_init(cv, NULL))<0 ){ \ + handle_thread_error(__rv, FUNC_COND_INIT, msg); \ + } \ } while (0) #define CV_WAIT_FULLBLK(bp) \ @@ -1687,7 +1687,7 @@ RESUME_THREADS(); \ } while(0) -#else /* Concurrent */ +#else /* Concurrent */ #define MUTEX_INIT(mtx, attr) #define MUTEX_INITID(mtx, attr) @@ -1711,7 +1711,7 @@ #define DEC_NARTHREADS #define INC_NARTHREADS_CONTROLLED_ALWAYS #define DEC_NARTHREADS_CONTROLLED_ALWAYS - + #define MUTEX_INITBLK(bp) #define MUTEX_INITBLKID(bp, mtx) #define MUTEX_LOCKBLK(bp, msg) @@ -1751,25 +1751,25 @@ #define MUTEX_TRYLOCKBLK_NOCHK(bp, isbusy, msg) -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef LargeInts /* determine the number of words needed for a bignum block with n digits */ #define LrgNeed(n) ( ((sizeof(struct b_bignum) + ((n) - 1) * sizeof(DIGIT)) \ - + WordSize - 1) & -WordSize ) -#endif /* LargeInts */ + + WordSize - 1) & -WordSize ) +#endif /* LargeInts */ -#define PRINT_TEXTURE_INFO(wt, msg) \ +#define PRINT_TEXTURE_INFO(wt, msg) \ do {\ printf("%s\n", msg); \ - printf("refcount = %d", (wt)->refcount); \ - printf("\ttexName = %d", (wt)->texName); \ - printf("\ttextype = %d", (wt)->textype); \ - printf("\tserial = %d", (wt)->serial); \ - printf("\twidth = %d", (wt)->width); \ - printf("\theight = %d\n", (wt)->height); \ + printf("refcount = %d", (wt)->refcount); \ + printf("\ttexName = %d", (wt)->texName); \ + printf("\ttextype = %d", (wt)->textype); \ + printf("\tserial = %d", (wt)->serial); \ + printf("\twidth = %d", (wt)->width); \ + printf("\theight = %d\n", (wt)->height); \ } while (0) @@ -1794,14 +1794,14 @@ #define public_stringregion (curpstate->Public_stringregion) #define public_blockregion (curpstate->Public_blockregion) #endif /* ConcurrentCOMPILER */ - #define strtotal (curtstate->stringtotal) - #define blktotal (curtstate->blocktotal) -#else /* Concurrent */ + #define strtotal (curtstate->stringtotal) + #define blktotal (curtstate->blocktotal) +#else /* Concurrent */ #ifdef MultiProgram #define strtotal (curpstate->stringtotal) #define blktotal (curpstate->blocktotal) -#endif /* MultiProgram */ -#endif /* Concurrent */ +#endif /* MultiProgram */ +#endif /* Concurrent */ /* * Rationale for new pattern (element) codes. @@ -1972,35 +1972,35 @@ */ /* pattern function and operator names. subscripts into patimg(). */ -#define PF_Any 0 -#define PF_Break 1 -#define PF_BreakX 2 -#define PF_NotAny 3 -#define PF_NSpan 4 -#define PF_Span 5 -#define PF_Len 6 -#define PF_RPos 7 -#define PF_Pos 8 -#define PF_RTab 9 -#define PF_Tab 10 -#define PF_Arbno 11 +#define PF_Any 0 +#define PF_Break 1 +#define PF_BreakX 2 +#define PF_NotAny 3 +#define PF_NSpan 4 +#define PF_Span 5 +#define PF_Len 6 +#define PF_RPos 7 +#define PF_Pos 8 +#define PF_RTab 9 +#define PF_Tab 10 +#define PF_Arbno 11 /* pattern image codes. parameters e.g. to get_patimage(). */ -#define PI_EMPTY 12 -#define PI_FPAREN 13 -#define PI_BPAREN 14 +#define PI_EMPTY 12 +#define PI_FPAREN 13 +#define PI_BPAREN 14 #define PI_FBRACE 15 #define PI_BBRACE 16 -#define PI_BQUOTE 17 -#define PI_QUOTE 18 -#define PI_SQUOTE 19 -#define PI_COMMA 20 -#define PI_PERIOD 21 -#define PI_CONCAT 22 -#define PI_ALT 23 -#define PI_ONM 24 -#define PI_IMM 25 -#define PI_SETCUR 26 -#define NUM_PATIMGS 27 +#define PI_BQUOTE 17 +#define PI_QUOTE 18 +#define PI_SQUOTE 19 +#define PI_COMMA 20 +#define PI_PERIOD 21 +#define PI_CONCAT 22 +#define PI_ALT 23 +#define PI_ONM 24 +#define PI_IMM 25 +#define PI_SETCUR 26 +#define NUM_PATIMGS 27 /* pattern argument-type codes. argument #2 to arg_image(). */ #define PT_MF 25 @@ -2008,28 +2008,28 @@ #define PT_VP 27 #define PT_EVAL 28 -#endif /* PatternType */ - -#define INIT_ADDRINFO_HINTS(_hints, _fam, _sock, _flags, _proto) \ - do { \ - memset(&_hints, 0, sizeof(struct addrinfo)); \ - /* IPv4 or IPv6 or IP */ \ - _hints.ai_family = _fam; \ - /* 0=>Any socket */ \ - _hints.ai_socktype = _sock; \ - /* wildcard IP + canonical name */ \ - _hints.ai_flags = _flags; \ - /* 0=>Any protocol */ \ - _hints.ai_protocol = _proto; \ - _hints.ai_canonname = NULL; \ - _hints.ai_addr = NULL; \ - _hints.ai_next = NULL; \ +#endif /* PatternType */ + +#define INIT_ADDRINFO_HINTS(_hints, _fam, _sock, _flags, _proto) \ + do { \ + memset(&_hints, 0, sizeof(struct addrinfo)); \ + /* IPv4 or IPv6 or IP */ \ + _hints.ai_family = _fam; \ + /* 0=>Any socket */ \ + _hints.ai_socktype = _sock; \ + /* wildcard IP + canonical name */ \ + _hints.ai_flags = _flags; \ + /* 0=>Any protocol */ \ + _hints.ai_protocol = _proto; \ + _hints.ai_canonname = NULL; \ + _hints.ai_addr = NULL; \ + _hints.ai_next = NULL; \ } while (0) -#define SAFE_strncpy(_dst, _src, _bufsize) \ - do { \ - strncpy(_dst, _src, _bufsize - 1); \ - _dst[_bufsize - 1] = '0'; \ +#define SAFE_strncpy(_dst, _src, _bufsize) \ + do { \ + strncpy(_dst, _src, _bufsize - 1); \ + _dst[_bufsize - 1] = '0'; \ } while (0) /* diff --git a/src/h/rproto.h b/src/h/rproto.h index e84f908b0..d47b36a71 100644 --- a/src/h/rproto.h +++ b/src/h/rproto.h @@ -5,354 +5,354 @@ /* * Prototypes common to the compiler and interpreter. */ -void EVInit (void); -int activate (dptr val, struct b_coexpr *ncp, dptr result); -word add (word a,word b,int *over_flowp); -void addmem (struct b_set *ps,struct b_selem *pe, union block **pl); -struct astkblk *alcactiv (void); +void EVInit (void); +int activate (dptr val, struct b_coexpr *ncp, dptr result); +word add (word a,word b,int *over_flowp); +void addmem (struct b_set *ps,struct b_selem *pe, union block **pl); +struct astkblk *alcactiv (void); #ifdef MultiProgram -struct b_cset *alccset_0 (void); -struct b_cset *alccset_1 (void); +struct b_cset *alccset_0 (void); +struct b_cset *alccset_1 (void); #undef alcfile -struct b_file *alcfile (FILE *fd,int status,dptr name); +struct b_file *alcfile (FILE *fd,int status,dptr name); #define alcfile (curpstate->Alcfile) -struct b_file *alcfile_1 (FILE *fd,int status,dptr name); -union block *alchash_0 (int tcode); -union block *alchash_1 (int tcode); -struct b_slots *alcsegment_0 (word nslots); -struct b_slots *alcsegment_1 (word nslots); +struct b_file *alcfile_1 (FILE *fd,int status,dptr name); +union block *alchash_0 (int tcode); +union block *alchash_1 (int tcode); +struct b_slots *alcsegment_0 (word nslots); +struct b_slots *alcsegment_1 (word nslots); #undef alclist_raw -struct b_list *alclist_raw (uword size, uword nslots); +struct b_list *alclist_raw (uword size, uword nslots); #define alclist_raw (curpstate->Alclist_raw) -struct b_list *alclist_raw_1 (uword size, uword nslots); -struct b_list *alclist_0 (uword size, uword nslots); -struct b_list *alclist_1 (uword size, uword nslots); -struct b_lelem *alclstb_0 (uword nslots,uword first,uword nused); -struct b_lelem *alclstb_1 (uword nslots,uword first,uword nused); +struct b_list *alclist_raw_1 (uword size, uword nslots); +struct b_list *alclist_0 (uword size, uword nslots); +struct b_list *alclist_1 (uword size, uword nslots); +struct b_lelem *alclstb_0 (uword nslots,uword first,uword nused); +struct b_lelem *alclstb_1 (uword nslots,uword first,uword nused); #undef alcreal -struct b_real *alcreal (double val); +struct b_real *alcreal (double val); #define alcreal (curpstate->Alcreal) -struct b_real *alcreal_1 (double val); -struct b_selem *alcselem_0 (dptr mbr,uword hn); -struct b_selem *alcselem_1 (dptr mbr,uword hn); +struct b_real *alcreal_1 (double val); +struct b_selem *alcselem_0 (dptr mbr,uword hn); +struct b_selem *alcselem_1 (dptr mbr,uword hn); #undef alcstr -char *alcstr (char *s,word slen); +char *alcstr (char *s,word slen); #define alcstr (curpstate->Alcstr) -char *alcstr_1 (char *s,word slen); -struct b_telem *alctelem_0 (void); -struct b_telem *alctelem_1 (void); -struct b_tvtbl *alctvtbl_0 (dptr tbl,dptr ref,uword hashnum); -struct b_tvtbl *alctvtbl_1 (dptr tbl,dptr ref,uword hashnum); -struct b_tvmonitored *alctvmonitored (dptr tv, word ipc_in); +char *alcstr_1 (char *s,word slen); +struct b_telem *alctelem_0 (void); +struct b_telem *alctelem_1 (void); +struct b_tvtbl *alctvtbl_0 (dptr tbl,dptr ref,uword hashnum); +struct b_tvtbl *alctvtbl_1 (dptr tbl,dptr ref,uword hashnum); +struct b_tvmonitored *alctvmonitored (dptr tv, word ipc_in); void assign_event_functions(struct progstate *p, struct descrip cs); int invaluemask(struct progstate *p, int evcode, struct descrip *val); #ifdef PatternType -struct b_pattern *alcpattern_0 (word size); -struct b_pattern *alcpattern_1 (word size); +struct b_pattern *alcpattern_0 (word size); +struct b_pattern *alcpattern_1 (word size); #if COMPILER -struct b_pelem *alcpelem_0 (word); -struct b_pelem *alcpelem_1 (word); -#else /* COMPILER */ -struct b_pelem *alcpelem_0 (word, word *); -struct b_pelem *alcpelem_1 (word, word *); -#endif /* COMPILER */ -#endif /* PatternType */ -#else /* MultiProgram */ -struct b_cset *alccset (void); -struct b_file *alcfile (FILE *fd,int status,dptr name); -union block *alchash (int tcode); -struct b_slots *alcsegment (word nslots); -struct b_list *alclist_raw (uword size, uword nslots); -struct b_list *alclist (uword size, uword nslots); -struct b_lelem *alclstb (uword nslots,uword first,uword nused); -struct b_real *alcreal (double val); -struct b_selem *alcselem (dptr mbr,uword hn); -char *alcstr (char *s,word slen); -struct b_telem *alctelem (void); -struct b_tvtbl *alctvtbl (dptr tbl,dptr ref,uword hashnum); +struct b_pelem *alcpelem_0 (word); +struct b_pelem *alcpelem_1 (word); +#else /* COMPILER */ +struct b_pelem *alcpelem_0 (word, word *); +struct b_pelem *alcpelem_1 (word, word *); +#endif /* COMPILER */ +#endif /* PatternType */ +#else /* MultiProgram */ +struct b_cset *alccset (void); +struct b_file *alcfile (FILE *fd,int status,dptr name); +union block *alchash (int tcode); +struct b_slots *alcsegment (word nslots); +struct b_list *alclist_raw (uword size, uword nslots); +struct b_list *alclist (uword size, uword nslots); +struct b_lelem *alclstb (uword nslots,uword first,uword nused); +struct b_real *alcreal (double val); +struct b_selem *alcselem (dptr mbr,uword hn); +char *alcstr (char *s,word slen); +struct b_telem *alctelem (void); +struct b_tvtbl *alctvtbl (dptr tbl,dptr ref,uword hashnum); #ifdef PatternType -struct b_pattern *alcpattern (word size); +struct b_pattern *alcpattern (word size); #if COMPILER -struct b_pelem *alcpelem(word pattern_code); -#else /* COMPILER */ -struct b_pelem *alcpelem(word pattern_code, word *origin_ipc); -#endif /* COMPILER */ -#endif /* PatternType */ -#endif /* MultiProgram */ +struct b_pelem *alcpelem(word pattern_code); +#else /* COMPILER */ +struct b_pelem *alcpelem(word pattern_code, word *origin_ipc); +#endif /* COMPILER */ +#endif /* PatternType */ +#endif /* MultiProgram */ #ifdef Arrays -struct b_list *alclisthdr (uword size, union block *bptr); -#endif /* Arrays */ +struct b_list *alclisthdr (uword size, union block *bptr); +#endif /* Arrays */ -char *alc_strerror (int); -void set_errortext (int i); -void set_syserrortext(int ern); +char *alc_strerror (int); +void set_errortext (int i); +void set_syserrortext(int ern); #if HAVE_LIBZ -void set_gzerrortext(gzFile f); -#endif /* HAVE_LIBZ */ +void set_gzerrortext(gzFile f); +#endif /* HAVE_LIBZ */ -struct b_cons *alccons (union block *); +struct b_cons *alccons (union block *); -int anycmp (dptr dp1,dptr dp2); -int anycmpBase (dptr dp1,dptr dp2,int sortType); +int anycmp (dptr dp1,dptr dp2); +int anycmpBase (dptr dp1,dptr dp2,int sortType); #ifdef Arrays -int arraytolist (struct descrip *arr); -int cplist2realarray(dptr dp, dptr dp2, word i, word j, - word skipcopyelements); -#endif /* Arrays */ -int bfunc (void); -struct b_proc *bi_strprc (dptr s, C_integer arity); +int arraytolist (struct descrip *arr); +int cplist2realarray(dptr dp, dptr dp2, word i, word j, + word skipcopyelements); +#endif /* Arrays */ +int bfunc (void); +struct b_proc *bi_strprc (dptr s, C_integer arity); #if __clang__ || __GNUC__ /* Stop clang and gcc from warning "control may reach end of non-void function" when calling this function */ -void c_exit (int i) __attribute__ ((noreturn,nothrow)); +void c_exit (int i) __attribute__ ((noreturn,nothrow)); #else -void c_exit (int i); +void c_exit (int i); #endif /* __clang__ */ -int c_get (struct b_list *hp, struct descrip *res); -void c_put (struct descrip *l, struct descrip *val); -int c_inserttable (union block **pbp, int n, dptr x); -int c_insertset (union block **pps, dptr pd); -int CmdParamToArgv (char *s, char ***avp, int dequote); -int cnv_c_dbl (dptr s, double *d); -int cnv_c_int (dptr s, C_integer *d); -int cnv_c_str (dptr s, dptr d); +int c_get (struct b_list *hp, struct descrip *res); +void c_put (struct descrip *l, struct descrip *val); +int c_inserttable (union block **pbp, int n, dptr x); +int c_insertset (union block **pps, dptr pd); +int CmdParamToArgv (char *s, char ***avp, int dequote); +int cnv_c_dbl (dptr s, double *d); +int cnv_c_int (dptr s, C_integer *d); +int cnv_c_str (dptr s, dptr d); #ifdef MultiProgram -int cnv_cset_0 (dptr s, dptr d); -int cnv_cset_1 (dptr s, dptr d); +int cnv_cset_0 (dptr s, dptr d); +int cnv_cset_1 (dptr s, dptr d); #else -int cnv_cset (dptr s, dptr d); -#endif /* MultiProgram */ -int cnv_ec_int (dptr s, C_integer *d); -int cnv_eint (dptr s, dptr d); -int cnv_list (dptr s, dptr d); +int cnv_cset (dptr s, dptr d); +#endif /* MultiProgram */ +int cnv_ec_int (dptr s, C_integer *d); +int cnv_eint (dptr s, dptr d); +int cnv_list (dptr s, dptr d); #ifdef MultiProgram #undef cnv_int -int cnv_int (dptr s, dptr d); +int cnv_int (dptr s, dptr d); #define cnv_int (curpstate->Cnvint) -int cnv_int_1 (dptr s, dptr d); +int cnv_int_1 (dptr s, dptr d); #undef cnv_real -int cnv_real (dptr s, dptr d); +int cnv_real (dptr s, dptr d); #define cnv_real (curpstate->Cnvreal) -int cnv_real_1 (dptr s, dptr d); +int cnv_real_1 (dptr s, dptr d); #undef cnv_str -int cnv_str (dptr s, dptr d); +int cnv_str (dptr s, dptr d); #define cnv_str (curpstate->Cnvstr) -int cnv_str_1 (dptr s, dptr d); -int cnv_tcset_0 (struct b_cset *cbuf, dptr s, dptr d); -int cnv_tcset_1 (struct b_cset *cbuf, dptr s, dptr d); -int cnv_tstr_0 (char *sbuf, dptr s, dptr d); -int cnv_tstr_1 (char *sbuf, dptr s, dptr d); -#else /* MultiProgram */ -int cnv_int (dptr s, dptr d); -int cnv_real (dptr s, dptr d); -int cnv_str (dptr s, dptr d); -int cnv_tcset (struct b_cset *cbuf, dptr s, dptr d); -int cnv_tstr (char *sbuf, dptr s, dptr d); -#endif /* MultiProgram */ +int cnv_str_1 (dptr s, dptr d); +int cnv_tcset_0 (struct b_cset *cbuf, dptr s, dptr d); +int cnv_tcset_1 (struct b_cset *cbuf, dptr s, dptr d); +int cnv_tstr_0 (char *sbuf, dptr s, dptr d); +int cnv_tstr_1 (char *sbuf, dptr s, dptr d); +#else /* MultiProgram */ +int cnv_int (dptr s, dptr d); +int cnv_real (dptr s, dptr d); +int cnv_str (dptr s, dptr d); +int cnv_tcset (struct b_cset *cbuf, dptr s, dptr d); +int cnv_tstr (char *sbuf, dptr s, dptr d); +#endif /* MultiProgram */ #ifdef PatternType struct b_pelem * Alternate(struct b_pelem * L,struct b_pelem * R); struct b_pelem * Arbno_Simple(struct b_pelem *pe); struct b_pelem *Bracket(struct b_pelem *E,struct b_pelem * P, - struct b_pelem * A); + struct b_pelem * A); #ifdef MultiProgram -int cnv_pattern_0(dptr s, dptr p); -int cnv_pattern_1(dptr s, dptr p); -#else /* MultiProgram */ -int cnv_pattern(dptr s, dptr p); -#endif /* MultiProgram */ -struct b_pelem *Concat (struct b_pelem * L, struct b_pelem *R, int Incr ); -struct b_pelem *Copy (struct b_pelem * P); +int cnv_pattern_0(dptr s, dptr p); +int cnv_pattern_1(dptr s, dptr p); +#else /* MultiProgram */ +int cnv_pattern(dptr s, dptr p); +#endif /* MultiProgram */ +struct b_pelem *Concat (struct b_pelem * L, struct b_pelem *R, int Incr ); +struct b_pelem *Copy (struct b_pelem * P); union block *pattern_make(int stck_size, struct b_pelem * pnext, - int pattern_code, int index, struct descrip param); + int pattern_code, int index, struct descrip param); union block *pelem_make(struct b_pelem * pnext, int pattern_code, - int index, struct descrip param); + int index, struct descrip param); -dptr bi_pat (int what); -int arg_image (struct descrip arg, int pcode, int type, - dptr result); -int construct_image (dptr left, dptr s, dptr r, dptr result); +dptr bi_pat (int what); +int arg_image (struct descrip arg, int pcode, int type, + dptr result); +int construct_image (dptr left, dptr s, dptr r, dptr result); struct b_pattern * breakx_make(struct b_pelem * B); int pattern_image(union block *pe, int prev_index, dptr result, - int peCount, int pe_index, int stop_index); -#endif /* PatternType */ -int co_chng (struct b_coexpr *ncp, struct descrip *valloc, - struct descrip *rsltloc, - int swtch_typ, int first); -void co_init (struct b_coexpr *sblkp); -void coacttrace (struct b_coexpr *ccp,struct b_coexpr *ncp); -void cofailtrace (struct b_coexpr *ccp,struct b_coexpr *ncp); -void corettrace (struct b_coexpr *ccp,struct b_coexpr *ncp); -int coswitch (word *old, word *new, int first); -int cphash (dptr dp1, dptr dp2, word n, int tcode); + int peCount, int pe_index, int stop_index); +#endif /* PatternType */ +int co_chng (struct b_coexpr *ncp, struct descrip *valloc, + struct descrip *rsltloc, + int swtch_typ, int first); +void co_init (struct b_coexpr *sblkp); +void coacttrace (struct b_coexpr *ccp,struct b_coexpr *ncp); +void cofailtrace (struct b_coexpr *ccp,struct b_coexpr *ncp); +void corettrace (struct b_coexpr *ccp,struct b_coexpr *ncp); +int coswitch (word *old, word *new, int first); +int cphash (dptr dp1, dptr dp2, word n, int tcode); #ifdef MultiProgram -int cplist_0 (dptr dp1,dptr dp2,word i,word j); -int cplist_1 (dptr dp1,dptr dp2,word i,word j); +int cplist_0 (dptr dp1,dptr dp2,word i,word j); +int cplist_1 (dptr dp1,dptr dp2,word i,word j); #ifdef Arrays -int cprealarray_0 (dptr dp1,dptr dp2,word i,word j); -int cpintarray_0 (dptr dp1,dptr dp2,word i,word j); -int cprealarray_1 (dptr dp1,dptr dp2,word i,word j); -int cpintarray_1 (dptr dp1,dptr dp2,word i,word j); +int cprealarray_0 (dptr dp1,dptr dp2,word i,word j); +int cpintarray_0 (dptr dp1,dptr dp2,word i,word j); +int cprealarray_1 (dptr dp1,dptr dp2,word i,word j); +int cpintarray_1 (dptr dp1,dptr dp2,word i,word j); struct descrip listtoarray(dptr l); -#endif /* Arrays */ -int cpset_0 (dptr dp1,dptr dp2,word size); -int cpset_1 (dptr dp1,dptr dp2,word size); -int cptable_0 (dptr dp1,dptr dp2,word size); -int cptable_1 (dptr dp1,dptr dp2,word size); -void EVStrAlc_0 (word n); -void EVStrAlc_1 (word n); -#else /* MultiProgram */ -int cplist (dptr dp1,dptr dp2,word i,word j); -int cpset (dptr dp1,dptr dp2,word size); -int cptable (dptr dp1,dptr dp2,word size); +#endif /* Arrays */ +int cpset_0 (dptr dp1,dptr dp2,word size); +int cpset_1 (dptr dp1,dptr dp2,word size); +int cptable_0 (dptr dp1,dptr dp2,word size); +int cptable_1 (dptr dp1,dptr dp2,word size); +void EVStrAlc_0 (word n); +void EVStrAlc_1 (word n); +#else /* MultiProgram */ +int cplist (dptr dp1,dptr dp2,word i,word j); +int cpset (dptr dp1,dptr dp2,word size); +int cptable (dptr dp1,dptr dp2,word size); #ifdef Arrays -int cprealarray (dptr dp1,dptr dp2,word i,word j); -int cpintarray (dptr dp1,dptr dp2,word i,word j); +int cprealarray (dptr dp1,dptr dp2,word i,word j); +int cpintarray (dptr dp1,dptr dp2,word i,word j); struct descrip listtoarray(dptr l); -#endif /* Arrays */ -#endif /* MultiProgram */ -void cpslots (dptr dp1,dptr slotptr,word i, word j); -int csetcmp (unsigned int *cs1,unsigned int *cs2); -int cssize (dptr dp); -word cvpos (word pos, word len); -void datainit (void); +#endif /* Arrays */ +#endif /* MultiProgram */ +void cpslots (dptr dp1,dptr slotptr,word i, word j); +int csetcmp (unsigned int *cs1,unsigned int *cs2); +int cssize (dptr dp); +word cvpos (word pos, word len); +void datainit (void); #ifdef MultiProgram -void deallocate_0 (union block *bp); -void deallocate_1 (union block *bp); -#else /* MultiProgram */ -void deallocate (union block *bp); -#endif /* MultiProgram */ -int def_c_dbl (dptr s, double df, double * d); -int def_c_int (dptr s, C_integer df, C_integer * d); -int def_c_str (dptr s, char * df, dptr d); -int def_cset (dptr s, struct b_cset * df, dptr d); -int def_ec_int (dptr s, C_integer df, C_integer * d); -int def_eint (dptr s, C_integer df, dptr d); -int def_int (dptr s, C_integer df, dptr d); -int def_real (dptr s, double df, dptr d); -int def_str (dptr s, dptr df, dptr d); -int def_tcset (struct b_cset *cbuf,dptr s,struct b_cset *df,dptr d); -int def_tstr (char *sbuf, dptr s, dptr df, dptr d); -word div3 (word a,word b, int *over_flowp); -int doasgn (dptr dp1,dptr dp2); -int doimage (int c,int q); -int dp_pnmcmp (struct pstrnm *pne,dptr dp); -void drunerr (int n, double v); -void dumpact (struct b_coexpr *ce); -struct b_proc * dynrecord (dptr s, dptr fields, int n); -void env_int (char *name,word *variable,int non_neg, uword limit); -int equiv (dptr dp1,dptr dp2); -int err (void); -void err_msg (int n, dptr v); -void error (char *s1, char *s2); +void deallocate_0 (union block *bp); +void deallocate_1 (union block *bp); +#else /* MultiProgram */ +void deallocate (union block *bp); +#endif /* MultiProgram */ +int def_c_dbl (dptr s, double df, double * d); +int def_c_int (dptr s, C_integer df, C_integer * d); +int def_c_str (dptr s, char * df, dptr d); +int def_cset (dptr s, struct b_cset * df, dptr d); +int def_ec_int (dptr s, C_integer df, C_integer * d); +int def_eint (dptr s, C_integer df, dptr d); +int def_int (dptr s, C_integer df, dptr d); +int def_real (dptr s, double df, dptr d); +int def_str (dptr s, dptr df, dptr d); +int def_tcset (struct b_cset *cbuf,dptr s,struct b_cset *df,dptr d); +int def_tstr (char *sbuf, dptr s, dptr df, dptr d); +word div3 (word a,word b, int *over_flowp); +int doasgn (dptr dp1,dptr dp2); +int doimage (int c,int q); +int dp_pnmcmp (struct pstrnm *pne,dptr dp); +void drunerr (int n, double v); +void dumpact (struct b_coexpr *ce); +struct b_proc * dynrecord (dptr s, dptr fields, int n); +void env_int (char *name,word *variable,int non_neg, uword limit); +int equiv (dptr dp1,dptr dp2); +int err (void); +void err_msg (int n, dptr v); +void error (char *s1, char *s2); #if __clang__ || __GNUC__ /* Stop clang and gcc from warning "control may reach end of non-void function" when calling this function */ -void fatalerr (int n,dptr v) __attribute__ ((noreturn,nothrow)); +void fatalerr (int n,dptr v) __attribute__ ((noreturn,nothrow)); #else -void fatalerr (int n,dptr v); +void fatalerr (int n,dptr v); #endif /* __clang__ || __GNUC__ */ -int findcol (word *ipc_in); -char *findfile (word *ipc_in); +int findcol (word *ipc_in); +char *findfile (word *ipc_in); #ifdef MultiProgram -char *findfile_p (word *ipc_in, struct progstate *); -#endif /* MultiProgram */ -int findipc (int line); -word * findoldipc (struct b_coexpr *ce, int level); -int findline (word *ipc_in); +char *findfile_p (word *ipc_in, struct progstate *); +#endif /* MultiProgram */ +int findipc (int line); +word * findoldipc (struct b_coexpr *ce, int level); +int findline (word *ipc_in); #ifdef MultiProgram -int findline_p (word *ipc_in, struct progstate *); -#endif /* MultiProgram */ -int findloc (word *ipc_in); -int findsyntax (word *ipc_in); -int fldlookup (struct b_record *rec, const char * const fld); -void fpetrap (void); - -int getenv_r (const char *name, char *buf, size_t len); -word getrandom (void); -int getvar (char *s,dptr vp); - -int getkeyword (char *s, dptr vp); - -int get_CCompiler (char *s); -int get_num_cpu_cores(); -uword hash (dptr dp); -union block **hchain (union block *pb,uword hn); -union block *hgfirst (union block *bp, struct hgstate *state); -union block *hgnext (union block*b,struct hgstate*s,union block *e); -int hitsyntax (word *ipc_in); -union block *hmake (int tcode,word nslots,word nelem); -void icon_init (char *name, int *argcp, char *argv[]); -void iconhost (char *hostname); -int idelay (int n); +int findline_p (word *ipc_in, struct progstate *); +#endif /* MultiProgram */ +int findloc (word *ipc_in); +int findsyntax (word *ipc_in); +int fldlookup (struct b_record *rec, const char * const fld); +void fpetrap (void); + +int getenv_r (const char *name, char *buf, size_t len); +word getrandom (void); +int getvar (char *s,dptr vp); + +int getkeyword (char *s, dptr vp); + +int get_CCompiler (char *s); +int get_num_cpu_cores(); +uword hash (dptr dp); +union block **hchain (union block *pb,uword hn); +union block *hgfirst (union block *bp, struct hgstate *state); +union block *hgnext (union block*b,struct hgstate*s,union block *e); +int hitsyntax (word *ipc_in); +union block *hmake (int tcode,word nslots,word nelem); +void icon_init (char *name, int *argcp, char *argv[]); +void iconhost (char *hostname); +int idelay (int n); #ifdef MultiProgram #ifdef TSTATARG -int interp_0 (int fsig,dptr cargp, struct threadstate *curtstate); -int interp_1 (int fsig,dptr cargp, struct threadstate *curtstate); -#else /* TSTATARG */ -int interp_0 (int fsig,dptr cargp); -int interp_1 (int fsig,dptr cargp); -#endif /* TSTATARG */ -#else /* MultiProgram */ -int interp (int fsig,dptr cargp); -#endif /* MultiProgram */ +int interp_0 (int fsig,dptr cargp, struct threadstate *curtstate); +int interp_1 (int fsig,dptr cargp, struct threadstate *curtstate); +#else /* TSTATARG */ +int interp_0 (int fsig,dptr cargp); +int interp_1 (int fsig,dptr cargp); +#endif /* TSTATARG */ +#else /* MultiProgram */ +int interp (int fsig,dptr cargp); +#endif /* MultiProgram */ #ifdef PatternType #ifdef MultiProgram -int internal_match_0(char * pat_sub, int Length, int Pat_S, - struct descrip op, struct b_pelem * pattern, - int *Start, int *Stop, int initial_cursor, - int Anchored_Mode); -int internal_match_1(char * pat_sub, int Length, int Pat_S, - struct descrip op, struct b_pelem * pattern, - int *Start, int *Stop, int initial_cursor, - int Anchored_Mode); -#else /* MultiProgram */ -int internal_match (char * pat_sub, int Length, int Pat_S, - struct descrip op, struct b_pelem * pattern, - int *Start, int *Stop, int initial_cursor, - int Anchored_Mode); -#endif /* MultiProgram */ -#endif /* PatternType */ -void inttrap (void); -void irunerr (int n, C_integer v); -int iselect (int fd, int t); -int is_in_a_block_region(char *block); -int Kascii (dptr cargp); -int Kcset (dptr cargp); -int Kdigits (dptr cargp); -int Klcase (dptr cargp); -int Kletters (dptr cargp); -int Kucase (dptr cargp); -int lexcmp (dptr dp1,dptr dp2); -word longread (char *s,int width, word len,FILE *fname); +int internal_match_0(char * pat_sub, int Length, int Pat_S, + struct descrip op, struct b_pelem * pattern, + int *Start, int *Stop, int initial_cursor, + int Anchored_Mode); +int internal_match_1(char * pat_sub, int Length, int Pat_S, + struct descrip op, struct b_pelem * pattern, + int *Start, int *Stop, int initial_cursor, + int Anchored_Mode); +#else /* MultiProgram */ +int internal_match (char * pat_sub, int Length, int Pat_S, + struct descrip op, struct b_pelem * pattern, + int *Start, int *Stop, int initial_cursor, + int Anchored_Mode); +#endif /* MultiProgram */ +#endif /* PatternType */ +void inttrap (void); +void irunerr (int n, C_integer v); +int iselect (int fd, int t); +int is_in_a_block_region(char *block); +int Kascii (dptr cargp); +int Kcset (dptr cargp); +int Kdigits (dptr cargp); +int Klcase (dptr cargp); +int Kletters (dptr cargp); +int Kucase (dptr cargp); +int lexcmp (dptr dp1,dptr dp2); +word longread (char *s,int width, word len,FILE *fname); #if HAVE_LIBZ -word gzlongread (char *s,int width, word len,FILE *fd); -#endif /* HAVE_LIBZ */ +word gzlongread (char *s,int width, word len,FILE *fd); +#endif /* HAVE_LIBZ */ #ifdef FAttrib #if UNIX -char * make_mode (mode_t st_mode); -#endif /* UNIX */ +char * make_mode (mode_t st_mode); +#endif /* UNIX */ #if MSDOS -char * make_mode (unsigned short st_mode); +char * make_mode (unsigned short st_mode); #ifndef NTGCC -int strcasecmp (char *s1, char *s2); -int strncasecmp (char *s1, char *s2, int n); -#endif /* NTGCC */ -#endif /* MSDOS */ -#endif /* FAttrib */ -union block **memb (union block *pb,dptr x,uword hn, int *res); -void mksubs (dptr var,dptr val,word i,word j, dptr result); -word mod3 (word a,word b, int *over_flowp); -word mul (word a,word b, int *over_flowp); -word neg (word a, int *over_flowp); -void new_context (int fsig, dptr cargp); /* w/o CoExpr: a stub*/ -int numcmp (dptr dp1,dptr dp2,dptr dp3); -void openlog (char *p); -void outimage (FILE *f,dptr dp,int noimage); +int strcasecmp (char *s1, char *s2); +int strncasecmp (char *s1, char *s2, int n); +#endif /* NTGCC */ +#endif /* MSDOS */ +#endif /* FAttrib */ +union block **memb (union block *pb,dptr x,uword hn, int *res); +void mksubs (dptr var,dptr val,word i,word j, dptr result); +word mod3 (word a,word b, int *over_flowp); +word mul (word a,word b, int *over_flowp); +word neg (word a, int *over_flowp); +void new_context (int fsig, dptr cargp); /* w/o CoExpr: a stub*/ +int numcmp (dptr dp1,dptr dp2,dptr dp3); +void openlog (char *p); +void outimage (FILE *f,dptr dp,int noimage); #ifdef PatternType -union block *pattern_make_pelem (int stck_size, struct b_pelem * pe); -#endif /* PatternType */ -struct b_coexpr *popact (struct b_coexpr *ce); +union block *pattern_make_pelem (int stck_size, struct b_pelem * pe); +#endif /* PatternType */ +struct b_coexpr *popact (struct b_coexpr *ce); #if NT unsigned long long int memorysize(int); unsigned long long int physicalmemorysize(); @@ -360,22 +360,22 @@ unsigned long long int physicalmemorysize(); unsigned long memorysize(int); unsigned long physicalmemorysize(); #endif /* NT */ -word prescan (dptr d); -int pstrnmcmp (struct pstrnm *a,struct pstrnm *b); +word prescan (dptr d); +int pstrnmcmp (struct pstrnm *a,struct pstrnm *b); #ifdef PseudoPty void ptclose(struct ptstruct *ptStruct); struct ptstruct *ptopen(char *command); int ptgetstrt(char *buffer, const int bufsiz, struct ptstruct *ptStruct, - unsigned long waittime, int longread); + unsigned long waittime, int longread); int ptgetstr(char *buffer, const int bufsiz, struct ptstruct *ptStruct, - struct timeval *timeout); + struct timeval *timeout); int ptlongread(char *buffer, const int nelem, struct ptstruct *ptStruct); int ptputstr(struct ptstruct *ptStruct, char *buffer, int bufsize); int ptputc(char c, struct ptstruct *ptStruct); int ptflush(struct ptstruct *ptStruct); #ifdef MSWindows struct b_list *findactivepty(struct b_list *lps); -#endif /* MSWindows */ +#endif /* MSWindows */ /* * System pty prototypes missing from standard includes due to XOPEN_SOURCE @@ -387,86 +387,86 @@ int grantpt(int); int unlockpt(int); int posix_openpt(int); int ptsname_r(int, char *, size_t); -#endif /* PseudoPty */ -int pushact (struct b_coexpr *ce, struct b_coexpr *actvtr); -int putstr (FILE *f,dptr d); -char *qsearch (char *key, char *base, int nel, int width, - int (*cmp)()); -int qtos (dptr dp,char *sbuf); -int radix (int sign, register int r, register char *s, - register char *end_s, union numeric *result); +#endif /* PseudoPty */ +int pushact (struct b_coexpr *ce, struct b_coexpr *actvtr); +int putstr (FILE *f,dptr d); +char *qsearch (char *key, char *base, int nel, int width, + int (*cmp)()); +int qtos (dptr dp,char *sbuf); +int radix (int sign, register int r, register char *s, + register char *end_s, union numeric *result); #ifdef PatternType -struct b_pelem *ResolvePattern (struct b_pattern *pat); -#endif /* PatternType */ +struct b_pelem *ResolvePattern (struct b_pattern *pat); +#endif /* PatternType */ #ifdef MultiProgram -char *reserve_0 (int region, word nbytes); -char *reserve_1 (int region, word nbytes); -#else /* MultiProgram */ -char *reserve (int region, word nbytes); -#endif /* MultiProgram */ -void retderef (dptr valp, word *low, word *high); +char *reserve_0 (int region, word nbytes); +char *reserve_1 (int region, word nbytes); +#else /* MultiProgram */ +char *reserve (int region, word nbytes); +#endif /* MultiProgram */ +void retderef (dptr valp, word *low, word *high); #if !NT void rusage2rec(struct rusage *usg, struct descrip *dp, struct b_record **rp); -#endif /* NT */ -void segvtrap (void); -void stkdump (int); -word sub (word a,word b, int *over_flowp); +#endif /* NT */ +void segvtrap (void); +void stkdump (int); +word sub (word a,word b, int *over_flowp); #if __clang__ || __GNUC__ /* Stop clang and gcc from warning "control may reach end of non-void function" when calling this function */ -void syserr (char *s) __attribute__ ((noreturn,nothrow)); +void syserr (char *s) __attribute__ ((noreturn,nothrow)); #else -void syserr (char *s); +void syserr (char *s); #endif /* __clang__ || __GNUC__ */ -struct b_coexpr *topact (struct b_coexpr *ce); -void xmfree (void); +struct b_coexpr *topact (struct b_coexpr *ce); +void xmfree (void); #ifdef MultiProgram - void resolve (struct progstate *pstate); - struct progstate *findicode (word *opnd); - struct b_coexpr *loadicode (char *name, struct b_file *theInput, + void resolve (struct progstate *pstate); + struct progstate *findicode (word *opnd); + struct b_coexpr *loadicode (char *name, struct b_file *theInput, struct b_file *theOutput, struct b_file *theError, C_integer bs, C_integer ss, C_integer stk); void actparent (int eventcode); - void mmrefresh (void); + void mmrefresh (void); int mt_activate (dptr tvalp, dptr rslt, struct b_coexpr *ncp); struct progstate *findprogramforblock(union block *p); void EVVariable(dptr dx, int eventcode); -#else /* MultiProgram */ - void resolve (void); -#endif /* MultiProgram */ +#else /* MultiProgram */ + void resolve (void); +#endif /* MultiProgram */ #ifdef ExternalFunctions - dptr extcall (dptr x, int nargs, int *signal); -#endif /* ExternalFunctions */ + dptr extcall (dptr x, int nargs, int *signal); +#endif /* ExternalFunctions */ #ifdef LargeInts #ifdef MultiProgram - struct b_bignum *alcbignum_0 (word n); - struct b_bignum *alcbignum_1 (word n); -#else /* MultiProgram */ - struct b_bignum *alcbignum (word n); -#endif /* MultiProgram */ - word bigradix (int sign, int r, char *s, char *x, - union numeric *result); -int bigtoreal (dptr da, double *result); - int realtobig (dptr da, dptr dx); - int bigtos (dptr da, dptr dx); - void bigprint (FILE *f, dptr da); - int cpbignum (dptr da, dptr db); - int bigadd (dptr da, dptr db, dptr dx); - int bigsub (dptr da, dptr db, dptr dx); - int bigmul (dptr da, dptr db, dptr dx); - int bigdiv (dptr da, dptr db, dptr dx); - int bigmod (dptr da, dptr db, dptr dx); - int bigneg (dptr da, dptr dx); - int bigpow (dptr da, dptr db, dptr dx); - int bigpowri (double a, dptr db, dptr drslt); - int bigand (dptr da, dptr db, dptr dx); - int bigor (dptr da, dptr db, dptr dx); - int bigxor (dptr da, dptr db, dptr dx); - int bigshift (dptr da, dptr db, dptr dx); - word bigcmp (dptr da, dptr db); - int bigrand (dptr da, dptr dx); -#endif /* LargeInts */ + struct b_bignum *alcbignum_0 (word n); + struct b_bignum *alcbignum_1 (word n); +#else /* MultiProgram */ + struct b_bignum *alcbignum (word n); +#endif /* MultiProgram */ + word bigradix (int sign, int r, char *s, char *x, + union numeric *result); +int bigtoreal (dptr da, double *result); + int realtobig (dptr da, dptr dx); + int bigtos (dptr da, dptr dx); + void bigprint (FILE *f, dptr da); + int cpbignum (dptr da, dptr db); + int bigadd (dptr da, dptr db, dptr dx); + int bigsub (dptr da, dptr db, dptr dx); + int bigmul (dptr da, dptr db, dptr dx); + int bigdiv (dptr da, dptr db, dptr dx); + int bigmod (dptr da, dptr db, dptr dx); + int bigneg (dptr da, dptr dx); + int bigpow (dptr da, dptr db, dptr dx); + int bigpowri (double a, dptr db, dptr drslt); + int bigand (dptr da, dptr db, dptr dx); + int bigor (dptr da, dptr db, dptr dx); + int bigxor (dptr da, dptr db, dptr dx); + int bigshift (dptr da, dptr db, dptr dx); + word bigcmp (dptr da, dptr db); + int bigrand (dptr da, dptr dx); +#endif /* LargeInts */ int dup2(int h1, int h2); @@ -482,191 +482,191 @@ int checkOpenConsole( FILE *w, char *s ); #ifndef NTGCC int strcasecmp(char *s1, char *s2); int strncasecmp(char *s1, char *s2, int n); - #endif /* NTGCC */ - #endif /* MSDOS */ - #endif /* FAttrib */ -#endif /* MSWindows */ + #endif /* NTGCC */ + #endif /* MSDOS */ + #endif /* FAttrib */ +#endif /* MSWindows */ #if defined(Graphics) || defined(PosixFns) struct b_list *findactivewindow(struct b_list *); - char *si_i2s (siptr sip, int i); - int si_s2i (siptr sip, char *s); -#endif /* Graphics || PosixFns */ + char *si_i2s (siptr sip, int i); + int si_s2i (siptr sip, char *s); +#endif /* Graphics || PosixFns */ #ifdef Graphics /* * portable graphics routines in rwindow.r and rwinrsc.r */ - wcp alc_context (wbp w); - wbp alc_wbinding (void); - wsp alc_winstate (void); - int atobool (char *s); - void c_push (dptr l,dptr val); /* in fstruct.r */ - int docircles (wbp w, int argc, dptr argv, int fill); - void drawCurve (wbp w, XPoint *p, int n); - char *evquesub (wbp w, int i); - void genCurve (wbp w, XPoint *p, int n, void (*h)()); - void genCurve(wbp w, XPoint *p, int n, void (*helper) (wbp, XPoint [], int)); - void curveLister (wbp w, XPoint *thepoints, int n); - wsp getactivewindow (void); - int getpattern (wbp w, char *answer); - char *getselection (wbp w, char *buf); - void gotorc (wbp w,int r,int c); - void gotoxy (wbp w, int x, int y); + wcp alc_context (wbp w); + wbp alc_wbinding (void); + wsp alc_winstate (void); + int atobool (char *s); + void c_push (dptr l,dptr val); /* in fstruct.r */ + int docircles (wbp w, int argc, dptr argv, int fill); + void drawCurve (wbp w, XPoint *p, int n); + char *evquesub (wbp w, int i); + void genCurve (wbp w, XPoint *p, int n, void (*h)()); + void genCurve(wbp w, XPoint *p, int n, void (*helper) (wbp, XPoint [], int)); + void curveLister (wbp w, XPoint *thepoints, int n); + wsp getactivewindow (void); + int getpattern (wbp w, char *answer); + char *getselection (wbp w, char *buf); + void gotorc (wbp w,int r,int c); + void gotoxy (wbp w, int x, int y); struct palentry *palsetup(int p); - int palnum (dptr d); - int parsecolor (wbp w, char *s, long *r, long *g, long *b, long *a); - int parsefont (char *s, char *fam, int *sty, int *sz, int *tp); - int parsegeometry (char *buf, SHORT *x, SHORT *y, SHORT *w, SHORT *h); - int parsepattern (char *s, int len, int *w, int *nbits, C_integer *bits); - void qevent (wsp ws, dptr e, int x, int y, uword t, long f); + int palnum (dptr d); + int parsecolor (wbp w, char *s, long *r, long *g, long *b, long *a); + int parsefont (char *s, char *fam, int *sty, int *sz, int *tp); + int parsegeometry (char *buf, SHORT *x, SHORT *y, SHORT *w, SHORT *h); + int parsepattern (char *s, int len, int *w, int *nbits, C_integer *bits); + void qevent (wsp ws, dptr e, int x, int y, uword t, long f); - int readBMP (char *filename, int p, struct imgdata *imd); - int readGIF (char *fname, int p, struct imgdata *d); + int readBMP (char *filename, int p, struct imgdata *imd); + int readGIF (char *fname, int p, struct imgdata *d); int readImage (char *filename, int p, struct imgdata *imd); - int writeImage (wbp w, char *filename, int x, int y, int width, int height); - int rectargs (wbp w, int argc, dptr argv, int i, - word *px, word *py, word *pw, word *ph); - char *rgbkey (int p, double r, double g, double b); - - int setrgbmode (wbp w, char *s); - int setselection (wbp w, dptr val); - int setsize (wbp w, char *s); - int ulcmp (pointer p1, pointer p2); - int wattrib (wbp w, char *s, long len, dptr answer, char *abuf); - int wgetche (wbp w, dptr res); - int wgetchne (wbp w, dptr res); - int wgetevent (wbp w, dptr res, int t); - int wgetstrg (char *s, long maxlen, FILE *f); - void wgoto (wbp w, int row, int col); - int wlongread (char *s, int elsize, int nelem, FILE *f); - void wputstr (wbp w, char *s, int len); - int writeGIF (wbp w, char *filename, - int x, int y, int width, int height); - int writeBMP (wbp w, char *filename, - int x, int y, int width, int height); - int xyrowcol (dptr dx); + int writeImage (wbp w, char *filename, int x, int y, int width, int height); + int rectargs (wbp w, int argc, dptr argv, int i, + word *px, word *py, word *pw, word *ph); + char *rgbkey (int p, double r, double g, double b); + + int setrgbmode (wbp w, char *s); + int setselection (wbp w, dptr val); + int setsize (wbp w, char *s); + int ulcmp (pointer p1, pointer p2); + int wattrib (wbp w, char *s, long len, dptr answer, char *abuf); + int wgetche (wbp w, dptr res); + int wgetchne (wbp w, dptr res); + int wgetevent (wbp w, dptr res, int t); + int wgetstrg (char *s, long maxlen, FILE *f); + void wgoto (wbp w, int row, int col); + int wlongread (char *s, int elsize, int nelem, FILE *f); + void wputstr (wbp w, char *s, int len); + int writeGIF (wbp w, char *filename, + int x, int y, int width, int height); + int writeBMP (wbp w, char *filename, + int x, int y, int width, int height); + int xyrowcol (dptr dx); /* * graphics implementation routines supplied for each platform * (excluding those defined as macros for X-windows) */ - int SetPattern (wbp w, char *name, int len); - int SetPatternBits (wbp w, int width, C_integer *bits, int nbits); - int allowresize (wbp w, int on); - int blimage (wbp w, int x, int y, int wd, int h, - int ch, unsigned char *s, word len); + int SetPattern (wbp w, char *name, int len); + int SetPatternBits (wbp w, int width, C_integer *bits, int nbits); + int allowresize (wbp w, int on); + int blimage (wbp w, int x, int y, int wd, int h, + int ch, unsigned char *s, word len); char child_window_stuff(wbp w, wbp wp, int child_window); char child_window_generic(wbp w, wbp wp, int child_window); - wcp clone_context (wbp w); - int copyArea (wbp w,wbp w2,int x,int y,int wd,int h,int x2,int y2); - int do_config (wbp w, int status); - int dumpimage (wbp w, char *filename, unsigned int x, unsigned int y, - unsigned int width, unsigned int height); - void eraseArea (wbp w, int x, int y, int width, int height); - void fillrectangles (wbp w, XRectangle *recs, int nrecs); - void free_binding (wbp w); - void free_context (wcp wc); - void free_mutable (wbp w, int mute_index); - int free_window (wsp ws); - void freecolor (wbp w, char *s); - char *get_mutable_name (wbp w, int mute_index); - void getbg (wbp w, char *answer); - void getcanvas (wbp w, char *s); - int getdefault (wbp w, char *prog, char *opt, char *answer); - void getdisplay (wbp w, char *answer); - void getdrawop (wbp w, char *answer); - void getfg (wbp w, char *answer); - void getfntnam (wbp w, char *answer); - void geticonic (wbp w, char *answer); - int geticonpos (wbp w, char *s); - int getimstr (wbp w, int x, int y, int width, int hgt, - struct palentry *ptbl, unsigned char *data); - int getimstr24 (wbp w, int xx, int yy, int width, int hgt, - unsigned char *d); - void getlinestyle (wbp w, char *answer); - int getpixel_init (wbp w, struct imgmem *imem); - int getpixel_term (wbp w, struct imgmem *imem); - int getpixel (wbp w,int x,int y,long *rv,char *s,struct imgmem *im); - void getpointername (wbp w, char *answer); - int getpos (wbp w); - int getvisual (wbp w, char *answer); - int isetbg (wbp w, int bg); - int isetfg (wbp w, int fg); + wcp clone_context (wbp w); + int copyArea (wbp w,wbp w2,int x,int y,int wd,int h,int x2,int y2); + int do_config (wbp w, int status); + int dumpimage (wbp w, char *filename, unsigned int x, unsigned int y, + unsigned int width, unsigned int height); + void eraseArea (wbp w, int x, int y, int width, int height); + void fillrectangles (wbp w, XRectangle *recs, int nrecs); + void free_binding (wbp w); + void free_context (wcp wc); + void free_mutable (wbp w, int mute_index); + int free_window (wsp ws); + void freecolor (wbp w, char *s); + char *get_mutable_name (wbp w, int mute_index); + void getbg (wbp w, char *answer); + void getcanvas (wbp w, char *s); + int getdefault (wbp w, char *prog, char *opt, char *answer); + void getdisplay (wbp w, char *answer); + void getdrawop (wbp w, char *answer); + void getfg (wbp w, char *answer); + void getfntnam (wbp w, char *answer); + void geticonic (wbp w, char *answer); + int geticonpos (wbp w, char *s); + int getimstr (wbp w, int x, int y, int width, int hgt, + struct palentry *ptbl, unsigned char *data); + int getimstr24 (wbp w, int xx, int yy, int width, int hgt, + unsigned char *d); + void getlinestyle (wbp w, char *answer); + int getpixel_init (wbp w, struct imgmem *imem); + int getpixel_term (wbp w, struct imgmem *imem); + int getpixel (wbp w,int x,int y,long *rv,char *s,struct imgmem *im); + void getpointername (wbp w, char *answer); + int getpos (wbp w); + int getvisual (wbp w, char *answer); + int isetbg (wbp w, int bg); + int isetfg (wbp w, int fg); void linkfiletowindow(wbp w, struct b_file *fl); - int lowerWindow (wbp w); - int mutable_color (wbp w, dptr argv, int ac, int *retval); + int lowerWindow (wbp w); + int mutable_color (wbp w, dptr argv, int ac, int *retval); char my_wmap (wbp w); - int nativecolor (wbp w, char *s, long *r, long *g, long *b); + int nativecolor (wbp w, char *s, long *r, long *g, long *b); /* Exclude those functions defined as macros */ - int pollevent (void); + int pollevent (void); #ifndef MSWindows - void wflush (wbp w); + void wflush (wbp w); #endif - int query_pointer (wbp w, XPoint *pp); - int query_rootpointer (XPoint *pp); - int raiseWindow (wbp w); - int readimage (wbp w, char *filename, int x, int y, int *status); - int rebind (wbp w, wbp w2); - int set_mutable (wbp w, int i, char *s); - int setbg (wbp w, char *s); - int setcanvas (wbp w, char *s); - void setclip (wbp w); - int setcursor (wbp w, int on); - int setdisplay (wbp w, char *s); - int setdrawop (wbp w, char *val); - int setfg (wbp w, char *s); - int setfillstyle (wbp w, char *s); - int setfont (wbp w, char **s); - int setgamma (wbp w, double gamma); - int setgeometry (wbp w, char *geo); - int setheight (wbp w, SHORT new_height); - int seticonicstate (wbp w, char *s); - int seticonlabel (wbp w, char *val); - int seticonpos (wbp w, char *s); - int setimage (wbp w, char *val); - int setinputmask (wbp w, char *val); - int setleading (wbp w, int i); - int setlinestyle (wbp w, char *s); - int setlinewidth (wbp w, LONG linewid); - int setpointer (wbp w, char *val); - int setwidth (wbp w, SHORT new_width); - int setwindowlabel (wbp w, char *val); - int strimage (wbp w, int x, int y, int width, int height, - struct palentry *e, unsigned char *s, - word len, int on_icon); - void toggle_fgbg (wbp w); - int walert (wbp w, int volume); - void warpPointer (wbp w, int x, int y); - int wclose (wbp w); + int query_pointer (wbp w, XPoint *pp); + int query_rootpointer (XPoint *pp); + int raiseWindow (wbp w); + int readimage (wbp w, char *filename, int x, int y, int *status); + int rebind (wbp w, wbp w2); + int set_mutable (wbp w, int i, char *s); + int setbg (wbp w, char *s); + int setcanvas (wbp w, char *s); + void setclip (wbp w); + int setcursor (wbp w, int on); + int setdisplay (wbp w, char *s); + int setdrawop (wbp w, char *val); + int setfg (wbp w, char *s); + int setfillstyle (wbp w, char *s); + int setfont (wbp w, char **s); + int setgamma (wbp w, double gamma); + int setgeometry (wbp w, char *geo); + int setheight (wbp w, SHORT new_height); + int seticonicstate (wbp w, char *s); + int seticonlabel (wbp w, char *val); + int seticonpos (wbp w, char *s); + int setimage (wbp w, char *val); + int setinputmask (wbp w, char *val); + int setleading (wbp w, int i); + int setlinestyle (wbp w, char *s); + int setlinewidth (wbp w, LONG linewid); + int setpointer (wbp w, char *val); + int setwidth (wbp w, SHORT new_width); + int setwindowlabel (wbp w, char *val); + int strimage (wbp w, int x, int y, int width, int height, + struct palentry *e, unsigned char *s, + word len, int on_icon); + void toggle_fgbg (wbp w); + int walert (wbp w, int volume); + void warpPointer (wbp w, int x, int y); + int wclose (wbp w); #ifndef MSWindows - void wflush (wbp w); + void wflush (wbp w); #endif - int wgetq (wbp w, dptr res, int t); - FILE *wopen (char *nm, struct b_list *hp, dptr attr, int n, int *e, int is_3d, int is_gl); + int wgetq (wbp w, dptr res, int t); + FILE *wopen (char *nm, struct b_list *hp, dptr attr, int n, int *e, int is_3d, int is_gl); #ifdef Graphics3D - FILE *wopengl (char *nm, struct b_list *hp, dptr attr, int n,int *e); -#endif /* Graphics3D */ + FILE *wopengl (char *nm, struct b_list *hp, dptr attr, int n,int *e); +#endif /* Graphics3D */ - int wputc (int ci, wbp w); + int wputc (int ci, wbp w); #if HAVE_LIBPNG int writePNG(wbp w, char *filename, int x, int y, int width, int height); -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #if HAVE_LIBJPEG int writeJPEG(wbp w, char *filename, int x, int y, int width, int height); -#endif /* HAVE_LIBJPEG */ - void wsync (wbp w); - void xdis (wbp w, char *s, int n); +#endif /* HAVE_LIBJPEG */ + void wsync (wbp w); + void xdis (wbp w, char *s, int n); #ifdef ConsoleWindow - FILE* OpenConsole (void); - int Consolefprintf (FILE *file, const char *format, ...); - int Consoleputc (int c, FILE *file); - int Consolefflush (FILE *file); - #endif /* ConsoleWindow */ + FILE* OpenConsole (void); + int Consolefprintf (FILE *file, const char *format, ...); + int Consoleputc (int c, FILE *file); + int Consolefflush (FILE *file); + #endif /* ConsoleWindow */ #ifdef MacGraph /* @@ -705,55 +705,55 @@ int checkOpenConsole( FILE *w, char *s ); void drawsegments(wbinding *wb, XSegment *segs, int nsegs); void fillarcs(wbp wb, XArc *arcs, int narcs); void fillpolygon(wbp wb, XPoint *pts, int npts); - #endif /* MacGraph */ + #endif /* MacGraph */ #ifdef XWindows /* * Implementation routines specific to X-Windows */ - void unsetclip (wbp w); - void moveWindow (wbp w, int x, int y); - int moveResizeWindow (wbp w, int x, int y, int wd, int h); - int resetfg (wbp w); - int setfgrgb (wbp w, int r, int g, int b); - int setbgrgb (wbp w, int r, int g, int b); - - XColor xcolor (wbp w, LinearColor clr); - LinearColor lcolor (wbp w, XColor color); - int pixmap_open (wbp w, dptr attribs, int argc); - int pixmap_init (wbp w); - int remap (wbp w, int x, int y); - int seticonimage (wbp w, dptr dp); - void makeIcon (wbp w, int x, int y); - int translate_key_event (XKeyEvent *k1, char *s, KeySym *k2); - int handle_misc (wdp display, wbp w); - wdp alc_display (char *s); - void free_display (wdp wd); - wfp alc_font (wbp w, char **s); - wfp tryfont (wbp w, char *s); - wclrp alc_rgb (wbp w, char *s, unsigned int r, - unsigned int g, unsigned int b, - int is_iconcolor); - wclrp alc_rgb2 (wbp w, char *s, unsigned int r, - unsigned int g, unsigned int b); - wclrp alc_rgbTrueColor (wbp w,unsigned long r, - unsigned long g, unsigned long b); - int alc_centry (wdp wd); - wclrp alc_color (wbp w, char *s); - void copy_colors (wbp w1, wbp w2); - void free_xcolor (wbp w, unsigned long c); - void free_xcolors (wbp w, int extent); - int go_virtual (wbp w); - int resizePixmap (wbp w, int width, int height); - void wflushall (void); + void unsetclip (wbp w); + void moveWindow (wbp w, int x, int y); + int moveResizeWindow (wbp w, int x, int y, int wd, int h); + int resetfg (wbp w); + int setfgrgb (wbp w, int r, int g, int b); + int setbgrgb (wbp w, int r, int g, int b); + + XColor xcolor (wbp w, LinearColor clr); + LinearColor lcolor (wbp w, XColor color); + int pixmap_open (wbp w, dptr attribs, int argc); + int pixmap_init (wbp w); + int remap (wbp w, int x, int y); + int seticonimage (wbp w, dptr dp); + void makeIcon (wbp w, int x, int y); + int translate_key_event (XKeyEvent *k1, char *s, KeySym *k2); + int handle_misc (wdp display, wbp w); + wdp alc_display (char *s); + void free_display (wdp wd); + wfp alc_font (wbp w, char **s); + wfp tryfont (wbp w, char *s); + wclrp alc_rgb (wbp w, char *s, unsigned int r, + unsigned int g, unsigned int b, + int is_iconcolor); + wclrp alc_rgb2 (wbp w, char *s, unsigned int r, + unsigned int g, unsigned int b); + wclrp alc_rgbTrueColor (wbp w,unsigned long r, + unsigned long g, unsigned long b); + int alc_centry (wdp wd); + wclrp alc_color (wbp w, char *s); + void copy_colors (wbp w1, wbp w2); + void free_xcolor (wbp w, unsigned long c); + void free_xcolors (wbp w, int extent); + int go_virtual (wbp w); + int resizePixmap (wbp w, int width, int height); + void wflushall (void); void postcursor(wbp); void scrubcursor(wbp); - void mkfont (char *s, char is_3D); + void mkfont (char *s, char is_3D); #ifdef HAVE_XFT void drawstrng(wbp w, int x, int y, char *str, int slen); -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ - #endif /* XWindows */ + #endif /* XWindows */ int setglXVisual(wdp wd); @@ -763,12 +763,12 @@ int checkOpenConsole( FILE *w, char *s ); int add_3dfont(char *fname, int fsize, char ftype); int c_traverse(struct b_list *hp, struct descrip * res, int position); int cpp_drawstring3d(double x, double y, double z, char *s, char *f, - int t, int size, void *tfont); + int t, int size, void *tfont); void cube(double length, double x, double y, double z, int gen); void cylinder(double radius1, double radius2, double height, - double x, double y, double z, int slices, int rings, int gen); + double x, double y, double z, int slices, int rings, int gen); void disk(double radius1, double radius2, double angle1, double angle2, - double x, double y, double z, int slices, int rings, int gen); + double x, double y, double z, int slices, int rings, int gen); int drawpoly(wbp w, double* v, int num, int type, int dim); int drawstrng3d(wbp w, double x, double y, double z, char *s); int fileimage(wbp w, char* filename); @@ -811,25 +811,25 @@ int checkOpenConsole( FILE *w, char *s ); int setslices(wbp w, char *s); int settexcoords(wbp w, char* s); int settexmode(wbp w, char* s); - int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, - int is_init); + int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, + int is_init); void sphere(double radius, double x, double y, double z, - int slices, int rings, int gen); + int slices, int rings, int gen); wfp srch_3dfont(char *fname, int fsize, char ftype); int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2); int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height); int TexFillRect(wbp w, int texhandle, int x, int y, int width, int height, - int isfg); + int isfg); int TexDrawPoint(wbp w, int texhandle, int x, int y); int TexReadImage(wbp w, int texhandle, int x, int y,struct imgdata *imd); - int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, - int height, int xt, int yt, int width2, int height2); + int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, + int height, int xt, int yt, int width2, int height2); int copyareaTexToTex(wbp w, int texhandle, int dest_texhandle, - int x, int y, int width, int height, int xt, int yt); + int x, int y, int width, int height, int xt, int yt); int texwindow2D(wbp w, wbp w2d); int texwindow3D(wbp w1, wbp w2); void torus(double radius1, double radius2, double x,double y, double z, - int slices, int rings, int gen); + int slices, int rings, int gen); int translate(wbp w, dptr argv, int i, dptr f); int traversefunctionlist(wbp w); int create3Dlisthdr(dptr dp, char *strname, word size); @@ -845,8 +845,8 @@ int checkOpenConsole( FILE *w, char *s ); void bindtexture(wbp w, int texturehandle); void applyAutomaticTextureCoords(int enable); void applymatrix(wbp w, double a[]); - int create_display_list(wbp w, int size); - #endif /* Graphics3D */ + int create_display_list(wbp w, int size); + #endif /* Graphics3D */ #ifdef GraphicsGL /* @@ -892,11 +892,11 @@ int checkOpenConsole( FILE *w, char *s ); int drawstring2d(wbp w, struct b_record *rp); int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, int fill, int draw); - /* + /* * 2D API */ - /* + /* * Rendering functions */ int gl_blimage(wbp w, int x, int y, int width, int height, int ch, unsigned char *s, word len); @@ -927,7 +927,7 @@ int checkOpenConsole( FILE *w, char *s ); int gl_getpixel(wbp w, int x, int y, long *rv, char *s, struct imgmem *imem); char *gl_loadimage(wbp w, char *filename, unsigned int *height, unsigned int *width, int atorigin, int *is_pixmap); - /* + /* * Context functions */ void gl_getfg(wbp w, char *s); @@ -1021,35 +1021,35 @@ int checkOpenConsole( FILE *w, char *s ); FILE *gl_wopen(char *name, struct b_list *lp, dptr attrs, int n, int *err_index, int is_3d); int gl_wmap(wbp w); void gl_wsync(wbp w); - #endif /* GraphicsGL */ + #endif /* GraphicsGL */ #ifdef MSWindows - wdp alc_display (char *s); + wdp alc_display (char *s); /* * Implementation routines specific to MS Windows */ - int playmedia (wbp w, char *s); - char *nativecolordialog (wbp w,long r,long g, long b,char *s); - int nativefontdialog (wbp w, char *buf, int flags, int fheight,char*colr); - char *nativeselectdialog (wbp w,struct b_list *,char *s); - char *nativefiledialog (wbp w, char *s1, char *s2, char *s3, - char *s4, int i, int j, int k); - HFONT mkfont (char *s, char is_3D); - int sysTextWidth (wbp w, char *s, int n); - int sysFontHeight (wbp w); - int mswinsystem (char *s); - void UpdateCursorPos (wsp ws, wcp wc); - LRESULT_CALLBACK WndProc (HWND, UINT, WPARAM, LPARAM); - HDC CreateWinDC (wbp); - HDC CreatePixDC (wbp, HDC); - HBITMAP loadimage (wbp wb, char *filename, unsigned int *width, - unsigned int *height, int atorigin, int *status); + int playmedia (wbp w, char *s); + char *nativecolordialog (wbp w,long r,long g, long b,char *s); + int nativefontdialog (wbp w, char *buf, int flags, int fheight,char*colr); + char *nativeselectdialog (wbp w,struct b_list *,char *s); + char *nativefiledialog (wbp w, char *s1, char *s2, char *s3, + char *s4, int i, int j, int k); + HFONT mkfont (char *s, char is_3D); + int sysTextWidth (wbp w, char *s, int n); + int sysFontHeight (wbp w); + int mswinsystem (char *s); + void UpdateCursorPos (wsp ws, wcp wc); + LRESULT_CALLBACK WndProc (HWND, UINT, WPARAM, LPARAM); + HDC CreateWinDC (wbp); + HDC CreatePixDC (wbp, HDC); + HBITMAP loadimage (wbp wb, char *filename, unsigned int *width, + unsigned int *height, int atorigin, int *status); void wfreersc(); int getdepth(wbp w); HBITMAP CreateBitmapFromData(char *data); int resizePixmap(wbp w, int width, int height); int textWidth(wbp w, char *s, int n); - int seticonimage (wbp w, dptr dp); + int seticonimage (wbp w, dptr dp); int devicecaps(wbp w, int i); void fillarcs(wbp wb, XArc *arcs, int narcs); void drawarcs(wbp wb, XArc *arcs, int narcs); @@ -1075,7 +1075,7 @@ int checkOpenConsole( FILE *w, char *s ); void geteditregion(childcontrol *cc, dptr d); void seteditregion(childcontrol *cc, char *s2); void movechild(childcontrol *cc, - C_integer x, C_integer y, C_integer width, C_integer height); + C_integer x, C_integer y, C_integer width, C_integer height); int setchildfont(childcontrol *cc, char *fontname); void setfocusonchild(wsp ws, childcontrol *cc, int width, int height); void setchildselection(wsp ws, childcontrol *cc, int x, int y); @@ -1089,9 +1089,9 @@ int checkOpenConsole( FILE *w, char *s ); int pathOpenHandle(char *fname, char *mode); void closelog(); -#endif /* MSWindows */ +#endif /* MSWindows */ -#endif /* Graphics */ +#endif /* Graphics */ #ifdef Audio @@ -1102,79 +1102,79 @@ void audio_exit(); struct AudioFile * StartMP3Thread(char filename[]); struct AudioFile * StartWAVThread(char filename[]); struct AudioFile * StartOggVorbisThread(char filename[]); -#endif /* Audio */ +#endif /* Audio */ /* * Prototypes for the run-time system. */ -struct b_external *alcextrnl (int n); +struct b_external *alcextrnl (int n); #ifdef MultiProgram -struct b_record *alcrecd_0 (int nflds,union block *recptr); -struct b_record *alcrecd_1 (int nflds,union block *recptr); -struct b_tvsubs *alcsubs_0 (word len,word pos,dptr var); -struct b_tvsubs *alcsubs_1 (word len,word pos,dptr var); -#else /* MultiProgram */ -struct b_record *alcrecd (int nflds,union block *recptr); -struct b_tvsubs *alcsubs (word len,word pos,dptr var); -#endif /* MultiProgram */ -int bfunc (void); -dptr calliconproc (struct descrip proc, dptr args, int nargs); -long ckadd (long i, long j); -long ckmul (long i, long j); -long cksub (long i, long j); -void cmd_line (int argc, char **argv, dptr rslt); -struct b_coexpr *create (continuation fnc,struct b_proc *p,int ntmp,int wksz); -int collect (int region); +struct b_record *alcrecd_0 (int nflds,union block *recptr); +struct b_record *alcrecd_1 (int nflds,union block *recptr); +struct b_tvsubs *alcsubs_0 (word len,word pos,dptr var); +struct b_tvsubs *alcsubs_1 (word len,word pos,dptr var); +#else /* MultiProgram */ +struct b_record *alcrecd (int nflds,union block *recptr); +struct b_tvsubs *alcsubs (word len,word pos,dptr var); +#endif /* MultiProgram */ +int bfunc (void); +dptr calliconproc (struct descrip proc, dptr args, int nargs); +long ckadd (long i, long j); +long ckmul (long i, long j); +long cksub (long i, long j); +void cmd_line (int argc, char **argv, dptr rslt); +struct b_coexpr *create (continuation fnc,struct b_proc *p,int ntmp,int wksz); +int collect (int region); #ifdef CoClean void coclean(struct b_coexpr *cp); #endif -void cotrace (struct b_coexpr *ccp, struct b_coexpr *ncp, - int swtch_typ, dptr valloc); +void cotrace (struct b_coexpr *ccp, struct b_coexpr *ncp, + int swtch_typ, dptr valloc); #ifdef MultiProgram -void deref_0 (dptr dp1, dptr dp2); -void deref_1 (dptr dp1, dptr dp2); -#else /* MultiProgram */ -void deref (dptr dp1, dptr dp2); -#endif /* MultiProgram */ -void envset (void); -int eq (dptr dp1,dptr dp2); -int fixtrap (void); -int get_name (dptr dp1, dptr dp2); -int getch (void); -int getche (void); -double getdbl (dptr dp); -int getimage (dptr dp1, dptr dp2); -int getstrg (char *buf, int maxi, struct b_file *fbp); -void hgrow (union block *bp); -void hshrink (union block *bp); -C_integer iipow (C_integer n1, C_integer n2, int *over_flowp); -void init (char *name, int *argcp, char *argv[], int trc_init); -int kbhit (void); -int nthcmp (dptr d1,dptr d2); -void nxttab (C_integer *col, dptr *tablst, dptr endlst, - C_integer *last, C_integer *interval); -int order (dptr dp, int sortType); -int pathFind (char target[], char buf[], int n); -int printable (int c); -int ripow (double r, C_integer n, dptr rslt); -void rtos (double n,dptr dp,char *s); -int sig_rsm (void); -struct b_proc *strprc (dptr s, C_integer arity); -int subs_asgn (dptr dest, const dptr src); -int tvmonitored_asgn(dptr dest, const dptr src); -int trcmp3 (struct dpair *dp1,struct dpair *dp2); -int trefcmp (dptr d1,dptr d2); -int tvalcmp (dptr d1,dptr d2); -int tvcmp4 (struct dpair *dp1,struct dpair *dp2); -int tvtbl_asgn (dptr dest, const dptr src); -void varargs (dptr argp, int nargs, dptr rslt); +void deref_0 (dptr dp1, dptr dp2); +void deref_1 (dptr dp1, dptr dp2); +#else /* MultiProgram */ +void deref (dptr dp1, dptr dp2); +#endif /* MultiProgram */ +void envset (void); +int eq (dptr dp1,dptr dp2); +int fixtrap (void); +int get_name (dptr dp1, dptr dp2); +int getch (void); +int getche (void); +double getdbl (dptr dp); +int getimage (dptr dp1, dptr dp2); +int getstrg (char *buf, int maxi, struct b_file *fbp); +void hgrow (union block *bp); +void hshrink (union block *bp); +C_integer iipow (C_integer n1, C_integer n2, int *over_flowp); +void init (char *name, int *argcp, char *argv[], int trc_init); +int kbhit (void); +int nthcmp (dptr d1,dptr d2); +void nxttab (C_integer *col, dptr *tablst, dptr endlst, + C_integer *last, C_integer *interval); +int order (dptr dp, int sortType); +int pathFind (char target[], char buf[], int n); +int printable (int c); +int ripow (double r, C_integer n, dptr rslt); +void rtos (double n,dptr dp,char *s); +int sig_rsm (void); +struct b_proc *strprc (dptr s, C_integer arity); +int subs_asgn (dptr dest, const dptr src); +int tvmonitored_asgn(dptr dest, const dptr src); +int trcmp3 (struct dpair *dp1,struct dpair *dp2); +int trefcmp (dptr d1,dptr d2); +int tvalcmp (dptr d1,dptr d2); +int tvcmp4 (struct dpair *dp1,struct dpair *dp2); +int tvtbl_asgn (dptr dest, const dptr src); +void varargs (dptr argp, int nargs, dptr rslt); #ifdef MultiProgram struct b_coexpr *alccoexp (long icodesize, long stacksize); -#else /* MultiProgram */ +#else /* MultiProgram */ struct b_coexpr *alccoexp (void); -#endif /* MultiProgram */ +#endif /* MultiProgram */ dptr rec_structinate(dptr dp, char *name, int nfields, char *a[]); @@ -1183,7 +1183,7 @@ struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, int status); int Mclose(struct MFile* mf); int Mpop_delete(struct MFile* mf, unsigned int msgnum); void Mstartreading(struct MFile* mf); -#endif /* Messaging */ +#endif /* Messaging */ #ifdef PosixFns #if NT @@ -1191,98 +1191,98 @@ FILE *mstmpfile(); void closetmpfiles(); int is_internal(char *s); int StartupWinSocket(void); -void stat2rec (struct _stat *st, dptr dp, struct b_record **rp); -#else /* NT */ -void stat2rec (struct stat *st, dptr dp, struct b_record **rp); -dptr make_pwd (struct passwd *pw, dptr result); -dptr make_group (struct group *pw, dptr result); -#endif /* NT */ - -dptr rec_structor (char *s); -dptr rec_structor3d (int type); -int sock_connect (char *s, int udp, int timeout, int af_fam); -int sock_getstrg (char *buf, int maxi, dptr file); -int getmodefd (int fd, char *mode); -int getmodenam (char *path, char *mode); -int get_uid (char *name); -int get_gid (char *name); +void stat2rec (struct _stat *st, dptr dp, struct b_record **rp); +#else /* NT */ +void stat2rec (struct stat *st, dptr dp, struct b_record **rp); +dptr make_pwd (struct passwd *pw, dptr result); +dptr make_group (struct group *pw, dptr result); +#endif /* NT */ + +dptr rec_structor (char *s); +dptr rec_structor3d (int type); +int sock_connect (char *s, int udp, int timeout, int af_fam); +int sock_getstrg (char *buf, int maxi, dptr file); +int getmodefd (int fd, char *mode); +int getmodenam (char *path, char *mode); +int get_uid (char *name); +int get_gid (char *name); #if !NT -dptr make_pwd (struct passwd *pw, dptr result); -dptr make_group (struct group *pw, dptr result); -#endif /* NT */ +dptr make_pwd (struct passwd *pw, dptr result); +dptr make_group (struct group *pw, dptr result); +#endif /* NT */ -dptr make_host (struct hostent *pw, dptr result); +dptr make_host (struct hostent *pw, dptr result); #ifdef HAVE_GETADDRINFO dptr make_host_from_addrinfo(char *name, struct addrinfo *inforesult, dptr result); #endif struct addrinfo *uni_getaddrinfo(char* addr, char* p, int is_udp, int family); -void set_gaierrortext(int i); - -dptr make_serv (struct servent *pw, dptr result); -int sock_listen (char *s, int udp, int af_fam); -int sock_name (int sock, char* addr, char* addrbuf, int bufsize); -int sock_me (int sock, char* addrbuf, int bufsize); -int sock_send (char* addr, char* msg, int msglen, int af_fam); -int sock_recv (int f, struct b_record **rp); -int sock_write (int f, char *s, int n); -struct descrip register_sig (int sig, struct descrip handler); -void signal_dispatcher (int sig); -int get_fd (struct descrip, unsigned int errmask); -dptr u_read (dptr f, int n, int fstatus, dptr d); -void dup_fds (dptr d_stdin, dptr d_stdout, dptr d_stderr); -int set_if_selectable (struct descrip *f, fd_set *fdsp, int *n); -void post_if_ready (dptr ldp, dptr f, fd_set *fdsp); -#endif /* PosixFns */ +void set_gaierrortext(int i); + +dptr make_serv (struct servent *pw, dptr result); +int sock_listen (char *s, int udp, int af_fam); +int sock_name (int sock, char* addr, char* addrbuf, int bufsize); +int sock_me (int sock, char* addrbuf, int bufsize); +int sock_send (char* addr, char* msg, int msglen, int af_fam); +int sock_recv (int f, struct b_record **rp); +int sock_write (int f, char *s, int n); +struct descrip register_sig (int sig, struct descrip handler); +void signal_dispatcher (int sig); +int get_fd (struct descrip, unsigned int errmask); +dptr u_read (dptr f, int n, int fstatus, dptr d); +void dup_fds (dptr d_stdin, dptr d_stdout, dptr d_stderr); +int set_if_selectable (struct descrip *f, fd_set *fdsp, int *n); +void post_if_ready (dptr ldp, dptr f, fd_set *fdsp); +#endif /* PosixFns */ #if COMPILER - struct b_refresh *alcrefresh (int na, int nl, int nt, int wk_sz); - int apply (dptr, dptr, dptr, continuation); - void atrace (void); - void ctrace (void); - void dynrec_start_set (word); - void failtrace (void); - void initalloc (void); - int invoke (int n, dptr args, dptr rslt, continuation c); - void rtrace (void); - void strace (void); - void tracebk (struct p_frame *lcl_pfp, dptr argp, FILE *fd); - int xdisp (struct p_frame *fp, dptr dp, int n, FILE *f); - -#else /* COMPILER */ + struct b_refresh *alcrefresh (int na, int nl, int nt, int wk_sz); + int apply (dptr, dptr, dptr, continuation); + void atrace (void); + void ctrace (void); + void dynrec_start_set (word); + void failtrace (void); + void initalloc (void); + int invoke (int n, dptr args, dptr rslt, continuation c); + void rtrace (void); + void strace (void); + void tracebk (struct p_frame *lcl_pfp, dptr argp, FILE *fd); + int xdisp (struct p_frame *fp, dptr dp, int n, FILE *f); + +#else /* COMPILER */ #ifdef MultiProgram struct b_refresh *alcrefresh_0(word *e, int nl, int nt); struct b_refresh *alcrefresh_1(word *e, int nl, int nt); -#else /* MultiProgram */ - struct b_refresh *alcrefresh (word *e, int nl, int nt); -#endif /* MultiProgram */ - void atrace (dptr dp); - void ctrace (dptr dp, int nargs, dptr arg); - void failtrace (dptr dp); - int invoke (int nargs, dptr *cargs, int *n); - void rtrace (dptr dp, dptr rval); - void strace (dptr dp, dptr rval); - void tracebk (struct pf_marker *lcl_pfp, dptr argp, FILE *fd); - int xdisp (struct pf_marker *fp, dptr dp, int n, FILE *f); +#else /* MultiProgram */ + struct b_refresh *alcrefresh (word *e, int nl, int nt); +#endif /* MultiProgram */ + void atrace (dptr dp); + void ctrace (dptr dp, int nargs, dptr arg); + void failtrace (dptr dp); + int invoke (int nargs, dptr *cargs, int *n); + void rtrace (dptr dp, dptr rval); + void strace (dptr dp, dptr rval); + void tracebk (struct pf_marker *lcl_pfp, dptr argp, FILE *fd); + int xdisp (struct pf_marker *fp, dptr dp, int n, FILE *f); #define Fargs dptr cargp - int Obscan (int nargs, Fargs); - int Ocreate (word *entryp, Fargs); - int Oescan (int nargs, Fargs); - int Ofield (int nargs, Fargs); - int Omkrec (int nargs, Fargs); - int Olimit (int nargs, Fargs); - int Ollist (int nargs, Fargs); + int Obscan (int nargs, Fargs); + int Ocreate (word *entryp, Fargs); + int Oescan (int nargs, Fargs); + int Ofield (int nargs, Fargs); + int Omkrec (int nargs, Fargs); + int Olimit (int nargs, Fargs); + int Ollist (int nargs, Fargs); #ifdef MultiProgram - void initalloc (word codesize, struct progstate *p); - #else /* MultiProgram */ - void initalloc (word codesize); - #endif /* MultiProgram */ + void initalloc (word codesize, struct progstate *p); + #else /* MultiProgram */ + void initalloc (word codesize); + #endif /* MultiProgram */ -#endif /* COMPILER */ +#endif /* COMPILER */ /* dynamic records */ struct b_proc *dynrecord(dptr s, dptr fields, int n); @@ -1293,33 +1293,33 @@ int dbclose(struct ISQLFile *); int dbfetch(struct ISQLFile *, dptr); void odbcerror (struct ISQLFile *fp, int errornum); void qalloc (struct ISQLFile *f, long n); /* query space alloc */ -#endif /* ISQL */ +#endif /* ISQL */ #ifdef DebugHeap void heaperr(char *msg, union block *p, int t); -#endif /* DebugHeap */ +#endif /* DebugHeap */ #ifdef LoadFunc -int makefunc (dptr d, char *name, int (*func)()); -#endif /* LoadFunc */ +int makefunc (dptr d, char *name, int (*func)()); +#endif /* LoadFunc */ #ifdef Arrays struct b_intarray *alcintarray(uword n); struct b_realarray *alcrealarray(uword n); -#endif /* Arrays */ +#endif /* Arrays */ #ifdef PthreadCoswitch void makesem(struct b_coexpr *cp); void *nctramp(void *arg); void handle_thread_error(int val, int func, char* msg); -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ void init_threadstate(struct threadstate *ts); -#ifdef Concurrent +#ifdef Concurrent #ifndef HAVE_KEYWORD__THREAD struct threadstate *get_tstate(); -#endif /* HAVE_KEYWORD__THREAD */ +#endif /* HAVE_KEYWORD__THREAD */ void thread_control(int action); void clean_threads(); void init_threads(); @@ -1329,34 +1329,34 @@ word get_mutex( pthread_mutexattr_t *mattr); word get_cv(word mtx); #if COMPILER void init_threadheap(struct threadstate *ts, word blksiz, word strsiz); -#else /* COMPILER */ +#else /* COMPILER */ void init_threadheap(struct threadstate *ts, word blksiz, word strsiz, - struct progstate *newp); -#endif /* COMPILER */ + struct progstate *newp); +#endif /* COMPILER */ int alcce_queues(struct b_coexpr *ep); -struct region *swap2publicheap(struct region * curr_private, - struct region * curr_public, - struct region ** p_public); -#endif /* Concurrent */ +struct region *swap2publicheap(struct region * curr_private, + struct region * curr_public, + struct region ** p_public); +#endif /* Concurrent */ struct region *newregion(word nbytes,word stdsize); #ifdef MultiProgram void init_sighandlers(struct progstate *pstate); -#else /* MultiProgram */ +#else /* MultiProgram */ void init_sighandlers(); -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if UNIX && defined(HAVE_WORKING_VFORK) void push_filepid(int pid, FILE *fp, word status); -#endif /* UNIX && defined(HAVE_WORKING_VFORK */ +#endif /* UNIX && defined(HAVE_WORKING_VFORK */ #ifdef DescripAmpAllocated int bigaddi (dptr da, word i, dptr dx); int bigsubi (dptr da, word i, dptr dx); int checkTypeInt (dptr da1, dptr da2, word n ); -#endif /* DescripAmpAllocated */ +#endif /* DescripAmpAllocated */ char * getenv_var(const char *name); @@ -1370,4 +1370,4 @@ SSL_CTX* create_ssl_context(dptr attr, int n, int type); int set_ssl_connection_errortext(SSL *ssl, int err); void set_ssl_context_errortext(int err, char* errtext); void set_errortext_with_val(int i, char* errval); -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ diff --git a/src/h/rstructs.h b/src/h/rstructs.h index 0ca6cccf6..b994fb6cf 100644 --- a/src/h/rstructs.h +++ b/src/h/rstructs.h @@ -10,30 +10,30 @@ * Run-time error numbers and text. */ struct errtab { - int err_no; /* error number */ - char *errmsg; /* error message */ + int err_no; /* error number */ + char *errmsg; /* error message */ }; /* * Descriptor */ -struct descrip { /* descriptor */ - word dword; /* type field */ +struct descrip { /* descriptor */ + word dword; /* type field */ union { - word integr; /* integer value */ + word integr; /* integer value */ #ifdef DescriptorDouble double realval; -#endif /* DescriptorDouble */ - char *sptr; /* pointer to character string */ - union block *bptr; /* pointer to a block */ - dptr descptr; /* pointer to a descriptor */ +#endif /* DescriptorDouble */ + char *sptr; /* pointer to character string */ + union block *bptr; /* pointer to a block */ + dptr descptr; /* pointer to a descriptor */ } vword; }; struct sdescrip { - word length; /* length of string */ - char *string; /* pointer to string */ + word length; /* length of string */ + char *string; /* pointer to string */ }; struct si_ { @@ -52,48 +52,48 @@ struct b_proc_list { }; #ifdef LargeInts -struct b_bignum { /* large integer block */ - word title; /* T_Lrgint */ - word blksize; /* block size */ - word msd, lsd; /* most and least significant digits */ - int sign; /* sign; 0 positive, 1 negative */ - DIGIT digits[1]; /* digits */ +struct b_bignum { /* large integer block */ + word title; /* T_Lrgint */ + word blksize; /* block size */ + word msd, lsd; /* most and least significant digits */ + int sign; /* sign; 0 positive, 1 negative */ + DIGIT digits[1]; /* digits */ }; -#endif /* LargeInts */ +#endif /* LargeInts */ #ifndef DescriptorDouble -struct b_real { /* real block */ - word title; /* T_Real */ - double realval; /* value */ +struct b_real { /* real block */ + word title; /* T_Real */ + double realval; /* value */ }; -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ -struct b_cset { /* cset block */ - word title; /* T_Cset */ - word size; /* size of cset */ - unsigned int bits[CsetSize]; /* array of bits */ +struct b_cset { /* cset block */ + word title; /* T_Cset */ + word size; /* size of cset */ + unsigned int bits[CsetSize]; /* array of bits */ }; #ifdef Unicode - /* - * Unicode string block + /* + * Unicode string block */ -struct b_unistr { +struct b_unistr { word title; /* T_UniStr */ word size; /* size in unicode character units, returned by *s */ word lcidx_used; /* cache: last unicode character index used */ word lbidx_used; /* cache: last byte index used */ - char bsize; /* The number of characters in each cbindex block below, - * k=1, 2,...,32 - */ - char encoding; /* In case we go beyound UTF-8, for now this field will - * always be set to 1. 0 represents "pure" ASCII - */ + char bsize; /* The number of characters in each cbindex block below, + * k=1, 2,...,32 + */ + char encoding; /* In case we go beyound UTF-8, for now this field will + * always be set to 1. 0 represents "pure" ASCII + */ /* char ielemsize; */ /* index element size, maybe inferrable from size */ char reserved[6]; /* explicit alighnment to 8-byte */ union cbindex { /* mapping of characters to their byte indicies in sd below */ - char c[16]; /* for short strings, this in-place table will be used */ - struct sdescrip sdb /* if size>16, allocate indexes in string region */ + char c[16]; /* for short strings, this in-place table will be used */ + struct sdescrip sdb /* if size>16, allocate indexes in string region */ } u; /* @@ -102,8 +102,8 @@ struct b_unistr { struct sdescrip sd; }; - /* - * Unicode cset block + /* + * Unicode cset block */ struct b_unicset { word title; @@ -113,7 +113,7 @@ struct b_unicset { union block *cset; union block *set; }; -#endif /* Unicode */ +#endif /* Unicode */ /* * This union was pulled out of struct b_file and made non-anonymous @@ -138,21 +138,21 @@ union f { #endif /* Audio */ #ifdef PseudoPty struct ptstruct *pt; -#endif /* PseudoPty */ +#endif /* PseudoPty */ #if HAVE_LIBSSL SSL *ssl; -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ int fd; /* other int-based file descriptor */ }; -struct b_file { /* file block */ - word title; /* T_File */ +struct b_file { /* file block */ + word title; /* T_File */ union f fd; - word status; /* file status */ + word status; /* file status */ #ifdef Concurrent word mutexid; -#endif /* Concurrent */ - struct descrip fname; /* file name (string qualifier) */ +#endif /* Concurrent */ + struct descrip fname; /* file name (string qualifier) */ }; #ifdef ISQL @@ -162,12 +162,12 @@ struct b_file { /* file block */ char *query; /* SQL query buffer */ long qsize; /* SQL query buffer size */ char *tablename; - struct b_proc *proc; /* current record constructor procedure */ + struct b_proc *proc; /* current record constructor procedure */ int refcount; struct ISQLFile *previous, *next; /* links, so we can find & free these*/ }; -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Messaging struct MFile { /* messaging file abstraction */ @@ -185,194 +185,194 @@ struct Mpoplist { }; #endif /* Messaging */ -struct b_lelem { /* list-element block */ - word title; /* T_Lelem */ - word blksize; /* size of block */ - union block *listprev; /* previous list-element block */ - union block *listnext; /* next list-element block */ - word nslots; /* total number of slots */ - word first; /* index of first used slot */ - word nused; /* number of used slots */ - struct descrip lslots[1]; /* array of slots */ +struct b_lelem { /* list-element block */ + word title; /* T_Lelem */ + word blksize; /* size of block */ + union block *listprev; /* previous list-element block */ + union block *listnext; /* next list-element block */ + word nslots; /* total number of slots */ + word first; /* index of first used slot */ + word nused; /* number of used slots */ + struct descrip lslots[1]; /* array of slots */ }; -struct b_list { /* list-header block */ - word title; /* T_List */ - word size; /* current list size */ - word id; /* identification number */ +struct b_list { /* list-header block */ + word title; /* T_List */ + word size; /* current list size */ + word id; /* identification number */ #ifdef Concurrent word shared; word mutexid; word max, full, empty ; word cvfull, cvempty; -#endif /* Concurrent */ - union block *listhead; /* pointer to first list-element block */ - union block *listtail; /* pointer to last list-element block */ +#endif /* Concurrent */ + union block *listhead; /* pointer to first list-element block */ + union block *listtail; /* pointer to last list-element block */ }; struct b_intarray { - word title; /* T_Intarray */ - word blksize; /* size of block */ - union block *listp; /* pointer to the list block */ - union block *dims; /* dimension sizes, NULL for 1D */ - word a[1]; /* true array size == size, above */ + word title; /* T_Intarray */ + word blksize; /* size of block */ + union block *listp; /* pointer to the list block */ + union block *dims; /* dimension sizes, NULL for 1D */ + word a[1]; /* true array size == size, above */ }; struct b_realarray { - word title; /* T_Realarray */ - word blksize; /* size of block */ - union block *listp; /* pointer to the list block */ - union block *dims; /* dimension sizes, NULL for 1D */ - double a[1]; /* true array size == size, above */ + word title; /* T_Realarray */ + word blksize; /* size of block */ + union block *listp; /* pointer to the list block */ + union block *dims; /* dimension sizes, NULL for 1D */ + double a[1]; /* true array size == size, above */ }; -struct b_mask { /* mask block, used to access fields across blocks */ - word title; /* T_Table, T_Set, T_List or, T_Record */ - word size; /* size */ - word id; /* identification number */ +struct b_mask { /* mask block, used to access fields across blocks */ + word title; /* T_Table, T_Set, T_List or, T_Record */ + word size; /* size */ + word id; /* identification number */ #ifdef Concurrent word shared; word mutexid; -#endif /* Concurrent */ +#endif /* Concurrent */ }; -struct b_proc { /* procedure block */ - word title; /* T_Proc */ - word blksize; /* size of block */ +struct b_proc { /* procedure block */ + word title; /* T_Proc */ + word blksize; /* size of block */ #if COMPILER int (*ccode)(); - #else /* COMPILER */ - union { /* entry points for */ - int (*ccode)(); /* C routines */ - uword ioff; /* and icode as offset */ - pointer icode; /* and icode as absolute pointer */ + #else /* COMPILER */ + union { /* entry points for */ + int (*ccode)(); /* C routines */ + uword ioff; /* and icode as offset */ + pointer icode; /* and icode as absolute pointer */ } entryp; - #endif /* COMPILER */ - - word nparam; /* number of parameters */ - word ndynam; /* number of dynamic locals */ - word nstatic; /* number of static locals */ - word fstatic; /* index (in global table) of first static */ - struct descrip pname; /* procedure name (string qualifier) */ - struct descrip lnames[1]; /* list of local names (qualifiers) */ + #endif /* COMPILER */ + + word nparam; /* number of parameters */ + word ndynam; /* number of dynamic locals */ + word nstatic; /* number of static locals */ + word fstatic; /* index (in global table) of first static */ + struct descrip pname; /* procedure name (string qualifier) */ + struct descrip lnames[1]; /* list of local names (qualifiers) */ }; -struct b_record { /* record block */ - word title; /* T_Record */ - word blksize; /* size of block */ - word id; /* identification number */ +struct b_record { /* record block */ + word title; /* T_Record */ + word blksize; /* size of block */ + word id; /* identification number */ #ifdef Concurrent word shared; word mutexid; -#endif /* Concurrent */ - union block *recdesc; /* pointer to record constructor */ - struct descrip fields[1]; /* fields */ +#endif /* Concurrent */ + union block *recdesc; /* pointer to record constructor */ + struct descrip fields[1]; /* fields */ }; /* * Alternate uses for procedure block fields, applied to records. */ -#define nfields nparam /* number of fields */ -#define recnum nstatic /* record number */ -#define recid fstatic /* record serial number */ -#define recname pname /* record name */ - -struct b_selem { /* set-element block */ - word title; /* T_Selem */ - union block *clink; /* hash chain link */ - uword hashnum; /* hash number */ - struct descrip setmem; /* the element */ +#define nfields nparam /* number of fields */ +#define recnum nstatic /* record number */ +#define recid fstatic /* record serial number */ +#define recname pname /* record name */ + +struct b_selem { /* set-element block */ + word title; /* T_Selem */ + union block *clink; /* hash chain link */ + uword hashnum; /* hash number */ + struct descrip setmem; /* the element */ }; /* * A set header must be a proper prefix of a table header, * and a set element must be a proper prefix of a table element. */ -struct b_set { /* set-header block */ - word title; /* T_Set */ - word size; /* size of the set */ - word id; /* identification number */ +struct b_set { /* set-header block */ + word title; /* T_Set */ + word size; /* size of the set */ + word id; /* identification number */ #ifdef Concurrent word shared; word mutexid; -#endif /* Concurrent */ - word mask; /* mask for slot num, equals n slots - 1 */ - struct b_slots *hdir[HSegs]; /* directory of hash slot segments */ +#endif /* Concurrent */ + word mask; /* mask for slot num, equals n slots - 1 */ + struct b_slots *hdir[HSegs]; /* directory of hash slot segments */ }; -struct b_table { /* table-header block */ - word title; /* T_Table */ - word size; /* current table size */ - word id; /* identification number */ +struct b_table { /* table-header block */ + word title; /* T_Table */ + word size; /* current table size */ + word id; /* identification number */ #ifdef Concurrent word shared; word mutexid; -#endif /* Concurrent */ - word mask; /* mask for slot num, equals n slots - 1 */ - struct b_slots *hdir[HSegs]; /* directory of hash slot segments */ - struct descrip defvalue; /* default table element value */ +#endif /* Concurrent */ + word mask; /* mask for slot num, equals n slots - 1 */ + struct b_slots *hdir[HSegs]; /* directory of hash slot segments */ + struct descrip defvalue; /* default table element value */ }; -struct b_slots { /* set/table hash slots */ - word title; /* T_Slots */ - word blksize; /* size of block */ - union block *hslots[HSlots]; /* array of slots (HSlots * 2^n entries) */ +struct b_slots { /* set/table hash slots */ + word title; /* T_Slots */ + word blksize; /* size of block */ + union block *hslots[HSlots]; /* array of slots (HSlots * 2^n entries) */ }; -struct b_telem { /* table-element block */ - word title; /* T_Telem */ - union block *clink; /* hash chain link */ - uword hashnum; /* for ordering chain */ - struct descrip tref; /* entry value */ - struct descrip tval; /* assigned value */ +struct b_telem { /* table-element block */ + word title; /* T_Telem */ + union block *clink; /* hash chain link */ + uword hashnum; /* for ordering chain */ + struct descrip tref; /* entry value */ + struct descrip tval; /* assigned value */ }; -struct b_tvsubs { /* substring trapped variable block */ - word title; /* T_Tvsubs */ - word sslen; /* length of substring */ - word sspos; /* position of substring */ - struct descrip ssvar; /* variable that substring is from */ +struct b_tvsubs { /* substring trapped variable block */ + word title; /* T_Tvsubs */ + word sslen; /* length of substring */ + word sspos; /* position of substring */ + struct descrip ssvar; /* variable that substring is from */ }; -struct b_tvtbl { /* table element trapped variable block */ - word title; /* T_Tvtbl */ - union block *clink; /* pointer to table header block */ - uword hashnum; /* hash number */ - struct descrip tref; /* entry value */ +struct b_tvtbl { /* table element trapped variable block */ + word title; /* T_Tvtbl */ + union block *clink; /* pointer to table header block */ + uword hashnum; /* hash number */ + struct descrip tref; /* entry value */ }; #ifdef EventMon struct b_tvmonitored { /* Monitored variable block */ word title; /* T_Tvmonitored */ - word cur_actv; /* current co-expression activation */ + word cur_actv; /* current co-expression activation */ struct descrip tv; /* the variable in the other program */ }; -#endif /* EventMon */ +#endif /* EventMon */ -struct b_external { /* external block */ - word title; /* T_External */ - word blksize; /* size of block */ - word exdata[1]; /* words of external data */ +struct b_external { /* external block */ + word title; /* T_External */ + word blksize; /* size of block */ + word exdata[1]; /* words of external data */ }; -struct astkblk { /* co-expression activator-stack block */ - int nactivators; /* number of valid activator entries in - * this block */ - struct astkblk *astk_nxt; /* next activator block */ - struct actrec { /* activator record */ - word acount; /* number of calls by this activator */ +struct astkblk { /* co-expression activator-stack block */ + int nactivators; /* number of valid activator entries in + * this block */ + struct astkblk *astk_nxt; /* next activator block */ + struct actrec { /* activator record */ + word acount; /* number of calls by this activator */ struct b_coexpr *activator; /* the activator itself */ } arec[ActStkBlkEnts]; }; #ifdef PatternType struct b_pattern { /*Pattern header block*/ - word title; /*T_Pattern*/ + word title; /*T_Pattern*/ word id; word stck_size; /* size of stack for pattern history during match*/ - union block * pe; /* pattern element */ + union block * pe; /* pattern element */ }; struct b_pelem { /* Pattern element block */ @@ -380,19 +380,19 @@ struct b_pelem { /* Pattern element block */ word pcode; /* Indicates Pattern type*/ union block * pthen; /* Pointer to succeeding pointer element*/ word index; /* posn of pattern elem in pointer chain - * (used in image) */ + * (used in image) */ word *origin_ipc; /* where elem was constructed - * (used in debugging) */ - struct descrip parameter; /* parameter */ + * (used in debugging) */ + struct descrip parameter; /* parameter */ }; -#endif /* PatternType */ +#endif /* PatternType */ /* * The following "generic link list" structure type is useful for * at least the Windows temp file list. */ struct b_cons { - word title; /* T_Cons */ + word title; /* T_Cons */ union block *data; union block *next; }; @@ -401,12 +401,12 @@ struct b_cons { /* * Structure for keeping set/table generator state across a suspension. */ -struct hgstate { /* hashed-structure generator state */ - int segnum; /* current segment number */ - word slotnum; /* current slot number */ - word tmask; /* structure mask before suspension */ - word sgmask[HSegs]; /* mask in use when the segment was created */ - uword sghash[HSegs]; /* hashnum in process when seg was created */ +struct hgstate { /* hashed-structure generator state */ + int segnum; /* current segment number */ + word slotnum; /* current slot number */ + word tmask; /* structure mask before suspension */ + word sgmask[HSegs]; /* mask in use when the segment was created */ + uword sghash[HSegs]; /* hashnum in process when seg was created */ }; @@ -438,15 +438,15 @@ struct dpair { * string and block regions. */ struct region { - word size; /* allocated region size in bytes */ - char *base; /* start of region */ - char *end; /* end of region */ - char *free; /* free pointer */ - struct region *prev, *next; /* forms a linked list of regions */ -#ifdef Concurrent - struct region *Tprev, *Tnext; /* forms a linked list of public regions. i.e not owned by any thread */ -#endif /* Concurrent */ - struct region *Gprev, *Gnext; /* global (all programs) lists */ + word size; /* allocated region size in bytes */ + char *base; /* start of region */ + char *end; /* end of region */ + char *free; /* free pointer */ + struct region *prev, *next; /* forms a linked list of regions */ +#ifdef Concurrent + struct region *Tprev, *Tnext; /* forms a linked list of public regions. i.e not owned by any thread */ +#endif /* Concurrent */ + struct region *Gprev, *Gnext; /* global (all programs) lists */ }; #ifdef Double @@ -456,7 +456,7 @@ struct region { struct size_dbl { char s[sizeof(double)]; }; -#endif /* Double */ +#endif /* Double */ #if COMPILER @@ -475,10 +475,10 @@ struct region { continuation succ_cont; #ifdef PatternType struct b_table *pattern_cache; /* cache variable refs used in a pattern */ -#endif /* PatternType */ +#endif /* PatternType */ struct tend_desc t; }; - #endif /* COMPILER */ + #endif /* COMPILER */ /* * when debugging is enabled a debug struct is placed after the tended @@ -490,12 +490,12 @@ struct debug { int old_line; }; -union numeric { /* long integers or real numbers */ +union numeric { /* long integers or real numbers */ word integer; double real; #ifdef LargeInts struct b_bignum *big; - #endif /* LargeInts */ + #endif /* LargeInts */ }; /* @@ -504,33 +504,33 @@ union numeric { /* long integers or real numbers */ * but a lot of fields are VM-only. */ struct threadstate { - - /* - * the threadstate is tied not only to a thread, but also to + + /* + * the threadstate is tied not only to a thread, but also to * a coexpression (for now!), since there is a one to one mapping - * between a co-expressn and it is corresponding thread + * between a co-expressn and it is corresponding thread * Note: (c is also equavelent to ctx->c) */ - + struct b_coexpr *c; #if ConcurrentCOMPILER continuation Coexpr_fnc; /* function containing co-expression code */ -#endif /* ConcurrentCOMPILER */ - +#endif /* ConcurrentCOMPILER */ + #ifdef Concurrent pthread_t tid; int Pollctr; - + /* used in fmath.r, log() */ double Lastbase; double Divisor; - + /* used in fstr.r, map() */ struct descrip Maps2; struct descrip Maps3; char Maptab[256]; - + /* used in rposix.r */ word *Callproc; word Callproc_Ibuf[100]; @@ -538,41 +538,41 @@ struct threadstate { #ifdef PosixFns char Savedbuf[BUFSIZ]; int Nsaved; -#endif /* PosixFns */ -#endif /* Concurrent */ +#endif /* PosixFns */ +#endif /* Concurrent */ /* signal mask? etc. */ /* * VM-specific per-thread variables. */ #if !COMPILER -#ifndef Concurrent +#ifndef Concurrent word Lastop; -#endif /* Concurrent */ +#endif /* Concurrent */ struct descrip Value_tmp; /* TLS */ dptr Xargp; /* TLS */ word Xnargs; /* TLS */ -/* struct ef_marker *Efp; * Expression frame pointer */ -/* struct gf_marker *Gfp; * Generator frame pointer */ -/* struct pf_marker *Pfp; * procedure frame pointer */ -/* inst Ipc; * Interpreter program counter */ +/* struct ef_marker *Efp; * Expression frame pointer */ +/* struct gf_marker *Gfp; * Generator frame pointer */ +/* struct pf_marker *Pfp; * procedure frame pointer */ +/* inst Ipc; * Interpreter program counter */ /* inst Oldipc; * the previous ipc, fix returned line zero */ -/* word *Sp; * Stack pointer */ -/* int Ilevel; * Depth of recursion in interp() */ - word *Stack; /* Interpreter stack */ - word *Stackend; /* End of interpreter stack */ -#endif /* !COMPILER */ - dptr Glbl_argp; /*TLS*/ /* global argp */ +/* word *Sp; * Stack pointer */ +/* int Ilevel; * Depth of recursion in interp() */ + word *Stack; /* Interpreter stack */ + word *Stackend; /* End of interpreter stack */ +#endif /* !COMPILER */ + dptr Glbl_argp; /*TLS*/ /* global argp */ struct descrip Kywd_pos; /* TLS */ struct descrip ksub; /* TLS */ struct descrip Kywd_ran; /* TLS */ #ifdef PatternType int K_patindex; /* TLS */ -#endif /* PatternType */ +#endif /* PatternType */ - dptr Field_argp; /* TLS -- see comment in imisc.r */ + dptr Field_argp; /* TLS -- see comment in imisc.r */ struct descrip K_current; /* TLS */ int K_errornumber; /* TLS */ @@ -586,25 +586,25 @@ struct threadstate { #ifdef PosixFns struct descrip AmperErrno; /* TLS */ -#endif /* PosixFns */ +#endif /* PosixFns */ word Line_num, /* line number for current execution point */ Column, Lastline, Lastcol; /*TLS*/ /* struct tend_desc *Tend; * chain of tended descriptors */ - struct descrip Eret_tmp; /* eret value during unwinding */ - + struct descrip Eret_tmp; /* eret value during unwinding */ + #ifdef Concurrent struct region *Curstring; /* separate regions vs shared */ struct region *Curblock; /* same above */ #ifdef DescripAmpAllocated - struct descrip stringtotal; /* cumulative total allocation */ - struct descrip blocktotal; /* cumulative total allocation */ -#else /* DescripAmpAllocated */ - uword stringtotal; /* cumulative total allocation */ - uword blocktotal; /* cumulative total allocation */ -#endif /* DescripAmpAllocated */ + struct descrip stringtotal; /* cumulative total allocation */ + struct descrip blocktotal; /* cumulative total allocation */ +#else /* DescripAmpAllocated */ + uword stringtotal; /* cumulative total allocation */ + uword blocktotal; /* cumulative total allocation */ +#endif /* DescripAmpAllocated */ #ifdef SoftThreads int sthrd_tick; @@ -612,8 +612,8 @@ struct threadstate { int sthrd_cur; struct b_coexpr * sthrds[SOFT_THREADS_SIZE]; struct b_coexpr * owner; /* the co-expression where the thread spawned */ -#endif /* SoftThreads */ -#endif /* Concurrent */ +#endif /* SoftThreads */ +#endif /* Concurrent */ #ifdef MultiProgram struct progstate *pstate; @@ -624,7 +624,7 @@ struct threadstate { * Structure for chaining threadstate structs. * The first node will be for the main thread, it will be always the first. * New nodes will be added to the end of the chain, setting roottstate->prev - * to point to the last node will make it easy to add at the end. The chain + * to point to the last node will make it easy to add at the end. The chain * is circular in one direction, backward, but not forward. */ struct threadstate *prev; @@ -642,13 +642,13 @@ struct threadstate { * source program location. */ struct ipc_fname { - word ipc_saved; /* offset of instruction into code region */ - word fname; /* offset of file name into string region */ + word ipc_saved; /* offset of instruction into code region */ + word fname; /* offset of file name into string region */ }; struct ipc_line { - word ipc_saved; /* offset of instruction into code region */ - int line; /* line number */ + word ipc_saved; /* offset of instruction into code region */ + int line; /* line number */ }; #ifdef MultiProgram @@ -657,21 +657,21 @@ struct ipc_line { * many global structures. */ struct progstate { - long hsize; /* size of icode, 0 = C|Python|... */ - /* hsize is a constant defined at load time, MT safe */ + long hsize; /* size of icode, 0 = C|Python|... */ + /* hsize is a constant defined at load time, MT safe */ struct progstate *parent; - /* parent is a constant defined at load time, MT safe */ + /* parent is a constant defined at load time, MT safe */ struct progstate *next; - /* next is a link list, seldom used, needs mutex */ - struct descrip parentdesc; /* implicit "&parent" */ - /* parentdesc is a constant defined at load time, MT safe */ - struct descrip eventmask; /* implicit "&eventmask" */ - /* eventmask is read-only (to me), MT safe */ - struct descrip eventcount; /* implicit "&eventcount" */ + /* next is a link list, seldom used, needs mutex */ + struct descrip parentdesc; /* implicit "&parent" */ + /* parentdesc is a constant defined at load time, MT safe */ + struct descrip eventmask; /* implicit "&eventmask" */ + /* eventmask is read-only (to me), MT safe */ + struct descrip eventcount; /* implicit "&eventcount" */ struct descrip valuemask; - struct descrip eventcode; /* &eventcode */ - struct descrip eventval; /* &eventval */ - struct descrip eventsource; /* &eventsource */ + struct descrip eventcode; /* &eventcode */ + struct descrip eventval; /* &eventval */ + struct descrip eventsource; /* &eventsource */ /* Systems don't have more than, oh, about 50 signals, eh? @@ -683,7 +683,7 @@ struct progstate { * trapped variable keywords' values */ struct descrip Kywd_err; /* Probably mutex. not important now */ - struct descrip Kywd_prog; + struct descrip Kywd_prog; struct descrip Kywd_trc; /* leave global for now */ struct b_coexpr *Mainhead; @@ -697,7 +697,7 @@ struct progstate { short *Ftabsp, *Fosp; int *Fo; char *Bm; - #endif /* FieldTableCompression */ + #endif /* FieldTableCompression */ dptr Fnames, Efnames; dptr Globals, Eglobals; dptr Gnames, Egnames; @@ -711,42 +711,42 @@ struct progstate { #ifdef Graphics struct descrip AmperX, AmperY, AmperRow, AmperCol;/* &x, &y, &row, &col */ - struct descrip AmperInterval; /* &interval */ - struct descrip LastEventWin; /* last Event() win */ + struct descrip AmperInterval; /* &interval */ + struct descrip LastEventWin; /* last Event() win */ int LastEvFWidth; int LastEvLeading; int LastEvAscent; - uword PrevTimeStamp; /* previous timestamp */ - uword Xmod_Control, Xmod_Shift, Xmod_Meta; /* control,shift,meta */ - struct descrip Kywd_xwin[2]; /* &window + ... */ + uword PrevTimeStamp; /* previous timestamp */ + uword Xmod_Control, Xmod_Shift, Xmod_Meta; /* control,shift,meta */ + struct descrip Kywd_xwin[2]; /* &window + ... */ #ifdef Graphics3D - struct descrip AmperPick; /* &pick */ - #endif /* Graphics3D */ - #endif /* Graphics */ - + struct descrip AmperPick; /* &pick */ + #endif /* Graphics3D */ + #endif /* Graphics */ + - word Coexp_ser; /* this program's serial numbers */ + word Coexp_ser; /* this program's serial numbers */ word List_ser; word Intern_list_ser; -#ifdef PatternType +#ifdef PatternType word Pat_ser; -#endif /* PatternType */ +#endif /* PatternType */ word Set_ser; word Table_ser; - word Kywd_time_elsewhere; /* ???? TLS vs global &time spent in other programs */ - word Kywd_time_out; /* ???? TLS vs global &time at last program switch out */ + word Kywd_time_elsewhere; /* ???? TLS vs global &time spent in other programs */ + word Kywd_time_out; /* ???? TLS vs global &time at last program switch out */ #ifdef Concurrent word mutexid_stringtotal; word mutexid_blocktotal; word mutexid_coll; - + struct region *Public_stringregion; /* separate regions vs shared */ struct region *Public_blockregion; /* same above */ -#endif /* Concurrent */ +#endif /* Concurrent */ struct region *stringregion; /* separate regions vs shared */ struct region *blockregion; /* same above */ @@ -754,17 +754,17 @@ struct progstate { /* in case we have separate heaps, i.e ThreadHeap is defined * total here will be only for "dead" threads */ #ifdef DescripAmpAllocated - struct descrip stringtotal; /* cumulative total allocation */ - struct descrip blocktotal; /* cumulative total allocation */ -#else /* DescripAmpAllocated */ - uword stringtotal; /* cumulative total allocation */ - uword blocktotal; /* cumulative total allocation */ -#endif /* DescripAmpAllocated */ - - word colltot; /* m total number of collections */ - word collstat; /* u number of static collect requests */ - word collstr; /* t number of string collect requests */ - word collblk; /* ex number of block collect requests */ + struct descrip stringtotal; /* cumulative total allocation */ + struct descrip blocktotal; /* cumulative total allocation */ +#else /* DescripAmpAllocated */ + uword stringtotal; /* cumulative total allocation */ + uword blocktotal; /* cumulative total allocation */ +#endif /* DescripAmpAllocated */ + + word colltot; /* m total number of collections */ + word collstat; /* u number of static collect requests */ + word collstr; /* t number of string collect requests */ + word collblk; /* ex number of block collect requests */ struct descrip K_main; struct b_file K_errout; @@ -782,19 +782,19 @@ struct progstate { /* * Function Instrumentation Fields. */ -#ifdef Arrays +#ifdef Arrays int (*Cprealarray)(dptr, dptr, word, word); int (*Cpintarray)(dptr, dptr, word, word); -#endif /* Arrays */ +#endif /* Arrays */ int (*Cplist)(dptr, dptr, word, word); int (*Cpset)(dptr, dptr, word); int (*Cptable)(dptr, dptr, word); void (*EVstralc)(word); #ifdef TSTATARG int (*Interp)(int,dptr, struct threadstate*); -#else /* TSTATARG */ +#else /* TSTATARG */ int (*Interp)(int,dptr); -#endif /* TSTATARG */ +#endif /* TSTATARG */ int (*Cnvcset)(dptr,dptr); int (*Cnvint)(dptr,dptr); int (*Cnvreal)(dptr,dptr); @@ -812,14 +812,14 @@ struct progstate { struct b_pelem * (*Alcpelem)(word, word *); int (*Cnvpattern)(dptr,dptr); int (*Internalmatch)(char*,int,int,struct descrip, - struct b_pelem*,int*,int*,int,int); -#endif /* PatternType */ + struct b_pelem*,int*,int*,int,int); +#endif /* PatternType */ struct b_list *(*Alclist_raw)(uword,uword); struct b_list *(*Alclist)(uword,uword); struct b_lelem *(*Alclstb)(uword,uword,uword); #ifndef DescriptorDouble struct b_real *(*Alcreal)(double); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ struct b_record *(*Alcrecd)(int, union block *); struct b_refresh *(*Alcrefresh)(word *, int, int); struct b_selem *(*Alcselem)(dptr, uword); @@ -832,43 +832,43 @@ struct progstate { char * (*Reserve)(int, word); struct threadstate *tstate, maintstate; - + }; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * Frame markers */ -struct ef_marker { /* expression frame marker */ - inst ef_failure; /* failure ipc */ - struct ef_marker *ef_efp; /* efp */ - struct gf_marker *ef_gfp; /* gfp */ - word ef_ilevel; /* ilevel */ +struct ef_marker { /* expression frame marker */ + inst ef_failure; /* failure ipc */ + struct ef_marker *ef_efp; /* efp */ + struct gf_marker *ef_gfp; /* gfp */ + word ef_ilevel; /* ilevel */ }; -struct pf_marker { /* procedure frame marker */ - word pf_nargs; /* number of arguments */ - struct pf_marker *pf_pfp; /* saved pfp */ - struct ef_marker *pf_efp; /* saved efp */ - struct gf_marker *pf_gfp; /* saved gfp */ - dptr pf_argp; /* saved argp */ - inst pf_ipc; /* saved ipc */ - word pf_ilevel; /* saved ilevel */ - dptr pf_scan; /* saved scanning environment */ +struct pf_marker { /* procedure frame marker */ + word pf_nargs; /* number of arguments */ + struct pf_marker *pf_pfp; /* saved pfp */ + struct ef_marker *pf_efp; /* saved efp */ + struct gf_marker *pf_gfp; /* saved gfp */ + dptr pf_argp; /* saved argp */ + inst pf_ipc; /* saved ipc */ + word pf_ilevel; /* saved ilevel */ + dptr pf_scan; /* saved scanning environment */ #ifdef PatternType struct b_table *pattern_cache; /* used to cache the variable references used in a pattern*/ -#endif /* PatternType */ +#endif /* PatternType */ - struct descrip pf_locals[1]; /* descriptors for locals */ + struct descrip pf_locals[1]; /* descriptors for locals */ }; -struct gf_marker { /* generator frame marker */ - word gf_gentype; /* type */ - struct ef_marker *gf_efp; /* efp */ - struct gf_marker *gf_gfp; /* gfp */ - inst gf_ipc; /* ipc */ - struct pf_marker *gf_pfp; /* pfp */ - dptr gf_argp; /* argp */ +struct gf_marker { /* generator frame marker */ + word gf_gentype; /* type */ + struct ef_marker *gf_efp; /* efp */ + struct gf_marker *gf_gfp; /* gfp */ + inst gf_ipc; /* ipc */ + struct pf_marker *gf_pfp; /* pfp */ + dptr gf_argp; /* argp */ }; /* @@ -877,39 +877,39 @@ struct gf_marker { /* generator frame marker */ * The first five members here *must* be identical to those for * gf_marker. */ -struct gf_smallmarker { /* generator frame marker */ - word gf_gentype; /* type */ - struct ef_marker *gf_efp; /* efp */ - struct gf_marker *gf_gfp; /* gfp */ - inst gf_ipc; /* ipc */ +struct gf_smallmarker { /* generator frame marker */ + word gf_gentype; /* type */ + struct ef_marker *gf_efp; /* efp */ + struct gf_marker *gf_gfp; /* gfp */ + inst gf_ipc; /* ipc */ }; /* * b_iproc blocks are used to statically initialize information about - * functions. They are identical to b_proc blocks except for + * functions. They are identical to b_proc blocks except for * the pname field which is a sdescrip (simple/string descriptor) instead * of a descrip. This is done because unions cannot be initialized. */ - -struct b_iproc { /* procedure block */ - word ip_title; /* T_Proc */ - word ip_blksize; /* size of block */ - int (*ip_entryp)(); /* entry point (code) */ - word ip_nparam; /* number of parameters */ - word ip_ndynam; /* number of dynamic locals */ - word ip_nstatic; /* number of static locals */ - word ip_fstatic; /* index (in global table) of first static */ - - struct sdescrip ip_pname; /* procedure name (string qualifier) */ - struct descrip ip_lnames[1]; /* list of local names (qualifiers) */ + +struct b_iproc { /* procedure block */ + word ip_title; /* T_Proc */ + word ip_blksize; /* size of block */ + int (*ip_entryp)(); /* entry point (code) */ + word ip_nparam; /* number of parameters */ + word ip_ndynam; /* number of dynamic locals */ + word ip_nstatic; /* number of static locals */ + word ip_fstatic; /* index (in global table) of first static */ + + struct sdescrip ip_pname; /* procedure name (string qualifier) */ + struct descrip ip_lnames[1]; /* list of local names (qualifiers) */ }; -#endif /* COMPILER */ +#endif /* COMPILER */ -struct b_coexpr { /* co-expression stack block */ - word title; /* T_Coexpr */ - word size; /* number of results produced */ - word id; /* identification number */ - word status; /* status (native/posix, sync/async, etc) */ +struct b_coexpr { /* co-expression stack block */ + word title; /* T_Coexpr */ + word size; /* number of results produced */ + word id; /* identification number */ + word status; /* status (native/posix, sync/async, etc) */ #ifdef Concurrent word shared; word mutexid; @@ -921,90 +921,90 @@ struct b_coexpr { /* co-expression stack block */ #ifdef SoftThreads int sthrd_tick; struct b_coexpr * parent; -#endif /* SoftThreads */ +#endif /* SoftThreads */ -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef EventMon word actv_count; /* number of times activated using EvGet() */ -#endif /* EventMon */ - struct b_coexpr *nextstk; /* pointer to next allocated stack */ - struct tend_desc *es_tend; /* current tended pointer */ - dptr es_argp; /* current argument pointer */ - dptr tvalloc; /* where to place transmitted value */ - struct descrip freshblk; /* refresh block pointer */ - struct astkblk *es_actstk; /* pointer to activation stack structure */ +#endif /* EventMon */ + struct b_coexpr *nextstk; /* pointer to next allocated stack */ + struct tend_desc *es_tend; /* current tended pointer */ + dptr es_argp; /* current argument pointer */ + dptr tvalloc; /* where to place transmitted value */ + struct descrip freshblk; /* refresh block pointer */ + struct astkblk *es_actstk; /* pointer to activation stack structure */ int coexp_act; /* used to pass signal across activations */ /* back to whomever activates, if they care */ #if COMPILER - continuation fnc; /* function containing co-expression code */ - struct p_frame *es_pfp; /* current procedure frame pointer */ - char *file_name; /* current file name */ - word line_num; /* current line_number */ -/* see p_frame pf below */ -#else /* COMPILER */ - struct pf_marker *es_pfp; /* current pfp */ - struct ef_marker *es_efp; /* efp */ - struct gf_marker *es_gfp; /* gfp */ - inst es_ipc; /* ipc */ + continuation fnc; /* function containing co-expression code */ + struct p_frame *es_pfp; /* current procedure frame pointer */ + char *file_name; /* current file name */ + word line_num; /* current line_number */ +/* see p_frame pf below */ +#else /* COMPILER */ + struct pf_marker *es_pfp; /* current pfp */ + struct ef_marker *es_efp; /* efp */ + struct gf_marker *es_gfp; /* gfp */ + inst es_ipc; /* ipc */ inst es_oldipc; /* oldipc */ - word es_ilevel; /* interpreter level */ - word *es_sp; /* sp */ - word *es_stack; /* beginning of interpreter stack */ - word *es_stackend; /* end of interpreter stack */ + word es_ilevel; /* interpreter level */ + word *es_sp; /* sp */ + word *es_stack; /* beginning of interpreter stack */ + word *es_stackend; /* end of interpreter stack */ word Lastop; - + #ifdef MultiProgram struct progstate *program; - #endif /* MultiProgram */ -#endif /* COMPILER */ + #endif /* MultiProgram */ +#endif /* COMPILER */ #ifdef PthreadCoswitch /* from the Icon pthreads-based co-expression implementation. */ - pthread_t thread; /* thread ID (thread handle) */ - sem_t sema; /* synchronization semaphore (if unnamed) */ - sem_t *semp; /* pointer to semaphore */ - int alive; /* set zero when thread is to die */ + pthread_t thread; /* thread ID (thread handle) */ + sem_t sema; /* synchronization semaphore (if unnamed) */ + sem_t *semp; /* pointer to semaphore */ + int alive; /* set zero when thread is to die */ - int tmplevel; + int tmplevel; int have_thread; #ifdef Concurrent struct threadstate *tstate; int isProghead; -#endif /* Concurrent */ -#endif /* PthreadCoswitch */ +#endif /* Concurrent */ +#endif /* PthreadCoswitch */ - word cstate[CStateSize]; /* C state information (registers, etc.) */ + word cstate[CStateSize]; /* C state information (registers, etc.) */ #if COMPILER struct p_frame pf; /* initial procedure frame */ -#endif +#endif /* WARNING: pf ^ _must_ be the LAST item in b_coexpr - * es_pfp points ^ HERE, so + * es_pfp points ^ HERE, so * the new pframes will be put _right_ after this! * anything you add after pf will be _clobbered_ * ref: rcoexpr.r: sblkp->es_pfp = &sblkp->pf; - * ref: rstructs.h, 2001 version + * ref: rstructs.h, 2001 version */ }; /* b_coexpr */ -struct b_refresh { /* co-expression refresh block */ - word title; /* T_Refresh */ - word blksize; /* size of block */ - word nlocals; /* number of local variables */ +struct b_refresh { /* co-expression refresh block */ + word title; /* T_Refresh */ + word blksize; /* size of block */ + word nlocals; /* number of local variables */ #if COMPILER - word nargs; /* number of arguments */ + word nargs; /* number of arguments */ word ntemps; /* number of temporary descriptors */ - word wrk_size; /* size of non-descriptor work area */ -#else /* COMPILER */ - word *ep; /* entry point */ - struct pf_marker pfmkr; /* marker for enclosing procedure */ -#endif /* COMPILER */ - struct descrip elems[1]; /* args and locals (VM: including Arg0) */ + word wrk_size; /* size of non-descriptor work area */ +#else /* COMPILER */ + word *ep; /* entry point */ + struct pf_marker pfmkr; /* marker for enclosing procedure */ +#endif /* COMPILER */ + struct descrip elems[1]; /* args and locals (VM: including Arg0) */ }; -union block { /* general block */ +union block { /* general block */ #ifndef DescriptorDouble struct b_real Real; -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ struct b_cset Cset; struct b_file File; struct b_proc Proc; @@ -1019,7 +1019,7 @@ union block { /* general block */ struct b_tvtbl Tvtbl; #ifdef EventMon struct b_tvmonitored Tvmonitored; -#endif /* EventMon */ +#endif /* EventMon */ struct b_refresh Refresh; struct b_coexpr Coexpr; struct b_external External; @@ -1028,14 +1028,14 @@ union block { /* general block */ #ifdef PatternType struct b_pattern Pattern; struct b_pelem Pelem; -#endif /* PatternType */ +#endif /* PatternType */ #ifdef LargeInts struct b_bignum Lrgint; -#endif /* LargeInts */ +#endif /* LargeInts */ #ifdef Arrays struct b_intarray Intarray; struct b_realarray Realarray; -#endif /* Arrays */ +#endif /* Arrays */ struct b_mask Mask; }; @@ -1044,12 +1044,12 @@ struct ptstruct { #if NT HANDLE master_read, master_write; HANDLE slave_pid; -#else /* WIN32 */ - int master_fd, slave_fd; /* master, slave pty file descriptor */ - pid_t slave_pid; /* process id of slave */ -#endif /* WIN32 */ - +#else /* WIN32 */ + int master_fd, slave_fd; /* master, slave pty file descriptor */ + pid_t slave_pid; /* process id of slave */ +#endif /* WIN32 */ + char slave_filename[256];/* pty slave filename associated with master pty */ char slave_command[256]; /* name of executable associated with slave */ }; -#endif /* PseudoPty */ +#endif /* PseudoPty */ diff --git a/src/h/rt.h b/src/h/rt.h index bd6045fab..7956e12da 100644 --- a/src/h/rt.h +++ b/src/h/rt.h @@ -1,4 +1,4 @@ -#ifndef RT_H /* only include once */ +#ifndef RT_H /* only include once */ #define RT_H 1 /* @@ -18,15 +18,15 @@ #ifdef Graphics #include "../h/graphics.h" -#endif /* Graphics */ +#endif /* Graphics */ #ifdef Audio #include "../h/audio.h" -#endif /* Audio */ +#endif /* Audio */ #ifdef PosixFns #include "../h/posix.h" -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Messaging #include "../h/messagin.h" @@ -41,4 +41,4 @@ #endif /* _UCRT */ -#endif /* RT_DOT_H */ +#endif /* RT_DOT_H */ diff --git a/src/h/sys.h b/src/h/sys.h index e326d9bd6..171988d34 100644 --- a/src/h/sys.h +++ b/src/h/sys.h @@ -7,7 +7,7 @@ #undef printf #undef fprintf #undef fflush -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ /* * Universal (Standard ANSI C) includes. @@ -27,19 +27,19 @@ #ifdef ConsoleWindow #undef exit #define exit c_exit - #endif /* Console Window */ + #endif /* Console Window */ /* * Operating-system-dependent includes. */ #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #ifdef ISQL #undef Type #undef Precision -#endif /* ISQL */ +#endif /* ISQL */ #if MSDOS #undef Type @@ -51,44 +51,44 @@ /* Mingw GCC 4.8.1 idiotically #define's stat. We need that name intact. */ #ifdef stat #undef stat -#endif /* stat */ +#endif /* stat */ #include #ifndef OLD_NTGCC /* The new GCC needs locking.h but the old one doesn't*/ #include - #endif /* OLD_NTGCC */ -#endif /* NTGCC */ + #endif /* OLD_NTGCC */ +#endif /* NTGCC */ #ifdef MSVC #include -#endif /* MSVC */ +#endif /* MSVC */ #ifdef MSWindows #define int_PASCAL int PASCAL #define LRESULT_CALLBACK LRESULT CALLBACK #define BOOL_CALLBACK BOOL CALLBACK #ifdef PosixFns - /* + /* * Avoid a conflict between rpcndr.h and jmorecfg.h (jpeg) about "boolean" - * uncomment the "boolean" lines below if you have this issue. + * uncomment the "boolean" lines below if you have this issue. */ /* #define boolean bolean */ #include /* #undef boolean */ #include - #else /* PosixFns */ + #else /* PosixFns */ #include - #endif /* PosixFns */ + #endif /* PosixFns */ #include #include - #else /* MSWindows */ + #else /* MSWindows */ #if NT #ifndef PATH_MAX #define PATH_MAX 512 - #endif /* PATH_MAX */ + #endif /* PATH_MAX */ #ifdef PosixFns - /* + /* * Avoid a conflict between rpcndr.h and jmorecfg.h (jpeg) about "boolean" - * uncomment the "boolean" lines below if you have this issue. + * uncomment the "boolean" lines below if you have this issue. */ /* #define boolean bolean */ #include @@ -98,10 +98,10 @@ #if defined(ISQL) || defined(Audio) #include #include - #endif /* ISQL */ - #endif /* PosixFns */ - #endif /* NT */ - #endif /* MSWindows */ + #endif /* ISQL */ + #endif /* PosixFns */ + #endif /* NT */ + #endif /* MSWindows */ #include #define Type(d) (int)((d).dword & TypeMask) #undef lst1 @@ -109,7 +109,7 @@ /*MinGW32 needs these defined*/ #ifndef EWOULDBLOCK - + #define EWOULDBLOCK WSAEWOULDBLOCK #define EINPROGRESS WSAEINPROGRESS #define EALREADY WSAEALREADY @@ -145,9 +145,9 @@ #define EDQUOT WSAEDQUOT #define ESTALE WSAESTALE #define EREMOTE WSAEREMOTE -#endif /* EWOULDBLOCK */ - -#endif /* MSDOS */ +#endif /* EWOULDBLOCK */ + +#endif /* MSDOS */ #if UNIX #include @@ -162,10 +162,10 @@ #endif #ifdef HAVE_SYS_RESOURCE_H #include -#endif /* HAVE_SYS_RESOURCE_H */ +#endif /* HAVE_SYS_RESOURCE_H */ #ifdef HAVE_SYS_FILE_H #include -#endif /* HAVE_FILE_H */ +#endif /* HAVE_FILE_H */ #include #include #ifdef SysSelectH @@ -173,27 +173,27 @@ #endif #if defined(PseudoPty) || defined(Audio) #include -#endif /* PseudoPty || Audio */ +#endif /* PseudoPty || Audio */ #ifdef Audio #include #include #include -#endif /* Audio */ -#endif /* UNIX */ +#endif /* Audio */ +#endif /* UNIX */ #ifdef HAVE_LIBPTHREAD #if !UNIX || !defined(Audio) #include -#endif /* PthreadCoswitch & ! Audio */ +#endif /* PthreadCoswitch & ! Audio */ #include -#endif /* HAVE_LIBPTHREAD */ +#endif /* HAVE_LIBPTHREAD */ #if VMS #include #include #include #include -#endif /* VMS */ +#endif /* VMS */ #include /* @@ -206,7 +206,7 @@ #define printf Consoleprintf #define fprintf Consolefprintf #define fflush Consolefflush -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef XWindows /* @@ -222,11 +222,11 @@ #ifdef HAVE_LIBXPM #include "../xpm/xpm.h" - #endif /* HAVE_LIBXPM */ + #endif /* HAVE_LIBXPM */ #undef UNIX #define UNIX 0 - #else /* VMS */ + #else /* VMS */ #undef VMS #ifdef Redhat71 @@ -239,13 +239,13 @@ #ifdef X_NOT_STDC_ENV #undef X_NOT_STDC_ENV #endif -#endif /* Redhat71 */ +#endif /* Redhat71 */ #ifdef HAVE_LIBXPM #include "../xpm/xpm.h" - #else /* HAVE_LIBXPM */ + #else /* HAVE_LIBXPM */ #include - #endif /* HAVE_LIBXPM */ + #endif /* HAVE_LIBXPM */ #include #include @@ -253,9 +253,9 @@ #undef VMS #define VMS 0 - #endif /* VMS */ + #endif /* VMS */ -#endif /* XWindows */ +#endif /* XWindows */ /* * Include this after Xlib stuff, jmorecfg.h expects this. @@ -275,21 +275,21 @@ /* avoid warnings over duplicate definition of HAVE_STDLIB_H in jpeglib.h */ #undef HAVE_STDLIB_H -#endif /* NTGCC */ +#endif /* NTGCC */ #include "jpeglib.h" #include "jerror.h" #ifndef HAVE_LIBPNG #include -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ /* we do not use their definitions of GLOBAL, LOCAL, or OF; we use our own */ #ifdef NTGCC #undef boolean -#endif /* NTGCC */ +#endif /* NTGCC */ #undef GLOBAL #undef LOCAL #undef OF -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #define VanquishReturn(s) return s; @@ -299,24 +299,24 @@ #ifndef HostStr #if !VMS && !Windows #include - #endif /* !VMS && !Windows*/ -#endif /* HostStr */ + #endif /* !VMS && !Windows*/ +#endif /* HostStr */ #ifdef LoadFunc #if NT void *dlopen(char *, int); /* LoadLibrary */ void *dlsym(void *, char *sym); /* GetProcAddress */ int dlclose(void *); /* FreeLibrary */ -#else /* NT */ +#else /* NT */ #include -#endif /* NT */ -#endif /* LoadFunc */ +#endif /* NT */ +#endif /* LoadFunc */ #include "../h/filepat.h" #ifdef Dbm #include -#endif /* Dbm */ +#endif /* Dbm */ #ifdef ISQL #ifndef BOOL @@ -331,13 +331,13 @@ #undef BOOL #ifdef DebugHeap -#define Type(d) (int)((((d).dword & F_Typecode) ? ((int)((d).dword & TypeMask)) : (heaperr("descriptor type error",BlkLoc(d),(d).dword), -1))) +#define Type(d) (int)((((d).dword & F_Typecode) ? ((int)((d).dword & TypeMask)) : (heaperr("descriptor type error",BlkLoc(d),(d).dword), -1))) #else #define Type(d) (int)((d).dword & TypeMask) #endif #define Precision 16 -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Messaging # include @@ -346,24 +346,24 @@ #ifdef ConsoleWindow #undef putc #define putc Consoleputc -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #if HAVE_LIBGL #include #ifdef XWindows #include -#endif /* XWindows */ +#endif /* XWindows */ #include #if HAVE_LIBFREETYPE #include #include FT_FREETYPE_H - #define PNG_SKIP_SETJMP_CHECK /* - * Fixes compile error for Ubuntu 16.04: - * 'expected [...] before __pngconf.h in - * libpng already includes setjmp.h' - */ -#endif /* HAVE_LIBFREETYPE */ -#endif /* HAVE_LIBGL */ + #define PNG_SKIP_SETJMP_CHECK /* + * Fixes compile error for Ubuntu 16.04: + * 'expected [...] before __pngconf.h in + * libpng already includes setjmp.h' + */ +#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBGL */ #if HAVE_LIBZ # ifdef STDC @@ -388,53 +388,53 @@ #include #endif -#else /* HAVE_LIBPNG */ +#else /* HAVE_LIBPNG */ #include -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ #ifndef VMS #define VMS 0 #endif -#else /* HAVE_LIBZ */ +#else /* HAVE_LIBZ */ /* If you claim to have libpng, but you don't have libz, that's no good */ #if HAVE_LIBPNG /*#include */ -#endif /* HAVE_LIBPNG */ -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBZ */ #ifdef HAVE_VOICE #include "../lib/voice/jvoip.h" -#endif /* HAVE_VOICE */ +#endif /* HAVE_VOICE */ #ifdef HAVE_LIBOPENAL #if HAVE_ALTYPES - #include - #include -#endif /* HAVE_ALTYPES */ - #include - #include - #include + #include + #include +#endif /* HAVE_ALTYPES */ + #include + #include + #include /* * 10/2008: alut.h is a legacy header. Putting this in to see what breaks. */ #if HAVE_ALUT - #include + #include #endif -#endif /* HAVE_LIBOPENAL */ +#endif /* HAVE_LIBOPENAL */ /* Ogg Vorbis */ #ifdef HAVE_LIBOGG - #include - #include -#endif /* HAVE_LIBOGG */ + #include + #include +#endif /* HAVE_LIBOGG */ /* OpenCL */ #ifdef HAVE_LIBCL - #include -#endif /* HAVE_LIBCL */ + #include +#endif /* HAVE_LIBCL */ #ifdef HAVE_LIBSSL /* openssl thinks we are a VMS system when VMS=0 */ @@ -451,4 +451,4 @@ #define VMS 0 #endif -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ diff --git a/src/h/typedefs.h b/src/h/typedefs.h index 08e7b48d6..291ef8cf8 100644 --- a/src/h/typedefs.h +++ b/src/h/typedefs.h @@ -2,7 +2,7 @@ * typdefs for the run-time system. */ -typedef int ALIGN; /* pick most stringent type for alignment */ +typedef int ALIGN; /* pick most stringent type for alignment */ typedef unsigned int DIGIT; /* @@ -54,14 +54,14 @@ typedef int (*continuation) (void); * (Both of these are initialized to NULL by Icon 9.4.1 or later.) */ //typedef struct context **cstate; -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ #if !COMPILER /* * Typedefs for the interpreter. */ - + /* * Icode consists of operators and arguments. Operators are small integers, * while arguments may be pointers. To conserve space in icode files on @@ -78,32 +78,32 @@ typedef int (*continuation) (void); * For the moment, the dubious coding is isolated under control of the * size of integers. */ - + #if IntBits != WordBits - + typedef union { int *op; word *opnd; } inst; - - #else /* IntBits != WordBits */ - + + #else /* IntBits != WordBits */ + typedef union { word *op; word *opnd; } inst; - - #endif /* IntBits != WordBits */ - -#endif /* COMPILER */ + + #endif /* IntBits != WordBits */ + +#endif /* COMPILER */ typedef enum TRuntime_Status_states { - RTSTATUS_NORMAL=0, /* Normal operation */ - RTSTATUS_GC, /* Garbage collection */ - RTSTATUS_SIGNAL, /* Normal Signal Handling */ - RTSTATUS_EXIT, /* Normal Shutdown */ - RTSTATUS_RUNERROR, /* Runtime Error shutdown */ - RTSTATUS_SYSERROR, /* System Error shutdown */ - RTSTATUS_HARDERROR /* Hardware Error shutdown, triggered by signals - SIGBUS, SIGFPE, SIGILL, and SIGSEGV */ + RTSTATUS_NORMAL=0, /* Normal operation */ + RTSTATUS_GC, /* Garbage collection */ + RTSTATUS_SIGNAL, /* Normal Signal Handling */ + RTSTATUS_EXIT, /* Normal Shutdown */ + RTSTATUS_RUNERROR, /* Runtime Error shutdown */ + RTSTATUS_SYSERROR, /* System Error shutdown */ + RTSTATUS_HARDERROR /* Hardware Error shutdown, triggered by signals + SIGBUS, SIGFPE, SIGILL, and SIGSEGV */ } TRuntime_Status; diff --git a/src/h/version.h b/src/h/version.h index cc610b48b..ed5acebce 100644 --- a/src/h/version.h +++ b/src/h/version.h @@ -41,59 +41,59 @@ */ #define Version "Unicon Version " VersionNumber " (iconc). " VersionDate -#else /* COMPILER */ +#else /* COMPILER */ /* * &version */ #define Version "Unicon Version " VersionNumber ". " VersionDate - + /* * Version numbers to be sure ucode is compatible with the linker * and icode is compatible with the run-time system. */ - + #define UVersion "U12.1.00" - + #ifdef FieldTableCompression - #if IntBits == 16 - #define IVersion "I12.U.30FT/16/16" - #endif /* IntBits == 16 */ + #if IntBits == 16 + #define IVersion "I12.U.30FT/16/16" + #endif /* IntBits == 16 */ - #if IntBits == 32 + #if IntBits == 32 #if WordBits==64 - #define IVersion "I12.U.30FT/32/64" + #define IVersion "I12.U.30FT/32/64" #else - #define IVersion "I12.U.30FT/32/32" + #define IVersion "I12.U.30FT/32/32" #endif - #endif /* IntBits == 32 */ + #endif /* IntBits == 32 */ - #if IntBits == 64 - #define IVersion "I12.U.30FT/64/64" - #endif /* IntBits == 64 */ + #if IntBits == 64 + #define IVersion "I12.U.30FT/64/64" + #endif /* IntBits == 64 */ - #else /* FieldTableCompression */ + #else /* FieldTableCompression */ - #if IntBits == 16 - #define IVersion "I12.U.30/16/32" - #endif /* IntBits == 16 */ + #if IntBits == 16 + #define IVersion "I12.U.30/16/32" + #endif /* IntBits == 16 */ - #if IntBits == 32 + #if IntBits == 32 #if WordBits==64 - #define IVersion "I12.U.30/32/64" + #define IVersion "I12.U.30/32/64" #else - #define IVersion "I12.U.30/32/32" + #define IVersion "I12.U.30/32/32" #endif - #endif /* IntBits == 32 */ + #endif /* IntBits == 32 */ + + #if IntBits == 64 + #define IVersion "I12.U.30/64/64" + #endif /* IntBits == 64 */ - #if IntBits == 64 - #define IVersion "I12.U.30/64/64" - #endif /* IntBits == 64 */ + #endif /* FieldTableCompression */ - #endif /* FieldTableCompression */ - -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Version number for event monitoring. diff --git a/src/h/xwin.h b/src/h/xwin.h index d903a5eb0..12d09b133 100644 --- a/src/h/xwin.h +++ b/src/h/xwin.h @@ -1,37 +1,37 @@ #ifdef XWindows -#define DRAWOP_AND GXand -#define DRAWOP_ANDINVERTED GXandInverted -#define DRAWOP_ANDREVERSE GXandReverse -#define DRAWOP_CLEAR GXclear -#define DRAWOP_COPY GXcopy -#define DRAWOP_COPYINVERTED GXcopyInverted -#define DRAWOP_EQUIV GXequiv -#define DRAWOP_INVERT GXinvert -#define DRAWOP_NAND GXnand -#define DRAWOP_NOOP GXnoop -#define DRAWOP_NOR GXnor -#define DRAWOP_OR GXor -#define DRAWOP_ORINVERTED GXorInverted -#define DRAWOP_ORREVERSE GXorReverse -#define DRAWOP_REVERSE 0x10 -#define DRAWOP_SET GXset -#define DRAWOP_XOR GXxor - -#define XLFD_Foundry 1 -#define XLFD_Family 2 -#define XLFD_Weight 3 -#define XLFD_Slant 4 -#define XLFD_SetWidth 5 -#define XLFD_AddStyle 6 -#define XLFD_Size 7 -#define XLFD_PointSize 8 -#define XLFD_Spacing 11 -#define XLFD_CharSet 13 +#define DRAWOP_AND GXand +#define DRAWOP_ANDINVERTED GXandInverted +#define DRAWOP_ANDREVERSE GXandReverse +#define DRAWOP_CLEAR GXclear +#define DRAWOP_COPY GXcopy +#define DRAWOP_COPYINVERTED GXcopyInverted +#define DRAWOP_EQUIV GXequiv +#define DRAWOP_INVERT GXinvert +#define DRAWOP_NAND GXnand +#define DRAWOP_NOOP GXnoop +#define DRAWOP_NOR GXnor +#define DRAWOP_OR GXor +#define DRAWOP_ORINVERTED GXorInverted +#define DRAWOP_ORREVERSE GXorReverse +#define DRAWOP_REVERSE 0x10 +#define DRAWOP_SET GXset +#define DRAWOP_XOR GXxor + +#define XLFD_Foundry 1 +#define XLFD_Family 2 +#define XLFD_Weight 3 +#define XLFD_Slant 4 +#define XLFD_SetWidth 5 +#define XLFD_AddStyle 6 +#define XLFD_Size 7 +#define XLFD_PointSize 8 +#define XLFD_Spacing 11 +#define XLFD_CharSet 13 #define TEXTWIDTH(w,s,n) XTextWidth((w)->context->font->fsp, s, n) #define SCREENDEPTH(w)\ - DefaultDepth((w)->window->display->display, w->window->display->screen) + DefaultDepth((w)->window->display->display, w->window->display->screen) #define ASCENT(w) ((w)->context->font->fsp->ascent) #define DESCENT(w) ((w)->context->font->fsp->descent) #define LEADING(w) ((w)->context->leading) @@ -39,9 +39,9 @@ #define FWIDTH(w) ((w)->context->font->fsp->max_bounds.width) #define LINEWIDTH(w) ((w)->context->linewidth) #define DISPLAYHEIGHT(w)\ - DisplayHeight(w->window->display->display, w->window->display->screen) + DisplayHeight(w->window->display->display, w->window->display->screen) #define DISPLAYWIDTH(w)\ - DisplayWidth(w->window->display->display, w->window->display->screen) + DisplayWidth(w->window->display->display, w->window->display->screen) #define FS_SOLID FillSolid #define FS_STIPPLE FillStippled #define hidecrsr(x) /* noop */ @@ -87,12 +87,12 @@ * The following constants define limitations in the system, gradually being * removed as this code is rewritten to use dynamic allocation. */ -#define DMAXCOLORS 256 -#define WMAXCOLORS 256 -#define MAXCOLORNAME 40 +#define DMAXCOLORS 256 +#define WMAXCOLORS 256 +#define MAXCOLORNAME 40 #define CLR_SHARED 0 #define CLR_MUTABLE 1 -#define NUMCURSORSYMS 78 +#define NUMCURSORSYMS 78 /* * Macros to ease coding in which every X call must be done twice. @@ -112,27 +112,27 @@ #define RENDER7(func,v1,v2,v3,v4,v5,v6,v7) {\ if (stdwin) func(stddpy, stdwin, stdgc, v1, v2, v3, v4, v5, v6, v7); \ func(stddpy, stdpix, stdgc, v1, v2, v3, v4, v5, v6, v7);} - + #define MAXDESCENDER(w) (w->context->font->fsp->max_bounds.descent) /* * Macros to perform direct window system calls from graphics routines */ -#define STDLOCALS_RENDER(w) \ - wsp ws = (w)->window; \ - GC stdgc = (w)->context->gc; \ - Display *stddpy = ws->display->display; \ - Window stdwin = ws->win; \ +#define STDLOCALS_RENDER(w) \ + wsp ws = (w)->window; \ + GC stdgc = (w)->context->gc; \ + Display *stddpy = ws->display->display; \ + Window stdwin = ws->win; \ Pixmap stdpix = ws->pix; -#define STDLOCALS(w) \ - wcp wc = (w)->context; \ - wsp ws = (w)->window; \ - wdp wd = (w)->window->display; \ - GC stdgc = wc->gc; \ - Display *stddpy = wd->display; \ - Window stdwin = ws->win; \ +#define STDLOCALS(w) \ + wcp wc = (w)->context; \ + wsp ws = (w)->window; \ + wdp wd = (w)->window->display; \ + GC stdgc = wc->gc; \ + Display *stddpy = wd->display; \ + Window stdwin = ws->win; \ Pixmap stdpix = ws->pix; #define drawarcs(w, arcs, narcs) \ @@ -189,19 +189,19 @@ * containing the current color setting. * * Note the structure is a simple array with a hash table superimposed - * + * */ typedef struct wcolor { - int refcount; - char name[6+MAXCOLORNAME]; /* name for WAttrib & WColor reads */ - unsigned short r, g, b; /* rgb for colorsearch */ + int refcount; + char name[6+MAXCOLORNAME]; /* name for WAttrib & WColor reads */ + unsigned short r, g, b; /* rgb for colorsearch */ #ifdef GraphicsGL unsigned short a; - int id; /* for mutable color */ -#endif /* GraphicsGL */ - unsigned long c; /* X pixel value */ - int type; /* CLR_SHARED or CLR_MUTABLE */ - int prev, next; /* hash table bucket prev/next */ + int id; /* for mutable color */ +#endif /* GraphicsGL */ + unsigned long c; /* X pixel value */ + int type; /* CLR_SHARED or CLR_MUTABLE */ + int prev, next; /* hash table bucket prev/next */ } *wclrp; /* @@ -219,19 +219,19 @@ typedef struct wcolor { * Utility macros to extract RGB color components when dealing with TRUE COLOR visuals. */ -#define TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(red_mask, green_mask, blue_mask) \ - unsigned long rshift=0, rbits=0, gshift=0, gbits=0, bshift=0, bbits=0; \ - do { \ - unsigned long rmask = red_mask, gmask = green_mask, bmask = blue_mask; \ - while (!(rmask & 1)) { rshift++; rmask >>= 1; } \ - while (rmask & 1) { rbits++; rmask >>= 1; } \ - if (rbits>8) { rshift += rbits-8; rbits = 8; } \ - while (!(gmask & 1)) { gshift++; gmask >>= 1; } \ - while (gmask & 1) { gbits++; gmask >>= 1; } \ - if (gbits>8) { gshift += gbits-8; gbits = 8;} \ - while (!(bmask & 1)) { bshift++; bmask >>= 1; } \ - while (bmask & 1) { bbits++; bmask >>= 1; } \ - if (bbits>8) { bshift += bbits-8; bbits = 8; } \ +#define TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(red_mask, green_mask, blue_mask) \ + unsigned long rshift=0, rbits=0, gshift=0, gbits=0, bshift=0, bbits=0; \ + do { \ + unsigned long rmask = red_mask, gmask = green_mask, bmask = blue_mask; \ + while (!(rmask & 1)) { rshift++; rmask >>= 1; } \ + while (rmask & 1) { rbits++; rmask >>= 1; } \ + if (rbits>8) { rshift += rbits-8; rbits = 8; } \ + while (!(gmask & 1)) { gshift++; gmask >>= 1; } \ + while (gmask & 1) { gbits++; gmask >>= 1; } \ + if (gbits>8) { gshift += gbits-8; gbits = 8;} \ + while (!(bmask & 1)) { bshift++; bmask >>= 1; } \ + while (bmask & 1) { bbits++; bmask >>= 1; } \ + if (bbits>8) { bshift += bbits-8; bbits = 8; } \ } while (0) #define TRUECOLOR_GET_RGB_BYTE(c, cshifts, cbits) (((c >> cshift) & ((1 << cbits)-1)) << (8-cbits)) @@ -239,4 +239,4 @@ typedef struct wcolor { #define TRUECOLOR_GET_RGB_GREEN(c) (((c >> gshift) & ((1 << gbits)-1)) << (8-gbits)) #define TRUECOLOR_GET_RGB_BLUE(c) (((c >> bshift) & ((1 << bbits)-1)) << (8-bbits)) -#endif /* XWindows */ +#endif /* XWindows */ diff --git a/src/iconc/clocal.c b/src/iconc/clocal.c index 2d37bbb25..308c3290b 100644 --- a/src/iconc/clocal.c +++ b/src/iconc/clocal.c @@ -12,7 +12,7 @@ /* place to put anything system specific */ Deliberate Syntax Error #endif /* PORT */ - + #if MSDOS #if MICROSOFT @@ -33,7 +33,7 @@ extern unsigned _stklen = 8192; #endif /* TURBO */ #endif /* MSDOS */ - + /* * End of operating-system specific code. diff --git a/src/iconc/cmain.c b/src/iconc/cmain.c index d4ee153dc..a152faa08 100644 --- a/src/iconc/cmain.c +++ b/src/iconc/cmain.c @@ -43,7 +43,7 @@ extern char patchpath[]; extern int optind; /* index into parent argv vector */ extern int optopt; /* character checked for validity */ extern char *optarg; /* argument associated with option */ - + static int @@ -634,7 +634,7 @@ Deliberate Syntax Error } return ret_code; } - + /* * Write the iconc command-line into a comment in the C file generated by iconc. */ @@ -727,7 +727,7 @@ Deliberate Syntax Error quitf("could not run %s",ofile); } - + static void report(s) char *s; { @@ -751,7 +751,7 @@ Deliberate Syntax Error */ } - + /* * rmfile - remove a file */ @@ -761,7 +761,7 @@ char *fname; { remove(fname); } - + /* * open_out - open a C output file and write identifying information * to the front. @@ -799,7 +799,7 @@ char *fname; fflush(f); return f; } - + /* * Print an error message if called incorrectly. The message depends * on the legal options for this system. diff --git a/src/iconc/cmem.c b/src/iconc/cmem.c index 099b74a62..f38f6d177 100644 --- a/src/iconc/cmem.c +++ b/src/iconc/cmem.c @@ -23,7 +23,7 @@ char pre[PrfxSz] = {'0', '0', '0'}; /* initial function name prefix */ extern struct str_buf lex_sbuf; - + /* * init - initialize memory for the translator */ diff --git a/src/iconc/csym.c b/src/iconc/csym.c index 31d9880e9..aca96c6e8 100644 --- a/src/iconc/csym.c +++ b/src/iconc/csym.c @@ -51,7 +51,7 @@ int op_tbl_sz; struct pentry *proc_lst = NULL; /* procedure list */ struct rentry *rec_lst = NULL; /* record list */ - + /* *instl_p - install procedure or record in global symbol table, returning * the symbol table entry. @@ -158,7 +158,7 @@ install(name, flag) tsyserr("install: unrecognized symbol table flag."); } } - + /* * dcl_loc - handle declaration of a local identifier. */ @@ -179,7 +179,7 @@ struct lentry *next; tfatal("dcl_loc: inconsistent redeclaration", name); return lp; } - + /* * putloc - make a local symbol table entry and return pointer to it. */ @@ -198,7 +198,7 @@ struct lentry *putloc(char *id,int id_type) } return ptr; } - + /* * putglob makes a global symbol table entry and returns a pointer to it. */ @@ -214,7 +214,7 @@ static struct gentry *putglob(char *id, int id_type) } return ptr; } - + /* * putlit makes a constant symbol table entry and returns a pointer to it. */ @@ -230,7 +230,7 @@ struct centry *putlit(char *image, int littype, int len) } return ptr; } - + /* * llookup looks up id in local symbol table and returns pointer to * to it if found or NULL if not present. @@ -245,7 +245,7 @@ static struct lentry *llookup(char *id) ptr = ptr->blink; return ptr; } - + /* * flookup looks up id in flobal symbol table and returns pointer to * to it if found or NULL if not present. @@ -260,7 +260,7 @@ struct fentry *flookup(char *id) } return ptr; } - + /* * glookup looks up id in global symbol table and returns pointer to * to it if found or NULL if not present. @@ -275,7 +275,7 @@ struct gentry *glookup(char *id) } return ptr; } - + /* * clookup looks up id in constant symbol table and returns pointer to * to it if found or NULL if not present. @@ -290,7 +290,7 @@ static struct centry *clookup(char *image, int flag) return ptr; } - + #ifdef DeBug /* * symdump - dump symbol tables. @@ -369,7 +369,7 @@ void ldump(struct lentry **lhash) } fflush(stderr); } - + /* * gdump displays global symbol table to stderr. */ @@ -390,7 +390,7 @@ void gdump() } fflush(stderr); } - + /* * cdump displays constant symbol table to stderr. */ @@ -411,7 +411,7 @@ void cdump() } fflush(stderr); } - + /* * fdump displays field symbol table to stderr. */ @@ -434,7 +434,7 @@ void fdump() } fflush(stderr); } - + /* * prt_flds - print a list of fields stored in reverse order. */ @@ -463,7 +463,7 @@ void rdump() } } #endif /* DeBug */ - + /* * alcloc allocates a local symbol table entry, fills in fields with * specified values and returns pointer to new entry. @@ -509,7 +509,7 @@ static struct gentry *alcglob(struct gentry *blink, char *name, int flag) gp->flag = flag; return gp; } - + /* * alclit allocates a constant symbol table entry, fills in fields with * specified values and returns pointer to new entry. diff --git a/src/iconc/ctrans.c b/src/iconc/ctrans.c index f74e74d60..2bb98adf6 100644 --- a/src/iconc/ctrans.c +++ b/src/iconc/ctrans.c @@ -79,7 +79,7 @@ adjust_class_recs(recs) } } } - + static void @@ -195,7 +195,7 @@ int trans(char *argv0) return __merr_errors; } - + /* * translate one file. */ @@ -240,7 +240,7 @@ char *filename; else yyparse(); /* Parse the input */ } - + /* * writecheck - check the return code from a stdio output operation * @@ -253,7 +253,7 @@ void writecheck(rc) quit("unable to write to icode file"); } */ - + /* * lnkdcl - find file locally or on LPATH and add to source list. */ @@ -272,7 +272,7 @@ char *name; else tfatal("cannot resolve reference to file name", name); } - + void src_file(name, srclist) char *name; diff --git a/src/iconc/typinfer.c b/src/iconc/typinfer.c index 879415da3..a6974c6c0 100644 --- a/src/iconc/typinfer.c +++ b/src/iconc/typinfer.c @@ -745,7 +745,7 @@ printf("hash-mask: %x hash-upper: %x hash-upper-shr: %d hash-shifts: %d\n", } #endif /* TypTrc */ } - + /* * find_new - walk the syntax tree allocating structure types where * operations create new structures. diff --git a/src/icont/ixhdr.c b/src/icont/ixhdr.c index c2fb0c7f4..c79a8e04d 100644 --- a/src/icont/ixhdr.c +++ b/src/icont/ixhdr.c @@ -62,7 +62,7 @@ char **argv; else hsyserr(UNICONX ": icode file not found: ", fullpath); } - + /* * doiconx(argv, file) - execute iconx, passing file as argv[1]. * diff --git a/src/icont/lcode.c b/src/icont/lcode.c index 2c5392bca..9fe9eaf39 100644 --- a/src/icont/lcode.c +++ b/src/icont/lcode.c @@ -71,7 +71,7 @@ word pc = 0; /* simulated program counter */ #define CodeCheck(n) if ((word)codep + (n) > (word)((word)codeb + maxcode))\ codeb = (char *) trealloc(codeb, &codep, &maxcode, 1,\ (n), "code buffer"); - + /* * gencode - read .u1 file, resolve variable references, and generate icode. * Basic process is to read each line in the file and take some action @@ -499,7 +499,7 @@ static void setfile() fnmfree++; newline(); } - + /* * lemit - emit opcode. * lemitl - emit opcode with reference to program label. @@ -812,7 +812,7 @@ int nargs, ndyn, nstat, fstat; } } } - + #ifdef OVLD /* * This table contains the method names that allow us to do operator @@ -1657,7 +1657,7 @@ void gentables() fprintf(stderr, " total %7ld\n", (long)tsize); } } - + /* * align() outputs zeroes as padding until pc is a multiple of WordSize. */ @@ -1679,7 +1679,7 @@ static void misalign() if ((pc + IntBits/ByteBits) % WordSize != 0) lemit(Op_Noop, "noop [pad]"); } - + /* * intout(i) outputs i as an int that is used by the runtime system * IntBits/ByteBits bytes must be moved from &word[0] to &codep[0]. @@ -1736,7 +1736,7 @@ static void shortout(short oint) } #endif /* FieldTableCompression */ - + /* * wordout(i) outputs i as a word that is used by the runtime system * WordSize bytes must be moved from &oword[0] to &codep[0]. @@ -1759,7 +1759,7 @@ word oword; codep += WordSize; pc += WordSize; } - + /* * outblock(a,i) output i bytes starting at address a. */ @@ -1772,7 +1772,7 @@ int count; while (count--) *codep++ = *addr++; } - + #ifdef DeBugLinker /* * dumpblock(a,i) dump contents of i bytes at address a, used only @@ -1791,7 +1791,7 @@ int count; putc('\n',dbgfile); } #endif /* DeBugLinker */ - + /* * flushcode - write buffered code to the output file. */ @@ -1802,7 +1802,7 @@ static void flushcode() quit("cannot write icode file"); codep = codeb; } - + /* * clearlab - clear label table to all zeroes. */ @@ -1813,7 +1813,7 @@ static void clearlab() for (i = 0; i < maxlabels; i++) labels[i] = 0; } - + /* * backpatch - fill in all forward references to lab. */ @@ -1844,7 +1844,7 @@ int lab; } labels[lab] = pc; } - + #ifdef DeBugLinker void idump(s) /* dump code region */ char *s; diff --git a/src/icont/lglob.c b/src/icont/lglob.c index fa0e20ba6..f4cc93044 100644 --- a/src/icont/lglob.c +++ b/src/icont/lglob.c @@ -158,7 +158,7 @@ skipOP: switch (op) { } return 1; } - + /* * scanrefs - scan .u1 files for references and mark unreferenced globals. * @@ -339,7 +339,7 @@ void scanrefs() */ free((char *)old); } - + /* * scanfile -- scan one file for references. */ @@ -424,7 +424,7 @@ char *filename; fclose(infile); } - + /* * */ diff --git a/src/icont/link.c b/src/icont/link.c index dd1f60ce9..38fed3893 100644 --- a/src/icont/link.c +++ b/src/icont/link.c @@ -77,7 +77,7 @@ struct lfile *llfiles = NULL; /* List of files to link */ int colmno = 0; /* current source column number */ int lineno = 0; /* current source line number */ int fatals = 0; /* number of errors encountered */ - + /* * cannotopen() - quitf with a detailed errno-based message */ @@ -108,7 +108,7 @@ void cannotopen(char *defaultmsg, char *filnam) quitf(msgbuf,filnam); } - + /* * ilink - link a number of files, returning error count */ @@ -448,7 +448,7 @@ char *outname; setexe(outname); return 0; } - + #ifdef ConsoleWindow extern FILE *flog; #endif /* ConsoleWindow */ @@ -476,7 +476,7 @@ char *s1, *s2, *s3; fprintf(stderr, "\"%s\": %s%s\n", s1, s2, s3); fflush(stderr); } - + /* * lfatal - issue a fatal linker error message. */ @@ -501,7 +501,7 @@ char *s1, *s2; fprintf(stderr, "Line %d # : ", lineno); fprintf(stderr, "\"%s\": %s\n", s1, s2); } - + /* * setexe - mark the output file as executable */ diff --git a/src/icont/llex.c b/src/icont/llex.c index 666161eda..02c5458ae 100644 --- a/src/icont/llex.c +++ b/src/icont/llex.c @@ -12,7 +12,7 @@ int nlflag = 0; /* newline last seen */ #if !EBCDIC #define tonum(c) (isdigit(c) ? (c - '0') : ((c & 037) + 9)) #endif /* !EBCDIC */ - + #if !EBCDIC /* * getopc - get an opcode from infile, return the opcode number (via @@ -76,7 +76,7 @@ char **id; return 0; } #endif /* !EBCDIC */ - + /* * getid - get an identifier from infile, put it in the identifier * table, and return a index to it. @@ -90,7 +90,7 @@ word getid() return EOF; return putident((int)strlen(&lsspace[indx])+1, 1); } - + /* * getstr - get an identifier from infile and return an index to it. */ @@ -129,7 +129,7 @@ word getstr() nlflag = (c == '\n'); return lsfree; } - + /* * getrest - get the rest of the line from infile, put it in the identifier * table, and return its index in the string space. @@ -159,7 +159,7 @@ word getrest() nlflag = (c == '\n'); return putident((int)(indx - lsfree), 1); } - + /* * getdec - get a decimal integer from infile, and return it. */ @@ -184,7 +184,7 @@ int getdec() rv = n * sign; return rv; /* some compilers ... */ } - + /* * getoct - get an octal number from infile, and return it. */ @@ -203,7 +203,7 @@ int getoct() nlflag = (c == '\n'); return n; } - + /* * Get integer, but if it's too large for a long, put the string via wp * and return -1. @@ -264,7 +264,7 @@ word getint(j,wp) return -1; /* indicate integer is too big */ } } - + /* * getreal - get an Icon real number from infile, and return it. */ @@ -318,7 +318,7 @@ double getreal() nlflag = (c == '\n'); return n; } - + /* * getlab - get a label ("L" followed by a number) from infile, * and return the number. @@ -334,7 +334,7 @@ int getlab() nlflag = (c == '\n'); return 0; } - + /* * getstrlit - get a string literal from infile, as a string * of octal bytes, and return its index into the string table. @@ -355,7 +355,7 @@ register int l; lsspace[indx++] = '\0'; return putident((int)(indx-lsfree), 1); } - + /* * newline - skip to next line. */ diff --git a/src/icont/lmem.c b/src/icont/lmem.c index 0984b85fd..81aca8cfe 100644 --- a/src/icont/lmem.c +++ b/src/icont/lmem.c @@ -121,7 +121,7 @@ void linit() */ putglobal(instid("main"), F_Global, 0, 0); } - + #ifdef DeBugLinker /* * dumplfiles - print the list of files to link. Used for debugging only. @@ -138,7 +138,7 @@ void dumplfiles() fflush(stderr); } #endif /* DeBugLinker */ - + /* * alsolink - create an lfile structure for the named file and add it to the * end of the list of files (llfiles) to generate link instructions for. @@ -289,7 +289,7 @@ int add_linked_file(char * file) return 1; } - + /* * getlfile - return a pointer (p) to the lfile structure pointed at by lptr * and move lptr to the lfile structure that p points at. That is, getlfile @@ -308,7 +308,7 @@ struct lfile **lptr; return p; } } - + /* * alclfile - allocate an lfile structure for the named file, fill * in the name and return a pointer to it. @@ -323,7 +323,7 @@ char *name; p->lf_name = salloc(name); return p; } - + #ifdef MultipleRuns /* * freelfile - free memory of an lfile structure. @@ -335,7 +335,7 @@ struct lfile *p; free((char *) p); } #endif /* MultipleRuns */ - + /* * lmfree - free memory used by the linker */ diff --git a/src/icont/lnklist.c b/src/icont/lnklist.c index 61c3c720b..568b12b2c 100644 --- a/src/icont/lnklist.c +++ b/src/icont/lnklist.c @@ -42,7 +42,7 @@ int n; p->iv_link = invkls; invkls = p; } - + /* * alclfile allocates an lfile structure for the named file, fills * in the name and returns a pointer to it. @@ -60,7 +60,7 @@ char *name; p->lf_name = salloc(name); return p; } - + /* * addlfile creates an lfile structure for the named file and add it to the * end of the list of files (lfiles) to generate link instructions for. diff --git a/src/icont/lsym.c b/src/icont/lsym.c index ee75e1216..2fbe9abf8 100644 --- a/src/icont/lsym.c +++ b/src/icont/lsym.c @@ -50,7 +50,7 @@ char *s; return putident(l, 1); } - + /* * putident - install the identifier named by the string starting at lsfree * and extending for len bytes. The installation entails making an @@ -111,7 +111,7 @@ int len, install; lsfree += l; return lihash[hash]->i_name; } - + /* * lexeql - compare two strings of given length. Returns non-zero if * equal, zero if not equal. @@ -125,7 +125,7 @@ register char *s1, *s2; return 0; return 1; } - + /* * alcident - get the next free identifier table entry, and fill it in with * the specified values. @@ -142,7 +142,7 @@ int len; ip->i_length = len; return ip; } - + /* * locinit - clear local symbol table. */ @@ -154,7 +154,7 @@ void locinit() nconst = -1; static1 = lstatics; } - + /* * putlocal - make a local symbol table entry. */ @@ -207,7 +207,7 @@ void putlocal(int n, word id, int flags, int imperror, word procname) else quit("putlocal: unknown flags"); } - + /* * putglobal - make a global symbol table entry. */ @@ -226,7 +226,7 @@ struct gentry *putglobal(word id, int flags, int nargs, int procid) p->g_procid = procid; return p; } - + /* * putconst - make a constant symbol table entry. */ @@ -275,7 +275,7 @@ union xval *valp; fprintf(stderr, "putconst: bad flags: %06o %011" LINTFRMT "o\n", flags, valp->ival); } - + /* * putfield - make a record/field table entry. */ @@ -312,7 +312,7 @@ int fnum; } rp2->r_link = alcfrec(rp, gp, fnum); } - + /* * glocate - lookup identifier in global symbol table, return NULL * if not present. @@ -326,7 +326,7 @@ struct gentry *glocate(word id) p = p->g_blink; return p; } - + /* * flocate - lookup identifier in field table. */ @@ -337,7 +337,7 @@ struct fentry *flocate(word id) p = p->f_blink; return p; } - + /* * alcglobal - create a new global symbol table entry. */ @@ -368,7 +368,7 @@ int procid; lglast = gp; return gp; } - + /* * alcfhead - allocate a field table header. */ @@ -393,7 +393,7 @@ struct rentry *rlist; lflast = fp; return fp; } - + /* * alcfrec - allocate a field table record list element. */ @@ -410,7 +410,7 @@ int fnum; rp->r_fnum = fnum; return rp; } - + /* * blocate - search for a function. The search is linear to make * it easier to add/delete functions. If found, returns index+1 for entry. diff --git a/src/icont/tcode.c b/src/icont/tcode.c index 075448791..a35819226 100644 --- a/src/icont/tcode.c +++ b/src/icont/tcode.c @@ -62,7 +62,7 @@ struct creatstk { int breaklab; /* previous value of breaklab */ }; static int nextlab; /* next label allocated by alclab() */ - + /* * codegen - traverse tree t, generating code. */ @@ -73,7 +73,7 @@ nodeptr t; nextlab = 1; traverse(t); } - + /* * traverse - traverse tree rooted at t and generate code. This is just * plug and chug code for each of the node types. @@ -688,7 +688,7 @@ register nodeptr t; free(t); return n; } - + /* * binop emits code for binary operators. For non-augmented operators, * the name of operator is emitted. For augmented operators, an "asgn" @@ -893,7 +893,7 @@ int op; emit(name); if (asgn) emit("asgn"); - + } /* * unopa and unopb handle code emission for unary operators. unary operator @@ -940,7 +940,7 @@ nodeptr t; tsyserr("unopa: undefined unary operator"); } } - + /* * unopb is the back-end code emitter for unary operators. It emits * the operations represented by the token op. For tokens representing @@ -1032,7 +1032,7 @@ int op; } emit(name); } - + /* * setloc emits "filen" and "line" directives for the source location of * node n. A directive is only emitted if the corresponding value @@ -1076,7 +1076,7 @@ void tcodeinit() lastcol = 0; } #endif /* Multiple Runs */ - + /* * The emit* routines output ucode to codefile. The various routines are: * @@ -1118,7 +1118,7 @@ char *s, *a; { writecheck(fprintf(codefile, "\t%s\t%s\n", s, a)); } - + /* * alclab allocates n labels and returns the first. For the interpreter, * labels are restarted at 1 for each procedure, while in the compiler, diff --git a/src/icont/tlocal.c b/src/icont/tlocal.c index aaf162643..3131f8020 100644 --- a/src/icont/tlocal.c +++ b/src/icont/tlocal.c @@ -13,7 +13,7 @@ /* place to put anything system specific */ Deliberate Syntax Error #endif /* PORT */ - + #if MSDOS #if MICROSOFT diff --git a/src/icont/tmain.c b/src/icont/tmain.c index a88aaf053..b2ead9817 100644 --- a/src/icont/tmain.c +++ b/src/icont/tmain.c @@ -86,7 +86,7 @@ extern char *optarg; /* argument associated with option */ int ConsolePause = 1; #endif /* ConsoleWindow */ - + #if NT || defined(ConsoleWindow) /* @@ -205,7 +205,7 @@ int CmdParamToArgv(char *s, char ***avp, int dequote) return rv; } - + LRESULT_CALLBACK WndProc (HWND, UINT, WPARAM, LPARAM); #if 0 @@ -741,7 +741,7 @@ void iconx(int argc, char** argv){ exit(EXIT_SUCCESS); } - + /* * execute - execute iconx to run the icon program */ @@ -851,7 +851,7 @@ Deliberate Syntax Error quitf("could not run %s",iconxloc); } - + void report(s) char *s; { @@ -863,7 +863,7 @@ char *s; fflush(flog); } } - + /* * Print an error message if called incorrectly. The message depends * on the legal options for this system. diff --git a/src/icont/tmem.c b/src/icont/tmem.c index 2b650f486..d8b58403f 100644 --- a/src/icont/tmem.c +++ b/src/icont/tmem.c @@ -21,7 +21,7 @@ struct tgentry *glast; /* last global table entry */ extern struct str_buf lex_sbuf; - + /* * tmalloc - allocate memory for the translator */ @@ -34,7 +34,7 @@ void tmalloc() init_str(); init_sbuf(&lex_sbuf); } - + /* * meminit - clear tables for use in translating the next file */ @@ -61,7 +61,7 @@ void tminit() for (cp = chash; cp < &chash[lchsize]; cp++) *cp = NULL; } - + /* * tmfree - free memory used by the translator */ diff --git a/src/icont/trans.c b/src/icont/trans.c index ae4d8b6d5..c73cc2934 100644 --- a/src/icont/trans.c +++ b/src/icont/trans.c @@ -22,7 +22,7 @@ int nocode; /* non-zero to suppress code generation */ int in_line; /* current input line number */ int incol; /* current input column number */ int peekc; /* one-character look ahead */ - + /* * translate a number of files, returning an error count */ @@ -60,7 +60,7 @@ char **ifiles; return afatals; } - + extern char *pofile; /* * translate one file. @@ -188,7 +188,7 @@ char *filename; remove(oname1); } } - + /* * writecheck - check the return code from a stdio output operation */ diff --git a/src/icont/tsym.c b/src/icont/tsym.c index 420256eff..1997d5603 100644 --- a/src/icont/tsym.c +++ b/src/icont/tsym.c @@ -33,7 +33,7 @@ void gdump (void); void ldump (void); #endif /* DeBugTrans */ - + /* * Keyword table. */ @@ -48,7 +48,7 @@ static struct keyent keytab[] = { #include "../h/kdefs.h" NULL, -1 }; - + /* * loc_init - clear the local and constant symbol tables. */ @@ -85,7 +85,7 @@ void loc_init() cfirst = NULL; clast = NULL; } - + /* * install - put an identifier into the global or local symbol table. * The basic idea here is to look in the right table and install @@ -139,7 +139,7 @@ int flag, argcnt; tsyserr("install: unrecognized symbol table flag."); } } - + /* * putloc - make a local symbol table entry and return the index * of the entry in lhash. alcloc does the work if there is a collision. @@ -155,7 +155,7 @@ int putloc(char *id, int id_type) } return ptr->l_index; } - + /* * putglob makes a global symbol table entry. alcglob does the work if there * is a collision. @@ -170,7 +170,7 @@ static void putglob(char *id, int id_type, int n_args) ghash[ghasher(id)] = alcglob(ptr, id, id_type, n_args); } } - + /* * putlit makes a constant symbol table entry and returns the table "index" * of the constant. alclit does the work if there is a collision. @@ -186,7 +186,7 @@ int putlit(char *id, int idtype, int len) } return ptr->c_index; } - + /* * llookup looks up id in local symbol table and returns pointer to * to it if found or NULL if not present. @@ -201,7 +201,7 @@ static struct tlentry *llookup(char *id) ptr = ptr->l_blink; return ptr; } - + /* * glookup looks up id in global symbol table and returns pointer to * to it if found or NULL if not present. @@ -216,7 +216,7 @@ static struct tgentry *glookup(char *id) } return ptr; } - + /* * clookup looks up id in constant symbol table and returns pointer to * to it if found or NULL if not present. @@ -229,7 +229,7 @@ static struct tcentry *clookup(char *id, int flag) return ptr; } - + /* * klookup looks up keyword named by id in keyword table and returns * its number (keyid). @@ -244,7 +244,7 @@ int klookup(char *id) return 0; } - + #ifdef DeBugTrans /* * ldump displays local symbol table to stdout. @@ -269,7 +269,7 @@ void ldump() fflush(stderr); } - + /* * gdump displays global symbol table to stdout. */ @@ -293,7 +293,7 @@ void gdump() gptr->g_flag, gptr->g_nargs); fflush(stderr); } - + /* * cdump displays constant symbol table to stdout. */ @@ -317,7 +317,7 @@ void cdump() fflush(stderr); } #endif /* DeBugTrans */ - + /* * alcloc allocates a local symbol table entry, fills in fields with * specified values and returns the new entry. @@ -374,7 +374,7 @@ int flag, nargs; glast = gp; return gp; } - + /* * alclit allocates a constant symbol table entry, fills in fields with * specified values and returns the new entry. @@ -403,7 +403,7 @@ int len, flag; clast = cp; return cp; } - + /* * lout dumps local symbol table to fd, which is a .u1 file. */ @@ -416,7 +416,7 @@ FILE *fd; writecheck(fprintf(fd, "\tlocal\t%d,%06o,%s\n", lp->l_index, lp->l_flag, lp->l_name)); } - + /* * constout dumps constant symbol table to fd, which is a .u1 file. */ @@ -443,7 +443,7 @@ FILE *fd; } } } - + /* * rout dumps a record declaration for name to file fd, which is a .u2 file. */ @@ -462,7 +462,7 @@ char *name; for (lp = lfirst; lp != NULL; lp = lp->l_next) writecheck(fprintf(fd, "\t%d,%s\n", lp->l_index, lp->l_name)); } - + /* * gout writes various items to fd, which is a .u2 file. These items * include: implicit status, tracing activation, link directives, diff --git a/src/icont/util.c b/src/icont/util.c index 19807f4b4..26e92a103 100644 --- a/src/icont/util.c +++ b/src/icont/util.c @@ -12,7 +12,7 @@ extern int optind; extern char *ofile; - + /* * Information about Icon functions. */ @@ -34,7 +34,7 @@ char *ftable[] = { }; int ftbsize = sizeof(ftable)/sizeof(char *); - + /* * tcalloc - allocate and zero m*n bytes */ @@ -47,7 +47,7 @@ unsigned int m, n; quit("out of memory"); return a; } - + struct freedchunk { char *p; struct freedchunk *next; @@ -123,7 +123,7 @@ char *tbl_name; /* name of the table */ return (pointer)new_tbl; } - + /* * round2 - round an integer up to the next power of 2. diff --git a/src/preproc/bldtok.c b/src/preproc/bldtok.c index 1ad7bb6b4..cf8a454bd 100644 --- a/src/preproc/bldtok.c +++ b/src/preproc/bldtok.c @@ -57,7 +57,7 @@ static struct rsrvd_wrd pp_rsrvd[] = { {"error", PpError}, {"pragma", PpPragma}, {NULL, Invalid}}; - + /* * init_tok - initialize tokenizer. */ @@ -79,7 +79,7 @@ void init_tok() one_tok = new_token(PpNumber, spec_str("1"), "", 0); } } - + /* * pp_tok_id - see if s in the name of a preprocessing directive. */ @@ -92,7 +92,7 @@ char *s; ; return rw->tok_id; } - + /* * chk_eq_sign - look ahead to next character to see if it is an equal sign. * It is used for processing -D options. @@ -106,7 +106,7 @@ int chk_eq_sign() else return 0; } - + /* * chck_wh_sp - If the input is at white space, construct a white space token * and return it, otherwise return NULL. This function also helps keeps track @@ -261,7 +261,7 @@ struct char_src *cs; } return t; } - + /* * pp_number - Create a token for a preprocessing number (See ANSI C Standard * for the syntax of such a number). @@ -292,7 +292,7 @@ static struct token *pp_number() } } } - + /* * char_str - construct a token for a character constant or string literal. */ @@ -322,7 +322,7 @@ int tok_id; AdvChar(); return new_token(tok_id, str_install(&tknize_sbuf), fname, line); } - + /* * hdr_tok - create a token for an #include header. The delimiter may be * > or ". @@ -350,7 +350,7 @@ struct char_src *cs; AdvChar(); return new_token(tok_id, str_install(&tknize_sbuf), fname, line); } - + /* * tokenize - return the next token from the character source on the top * of the source stack. diff --git a/src/preproc/evaluate.c b/src/preproc/evaluate.c index 2b03aca50..47ab772b2 100644 --- a/src/preproc/evaluate.c +++ b/src/preproc/evaluate.c @@ -25,7 +25,7 @@ static long log_and (struct token **tp, struct token *trigger); static long log_or (struct token **tp, struct token *trigger); #include "../preproc/pproto.h" - + /* * ::= * defined @@ -242,7 +242,7 @@ struct token *trigger; /*NOTREACHED*/ return 0; /* avoid gcc warning */ } - + /* * ::= | * '+' | @@ -271,7 +271,7 @@ struct token *trigger; return primary(tp, trigger); } } - + /* * ::= | * '*' | @@ -311,7 +311,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '+' | @@ -337,7 +337,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '<<' | @@ -363,7 +363,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '<' | @@ -401,7 +401,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '==' | @@ -427,7 +427,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '&' @@ -446,7 +446,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '^' @@ -465,7 +465,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '|' @@ -484,7 +484,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '&&' @@ -503,7 +503,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '||' @@ -522,7 +522,7 @@ struct token *trigger; } return e1; } - + /* * ::= | * '?' ':' @@ -546,7 +546,7 @@ struct token *trigger; else return e1; } - + /* * eval - get the tokens for a conditional and evaluate it to 0 or 1. * trigger is the preprocessing directive that triggered the evaluation; diff --git a/src/preproc/files.c b/src/preproc/files.c index 168635f3e..e15b2a017 100644 --- a/src/preproc/files.c +++ b/src/preproc/files.c @@ -98,7 +98,7 @@ Deliberate Syntax Error next_char = NULL; fill_cbuf(); } - + /* * source - Open the file named fname or use stdin if fname is "-". fname * is the first file from which to read input (that is, the outermost file). @@ -116,7 +116,7 @@ char *fname; file_src(fname, f); } } - + /* * include - open the file named fname and make it the current input file. */ @@ -228,7 +228,7 @@ int system; errt2(trigger, "cannot open include file ", fname); file_src(path, f); } - + /* * init_files - Initialize this module, setting up the search path for * system header files. diff --git a/src/preproc/gettok.c b/src/preproc/gettok.c index 8c65226fa..f19a3207c 100644 --- a/src/preproc/gettok.c +++ b/src/preproc/gettok.c @@ -131,7 +131,7 @@ struct token *next_tok() else return t; } - + /* * Get the next raw non-white space token, freeing token that the argument * used to point to. @@ -171,7 +171,7 @@ struct token **tp; free_t(*tp); *tp = t; } - + /* * merge_whsp - merge a sequence of white space tokens into one token, * returning it along with the next token. Whether these are raw or diff --git a/src/preproc/macro.c b/src/preproc/macro.c index c458d694a..db64084aa 100644 --- a/src/preproc/macro.c +++ b/src/preproc/macro.c @@ -36,7 +36,7 @@ static char *date_mac = "__DATE__"; static char *time_mac = "__TIME__"; static char *rcrs_mac = "__RCRS__"; static char *defined = "defined"; - + /* * m_find - return return location of pointer to where macro belongs in * macro table. If the macro is not in the table, the pointer at the @@ -52,7 +52,7 @@ char *mname; ; return mpp; } - + /* * eq_id_lst - check to see if two identifier lists contain the same identifiers * in the same order. @@ -89,7 +89,7 @@ struct tok_lst *lst2; return 0; return eq_tok_lst(lst1->next, lst2->next); } - + /* * init_macro - initialize this module, setting up standard macros. */ @@ -175,7 +175,7 @@ void init_macro() *mpp = new_macro(rcrs_mac, NoArgs, 0, NULL, new_t_lst(copy_t(one_tok))); max_recurse = 1; } - + /* * m_install - install a macro. */ @@ -225,7 +225,7 @@ struct tok_lst *body; /* replacement list */ free_t_lst(body); } } - + /* * m_delete - delete a macro. */ @@ -257,7 +257,7 @@ struct token *mname; free_m(mp); } } - + /* * m_lookup - lookup a macro name. Return pointer to macro, if it is defined; * return NULL, if it is not. This routine sets the definition for macros @@ -281,7 +281,7 @@ struct macro *m_lookup(struct token *id) } return m; } - + /* * parm_indx - see if a name is a paramter to the given macro. */ @@ -295,7 +295,7 @@ static int parm_indx(char *id, struct macro *m) return i; return -1; } - + /* * cpy_str - copy a string into a string buffer, adding delimiters. */ @@ -319,7 +319,7 @@ struct str_buf *sbuf; for (s = rdelim; *s != '\0'; ++s) AppChar(*sbuf, *s); } - + /* * stringize - create a stringized version of a token. */ @@ -381,7 +381,7 @@ struct mac_expand *me; rel_sbuf(sbuf); return t; } - + /* * paste_parse - parse an expression involving token pasting operators (and * stringizing operators). Return a list of token lists. Each token list @@ -446,7 +446,7 @@ struct mac_expand *me; else return new_plsts(trigger, lst, plst); } - + /* * cpy_image - copy the image of a token into a character buffer adding * delimiters if it is a string or character literal. @@ -491,7 +491,7 @@ int *s; /* the string buffer can contain EOF */ return s; } - + /* * paste - return the next token from a source which pastes tokens. The * source may represent a series of token pasting operators. @@ -557,7 +557,7 @@ struct token *paste() return next_tok(); /* first token from pasted images */ } - + /* * mac_tok - return the next token from a source which is a macro. */ diff --git a/src/preproc/pinit.c b/src/preproc/pinit.c index 57e1ecd1d..731875c36 100644 --- a/src/preproc/pinit.c +++ b/src/preproc/pinit.c @@ -68,7 +68,7 @@ char **opt_args; mac_opts(opt_lst, opt_args); /* process options for predefined macros */ source(fname); /* establish primary source file */ } - + /* * mac_opts - handle options which affect what predefined macros are in * effect when preprocessing starts. Some of these options may be system @@ -490,7 +490,7 @@ Deliberate Syntax Error */ } } - + /* * str_src - establish a string, given by a character pointer and a length, * as the current source of tokens. diff --git a/src/preproc/preproc.c b/src/preproc/preproc.c index e3853e7d2..b44134d80 100644 --- a/src/preproc/preproc.c +++ b/src/preproc/preproc.c @@ -129,7 +129,7 @@ struct token *t; tlst->next = src_stack->cond; src_stack->cond = tlst; } - + /* * end_select - handle #elif, #else, and #endif */ @@ -186,7 +186,7 @@ struct token *t; free_t(t1); return; } - + /* * incl_file - handle #include */ @@ -285,7 +285,7 @@ struct token *t; free_t(file_tok); free_t(t); } - + /* * define - handle #define and #begdef */ @@ -412,7 +412,7 @@ struct token *t; m_install(mname, category, multi_line, prmlst, body); free_t(mname); } - + /* * expand - add expansion of macro to source stack. */ @@ -615,7 +615,7 @@ struct token *t; } free_t(t); } - + /* * interp_dir - interpret preprocessing directives and recognize macro calls. */ @@ -751,7 +751,7 @@ struct token *interp_dir() } } } - + /* * See if compiler used to build the preprocessor recognizes '\a' @@ -828,7 +828,7 @@ static struct token *check_bell() } #endif /* '\a' == Bell */ - + /* * preproc - return the next fully preprocessed token. */ diff --git a/src/rtt/rttlex.c b/src/rtt/rttlex.c index f670c61d1..6b53e0f3c 100644 --- a/src/rtt/rttlex.c +++ b/src/rtt/rttlex.c @@ -127,7 +127,7 @@ static int good_char[128] = { 1 /* | */, 1 /* } */, 1 /* ~ */, 0 /* \d */ }; #endif /* EBCDIC */ - + /* * init_lex - initialize lexical analyzer. */ @@ -232,7 +232,7 @@ void init_lex() } } } - + /* * int_suffix - we have reached the end of what seems to be an integer * constant. check for a valid suffix. @@ -266,7 +266,7 @@ char *s; errt2(yylval.t, "invalid integer constant: ", yylval.t->image); return tok_id; } - + /* * yylex - lexical analyzer, called by yacc-generated parser. */ diff --git a/src/runtime/cnv.r b/src/runtime/cnv.r index 67d0a5c34..69bbb952d 100644 --- a/src/runtime/cnv.r +++ b/src/runtime/cnv.r @@ -64,7 +64,7 @@ int cnv_c_dbl(dptr s, double *d) if (Type(*s) == T_Lrgint) return bigtoreal(s, d); else -#endif /* LargeInts */ +#endif /* LargeInts */ *d = IntVal(*s); @@ -93,9 +93,9 @@ int cnv_c_dbl(dptr s, double *d) #ifdef LargeInts case T_Lrgint: result.dword = D_Lrgint; - BlkLoc(result) = (union block *)numrc.big; + BlkLoc(result) = (union block *)numrc.big; return bigtoreal(&result, d); -#endif /* LargeInts */ +#endif /* LargeInts */ case T_Real: *d = numrc.real; @@ -112,7 +112,7 @@ int cnv_c_int(s, d) dptr s; C_integer *d; { - struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ + struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ union numeric numrc; char sbuf[MaxCvtLen]; @@ -123,7 +123,7 @@ C_integer *d; if (Type(*s) == T_Lrgint) { return 0; } -#endif /* LargeInts */ +#endif /* LargeInts */ *d = IntVal(*s); return 1; @@ -156,7 +156,7 @@ C_integer *d; case T_Integer: { *d = numrc.integer; return 1; - } + } case T_Real: { double dbl = numrc.real; if (dbl > MaxLong || dbl < MinLong) { @@ -243,7 +243,7 @@ int f(dptr s, dptr d) l = StrLen(str); while(l--) { Setb(*s1, *d); - s1++; + s1++; } EVValD(d, e_sconv); return 1; @@ -258,9 +258,9 @@ int f(dptr s, dptr d) #ifdef MultiProgram cnv_cset_macro(cnv_cset_0,0,0,0,0,0) cnv_cset_macro(cnv_cset_1,E_Aconv,E_Tconv,E_Nconv,E_Sconv,E_Fconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_cset_macro(cnv_cset,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * cnv_ec_int - cnv:(exact)C_integer(*s, *d), convert to an exact C integer @@ -269,7 +269,7 @@ int cnv_ec_int(s, d) dptr s; C_integer *d; { - struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ + struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ union numeric numrc; char sbuf[MaxCvtLen]; @@ -280,7 +280,7 @@ C_integer *d; if (Type(*s) == T_Lrgint) { return 0; } -#endif /* LargeInts */ +#endif /* LargeInts */ *d = IntVal(*s); return 1; } @@ -314,7 +314,7 @@ C_integer *d; int cnv_eint(s, d) dptr s, d; { - struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ + struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ char sbuf[MaxCvtLen]; union numeric numrc; @@ -341,14 +341,14 @@ dptr s, d; switch (ston(s, &numrc)) { case T_Integer: MakeInt(numrc.integer, d); - return 1; + return 1; #ifdef LargeInts case T_Lrgint: d->dword = D_Lrgint; - BlkLoc(*d) = (union block *)numrc.big; + BlkLoc(*d) = (union block *)numrc.big; return 1; -#endif /* LargeInts */ +#endif /* LargeInts */ default: return 0; @@ -362,7 +362,7 @@ dptr s, d; int f(s, d) dptr s, d; { - struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ + struct descrip cnvstr; /* not tended, see comment at cnv_c_dbl */ char sbuf[MaxCvtLen]; union numeric numrc; @@ -389,11 +389,11 @@ dptr s, d; EVValD(s, e_fconv); return 0; } -#else /* LargeInts */ +#else /* LargeInts */ EVValD(s, e_fconv); return 0; -#endif /* LargeInts */ - } +#endif /* LargeInts */ + } MakeInt((word)dbl,d); EVValD(d, e_sconv); return 1; @@ -419,10 +419,10 @@ dptr s, d; #ifdef LargeInts case T_Lrgint: d->dword = D_Lrgint; - BlkLoc(*d) = (union block *)numrc.big; + BlkLoc(*d) = (union block *)numrc.big; EVValD(d, e_sconv); - return 1; -#endif /* LargeInts */ + return 1; +#endif /* LargeInts */ case T_Integer: MakeInt(numrc.integer,d); @@ -434,11 +434,11 @@ dptr s, d; #ifdef LargeInts #ifdef DescriptorDouble - s->vword.realval = dbl; + s->vword.realval = dbl; #else BlkLoc(*s) = (union block *)alcreal(dbl); #endif - s->dword = D_Real; + s->dword = D_Real; if (realtobig(s, d) == Succeeded) { EVValD(d, e_sconv); return 1; @@ -447,11 +447,11 @@ dptr s, d; EVValD(s, e_fconv); return 0; } -#else /* LargeInts */ +#else /* LargeInts */ EVValD(s, e_fconv); return 0; -#endif /* LargeInts */ - } +#endif /* LargeInts */ + } MakeInt((word)dbl,d); EVValD(d, e_sconv); return 1; @@ -467,9 +467,9 @@ dptr s, d; #passthru #undef cnv_int cnv_int_macro(cnv_int,0,0,0,0,0) cnv_int_macro(cnv_int_1,E_Aconv,E_Tconv,E_Nconv,E_Fconv,E_Sconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_int_macro(cnv_int,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cnv_real_macro(f,e_aconv,e_tconv,e_sconv,e_fconv) /* @@ -485,9 +485,9 @@ int f(dptr s, dptr d) if (cnv_c_dbl(s, &dbl)) { #ifdef DescriptorDouble d->vword.realval = dbl; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ Protect(BlkLoc(*d) = (union block *)alcreal(dbl), fatalerr(0,NULL)); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ d->dword = D_Real; EVValD(d, e_sconv); return 1; @@ -502,9 +502,9 @@ int f(dptr s, dptr d) #passthru #undef cnv_real cnv_real_macro(cnv_real,0,0,0,0) cnv_real_macro(cnv_real_1,E_Aconv,E_Tconv,E_Sconv,E_Fconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_real_macro(cnv_real,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cnv_str_macro(f, e_aconv, e_tconv, e_nconv, e_sconf, e_fconv) @@ -528,13 +528,13 @@ int f(dptr s, dptr d) #ifdef LargeInts if (Type(*s) == T_Lrgint) { - bigtos(s,d); - } + bigtos(s,d); + } else -#endif /* LargeInts */ +#endif /* LargeInts */ itos(IntVal(*s), d, sbuf); - } + } real: { double res; GetReal(s, res); @@ -542,7 +542,7 @@ int f(dptr s, dptr d) } cset: { cstos(BlkD(*s,Cset)->bits, d, sbuf); - } + } default: { EVValD(s, e_fconv); return 0; @@ -558,9 +558,9 @@ int f(dptr s, dptr d) #passthru #undef cnv_str cnv_str_macro(cnv_str,0,0,0,0,0) cnv_str_macro(cnv_str_1,E_Aconv,E_Tconv,E_Nconv,E_Sconv,E_Fconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_str_macro(cnv_str,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cnv_tcset_macro(f, e_aconv, e_tconv, e_nconv, e_sconv, e_fconv) /* @@ -587,7 +587,7 @@ int f(struct b_cset *cbuf, dptr s, dptr d) return 1; } if (tmp_str(sbuf, s, &tmpstr)) { - for (l = 0; l < CsetSize; l++) + for (l = 0; l < CsetSize; l++) cbuf->bits[l] = 0; d->dword = D_Cset; BlkLoc(*d) = (union block *)cbuf; @@ -595,7 +595,7 @@ int f(struct b_cset *cbuf, dptr s, dptr d) l = StrLen(tmpstr); while(l--) { Setb(*s1, *d); - s1++; + s1++; } EVValD(d, e_sconv); return 1; @@ -610,9 +610,9 @@ int f(struct b_cset *cbuf, dptr s, dptr d) #ifdef MultiProgram cnv_tcset_macro(cnv_tcset_0,0,0,0,0,0) cnv_tcset_macro(cnv_tcset_1,E_Aconv,E_Tconv,E_Nconv,E_Sconv,E_Fconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_tcset_macro(cnv_tcset,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cnv_tstr_macro(f,e_aconv,e_tconv,e_nconv,e_sconv,e_fconv) /* @@ -642,9 +642,9 @@ int f(char *sbuf, dptr s, dptr d) #ifdef MultiProgram cnv_tstr_macro(cnv_tstr_0,0,0,0,0,0) cnv_tstr_macro(cnv_tstr_1,E_Aconv,E_Tconv,E_Nconv,E_Sconv,E_Fconv) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_tstr_macro(cnv_tstr,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef deref_macro(f, e_deref) /* @@ -693,34 +693,34 @@ void f(dptr s, dptr d) * Look up the element in the table. */ bp = BlkLoc(*s); - if (BlkType(Blk(bp,Tvtbl)->clink) == T_File) { - int status = Blk(Blk(bp,Tvtbl)->clink,File)->status; + if (BlkType(Blk(bp,Tvtbl)->clink) == T_File) { + int status = Blk(Blk(bp,Tvtbl)->clink,File)->status; #ifdef Dbm - if (status & Fs_Dbm) { - DBM *db; - datum key, content; - db = (DBM *)Blk(Blk(bp,Tvtbl)->clink,File)->fd.fp; - if (!cnv:string(bp->Tvtbl.tref, bp->Tvtbl.tref)) { /* key */ - fatalerr(103, &(bp->Tvtbl.tref)); - } - key.dptr = StrLoc(Blk(bp,Tvtbl)->tref); - key.dsize = StrLen(Blk(bp,Tvtbl)->tref); - content = dbm_fetch(db, key); - if (content.dptr == NULL) *d = nulldesc; - else { - StrLoc(*d) = alcstr(content.dptr, content.dsize); - Protect(StrLoc(*d),fatalerr(103, s)); - StrLen(*d) = content.dsize; - } - return; - } - else -#endif /* Dbm */ - fatalerr(103, s); - } + if (status & Fs_Dbm) { + DBM *db; + datum key, content; + db = (DBM *)Blk(Blk(bp,Tvtbl)->clink,File)->fd.fp; + if (!cnv:string(bp->Tvtbl.tref, bp->Tvtbl.tref)) { /* key */ + fatalerr(103, &(bp->Tvtbl.tref)); + } + key.dptr = StrLoc(Blk(bp,Tvtbl)->tref); + key.dsize = StrLen(Blk(bp,Tvtbl)->tref); + content = dbm_fetch(db, key); + if (content.dptr == NULL) *d = nulldesc; + else { + StrLoc(*d) = alcstr(content.dptr, content.dsize); + Protect(StrLoc(*d),fatalerr(103, s)); + StrLen(*d) = content.dsize; + } + return; + } + else +#endif /* Dbm */ + fatalerr(103, s); + } ep = memb(bp->Tvtbl.clink,&(bp->Tvtbl.tref), bp->Tvtbl.hashnum, &res); if (res == 1) - *d = Blk((*ep),Telem)->tval; /* found; use value */ + *d = Blk((*ep),Telem)->tval; /* found; use value */ else *d = Blk(Blk(bp,Tvtbl)->clink,Table)->defvalue; /* use default */ } @@ -736,31 +736,31 @@ void f(dptr s, dptr d) tvmonitored:{ #ifdef EventMon *d = *(VarLoc(BlkD(*s,Tvmonitored)->tv)); -#endif /* EventMon */ +#endif /* EventMon */ } default: { #ifdef Arrays - if (Offset(*s) > 0) { - if (BlkLoc(*s)->Realarray.title == T_Realarray) { + if (Offset(*s) > 0) { + if (BlkLoc(*s)->Realarray.title == T_Realarray) { #ifdef DescriptorDouble - d->vword.realval = *(double *)((word *)VarLoc(*s) + Offset(*s)); -#else /* DescriptorDouble */ - d->vword.bptr = - (union block *) alcreal(*(double *)((word *)VarLoc(*s) + - Offset(*s))); -#endif /* DescriptorDouble */ - d->dword = D_Real; - } - else if (BlkLoc(*s)->Intarray.title == T_Intarray) { - d->vword.integr = (word) *((word *)(VarLoc(*s)) + Offset(*s)) ; - d->dword = D_Integer; - } - else - *d = *(dptr)((word *)VarLoc(*s) + Offset(*s)); - } - else -#endif /* Arrays */ + d->vword.realval = *(double *)((word *)VarLoc(*s) + Offset(*s)); +#else /* DescriptorDouble */ + d->vword.bptr = + (union block *) alcreal(*(double *)((word *)VarLoc(*s) + + Offset(*s))); +#endif /* DescriptorDouble */ + d->dword = D_Real; + } + else if (BlkLoc(*s)->Intarray.title == T_Intarray) { + d->vword.integr = (word) *((word *)(VarLoc(*s)) + Offset(*s)) ; + d->dword = D_Integer; + } + else + *d = *(dptr)((word *)VarLoc(*s) + Offset(*s)); + } + else +#endif /* Arrays */ /* * An ordinary variable is being dereferenced. @@ -775,21 +775,21 @@ void f(dptr s, dptr d) #ifdef MultiProgram deref_macro(deref_0,0) deref_macro(deref_1,E_Deref) -#else /* MultiProgram */ +#else /* MultiProgram */ deref_macro(deref,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * getdbl - return as a double the value inside a real block. */ -double getdbl(dp) +double getdbl(dp) dptr dp; { double d; GetReal(dp, d); return d; } - + /* * tmp_str - Convert to temporary string. */ @@ -805,13 +805,13 @@ dptr d; #ifdef LargeInts if (Type(*s) == T_Lrgint) { - bigtos(s,d); - } + bigtos(s,d); + } else -#endif /* LargeInts */ +#endif /* LargeInts */ itos(IntVal(*s), d, sbuf); - } + } real: { double res; GetReal(s, res); @@ -824,9 +824,9 @@ dptr d; } return 1; } - + /* - * dp_pnmcmp - do a string comparison of a descriptor to the procedure + * dp_pnmcmp - do a string comparison of a descriptor to the procedure * name in a pstrnm struct; used in call to qsearch(). */ int dp_pnmcmp(pne,dp) @@ -838,7 +838,7 @@ struct descrip *dp; StrLoc(d) = pne->pstrep; return lexcmp(&d,dp); } - + /* * bi_strprc - convert a string to a (built-in) function or operator. */ @@ -847,7 +847,7 @@ struct b_proc *bi_strprc(dptr s, C_integer arity) C_integer i; #if !COMPILER struct pstrnm *pp; -#endif /* !COMPILER */ +#endif /* !COMPILER */ if (!StrLen(*s)) return NULL; @@ -858,9 +858,9 @@ struct b_proc *bi_strprc(dptr s, C_integer arity) */ if (!isalpha(*StrLoc(*s))) { for (i = 0; i < op_tbl_sz; ++i) - if (eq(s, &op_tbl[i].pname) && (arity == op_tbl[i].nparam || - op_tbl[i].nparam == -1)) - return &op_tbl[i]; + if (eq(s, &op_tbl[i].pname) && (arity == op_tbl[i].nparam || + op_tbl[i].nparam == -1)) + return &op_tbl[i]; return NULL; } @@ -870,13 +870,13 @@ struct b_proc *bi_strprc(dptr s, C_integer arity) #if COMPILER for (i = 0; i < n_globals; ++i) if (eq(s, &gnames[i])) - return builtins[i]; /* may be null */ -#else /* COMPILER */ + return builtins[i]; /* may be null */ +#else /* COMPILER */ pp = (struct pstrnm *)qsearch((char *)s,(char *)pntab,pnsize, - sizeof(struct pstrnm),dp_pnmcmp); + sizeof(struct pstrnm),dp_pnmcmp); if (pp!=NULL) return (struct b_proc *)pp->pblock; -#endif /* !COMPILER */ +#endif /* !COMPILER */ return NULL; } @@ -897,11 +897,11 @@ struct b_proc *strprc(dptr s, C_integer arity) return BlkD(globals[i], Proc); else return NULL; - } + } } return bi_strprc(s,arity); } - + /* * Service routines */ @@ -925,28 +925,28 @@ char *s; *p = '\0'; if (num >= 0L) do { - *--p = ival % 10L + '0'; - ival /= 10L; - } while (ival != 0L); + *--p = ival % 10L + '0'; + ival /= 10L; + } while (ival != 0L); else { if (ival == MinLong) { - p -= strlen(MaxNegInt); - strcpy(p, MaxNegInt); + p -= strlen(MaxNegInt); + strcpy(p, MaxNegInt); } else { - ival = -ival; - do { - *--p = '0' + (ival % 10L); - ival /= 10L; - } while (ival != 0L); - *--p = '-'; - } + ival = -ival; + do { + *--p = '0' + (ival % 10L); + ival /= 10L; + } while (ival != 0L); + *--p = '-'; + } } StrLen(*dp) = s + MaxCvtLen - 1 - p; StrLoc(*dp) = p; } - + /* * ston - convert a string to a numeric quantity if possible. @@ -961,20 +961,20 @@ union numeric *result; { register char *s = StrLoc(*sptr), *end_s; register int c; - int realflag = 0; /* indicates a real number */ + int realflag = 0; /* indicates a real number */ char msign = '+'; /* sign of mantissa */ char esign = '+'; /* sign of exponent */ double mantissa = 0; /* scaled mantissa with no fractional part */ - word lresult = 0; /* integer result */ - int scale = 0; /* number of decimal places to shift mantissa */ - int digits = 0; /* total number of digits seen */ - int sdigits = 0; /* number of significant digits seen */ - int exponent = 0; /* exponent part of real number */ - double fiveto; /* holds 5^scale */ - double power; /* holds successive squares of 5 to compute fiveto */ + word lresult = 0; /* integer result */ + int scale = 0; /* number of decimal places to shift mantissa */ + int digits = 0; /* total number of digits seen */ + int sdigits = 0; /* number of significant digits seen */ + int exponent = 0; /* exponent part of real number */ + double fiveto; /* holds 5^scale */ + double power; /* holds successive squares of 5 to compute fiveto */ int err_no; char *ssave; /* holds original ptr for bigradix */ - int suffix = 0; /* number of times to multiply 1024 into the result */ + int suffix = 0; /* number of times to multiply 1024 into the result */ if (StrLen(*sptr) == 0) return CvtFail; @@ -999,18 +999,18 @@ union numeric *result; } else if (c == '&') { if ((StrLen(*sptr) == 3) && (s[0] == 'p') && (s[1] == 'i')) { - result->real = Pi; - return T_Real; - } + result->real = Pi; + return T_Real; + } else if ((StrLen(*sptr) == 2) && (s[0] == 'e')) { - result->real = 2.71828182845904523536028747135266249775724709369996; - return T_Real; - } + result->real = 2.71828182845904523536028747135266249775724709369996; + return T_Real; + } if ((StrLen(*sptr) == 4) && (s[0] == 'p') && - (s[1] == 'h') && (s[2] == 'i')) { - result->real = 1.618033988749894848204586834365638117720309180; - return T_Real; - } + (s[1] == 'h') && (s[2] == 'i')) { + result->real = 1.618033988749894848204586834365638117720309180; + return T_Real; + } else return CvtFail; } @@ -1022,13 +1022,13 @@ union numeric *result; while (isdigit(c)) { digits++; if (mantissa < Big) { - mantissa = mantissa * 10 + (c - '0'); + mantissa = mantissa * 10 + (c - '0'); lresult = lresult * 10 + (c - '0'); - if (mantissa > 0.0) - sdigits++; - } + if (mantissa > 0.0) + sdigits++; + } else - scale++; + scale++; c = (s < end_s) ? *s++ : ' '; } @@ -1041,9 +1041,9 @@ union numeric *result; rv = bigradix((int)msign, (int)mantissa, s, end_s, result); if (rv == RunError) fatalerr(0, NULL); -#else /* LargeInts */ +#else /* LargeInts */ rv = radix((int)msign, (int)mantissa, s, end_s, result); -#endif /* LargeInts */ +#endif /* LargeInts */ return rv; } @@ -1054,16 +1054,16 @@ union numeric *result; realflag++; c = (s < end_s) ? *s++ : ' '; while (isdigit(c)) { - digits++; - if (mantissa < Big) { - mantissa = mantissa * 10 + (c - '0'); - lresult = lresult * 10 + (c - '0'); - scale--; - if (mantissa > 0.0) - sdigits++; - } + digits++; + if (mantissa < Big) { + mantissa = mantissa * 10 + (c - '0'); + lresult = lresult * 10 + (c - '0'); + scale--; + if (mantissa > 0.0) + sdigits++; + } c = (s < end_s) ? *s++ : ' '; - } + } } /* @@ -1085,16 +1085,16 @@ union numeric *result; realflag++; c = (s < end_s) ? *s++ : ' '; if (c == '+' || c == '-') { - esign = c; + esign = c; c = (s < end_s) ? *s++ : ' '; - } + } if (!isdigit(c)) - return CvtFail; + return CvtFail; while (isdigit(c)) { - exponent = exponent * 10 + (c - '0'); - if (exponent > 308) return CvtFail; + exponent = exponent * 10 + (c - '0'); + if (exponent > 308) return CvtFail; c = (s < end_s) ? *s++ : ' '; - } + } scale += (esign == '+') ? exponent : -exponent; } } @@ -1129,7 +1129,7 @@ union numeric *result; */ #if COMPILER if (largeints) -#endif /* COMPILER */ +#endif /* COMPILER */ if (!realflag) { int rv; rv = bigradix((int)msign, 10, ssave, end_s, result); @@ -1137,10 +1137,10 @@ union numeric *result; fatalerr(0, NULL); return rv; } -#endif /* LargeInts */ +#endif /* LargeInts */ if (!realflag) - return CvtFail; /* don't promote to real if integer format */ + return CvtFail; /* don't promote to real if integer format */ /* * Rough tests for overflow and underflow. @@ -1163,10 +1163,10 @@ union numeric *result; power = 5.0; for (;;) { if (exponent & 01) - fiveto *= power; + fiveto *= power; exponent >>= 1; if (exponent == 0) - break; + break; power *= power; } if (scale > 0) @@ -1210,7 +1210,7 @@ union numeric *result; while (isalnum(c)) { c = tonum(c); if (c >= r) - return CvtFail; + return CvtFail; num = num * r + c; c = (s < end_s) ? *s++ : ' '; } @@ -1229,9 +1229,9 @@ union numeric *result; return T_Integer; } -#endif /* COMPILER || !(defined LargeInts) */ +#endif /* COMPILER || !(defined LargeInts) */ + - /* * cvpos - convert position to strictly positive position * given length. @@ -1261,7 +1261,7 @@ register word len; return p; return (len + p + 1); } - + double dblZero = 0.0; /* @@ -1273,26 +1273,26 @@ double n; dptr dp; char *s; { - s++; /* leave room for leading zero */ + s++; /* leave room for leading zero */ sprintf(s, "%.*g", Precision, n + dblZero); /* format, avoiding -0 */ /* * Now clean up possible messes. */ - while (*s == ' ') /* delete leading blanks */ + while (*s == ' ') /* delete leading blanks */ s++; - if (*s == '.') { /* prefix 0 to initial period */ + if (*s == '.') { /* prefix 0 to initial period */ s--; *s = '0'; } else if (!strchr(s, '.') && !strchr(s,'e') && !strchr(s,'E')) - strcat(s, ".0"); /* if no decimal point or exp. */ - if (s[strlen(s) - 1] == '.') /* if decimal point is at end ... */ + strcat(s, ".0"); /* if no decimal point or exp. */ + if (s[strlen(s) - 1] == '.') /* if decimal point is at end ... */ strcat(s, "0"); StrLen(*dp) = strlen(s); StrLoc(*dp) = s; } - + /* * cstos - convert the cset bit array pointed at by cs into a string using * s as a buffer and making a descriptor for the resulting string. @@ -1310,9 +1310,9 @@ char *s; p = s; for (i = 0; i < CsetSize; i++) { if (cs[i]) - for (j=i*IntBits, w=cs[i]; w; j++, w >>= 1) - if (w & 01) - *p++ = FromAscii((char)j); + for (j=i*IntBits, w=cs[i]; w; j++, w >>= 1) + if (w & 01) + *p++ = FromAscii((char)j); } *p = '\0'; @@ -1346,9 +1346,9 @@ int cnv_list(dptr s, dptr d) if (size > 0) { /* only need to copy values for non-empty sets */ d1 = Blk(lp->listhead,Lelem)->lslots; for (j=0; j < HSegs && (seg= BlkPH(bp,Table,hdir)[j])!=NULL;j++) - for (k = segsize[j] - 1; k >= 0; k--) - for (ep= seg->hslots[k]; ep!=NULL;ep=BlkPE(ep,Telem,clink)) - *d1++ = BlkPE(ep,Selem,setmem); + for (k = segsize[j] - 1; k >= 0; k--) + for (ep= seg->hslots[k]; ep!=NULL;ep=BlkPE(ep,Telem,clink)) + *d1++ = BlkPE(ep,Selem,setmem); } Desc_EVValD(lp, E_Lcreate, D_List); diff --git a/src/runtime/data.r b/src/runtime/data.r index 7cbdb66c3..58c033e3e 100644 --- a/src/runtime/data.r +++ b/src/runtime/data.r @@ -13,7 +13,7 @@ struct b_proc Bnoproc; struct b_iproc mt_llist = { 6, (sizeof(struct b_proc) - sizeof(struct descrip)), Ollist, 0, -1, 0, 0, {sizeof( "[...]")-1, "[...]"}}; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * External declarations for function blocks. @@ -38,11 +38,11 @@ extern struct b_proc Bfield; extern struct b_proc Blimit; extern struct b_proc Bllist; - + struct b_proc *opblks[] = { - NULL, + NULL, #define OpDef(p,n,s,u) Cat(&B,p), #include "../h/odefs.h" #undef OpDef @@ -85,13 +85,13 @@ struct pstrnm pntab[] = { #undef FncDef #undef FncDefV - 0, 0 - }; + 0, 0 + }; int pnsize = (sizeof(pntab) / sizeof(struct pstrnm)) - 1; -#endif /* COMPILER */ - +#endif /* COMPILER */ + /* * Structures for built-in values. Parts of some of these structures are * initialized later. Since some C compilers cannot handle any partial @@ -106,9 +106,9 @@ struct b_cset blankcs = { 1, #if !EBCDIC cset_display(0, 0, 01, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#else /* EBCDIC */ +#else /* EBCDIC */ cset_display(0, 0, 0, 0, 01, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#endif /* EBCDIC */ +#endif /* EBCDIC */ }; /* @@ -119,9 +119,9 @@ struct b_cset lparcs = { 1, #if !EBCDIC cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#else /* EBCDIC */ +#else /* EBCDIC */ cset_display(0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#endif /* EBCDIC */ +#endif /* EBCDIC */ }; /* @@ -132,9 +132,9 @@ struct b_cset rparcs = { 1, #if !EBCDIC cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#else /* EBCDIC */ +#else /* EBCDIC */ cset_display(0, 0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) -#endif /* EBCDIC */ +#endif /* EBCDIC */ }; /* @@ -157,11 +157,11 @@ struct b_cset k_letters = {T_Cset, 52, }; struct b_cset k_ascii = {T_Cset, 128, cset_display(0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff, - 0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0) + 0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0) }; struct b_cset k_cset = {T_Cset, 256, cset_display(0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff, - 0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff) + 0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff,0xffff) }; /* @@ -170,50 +170,50 @@ struct b_cset k_cset = {T_Cset, 256, #ifndef MultiProgram /* input: is an Fs_Window if consolewindow; not doing that here anymore, add it to OpenConsole() */ -struct b_file k_errout = {T_File, NULL, Fs_Write}; /* &errout */ -struct b_file k_input = {T_File, NULL, Fs_Read}; /* &input */ -struct b_file k_output = {T_File, NULL, Fs_Write}; /* &output */ -#endif /* MultiProgram */ +struct b_file k_errout = {T_File, NULL, Fs_Write}; /* &errout */ +struct b_file k_input = {T_File, NULL, Fs_Read}; /* &input */ +struct b_file k_output = {T_File, NULL, Fs_Write}; /* &output */ +#endif /* MultiProgram */ /* * Keyword variables. */ #ifndef MultiProgram struct descrip kywd_err = {D_Integer}; /* &error */ -struct descrip kywd_prog; /* &progname */ -struct descrip kywd_trc = {D_Integer}; /* &trace */ -struct descrip k_eventcode = {D_Null}; /* &eventcode */ +struct descrip kywd_prog; /* &progname */ +struct descrip kywd_trc = {D_Integer}; /* &trace */ +struct descrip k_eventcode = {D_Null}; /* &eventcode */ struct descrip k_eventsource = {D_Null};/* &eventsource */ -struct descrip k_eventvalue = {D_Null}; /* &eventvalue */ +struct descrip k_eventvalue = {D_Null}; /* &eventvalue */ #if !ConcurrentCOMPILER -struct descrip k_subject; /* &subject */ -struct descrip kywd_ran = {D_Integer}; /* &random */ -struct descrip kywd_pos = {D_Integer}; /* &pos */ +struct descrip k_subject; /* &subject */ +struct descrip kywd_ran = {D_Integer}; /* &random */ +struct descrip kywd_pos = {D_Integer}; /* &pos */ #endif /* ConcurrentCOMPILER */ -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef FncTrace -struct descrip kywd_ftrc = {D_Integer}; /* &ftrace */ -#endif /* FncTrace */ +struct descrip kywd_ftrc = {D_Integer}; /* &ftrace */ +#endif /* FncTrace */ -struct descrip kywd_dmp = {D_Integer}; /* &dump */ +struct descrip kywd_dmp = {D_Integer}; /* &dump */ struct descrip nullptr = {((word)(F_Ptr | F_Nqual))}; /* descriptor with null block pointer */ -struct descrip trashcan; /* descriptor that is never read */ +struct descrip trashcan; /* descriptor that is never read */ /* * Various constant descriptors. */ -struct descrip blank; /* one-character blank string */ -struct descrip emptystr; /* zero-length empty string */ -struct descrip lcase; /* string of lowercase letters */ -struct descrip letr; /* "r" */ -struct descrip nulldesc = {D_Null}; /* null value */ -struct descrip onedesc = {D_Integer}; /* integer 1 */ -struct descrip ucase; /* string of uppercase letters */ -struct descrip zerodesc = {D_Integer}; /* integer 0 */ +struct descrip blank; /* one-character blank string */ +struct descrip emptystr; /* zero-length empty string */ +struct descrip lcase; /* string of lowercase letters */ +struct descrip letr; /* "r" */ +struct descrip nulldesc = {D_Null}; /* null value */ +struct descrip onedesc = {D_Integer}; /* integer 1 */ +struct descrip ucase; /* string of uppercase letters */ +struct descrip zerodesc = {D_Integer}; /* integer 0 */ #ifdef MultiProgram /* @@ -223,14 +223,14 @@ struct descrip csetdesc = {D_Cset}; struct descrip eventdesc; #ifdef DescriptorDouble struct descrip rzerodesc = {D_Real, 0.0}; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ struct descrip rzerodesc = {D_Real}; /* * Real block needed for event monitoring. */ struct b_real realzero = {T_Real, 0.0}; -#endif /* DescriptorDouble */ -#endif /* MultiProgram */ +#endif /* DescriptorDouble */ +#endif /* MultiProgram */ /* * An array of all characters for use in making one-character strings. @@ -254,7 +254,7 @@ unsigned char allchars[256] = { 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239, 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255, }; - + /* * Run-time error numbers and text. */ @@ -289,7 +289,7 @@ struct errtab errtab[] = { 127, "pattern expected", 128, "unevaluated variable or function call expected", 129, "unable to convert unevaluated variable to pattern", -#endif /* PatternType */ +#endif /* PatternType */ 130, "incorrect number of arguments", 131, "string is not a class name", /*#ifdef Graphics*/ @@ -302,7 +302,7 @@ struct errtab errtab[] = { 146, "incorrect number of arguments to drawing function", 147, "window attribute cannot be read or written as requested", 148, "graphics is not enabled in this virtual machine", -/*#endif*/ /* Graphics */ +/*#endif*/ /* Graphics */ /*#ifdef Graphics3D*/ 150, "drawing a 3D object while in 2D mode", @@ -310,9 +310,9 @@ struct errtab errtab[] = { 152, "modelview or projection expected", 153, "texture not in correct format", 154, "must have an even number of texture coordinates", -/*#else*/ /* Graphics3D */ +/*#else*/ /* Graphics3D */ 155, "3D graphics is not enabled in this virtual machine", -/*#endif*/ /* Graphics3D */ +/*#endif*/ /* Graphics3D */ #ifdef PatternType 160, "nonexistent variable name", @@ -322,7 +322,7 @@ struct errtab errtab[] = { 164, "unsupported unevaluated expression", 165, "null pattern argument where name was expected", 166, "unable to produce pattern image, possible malformed pattern", -#endif /* PatternType */ +#endif /* PatternType */ #ifdef PosixFns /* @@ -335,7 +335,7 @@ struct errtab errtab[] = { 173, "cannot open directory for writing", 174, "invalid file operation", 175, "network connection expected", -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Concurrent 180, "invalid mutex", @@ -344,12 +344,12 @@ struct errtab errtab[] = { 183, "concurrent threads are not enabled in this virtual machine", 184, "structure cannot have more than one mutex at the same time", 185, "converting an active co-expression to a thread is not yet supported", -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef Dbm 190, "dbm database expected", 191, "cannot open dbm database", -#endif /* Dbm */ +#endif /* Dbm */ 201, "division by zero", 202, "remaindering by zero", @@ -380,23 +380,23 @@ struct errtab errtab[] = { 308, "system stack overflow in co-expression", #ifdef PatternType 309, "pattern stack overflow", -#endif /* PatternType */ +#endif /* PatternType */ #if IntBits == 16 316, "interpreter stack too large", 318, "co-expression stack too large", -#endif /* IntBits == 16 */ +#endif /* IntBits == 16 */ #ifndef CoExpr 401, "co-expressions not implemented", -#endif /* CoExpr */ +#endif /* CoExpr */ 402, "program not compiled with debugging option", - 500, "program malfunction", /* for use by runerr() */ - 600, "vidget usage error", /* yeah! */ + 500, "program malfunction", /* for use by runerr() */ + 600, "vidget usage error", /* yeah! */ #ifdef PosixFns - 1040, "socket error", + 1040, "socket error", 1041, "cannot initialize network library", 1042, "fdup of closed file", 1043, "invalid signal", @@ -406,7 +406,7 @@ struct errtab errtab[] = { 1047, "invalid protocol name", 1048, "low-level read or select mixed with buffered read", 1049, "nonexistent service or services database error", -#endif /* PosixFns */ +#endif /* PosixFns */ 1050, "command not found", 1051, "cannot create temporary file", @@ -415,7 +415,7 @@ struct errtab errtab[] = { #ifdef ISQL 1100, "ODBC connection expected", -#endif /* ISQL */ +#endif /* ISQL */ #ifdef Messaging 1200, "system error (see errno)", @@ -449,7 +449,7 @@ struct errtab errtab[] = { 1307, "private key and certificate mismatch", 1308, "unknown protocol", -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ #endif /* Messaging */ @@ -457,7 +457,7 @@ struct errtab errtab[] = { * End of operating-system specific code. */ - 0, "" + 0, "" }; /* @@ -475,7 +475,7 @@ struct errtab errtab[] = { */ int (*optab[])() = { - err, + err, #define OpDef(p,n,s,u) Cat(O,p), #include "../h/odefs.h" #undef OpDef @@ -507,4 +507,4 @@ int (*keytab[])() = { #define KDef(p,n) Cat(K,p), #include "../h/kdefs.h" }; -#endif /* !COMPILER */ +#endif /* !COMPILER */ diff --git a/src/runtime/def.r b/src/runtime/def.r index ef9d3de4d..40b0b3e9f 100644 --- a/src/runtime/def.r +++ b/src/runtime/def.r @@ -116,9 +116,9 @@ DefConvert(def_int, C_integer, dptr, cnv_int, IntAsgn) #begdef RealAsgn #ifdef DescriptorDouble d->vword.realval = df; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ Protect(BlkLoc(*d) = (union block *)alcreal(df), fatalerr(0,NULL)); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ d->dword = D_Real; #enddef diff --git a/src/runtime/errmsg.r b/src/runtime/errmsg.r index bf8b73208..3df142bae 100644 --- a/src/runtime/errmsg.r +++ b/src/runtime/errmsg.r @@ -2,9 +2,9 @@ * errmsg.r -- err_msg, irunerr, drunerr */ -extern struct errtab errtab[]; /* error numbers and messages */ +extern struct errtab errtab[]; /* error numbers and messages */ -char *logopt; /* Log option destination */ +char *logopt; /* Log option destination */ /* * set &errornumber and &errortext to a given (run-time error) number @@ -66,7 +66,7 @@ void set_gaierrortext(int i) StrLen(k_errortext) = buflen; } } -#endif /* HAVE_GETADDRINFO */ +#endif /* HAVE_GETADDRINFO */ #if HAVE_LIBSSL /* @@ -124,9 +124,9 @@ int set_ssl_connection_errortext(SSL *ssl, int err) case SSL_ERROR_SYSCALL : if (errno == 0) { /* - * OpenSSL bug: an enexpcted EOF from peer, see: - * https://www.openssl.org/docs/man1.1.1/man3/SSL_get_error.html - */ + * OpenSSL bug: an enexpcted EOF from peer, see: + * https://www.openssl.org/docs/man1.1.1/man3/SSL_get_error.html + */ snprintf(buf2, 32 ,"unexpected EOF from peer"); } else { @@ -147,7 +147,7 @@ int set_ssl_connection_errortext(SSL *ssl, int err) ERR_error_string_n(ERR_get_error(), buf3 , 1024); printf("\n%s\n", buf3); } -#endif /* DEVMODE_DEBUG */ +#endif /* DEVMODE_DEBUG */ buf = (char *) ERR_reason_error_string(ERR_get_error()); if (buf == NULL) @@ -161,7 +161,7 @@ int set_ssl_connection_errortext(SSL *ssl, int err) return err; } -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ /* * set &errno and &errortext based on a system call failure that set errno. @@ -192,7 +192,7 @@ void set_gzerrortext(gzFile f) StrLen(k_errortext) = slen; } } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ /* * err_msg - print run-time error message, performing trace back if required. @@ -202,7 +202,7 @@ void err_msg(int n, dptr v) { register struct errtab *p; char *lfile = NULL; - FILE *logfptr = NULL; + FILE *logfptr = NULL; #ifdef Messaging int saveerrno = errno; @@ -214,19 +214,19 @@ void err_msg(int n, dptr v) #ifdef Concurrent #if !ConcurrentCOMPILER - /* - * Force all of the threads to stop before proceeding with the runtime error + /* + * Force all of the threads to stop before proceeding with the runtime error */ if (is:null(curpstate->eventmask)) if (IntVal(kywd_err) == 0 || !err_conv) #endif /* ConcurrentCOMPILER */ SUSPEND_THREADS(); -#endif /* Concurrent */ +#endif /* Concurrent */ if (logopt != NULL) logfptr = fopen(logopt, "a"); else if (((lfile = getenv("ULOG")) != NULL) && (lfile[0] != '\0')) { - logfptr = fopen(lfile, "a"); + logfptr = fopen(lfile, "a"); } if (n == 0) { k_errornumber = t_errornumber; @@ -260,15 +260,15 @@ void err_msg(int n, dptr v) #if COMPILER if (line_info) fprintf(stderr, "File %s; Line %d\n", file_name, line_num); -#else /* COMPILER */ +#else /* COMPILER */ fprintf(stderr, "File %s; Line %ld\n", findfile(ipc.opnd), (long)findline(ipc.opnd)); -#endif /* COMPILER */ +#endif /* COMPILER */ } else { IntVal(kywd_err)--; if (logfptr != NULL) - fclose(logfptr); + fclose(logfptr); return; } } @@ -284,15 +284,15 @@ void err_msg(int n, dptr v) #ifdef Messaging if (saveerrno != 0 && k_errornumber >= 1000) { - fprintf(stderr, "system error (errno %d): \"%s\"\n", - saveerrno, strerror(saveerrno)); + fprintf(stderr, "system error (errno %d): \"%s\"\n", + saveerrno, strerror(saveerrno)); } #endif /* Messaging */ if (!debug_info) c_exit(EXIT_FAILURE); - if (pfp == NULL) { /* skip if start-up problem */ + if (pfp == NULL) { /* skip if start-up problem */ if (dodump) abort(); c_exit(EXIT_FAILURE); @@ -304,26 +304,26 @@ void err_msg(int n, dptr v) fprintf(logfptr, "Run-time error %d\n", k_errornumber); #if COMPILER if (line_info) - fprintf(logfptr, "File %s; Line %d\n", file_name, line_num); -#else /* COMPILER */ + fprintf(logfptr, "File %s; Line %d\n", file_name, line_num); +#else /* COMPILER */ fprintf(logfptr, "File %s; Line %ld\n", findfile(ipc.opnd), - (long)findline(ipc.opnd)); -#endif /* COMPILER */ + (long)findline(ipc.opnd)); +#endif /* COMPILER */ fprintf(logfptr, "%s\n", StrLoc(k_errortext)); if (have_errval) { - fprintf(logfptr, "offending value: "); - outimage(logfptr, &k_errorvalue, 0); - putc('\n', logfptr); - } + fprintf(logfptr, "offending value: "); + outimage(logfptr, &k_errorvalue, 0); + putc('\n', logfptr); + } fprintf(logfptr, "Traceback:\n"); } tracebk(pfp, glbl_argp, logfptr); if (logopt != NULL) - fprintf(stderr, "Complete error traceback written to %s\n\n", logopt); + fprintf(stderr, "Complete error traceback written to %s\n\n", logopt); else if (lfile != NULL && lfile[0] != '\0' ) fprintf(stderr, "Complete error traceback written to %s\n\n", lfile); - + fflush(stderr); if (logfptr != NULL) fclose(logfptr); @@ -365,7 +365,7 @@ double v; t_errorvalue.vword.realval = v; t_errorvalue.dword = D_Real; t_have_val = 1; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ { union block *bp; bp = (union block *)alcreal(v); @@ -376,6 +376,6 @@ double v; t_have_val = 1; } } -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ err_msg(0,NULL); } diff --git a/src/runtime/extcall.r b/src/runtime/extcall.r index 73788d75b..91c531b0a 100644 --- a/src/runtime/extcall.r +++ b/src/runtime/extcall.r @@ -13,11 +13,11 @@ dptr dargv; int argc; int *ip; { - *ip = 216; /* no external function to find */ + *ip = 216; /* no external function to find */ return (dptr)NULL; } -#else /* ExternalFunctions */ -/* static char junk; /* prevent empty module */ -#endif /* ExternalFunctions */ -#endif /* !COMPILER */ +#else /* ExternalFunctions */ +/* static char junk; /* prevent empty module */ +#endif /* ExternalFunctions */ +#endif /* !COMPILER */ diff --git a/src/runtime/fconv.r b/src/runtime/fconv.r index d6c9e0593..f74edcee3 100644 --- a/src/runtime/fconv.r +++ b/src/runtime/fconv.r @@ -14,26 +14,26 @@ function{1} abs(n) return integer } inline { - C_integer i; - int over_flow = 0; - - if (n >= 0) - i = n; - else { - i = neg(n, &over_flow); - if (over_flow) { + C_integer i; + int over_flow = 0; + + if (n >= 0) + i = n; + else { + i = neg(n, &over_flow); + if (over_flow) { #ifdef LargeInts - struct descrip tmp; - MakeInt(n,&tmp); - if (bigneg(&tmp, &result) == RunError) /* alcbignum failed */ - runerr(0); + struct descrip tmp; + MakeInt(n,&tmp); + if (bigneg(&tmp, &result) == RunError) /* alcbignum failed */ + runerr(0); return result; -#else /* LargeInts */ - irunerr(203,n); +#else /* LargeInts */ + irunerr(203,n); errorfail; -#endif /* LargeInts */ - } - } +#endif /* LargeInts */ + } + } return C_integer i; } } @@ -45,16 +45,16 @@ function{1} abs(n) return integer } inline { - if (BlkD(n, Lrgint)->sign == 0) - result = n; - else { - if (bigneg(&n, &result) == RunError) /* alcbignum failed */ - runerr(0); - } + if (BlkD(n, Lrgint)->sign == 0) + result = n; + else { + if (bigneg(&n, &result) == RunError) /* alcbignum failed */ + runerr(0); + } return result; } } -#endif /* LargeInts */ +#endif /* LargeInts */ else if cnv:C_double(n) then { abstract { @@ -67,7 +67,7 @@ function{1} abs(n) else runerr(102,n) end - + /* * The convertible types cset, integer, and real are identical @@ -114,54 +114,54 @@ function{0,1} string(x[n]) char *tmp, *s, *s2; tended struct descrip t; if (n == 0) - return emptystr; + return emptystr; /* * convert x[0] to a string */ if (!cnv:string(x[0], x[0])) - fail; + fail; t = x[0]; for (i = 1; i < n; i++) { - /* - * if t is not at the end of the string region, make it so - */ - if (StrLoc(t) + StrLen(t) != strfree) { - Protect(StrLoc(t) = alcstr(StrLoc(t), StrLen(t)), runerr(0)); - } - if (!cnv:string(x[i], x[i])) fail; - - /* - * concatenate t and x[i] and store result in t - */ - if (StrLoc(t) + StrLen(t) == StrLoc(x[i])) { - StrLen(t) += StrLen(x[i]); - } - else if ((StrLoc(t) + StrLen(t) == strfree) && (DiffPtrs(strend,strfree) > StrLen(x[i]))) { - Protect(alcstr(StrLoc(x[i]), StrLen(x[i])), runerr(0)); - StrLen(t) += StrLen(x[i]); - } - else { - Protect(tmp = alcstr(NULL, StrLen(t)+StrLen(x[i])), runerr(0)); - s = tmp; - s2 = StrLoc(t); - len = StrLen(t); - for (j = 0; j < len; j++) - *s++ = *s2++; - s2 = StrLoc(x[i]); - len = StrLen(x[i]); - for (j = 0; j < len; j++) - *s++ = *s2++; - StrLoc(t) = tmp; - StrLen(t) += len; - } + /* + * if t is not at the end of the string region, make it so + */ + if (StrLoc(t) + StrLen(t) != strfree) { + Protect(StrLoc(t) = alcstr(StrLoc(t), StrLen(t)), runerr(0)); + } + if (!cnv:string(x[i], x[i])) fail; + + /* + * concatenate t and x[i] and store result in t + */ + if (StrLoc(t) + StrLen(t) == StrLoc(x[i])) { + StrLen(t) += StrLen(x[i]); + } + else if ((StrLoc(t) + StrLen(t) == strfree) && (DiffPtrs(strend,strfree) > StrLen(x[i]))) { + Protect(alcstr(StrLoc(x[i]), StrLen(x[i])), runerr(0)); + StrLen(t) += StrLen(x[i]); + } + else { + Protect(tmp = alcstr(NULL, StrLen(t)+StrLen(x[i])), runerr(0)); + s = tmp; + s2 = StrLoc(t); + len = StrLen(t); + for (j = 0; j < len; j++) + *s++ = *s2++; + s2 = StrLoc(x[i]); + len = StrLen(x[i]); + for (j = 0; j < len; j++) + *s++ = *s2++; + StrLoc(t) = tmp; + StrLen(t) += len; + } } return t; } end - + "numeric(x) - produces an integer or real number resulting from the " "type conversion of x, but fails if the conversion is not possible." @@ -193,16 +193,16 @@ function{0,1} numeric(n) } } end - + "proc(x,i) - convert x to a procedure if possible; use i to resolve " "ambiguous string names." #ifdef MultiProgram function{0,1} proc(x,i,c) -#else /* MultiProgram */ +#else /* MultiProgram */ function{0,1} proc(x,i) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef MultiProgram if is:coexpr(x) then { @@ -212,40 +212,40 @@ function{0,1} proc(x,i) return proc } body { - struct b_coexpr *ce = NULL; - struct b_proc *bp = NULL; - struct pf_marker *fp; - dptr dp=NULL; - CURTSTATE_AND_CE(); - if (BlkLoc(x) != BlkLoc(k_current)) { - ce = (struct b_coexpr *)BlkLoc(x); - dp = ce->es_argp; - fp = ce->es_pfp; - if (dp == NULL) fail; - } - else { - fp = pfp; - dp = glbl_argp; - } - /* follow upwards, i levels */ - while (i--) { - if (fp == NULL) fail; + struct b_coexpr *ce = NULL; + struct b_proc *bp = NULL; + struct pf_marker *fp; + dptr dp=NULL; + CURTSTATE_AND_CE(); + if (BlkLoc(x) != BlkLoc(k_current)) { + ce = (struct b_coexpr *)BlkLoc(x); + dp = ce->es_argp; + fp = ce->es_pfp; + if (dp == NULL) fail; + } + else { + fp = pfp; + dp = glbl_argp; + } + /* follow upwards, i levels */ + while (i--) { + if (fp == NULL) fail; #if COMPILER - dp = fp->old_argp; - fp = fp->old_pfp; -#else /* COMPILER */ - dp = fp->pf_argp; - fp = fp->pf_pfp; -#endif /* COMPILER */ - } - if (fp == NULL) fail; - if (dp) - bp = (struct b_proc *)BlkLoc(*(dp)); - else fail; - return proc(bp); - } + dp = fp->old_argp; + fp = fp->old_pfp; +#else /* COMPILER */ + dp = fp->pf_argp; + fp = fp->pf_pfp; +#endif /* COMPILER */ + } + if (fp == NULL) fail; + if (dp) + bp = (struct b_proc *)BlkLoc(*(dp)); + else fail; + return proc(bp); + } } -#endif /* MultiProgram */ +#endif /* MultiProgram */ if is:proc(x) then { abstract { @@ -254,18 +254,18 @@ function{0,1} proc(x,i) inline { #ifdef MultiProgram - if (!is:null(c)) { - struct progstate *p; - if (!is:coexpr(c)) runerr(118,c); - /* - * Test to see whether a given procedure belongs to a given - * program. Currently this is a sleazy pointer arithmetic check. - */ - p = BlkD(c,Coexpr)->program; - if (! InRange(p, BlkD(x,Proc)->entryp.icode, (char *)p + p->hsize)) - fail; - } -#endif /* MultiProgram */ + if (!is:null(c)) { + struct progstate *p; + if (!is:coexpr(c)) runerr(118,c); + /* + * Test to see whether a given procedure belongs to a given + * program. Currently this is a sleazy pointer arithmetic check. + */ + p = BlkD(c,Coexpr)->program; + if (! InRange(p, BlkD(x,Proc)->entryp.icode, (char *)p + p->hsize)) + fail; + } +#endif /* MultiProgram */ return x; } } @@ -281,7 +281,7 @@ function{0,1} proc(x,i) irunerr(205, i); errorfail; } - } + } abstract { return proc @@ -290,21 +290,21 @@ function{0,1} proc(x,i) struct b_proc *prc; #ifdef MultiProgram - struct progstate *prog, *savedprog; - - savedprog = curpstate; - if (is:null(c)) { - prog = curpstate; - } - else if (is:coexpr(c)) { - prog = BlkD(c,Coexpr)->program; - } - else { - runerr(118,c); - } - - ENTERPSTATE(prog); -#endif /* MultiProgram */ + struct progstate *prog, *savedprog; + + savedprog = curpstate; + if (is:null(c)) { + prog = curpstate; + } + else if (is:coexpr(c)) { + prog = BlkD(c,Coexpr)->program; + } + else { + runerr(118,c); + } + + ENTERPSTATE(prog); +#endif /* MultiProgram */ /* * Attempt to convert Arg0 to a procedure descriptor using i to @@ -312,14 +312,14 @@ function{0,1} proc(x,i) * is zero, only check builtins and ignore user procedures. * Fail if the conversion isn't successful. */ - if (i == 0) + if (i == 0) prc = bi_strprc(&x, 0); - else + else prc = strprc(&x, i); #ifdef MultiProgram - ENTERPSTATE(savedprog); -#endif /* MultiProgram */ + ENTERPSTATE(savedprog); +#endif /* MultiProgram */ if (prc == NULL) fail; else diff --git a/src/runtime/fdb.r b/src/runtime/fdb.r index 4c9fbc3a3..b5dc577f4 100644 --- a/src/runtime/fdb.r +++ b/src/runtime/fdb.r @@ -23,8 +23,8 @@ SQLHENV ISQLEnv=NULL; /* global environment variable */ #define COL_LEN SQL_MAX_COLUMN_NAME_LEN+1 /* hate long names... */ -#define FSTATUS(f) BlkD(f,File)->status /* file status */ -#define FDESC(f) BlkD(f,File)->fd.sqlf /* ISQLFile * */ +#define FSTATUS(f) BlkD(f,File)->status /* file status */ +#define FDESC(f) BlkD(f,File)->fd.sqlf /* ISQLFile * */ /*-- functions implementation --*/ @@ -42,13 +42,13 @@ function{0,1} dbcolumns(f,table_name) tended struct descrip rectypename=emptystr; tended struct b_record *r; static struct b_proc *proc; - + /* list declarations */ tended struct descrip L; tended struct b_list *hp; - + struct ISQLFile *fp; - + /* result set data buffers */ SQLCHAR szCatalog[STR_LEN], szSchema[STR_LEN]; @@ -56,21 +56,21 @@ function{0,1} dbcolumns(f,table_name) SQLCHAR szTypeName[STR_LEN], szRemarks[REM_LEN]; #ifdef MSWIN64 SQLLEN ColumnSize, BufferLength; -#else /* MSWIN64 */ +#else /* MSWIN64 */ SQLINTEGER ColumnSize, BufferLength; -#endif /* MSWIN64 */ +#endif /* MSWIN64 */ SQLSMALLINT DataType, DecimalDigits, NumPrecRadix, Nullable; - + SQLRETURN retcode; - + /* buffers for bytes available to return */ SQL_LENORIND cbCatalog, cbSchema, cbTableName, cbColumnName; SQL_LENORIND cbDataType, cbTypeName, cbColumnSize, cbBufferLength; SQL_LENORIND cbDecimalDigits, cbNumPrecRadix, cbNullable, cbRemarks; - + HSTMT hstmt; - + #ifdef MacOS static struct descrip colnames[12]; static int cnm=0; /* FIXME: thread unsafe */ @@ -100,14 +100,14 @@ function{0,1} dbcolumns(f,table_name) AsgnCStr(colnames[cnm], "remarks"); cnm++; }; -#else /* MacOS */ +#else /* MacOS */ static struct descrip colnames[12] = { {7,(word)"catalog"}, {6,(word)"schema"}, {9,(word)"tablename"}, {7,(word)"colname"}, {8,(word)"datatype"}, {8,(word)"typename"}, {7,(word)"colsize"}, {6,(word)"buflen"}, {9,(word)"decdigits"}, {12,(word)"numprecradix"}, {8,(word)"nullable"}, {7,(word)"remarks"} }; -#endif /* MacOS */ +#endif /* MacOS */ if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* ODBC file */ runerr(NOT_ODBC_FILE_ERR, f); @@ -125,7 +125,7 @@ function{0,1} dbcolumns(f,table_name) fail; } - retcode=SQLColumns(hstmt, + retcode=SQLColumns(hstmt, NULL, 0, /* all catalogs */ NULL, 0, /* all schemas */ (SQLCHAR *) StrLoc(table_name), StrLen(table_name), /* table */ @@ -135,7 +135,7 @@ function{0,1} dbcolumns(f,table_name) odbcerror(fp, COLUMNS_ERR); fail; } - + /* bind columns in result set to buffer (ODBC 3.x) */ SQLBindCol(hstmt, 1, SQL_C_CHAR, szCatalog, STR_LEN, &cbCatalog); @@ -150,9 +150,9 @@ function{0,1} dbcolumns(f,table_name) SQLBindCol(hstmt, 10, SQL_C_SSHORT, &NumPrecRadix, 0, &cbNumPrecRadix); SQLBindCol(hstmt, 11, SQL_C_SSHORT, &Nullable, 0, &cbNullable); SQLBindCol(hstmt, 12, SQL_C_CHAR, szRemarks, REM_LEN, &cbRemarks); - + /* create empty list */ - + if ((hp=alclist(0, MinListSlots)) == NULL) fail; L.dword=D_List; L.vword.bptr=(union block *) hp; @@ -179,12 +179,12 @@ function{0,1} dbcolumns(f,table_name) /* TABLE_NAME (varchar not NULL) */ StrLoc(r->fields[2])=cbTableName>0?alcstr((char *) szTableName, cbTableName):""; - StrLen(r->fields[2])=cbTableName>0?cbTableName:0; + StrLen(r->fields[2])=cbTableName>0?cbTableName:0; /* COLUMN_NAME (varchar not NULL) */ StrLoc(r->fields[3])=cbColumnName>0?alcstr((char *) szColumnName, cbColumnName):""; - StrLen(r->fields[3])=cbColumnName>0?cbColumnName:0; - + StrLen(r->fields[3])=cbColumnName>0?cbColumnName:0; + /* DATA_TYPE (Smallint not NULL) */ MakeInt(DataType, &(r->fields[4])); @@ -200,7 +200,7 @@ function{0,1} dbcolumns(f,table_name) /* DECIMAL_DIGITS (Smallint) */ MakeInt(DecimalDigits, &(r->fields[8])); - + /* NUM_PREC_RADIX (Smallint) */ MakeInt(NumPrecRadix, &(r->fields[9])); @@ -216,7 +216,7 @@ function{0,1} dbcolumns(f,table_name) c_put(&L, &R); } - + if (SQLFreeStmt(hstmt, SQL_DROP)!=SQL_SUCCESS) { /* release statement */ odbcerror(fp, FREE_STMT_ERR); fail; @@ -229,12 +229,12 @@ end function {0,1} dbdriver(f) if !is:file(f) then runerr(105, f); - + abstract { return record } - - body { + + body { SWORD len; UWORD result; static struct b_proc *proc; @@ -251,10 +251,10 @@ function {0,1} dbdriver(f) static int sql_parm[DBDRVNCOLS]={SQL_DRIVER_NAME, SQL_DRIVER_VER, SQL_DRIVER_ODBC_VER, SQL_ACTIVE_CONNECTIONS, SQL_ACTIVE_STATEMENTS, SQL_DATA_SOURCE_NAME}; - + /* SQLGetInfo() result is a string */ static int is_str[DBDRVNCOLS]={1,1,1,0,0,1}; - + /* unicon field names */ #ifdef MacOS static struct descrip colnames[6]; @@ -273,12 +273,12 @@ function {0,1} dbdriver(f) AsgnCStr(colnames[cnm], "dsn"); cnm++; } -#else /* MacOS */ +#else /* MacOS */ static struct descrip colnames[6]={ {4,(word)"name"}, {3,(word)"ver"}, {7,(word)"odbcver"}, {11,(word)"connections"}, {10,(word)"statements"}, {3,(word)"dsn"}}; -#endif /* MacOS */ - +#endif /* MacOS */ + if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* not an ODBC file */ runerr(NOT_ODBC_FILE_ERR, f); } @@ -303,7 +303,7 @@ function {0,1} dbdriver(f) } else { /* result is a number */ SQLGetInfo(fp->hdbc, (SQLUSMALLINT)sql_parm[i], - (PTR)&result, sizeof(result), NULL); + (PTR)&result, sizeof(result), NULL); MakeInt(result, &(r->fields[3])); } } @@ -333,9 +333,9 @@ function{1} dbkeys(f, table_name) /* list declarations */ tended struct descrip L; tended struct b_list *hp; - + struct ISQLFile *fp; - + UCHAR szPkCol[COL_LEN]; /* primary key column */ SQL_LENORIND cbPkCol, cbKeySeq; @@ -353,17 +353,17 @@ function{1} dbkeys(f, table_name) AsgnCStr(colnames[cnm], "seq"); cnm++; } -#else /* MacOS */ +#else /* MacOS */ static struct descrip colnames[2]={{3,(word)"col"}, {3,(word)"seq"}}; -#endif /* MacOS */ - +#endif /* MacOS */ + if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* ODBC mode */ runerr(NOT_ODBC_FILE_ERR, f); } fp=FDESC(f); /* file descriptor */ fp->proc = NULL; - + if (is:null(table_name) && (fp->tablename != NULL)) { MakeStr(fp->tablename, strlen(fp->tablename), &table_name); } @@ -377,7 +377,7 @@ function{1} dbkeys(f, table_name) SQLBindCol(hstmt, 4, SQL_C_CHAR, szPkCol, COL_LEN, &cbPkCol); SQLBindCol(hstmt, 5, SQL_C_SSHORT, &iKeySeq, TAB_LEN, &cbKeySeq); - retcode=SQLPrimaryKeys(hstmt, + retcode=SQLPrimaryKeys(hstmt, NULL, 0, /* all catalogs */ NULL, 0, /* all schemas */ (SQLCHAR *) StrLoc(table_name), StrLen(table_name)); /* table */ @@ -386,9 +386,9 @@ function{1} dbkeys(f, table_name) odbcerror(fp, PRIMARY_KEYS_ERR); fail; } - + /* create empty list */ - + if ((hp=alclist(0, MinListSlots)) == NULL) fail; L.dword=D_List; L.vword.bptr=(union block *) hp; @@ -396,7 +396,7 @@ function{1} dbkeys(f, table_name) /* create record fields definition */ if (proc == NULL) proc=dynrecord(&rectypename, colnames, DBKEYSNCOLS); - + /* populate list with column info */ @@ -410,10 +410,10 @@ function{1} dbkeys(f, table_name) StrLoc(r->fields[0])=cbPkCol>0?alcstr((char *) szPkCol, cbPkCol):""; StrLen(r->fields[0])=cbPkCol>0?cbPkCol:0; if (StrLoc(r->fields[0]) == NULL) runerr(306); - + /* key sequence (integer) */ MakeInt(iKeySeq, &(r->fields[1])); - + c_put(&L, &R); } @@ -431,12 +431,12 @@ end function {0,1} dblimits(f) if !is:file(f) then runerr(105, f); - + abstract { return record } - - body { + + body { SWORD len; UWORD result; struct ISQLFile *fp; @@ -446,7 +446,7 @@ function {0,1} dblimits(f) static struct b_proc *proc; char sbuf[256]; short i; - + static int sql_parm[DBLIMITSNCOLS]={SQL_MAX_BINARY_LITERAL_LEN, SQL_MAX_CHAR_LITERAL_LEN, SQL_MAX_COLUMN_NAME_LEN, SQL_MAX_COLUMNS_IN_GROUP_BY, SQL_MAX_COLUMNS_IN_ORDER_BY, @@ -459,7 +459,7 @@ function {0,1} dblimits(f) SQL_MAX_USER_NAME_LEN}; static int is_str[DBLIMITSNCOLS]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0}; - + #ifdef MacOS static struct descrip colnames[19]; static int cnm=0; /* FIXME: thread unsafe */ @@ -503,7 +503,7 @@ function {0,1} dblimits(f) AsgnCStr(colnames[cnm], "maxusernamelen"); cnm++; } -#else /* MacOS */ +#else /* MacOS */ static struct descrip colnames[19]={{12,(word)"maxbinlitlen"}, {13,(word)"maxcharlitlen"}, {13,(word)"maxcolnamelen"}, {14,(word)"maxgroupbycols"}, {14,(word)"maxorderbycols"}, @@ -514,7 +514,7 @@ function {0,1} dblimits(f) {10,(word)"maxrowsize"}, {14,(word)"maxrowsizelong"}, {10,(word)"maxstmtlen"}, {13,(word)"maxtblnamelen"}, {13,(word)"maxselecttbls"}, {14,(word)"maxusernamelen"}}; -#endif /* MacOS */ +#endif /* MacOS */ if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* not an ODBC file */ runerr(NOT_ODBC_FILE_ERR, f); @@ -553,15 +553,15 @@ end function {0,1} dbproduct(f) if !is:file(f) then runerr(105, f); - + abstract { return record } - + body { SWORD len; struct ISQLFile *fp; - char sbuf[256]; + char sbuf[256]; /* record structures */ tended struct descrip R; @@ -574,11 +574,11 @@ function {0,1} dbproduct(f) static struct descrip colnames[2]; static int cnm=0; /* FIXME: thread unsafe */ if (!cnm) { - AsgnCStr(colnames[cnm], "name"); + AsgnCStr(colnames[cnm], "name"); cnm++; - AsgnCStr(colnames[cnm], "ver"); + AsgnCStr(colnames[cnm], "ver"); cnm++; - } + } #else static struct descrip colnames[]={{4,(word)"name"}, {3,(word)"ver"}}; #endif @@ -618,17 +618,17 @@ function{0,1} sql(f, query) } body { - + int rc; struct ISQLFile *fp; - - if (!Qual(query)) runerr(103, query); + + if (!Qual(query)) runerr(103, query); if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* ODBC file */ runerr(NOT_ODBC_FILE_ERR, f); } - + fp=FDESC(f); fp->proc = NULL; @@ -660,49 +660,49 @@ function{0,1} dbtables(f) tended struct descrip rectypename=emptystr; tended struct b_record *r; static struct b_proc *proc; - + /* file declarations */ struct ISQLFile *fp; - + /* list declarations */ tended struct descrip L; tended struct b_list *hp; - + /* result set data buffers */ SQLCHAR szTblQualif[STR_LEN], szTblOwner[STR_LEN]; SQLCHAR szTblName[STR_LEN], szTblType[STR_LEN]; SQLCHAR szRemarks[REM_LEN]; - + SQLRETURN retcode; /* buffers for bytes available to return */ SQL_LENORIND cbQualif, cbOwner, cbName, cbType, cbRemarks; - + HSTMT hstmt; - + #ifdef MacOS static struct descrip colnames[5]; static int cnm=0; /* FIXME: thread unsafe */ if (!cnm) { - AsgnCStr(colnames[cnm], "qualifier"); - cnm++; - AsgnCStr(colnames[cnm], "owner"); - cnm++; - AsgnCStr(colnames[cnm], "name"); - cnm++; - AsgnCStr(colnames[cnm], "type"); - cnm++; - AsgnCStr(colnames[cnm], "remarks"); - cnm++; - } -#else /* MacOS */ + AsgnCStr(colnames[cnm], "qualifier"); + cnm++; + AsgnCStr(colnames[cnm], "owner"); + cnm++; + AsgnCStr(colnames[cnm], "name"); + cnm++; + AsgnCStr(colnames[cnm], "type"); + cnm++; + AsgnCStr(colnames[cnm], "remarks"); + cnm++; + } +#else /* MacOS */ static struct descrip colnames[5]={ {9,(word)"qualifier"}, {5,(word)"owner"}, {4,(word)"name"}, {4,(word)"type"}, {7,(word)"remarks"} }; -#endif /* MacOS */ +#endif /* MacOS */ if ((FSTATUS(f) & Fs_ODBC)!=Fs_ODBC) { /* ODBC file */ runerr(NOT_ODBC_FILE_ERR, f); @@ -721,18 +721,18 @@ function{0,1} dbtables(f) if (retcode!=SQL_SUCCESS) { odbcerror(fp, TABLES_ERR); fail; - } - + } + /* bind columns in result set to buffer (ODBC 2.x) */ - + SQLBindCol(hstmt, 1, SQL_C_CHAR, szTblQualif, STR_LEN, &cbQualif); SQLBindCol(hstmt, 2, SQL_C_CHAR, szTblOwner, STR_LEN, &cbOwner); SQLBindCol(hstmt, 3, SQL_C_CHAR, szTblName, STR_LEN, &cbName); SQLBindCol(hstmt, 4, SQL_C_SSHORT, szTblType, 0, &cbType); SQLBindCol(hstmt, 5, SQL_C_CHAR, szRemarks, STR_LEN, &cbRemarks); - + /* create empty list */ - + if ((hp=alclist(0, MinListSlots)) == NULL) fail; L.dword=D_List; L.vword.bptr=(union block *) hp; @@ -740,7 +740,7 @@ function{0,1} dbtables(f) /* create record type */ if (proc == NULL) proc=dynrecord(&rectypename, colnames, DBTBLNCOLS); - + while (SQLFetch(hstmt)==SQL_SUCCESS) { /* allocate record */ r = alcrecd(DBTBLNCOLS, (union block *)proc); @@ -763,10 +763,10 @@ function{0,1} dbtables(f) StrLoc(r->fields[4])=cbRemarks>0?alcstr((char *) szRemarks,cbRemarks):""; if (StrLoc(r->fields[4]) == NULL) runerr(306); StrLen(r->fields[4])=cbRemarks>0?cbRemarks:0; - + c_put(&L, &R); } - + if (SQLFreeStmt(hstmt, SQL_DROP)!=SQL_SUCCESS) { odbcerror(fp, FREE_STMT_ERR); fail; @@ -776,7 +776,7 @@ function{0,1} dbtables(f) } end -#else /* ISQL */ +#else /* ISQL */ MissingFunc2(dbcolumns) MissingFunc1(dbdriver) MissingFunc2(dbkeys) @@ -784,4 +784,4 @@ MissingFunc1(dblimits) MissingFunc1(dbproduct) MissingFunc2(sql) MissingFunc1(dbtables) -#endif /* ISQL */ +#endif /* ISQL */ diff --git a/src/runtime/fload.r b/src/runtime/fload.r index efa09968a..9b0500342 100644 --- a/src/runtime/fload.r +++ b/src/runtime/fload.r @@ -18,9 +18,9 @@ #ifdef LoadFunc -#ifndef RTLD_LAZY /* normally from */ +#ifndef RTLD_LAZY /* normally from */ #define RTLD_LAZY 1 -#endif /* RTLD_LAZY */ +#endif /* RTLD_LAZY */ #if NT void *dlopen(char *name, int flag) @@ -39,31 +39,31 @@ char *dlerror(void) { return "undiagnosed dynamic load error"; } -#endif /* NT */ +#endif /* NT */ #ifdef FreeBSD /* - * If DL_GETERRNO exists, this is an FreeBSD 1.1.5 or 2.0 + * If DL_GETERRNO exists, this is an FreeBSD 1.1.5 or 2.0 * which lacks dlerror(); supply a substitute. */ #passthru #ifdef DL_GETERRNO char *dlerror(void) { int no; - + if (0 == dlctl(NULL, DL_GETERRNO, &no)) return(strerror(no)); else return(NULL); } #passthru #endif -#endif /* __FreeBSD__ */ +#endif /* __FreeBSD__ */ #if COMPILER int glue(int, dptr, dptr, continuation); #else int glue(int, dptr); -#endif /* COMPILER */ +#endif /* COMPILER */ "loadfunc(filename,funcname) - load C function dynamically." @@ -83,16 +83,16 @@ function{0,1} loadfunc(filename,funcname) static char *curfile; static void *handle; char *funcname2; - + /* * Get a library handle, reusing it over successive calls. */ MUTEX_LOCKID(MTX_CURFILE_HANDLE); if (!handle || !curfile || strcmp(filename, curfile) != 0) { if (curfile) - free((pointer)curfile); /* free the old file name */ - curfile = salloc(filename); /* save the new name */ - handle = dlopen(filename, RTLD_LAZY); /* get the handle */ + free((pointer)curfile); /* free the old file name */ + curfile = salloc(filename); /* save the new name */ + handle = dlopen(filename, RTLD_LAZY); /* get the handle */ } /* @@ -106,20 +106,20 @@ function{0,1} loadfunc(filename,funcname) */ #if UNIX if (!handle) { - char path[MaxPath]; - if (findonpath(UNICONX, path, MaxPath)) { - int n = strlen(path); + char path[MaxPath]; + if (findonpath(UNICONX, path, MaxPath)) { + int n = strlen(path); /* Try the "not installed" location */ - snprintf(path+n-strlen(UNICONX), MaxPath - n, "../plugins/lib/%s", filename ); - handle = dlopen(path, RTLD_LAZY); /* get the handle */ + snprintf(path+n-strlen(UNICONX), MaxPath - n, "../plugins/lib/%s", filename ); + handle = dlopen(path, RTLD_LAZY); /* get the handle */ if (!handle) { /* Try the "installed" location */ snprintf(path+n-strlen(UNICONX), MaxPath - n, "../lib/unicon/plugins/lib/%s", filename ); - handle = dlopen(path, RTLD_LAZY); /* get the handle */ + handle = dlopen(path, RTLD_LAZY); /* get the handle */ + } } - } } -#endif /* UNIX */ +#endif /* UNIX */ #if NT /* * Replicate the UNIX logic above but with the added complications @@ -147,7 +147,7 @@ function{0,1} loadfunc(filename,funcname) handle = dlopen(path, RTLD_LAZY); if (!handle) { /* Repeat the whole process with .dll instead of .so */ int ext = strlen(filename); - if ((ext > 3) + if ((ext > 3) && (filename[--ext] == 'o') && (filename[--ext] == 's') && (filename[--ext] == '.')) { @@ -174,7 +174,7 @@ _Pragma("GCC diagnostic ignored \"-Wstringop-overflow=0\""); snprintf(path+n, MaxPath - n, "..\\plugins\\lib\\%s", dllname); handle = dlopen(path, RTLD_LAZY); if (!handle) { /* Try the "installed" location */ - snprintf(path+n, MaxPath - n, + snprintf(path+n, MaxPath - n, "..\\lib\\unicon\\plugins\\lib\\%s", dllname); handle = dlopen(path, RTLD_LAZY); } @@ -192,37 +192,37 @@ _Pragma("GCC diagnostic ignored \"-Wstringop-overflow=0\""); */ func = (int (*)())dlsym(handle, "init"); if (func) { - /* - * Windows .dll's have to be informed of the addresses for functions - * that are called from icall.h macros. FIXME: modify progstate to - * provide a discrete struct of functions pointers so that Windows - * .dll's can just be passed a pointer to those functions. - */ - struct rtentrypts { - int (*Cnvint)(dptr,dptr); - int (*Cnvreal)(dptr,dptr); - int (*Cnvstr)(dptr,dptr); - int (*Cnvtstr)(char *,dptr,dptr); - int (*Cnvcset)(dptr,dptr); - void (*Deref)(dptr,dptr); - - char * (*Alcstr)(char *, word); - struct b_real * (*Alcreal) (double); - double (*Getdbl) (dptr); - int (*Cnvcstr)(dptr,dptr); - } rtentryvector; + /* + * Windows .dll's have to be informed of the addresses for functions + * that are called from icall.h macros. FIXME: modify progstate to + * provide a discrete struct of functions pointers so that Windows + * .dll's can just be passed a pointer to those functions. + */ + struct rtentrypts { + int (*Cnvint)(dptr,dptr); + int (*Cnvreal)(dptr,dptr); + int (*Cnvstr)(dptr,dptr); + int (*Cnvtstr)(char *,dptr,dptr); + int (*Cnvcset)(dptr,dptr); + void (*Deref)(dptr,dptr); + + char * (*Alcstr)(char *, word); + struct b_real * (*Alcreal) (double); + double (*Getdbl) (dptr); + int (*Cnvcstr)(dptr,dptr); + } rtentryvector; #undef cnv_int_0 - rtentryvector.Cnvint = cnv_int; + rtentryvector.Cnvint = cnv_int; rtentryvector.Cnvreal = cnv_real; - rtentryvector.Cnvstr = cnv_str; - rtentryvector.Cnvcstr = cnv_c_str; - rtentryvector.Cnvtstr = cnv_tstr; - rtentryvector.Cnvcset = cnv_cset; - rtentryvector.Deref = deref; - rtentryvector.Alcstr = alcstr; - rtentryvector.Getdbl = getdbl; - - (void) (*func)(&rtentryvector); + rtentryvector.Cnvstr = cnv_str; + rtentryvector.Cnvcstr = cnv_c_str; + rtentryvector.Cnvtstr = cnv_tstr; + rtentryvector.Cnvcset = cnv_cset; + rtentryvector.Deref = deref; + rtentryvector.Alcstr = alcstr; + rtentryvector.Getdbl = getdbl; + + (void) (*func)(&rtentryvector); } /* @@ -248,7 +248,7 @@ _Pragma("GCC diagnostic ignored \"-Wstringop-overflow=0\""); #if COMPILER && NT fprintf(stderr, "\nloadfunc(\"%s\",\"%s\"): dl error\n", filename, funcname); -#else /* COMPILER && NT */ +#else /* COMPILER && NT */ if (!handle) { fprintf(stderr, "\nloadfunc(\"%s\",\"%s\"): cannot open file\n", filename, funcname); @@ -256,7 +256,7 @@ _Pragma("GCC diagnostic ignored \"-Wstringop-overflow=0\""); fprintf(stderr, "\nloadfunc(\"%s\",\"%s\"): %s\n", filename, funcname, dlerror()); } -#endif /* COMPILER && NT*/ +#endif /* COMPILER && NT*/ MUTEX_UNLOCKID(MTX_CURFILE_HANDLE); runerr(216); } @@ -289,21 +289,21 @@ int (*func)(); blk->blksize = sizeof(struct b_proc); #if COMPILER - blk->ccode = glue; /* set code addr to glue routine */ -#else /* COMPILER */ - blk->entryp.ccode = glue; /* set code addr to glue routine */ -#endif /* COMPILER */ + blk->ccode = glue; /* set code addr to glue routine */ +#else /* COMPILER */ + blk->entryp.ccode = glue; /* set code addr to glue routine */ +#endif /* COMPILER */ - blk->nparam = -1; /* varargs flag */ - blk->ndynam = -1; /* treat as built-in function */ + blk->nparam = -1; /* varargs flag */ + blk->ndynam = -1; /* treat as built-in function */ blk->nstatic = 0; blk->fstatic = 0; blk->pname.dword = strlen(name); blk->pname.vword.sptr = salloc(name); blk->lnames[0].dword = 0; blk->lnames[0].vword.sptr = (char *)func; - /* save func addr in lnames[0] vword */ - d->dword = D_Proc; /* build proc descriptor */ + /* save func addr in lnames[0] vword */ + d->dword = D_Proc; /* build proc descriptor */ d->vword.bptr = (union block *)blk; return 1; } @@ -326,34 +326,34 @@ continuation succ_cont; struct descrip r; tended struct descrip p; - dargv--; /* reset pointer to proc entry */ + dargv--; /* reset pointer to proc entry */ for (i = 0; i <= argc; i++) - deref(&dargv[i], &dargv[i]); /* dereference args including proc */ + deref(&dargv[i], &dargv[i]); /* dereference args including proc */ - blk = (struct b_proc *)dargv[0].vword.bptr; /* proc block address */ - func = (int (*)())blk->lnames[0].vword.sptr; /* entry point address */ + blk = (struct b_proc *)dargv[0].vword.bptr; /* proc block address */ + func = (int (*)())blk->lnames[0].vword.sptr; /* entry point address */ - p = dargv[0]; /* save proc for traceback */ - dargv[0] = nulldesc; /* set default return value */ + p = dargv[0]; /* save proc for traceback */ + dargv[0] = nulldesc; /* set default return value */ - status = (*func)(argc, dargv); /* call func */ + status = (*func)(argc, dargv); /* call func */ if (status == 0) { *rslt = dargv[0]; - Return; /* success */ + Return; /* success */ } if (status < 0) - Fail; /* failure */ + Fail; /* failure */ - r = dargv[0]; /* save result value */ - dargv[0] = p; /* restore proc for traceback */ + r = dargv[0]; /* save result value */ + dargv[0] = p; /* restore proc for traceback */ if (is:null(r)) - RunErr(status, NULL); /* error, no value */ - RunErr(status, &r); /* error, with value */ + RunErr(status, NULL); /* error, no value */ + RunErr(status, &r); /* error, with value */ } -#else /* COMPILER */ +#else /* COMPILER */ int glue(argc, dargv) int argc; @@ -364,28 +364,28 @@ dptr dargv; struct descrip r; tended struct descrip p; - blk = (struct b_proc *)dargv[0].vword.bptr; /* proc block address */ - func = (int (*)())blk->lnames[0].vword.sptr; /* entry point address */ + blk = (struct b_proc *)dargv[0].vword.bptr; /* proc block address */ + func = (int (*)())blk->lnames[0].vword.sptr; /* entry point address */ - p = dargv[0]; /* save proc for traceback */ - dargv[0] = nulldesc; /* set default return value */ + p = dargv[0]; /* save proc for traceback */ + dargv[0] = nulldesc; /* set default return value */ - status = (*func)(argc, dargv); /* call func */ + status = (*func)(argc, dargv); /* call func */ if (status == 0) - Return; /* success */ + Return; /* success */ if (status < 0) - Fail; /* failure */ + Fail; /* failure */ - r = dargv[0]; /* save result value */ - dargv[0] = p; /* restore proc for traceback */ + r = dargv[0]; /* save result value */ + dargv[0] = p; /* restore proc for traceback */ if (is:null(r)) - RunErr(status, NULL); /* error, no value */ - RunErr(status, &r); /* error, with value */ + RunErr(status, NULL); /* error, no value */ + RunErr(status, &r); /* error, with value */ } -#endif /* COMPILER */ +#endif /* COMPILER */ -#else /* LoadFunc */ -/*static char junk; /* avoid empty module */ -#endif /* LoadFunc */ +#else /* LoadFunc */ +/*static char junk; /* avoid empty module */ +#endif /* LoadFunc */ diff --git a/src/runtime/fmath.r b/src/runtime/fmath.r index 3981e6d32..a3e0f17e3 100644 --- a/src/runtime/fmath.r +++ b/src/runtime/fmath.r @@ -19,15 +19,15 @@ function{1} funcname(x) } inline { double y; - pre /* Pre math-operation range checking */ + pre /* Pre math-operation range checking */ errno = 0; y = ccode(x); - post /* Post math-operation C library error detection */ + post /* Post math-operation C library error detection */ return C_double y; } end #enddef - + #define aroundone if (x < -1.0 || x > 1.0) {drunerr(205, x); errorfail;} #define positive if (x < 0) {drunerr(205, x); errorfail;} @@ -56,7 +56,7 @@ MathOp(sqrt,sqrt, " - square root of x.", positive, edom) MathOp(dtor,DTOR, " - convert x from degrees to radians.", ; , ;) MathOp(rtod,RTOD, " - convert x from radians to degrees.", ; , ;) - + "atan(r1,r2) -- r1, r2 in radians; if r2 is present, produces atan2(r1,r2)." @@ -78,7 +78,7 @@ function{1} atan(x,y) return C_double atan2(x,y); } end - + "log(r1,r2) - logarithm of r1 to base r2." @@ -107,8 +107,8 @@ function{1} log(x,b) #ifndef Concurrent static double lastbase = 0.0; static double divisor; -#endif /* Concurrent */ - CURTSTATE(); +#endif /* Concurrent */ + CURTSTATE(); if (b <= 1.0) { drunerr(205, b); @@ -118,9 +118,9 @@ function{1} log(x,b) divisor = log(b); lastbase = b; } - x = log(x) / divisor; + x = log(x) / divisor; return C_double x; - } + } } end @@ -137,50 +137,50 @@ body { dtmp = argv[0]; if (argc == 1) { if (is:list(dtmp)) { - int i, j, size; - union block *bp; - size = BlkD(dtmp,List)->size; - if (size==0) fail; + int i, j, size; + union block *bp; + size = BlkD(dtmp,List)->size; + if (size==0) fail; #ifdef Arrays - if (BlkD(dtmp,List)->listtail == NULL) { - bp = BlkD(dtmp,List)->listhead; - if (bp->Intarray.title == T_Intarray) { - word mymax = bp->Intarray.a[0]; - for(i = 1; i < size; i++) - if (bp->Intarray.a[i] > mymax) mymax = bp->Intarray.a[i]; - return C_integer mymax; - } - else { - double mymax = bp->Realarray.a[0]; - for(i = 1; i < size; i++) - if (bp->Realarray.a[i] > mymax) mymax = bp->Realarray.a[i]; - dtmp.dword = D_Real; + if (BlkD(dtmp,List)->listtail == NULL) { + bp = BlkD(dtmp,List)->listhead; + if (bp->Intarray.title == T_Intarray) { + word mymax = bp->Intarray.a[0]; + for(i = 1; i < size; i++) + if (bp->Intarray.a[i] > mymax) mymax = bp->Intarray.a[i]; + return C_integer mymax; + } + else { + double mymax = bp->Realarray.a[0]; + for(i = 1; i < size; i++) + if (bp->Realarray.a[i] > mymax) mymax = bp->Realarray.a[i]; + dtmp.dword = D_Real; #ifdef DescriptorDouble - dtmp.vword.realval = mymax; -#else /* DescriptorDouble */ - dtmp.vword.bptr = (union block *)alcreal(mymax); -#endif /* DescriptorDouble */ - return dtmp; - } - } + dtmp.vword.realval = mymax; +#else /* DescriptorDouble */ + dtmp.vword.bptr = (union block *)alcreal(mymax); +#endif /* DescriptorDouble */ + return dtmp; + } + } #endif - /* - * normal max(L), walk through list elements - */ - bp = dtmp.vword.bptr; - dtmp = nulldesc; /* the minimal value */ - for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; - bp = Blk(bp,Lelem)->listnext) { - for (i = 0; i < Blk(bp,Lelem)->nused; i++) { - j = bp->Lelem.first + i; - if (j >= bp->Lelem.nslots) - j -= bp->Lelem.nslots; - if (anycmp(bp->Lelem.lslots+j, &dtmp) == Greater) - dtmp = bp->Lelem.lslots[j]; - } - } - } + /* + * normal max(L), walk through list elements + */ + bp = dtmp.vword.bptr; + dtmp = nulldesc; /* the minimal value */ + for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; + bp = Blk(bp,Lelem)->listnext) { + for (i = 0; i < Blk(bp,Lelem)->nused; i++) { + j = bp->Lelem.first + i; + if (j >= bp->Lelem.nslots) + j -= bp->Lelem.nslots; + if (anycmp(bp->Lelem.lslots+j, &dtmp) == Greater) + dtmp = bp->Lelem.lslots[j]; + } + } + } } else for(i=1;isize; - if (size==0) fail; + int i, j, size; + union block *bp; + size = BlkD(dtmp,List)->size; + if (size==0) fail; #ifdef Arrays - if (BlkD(dtmp,List)->listtail == NULL) { - bp = BlkD(dtmp,List)->listhead; - if (bp->Intarray.title == T_Intarray) { - word mymin = bp->Intarray.a[0]; - for(i = 1; i < size; i++) - if (bp->Intarray.a[i] < mymin) mymin = bp->Intarray.a[i]; - return C_integer mymin; - } - else { - double mymin = bp->Realarray.a[0]; - for(i = 1; i < size; i++) - if (bp->Realarray.a[i] < mymin) mymin = bp->Realarray.a[i]; - dtmp.dword = D_Real; + if (BlkD(dtmp,List)->listtail == NULL) { + bp = BlkD(dtmp,List)->listhead; + if (bp->Intarray.title == T_Intarray) { + word mymin = bp->Intarray.a[0]; + for(i = 1; i < size; i++) + if (bp->Intarray.a[i] < mymin) mymin = bp->Intarray.a[i]; + return C_integer mymin; + } + else { + double mymin = bp->Realarray.a[0]; + for(i = 1; i < size; i++) + if (bp->Realarray.a[i] < mymin) mymin = bp->Realarray.a[i]; + dtmp.dword = D_Real; #ifdef DescriptorDouble - dtmp.vword.realval = mymin; -#else /* DescriptorDouble */ - dtmp.vword.bptr = (union block *)alcreal(mymin); -#endif /* DescriptorDouble */ - return dtmp; - } - } + dtmp.vword.realval = mymin; +#else /* DescriptorDouble */ + dtmp.vword.bptr = (union block *)alcreal(mymin); +#endif /* DescriptorDouble */ + return dtmp; + } + } #endif - /* - * normal min(L), walk through list elements - */ - bp = dtmp.vword.bptr; - dtmp = nulldesc; - for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; - bp = Blk(bp,Lelem)->listnext) { - for (i = 0; i < Blk(bp,Lelem)->nused; i++) { - j = bp->Lelem.first + i; - if (j >= bp->Lelem.nslots) - j -= bp->Lelem.nslots; - dtmp = bp->Lelem.lslots[j]; /* the minimal value for now */ - break;break; - } - } - - for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; - bp = Blk(bp,Lelem)->listnext) { - for (i = 0; i < Blk(bp,Lelem)->nused; i++) { - j = bp->Lelem.first + i; - if (j >= bp->Lelem.nslots) - j -= bp->Lelem.nslots; - if (anycmp(bp->Lelem.lslots+j, &dtmp) == Less) - dtmp = bp->Lelem.lslots[j]; - } - } - } + /* + * normal min(L), walk through list elements + */ + bp = dtmp.vword.bptr; + dtmp = nulldesc; + for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; + bp = Blk(bp,Lelem)->listnext) { + for (i = 0; i < Blk(bp,Lelem)->nused; i++) { + j = bp->Lelem.first + i; + if (j >= bp->Lelem.nslots) + j -= bp->Lelem.nslots; + dtmp = bp->Lelem.lslots[j]; /* the minimal value for now */ + break;break; + } + } + + for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; + bp = Blk(bp,Lelem)->listnext) { + for (i = 0; i < Blk(bp,Lelem)->nused; i++) { + j = bp->Lelem.first + i; + if (j >= bp->Lelem.nslots) + j -= bp->Lelem.nslots; + if (anycmp(bp->Lelem.lslots+j, &dtmp) == Less) + dtmp = bp->Lelem.lslots[j]; + } + } + } } else for(i=1;i 0) dtmp = argv[i]; diff --git a/src/runtime/fmisc.r b/src/runtime/fmisc.r index b4ce63228..581d45f18 100644 --- a/src/runtime/fmisc.r +++ b/src/runtime/fmisc.r @@ -7,7 +7,7 @@ */ #if !COMPILER #include "../h/opdefs.h" -#endif /* !COMPILER */ +#endif /* !COMPILER */ "args(x,i) - produce number of arguments for procedure x." @@ -23,11 +23,11 @@ function{0,1} args(x,i) abstract { return integer } inline { #ifdef MultiProgram - return C_integer BlkD(x,Coexpr)->program->tstate->Xnargs; + return C_integer BlkD(x,Coexpr)->program->tstate->Xnargs; #else - fail; -#endif /* MultiProgram */ - } + fail; +#endif /* MultiProgram */ + } } else if !cnv:integer(i) then runerr(103, i) @@ -35,16 +35,16 @@ function{0,1} args(x,i) abstract { return any_value } inline { #ifdef MultiProgram - int c_i = IntVal(i); - if ((c_i <= 0) || (c_i > BlkD(x,Coexpr)->program->tstate->Xnargs)) fail; - return BlkD(x,Coexpr)->program->tstate->Xargp[IntVal(i)]; + int c_i = IntVal(i); + if ((c_i <= 0) || (c_i > BlkD(x,Coexpr)->program->tstate->Xnargs)) fail; + return BlkD(x,Coexpr)->program->tstate->Xargp[IntVal(i)]; #else - fail; -#endif /* MultiProgram */ - } + fail; +#endif /* MultiProgram */ + } } end - + #if !COMPILER #ifdef ExternalFunctions @@ -73,25 +73,25 @@ function{1} callout(x[nargs]) * the name of the routine as part of the convention of calling * routines with an argc/argv technique. */ - signal = -1; /* presume successful completiong */ + signal = -1; /* presume successful completiong */ retval = extcall(x, nargs, &signal); if (signal >= 0) { if (retval == NULL) runerr(signal); else - runerr(signal, *retval); + runerr(signal, *retval); } if (retval != NULL) { return *retval; } - else + else fail; } end -#endif /* ExternalFunctions */ -#endif /* !COMPILER */ - +#endif /* ExternalFunctions */ +#endif /* !COMPILER */ + "char(i) - produce a string consisting of character i." @@ -110,7 +110,7 @@ function{1} char(i) return string(1, (char *)&allchars[FromAscii(i) & 0xFF]); } end - + "collect(i1,i2) - call garbage collector to ensure i2 bytes in region i1." " no longer works." @@ -118,7 +118,7 @@ end function{1} collect(region, bytes) if !def:C_integer(region, (C_integer)0) then - runerr(101, region) + runerr(101, region) if !def:C_integer(bytes, (C_integer)0) then runerr(101, bytes) @@ -132,34 +132,34 @@ function{1} collect(region, bytes) errorfail; } switch (region) { - case 0: - DO_COLLECT(0); - break; - case Static: - DO_COLLECT(Static); /* i2 ignored if i1==Static */ - break; - case Strings: - if (DiffPtrs(strend,strfree) >= bytes){ - DO_COLLECT(Strings); /* force unneeded collection */ - } - else if (!reserve(Strings, bytes)) /* collect & reserve bytes */ + case 0: + DO_COLLECT(0); + break; + case Static: + DO_COLLECT(Static); /* i2 ignored if i1==Static */ + break; + case Strings: + if (DiffPtrs(strend,strfree) >= bytes){ + DO_COLLECT(Strings); /* force unneeded collection */ + } + else if (!reserve(Strings, bytes)) /* collect & reserve bytes */ fail; - break; - case Blocks: - if (DiffPtrs(blkend,blkfree) >= bytes){ - DO_COLLECT(Blocks); /* force unneeded collection */ - } - else if (!reserve(Blocks, bytes)) /* collect & reserve bytes */ + break; + case Blocks: + if (DiffPtrs(blkend,blkfree) >= bytes){ + DO_COLLECT(Blocks); /* force unneeded collection */ + } + else if (!reserve(Blocks, bytes)) /* collect & reserve bytes */ fail; - break; - default: + break; + default: irunerr(205, region); errorfail; } return nulldesc; } end - + "copy(x) - make a copy of object x." @@ -178,14 +178,14 @@ function{1} copy(x) coexpr: #ifdef PatternType pattern: -#endif /* PatternType */ +#endif /* PatternType */ inline { /* * Copy the null value, integers, long integers, reals, files, - * csets, procedures, and such by copying the descriptor. - * Note that for integers, this results in the assignment - * of a value, for the other types, a pointer is directed to - * a data block. + * csets, procedures, and such by copying the descriptor. + * Note that for integers, this results in the assignment + * of a value, for the other types, a pointer is directed to + * a data block. */ return x; } @@ -196,29 +196,29 @@ function{1} copy(x) * Pass the buck to cplist to copy a list. */ #ifdef Arrays - if (BlkD(x,List)->listtail!=NULL){ -#endif /* Arrays */ + if (BlkD(x,List)->listtail!=NULL){ +#endif /* Arrays */ if (cplist(&x, &result, (word)1, BlkD(x,List)->size + 1) == RunError) - runerr(0); + runerr(0); #ifdef Arrays - } - else if ( BlkType(BlkD(x,List)->listhead)==T_Realarray){ - if (cprealarray(&x, &result, (word)1, BlkD(x,List)->size + 1) == RunError) - runerr(0); - } - else /*if ( BlkType(BlkD(x,List)->listhead)==T_Intarray)*/{ - if (cpintarray(&x, &result, (word)1, BlkD(x,List)->size + 1) == RunError) - runerr(0); - } -#endif /* Arrays */ + } + else if ( BlkType(BlkD(x,List)->listhead)==T_Realarray){ + if (cprealarray(&x, &result, (word)1, BlkD(x,List)->size + 1) == RunError) + runerr(0); + } + else /*if ( BlkType(BlkD(x,List)->listhead)==T_Intarray)*/{ + if (cpintarray(&x, &result, (word)1, BlkD(x,List)->size + 1) == RunError) + runerr(0); + } +#endif /* Arrays */ return result; } table: { body { - if (cptable(&x, &result, BlkD(x,Table)->size) == RunError) { - runerr(0); - } - return result; + if (cptable(&x, &result, BlkD(x,Table)->size) == RunError) { + runerr(0); + } + return result; } } @@ -229,7 +229,7 @@ function{1} copy(x) */ if (cpset(&x, &result, BlkD(x,Set)->size) == RunError) runerr(0); - return result; + return result; } } @@ -246,7 +246,7 @@ function{1} copy(x) /* * Allocate space for the new record and copy the old - * one into it. + * one into it. */ old_rec = BlkD(x, Record); i = Blk(old_rec->recdesc,Proc)->nfields; @@ -257,7 +257,7 @@ function{1} copy(x) d2 = old_rec->fields; while (i--) *d1++ = *d2++; - Desc_EVValD(new_rec, E_Rcreate, D_Record); + Desc_EVValD(new_rec, E_Rcreate, D_Record); return record(new_rec); } } @@ -273,22 +273,22 @@ function{1} copy(x) * then allocate new block and copy the data. */ op = BlkLoc(x); - n = (op->externl.blksize - (sizeof(struct b_external) - + n = (op->externl.blksize - (sizeof(struct b_external) - sizeof(word))) / sizeof(word); Protect(bp = (union block *)alcextrnl(n), runerr(0)); while (n--) bp->externl.exdata[n] = op->externl.exdata[n]; result.dword = D_External; BlkLoc(result) = bp; - return result; + return result; } else -#endif /* Never */ +#endif /* Never */ runerr(123,x); } } end - + "display(i,f) - display local variables of i most recent" " procedure activations, plus global variables." @@ -304,19 +304,19 @@ function{1} display(i,f,c) struct threadstate *curtstate = (struct threadstate *) pthread_getspecific(tstate_key); struct b_coexpr *curtstate_ce = curtstate->c; -#endif /* Concurrent */ +#endif /* Concurrent */ } -#else /* MultiProgram */ +#else /* MultiProgram */ function{1} display(i,f) -#endif /* MultiProgram */ +#endif /* MultiProgram */ if !def:C_integer(i,(C_integer)k_level) then runerr(101, i) if is:null(f) then inline { - f.dword = D_File; - BlkLoc(f) = (union block *)&k_errout; + f.dword = D_File; + BlkLoc(f) = (union block *)&k_errout; } else if !is:file(f) then runerr(105, f) @@ -327,7 +327,7 @@ function{1} display(i,f) else if (BlkLoc(c) != BlkLoc(k_current)) ce = (struct b_coexpr *)BlkLoc(c); } -#endif /* MultiProgram */ +#endif /* MultiProgram */ abstract { return null @@ -345,7 +345,7 @@ function{1} display(i,f) /* * Produce error if file cannot be written. */ - if ((BlkD(f,File)->status & Fs_Write) == 0) + if ((BlkD(f,File)->status & Fs_Write) == 0) runerr(213, f); std_f = BlkD(f,File)->fd.fp; @@ -364,31 +364,31 @@ function{1} display(i,f) if (IS_TS_THREAD(BlkD(k_current,Coexpr)->status)) fprintf(std_f,"thread_%ld(%ld)\n\n", (long)BlkD(k_current,Coexpr)->id, - (long)BlkD(k_current,Coexpr)->size); + (long)BlkD(k_current,Coexpr)->size); else -#endif /* Concurrent */ +#endif /* Concurrent */ fprintf(std_f,"co-expression_%ld(%ld)\n\n", (long)BlkD(k_current,Coexpr)->id, - (long)BlkD(k_current,Coexpr)->size); + (long)BlkD(k_current,Coexpr)->size); fflush(std_f); #ifdef MultiProgram if (ce) { savedprog = curpstate; - if ((ce->es_pfp == NULL) || (ce->es_argp == NULL)) fail; - ENTERPSTATE(ce->program); + if ((ce->es_pfp == NULL) || (ce->es_argp == NULL)) fail; + ENTERPSTATE(ce->program); r = xdisp(ce->es_pfp, ce->es_argp, (int)i, std_f); - ENTERPSTATE(savedprog); + ENTERPSTATE(savedprog); } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ r = xdisp(pfp, glbl_argp, (int)i, std_f); if (r == Failed) runerr(305); return nulldesc; } end - + "errorclear() - clear error condition." @@ -405,7 +405,7 @@ function{1} errorclear() return nulldesc; } end - + #if !COMPILER "function() - generate the names of the functions." @@ -419,13 +419,13 @@ function{*} function() CURTSTATVAR(); for (i = 0; ipe; + ep = Blk(bp, Pattern)->pe; - if (pattern_image(ep, -1, &result, 0, i, -1) == RunError) + if (pattern_image(ep, -1, &result, 0, i, -1) == RunError) runerr(166, x); return result; } end -#endif /* PatternType */ - +#endif /* PatternType */ + "image(x) - return string image of object x." /* * All the interesting work happens in getimage() @@ -568,12 +568,12 @@ function{1} image(x) } #else if (getimage(&x,&result) == RunError) - runerr(0); + runerr(0); #endif return result; } end - + "ishift(i,j) - produce i shifted j bit positions (left if j<0, right if j>0)." @@ -588,7 +588,7 @@ function{1} ishift(i,j) return integer } body { - uword ci; /* shift in 0s, even if negative */ + uword ci; /* shift in 0s, even if negative */ C_integer cj; #ifdef LargeInts if (Type(j) == T_Lrgint) @@ -600,10 +600,10 @@ function{1} ishift(i,j) runerr(0); return result; } -#else /* LargeInts */ +#else /* LargeInts */ ci = (uword)IntVal(i); cj = IntVal(j); -#endif /* LargeInts */ +#endif /* LargeInts */ /* * Check for a shift of WordSize or greater; handle specially because * this is beyond C's defined behavior. Otherwise shift as requested. @@ -617,10 +617,10 @@ function{1} ishift(i,j) if (IntVal(i) >= 0) return C_integer ci >> -cj; /*else*/ - return C_integer ~(~ci >> -cj); /* sign extending shift */ + return C_integer ~(~ci >> -cj); /* sign extending shift */ } end - + "ord(s) - produce integer ordinal (value) of single character." @@ -636,7 +636,7 @@ function{1} ord(s) return C_integer ToAscii(*StrLoc(s) & 0xFF); } end - + "name(v) - return the name of a variable." @@ -645,9 +645,9 @@ function{1} name(underef v, c) declare { struct progstate *prog, *savedprog; } -#else /* MultiProgram */ +#else /* MultiProgram */ function{1} name(underef v) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * v must be a variable */ @@ -678,19 +678,19 @@ function{1} name(underef v) } ENTERPSTATE(prog); -#endif /* MultiProgram */ - i = get_name(&v, &result); /* return val ? #%#% */ +#endif /* MultiProgram */ + i = get_name(&v, &result); /* return val ? #%#% */ #ifdef MultiProgram ENTERPSTATE(savedprog); -#endif /* MultiProgram */ +#endif /* MultiProgram */ if (i == RunError) runerr(0); return result; } end - + "runerr(i,x) - produce runtime error i with value x." @@ -713,7 +713,7 @@ function{} runerr(i,x[n]) runerr((int)i, x[0]); } end - + "seq(i, j) - generate i, i+j, i+2*j, ... ." function{1,*} seq(from, by) @@ -767,12 +767,12 @@ function{1,*} seq(from, by) r_args[0].dword = D_Proc; r_args[0].vword.bptr = (union block *)&Bseq; } -#endif /* COMPILER */ +#endif /* COMPILER */ runerr(203); } end - + "serial(x) - return serial number of structure." function {0,1} serial(x) @@ -798,26 +798,26 @@ function {0,1} serial(x) } null: inline { #if !ConcurrentCOMPILER - CURTSTATE(); + CURTSTATE(); #endif /* ConcurrentCOMPILER */ return C_integer BlkD(k_current,Coexpr)->id; } #ifdef Graphics file: inline { - if (BlkD(x,File)->status & Fs_Window) { - wsp ws = BlkD(x,File)->fd.wb->window; - return C_integer ws->serial; - } - else { - fail; - } - } -#endif /* Graphics */ + if (BlkD(x,File)->status & Fs_Window) { + wsp ws = BlkD(x,File)->fd.wb->window; + return C_integer ws->serial; + } + else { + fail; + } + } +#endif /* Graphics */ default: inline { fail; } } end - + "sort(x,i) - sort structure x by method i (for tables)" function{1} sort(t, i) @@ -835,7 +835,7 @@ function{1} sort(t, i) */ size = BlkD(t,List)->size; if (cplist(&t, &result, (word)1, size + 1) == RunError) - runerr(0); + runerr(0); qsort((char *)Blk(BlkD(result,List)->listhead,Lelem)->lslots, (int)size, sizeof(struct descrip),(QSortFncCast) anycmp); @@ -883,14 +883,14 @@ function{1} sort(t, i) return new list(store[type(t).set_elem]) } body { - register word size; - tended struct descrip d; - cnv_list(&t, &d); /* can't fail, already know t is a set */ + register word size; + tended struct descrip d; + cnv_list(&t, &d); /* can't fail, already know t is a set */ - size = BlkD(t,Set)->size; - if (size > 1) /* only need to sort non-trivial sets */ - qsort((char *)Blk(BlkD(d,List)->listhead,Lelem)->lslots, - (int)size,sizeof(struct descrip),(QSortFncCast)anycmp); + size = BlkD(t,Set)->size; + if (size > 1) /* only need to sort non-trivial sets */ + qsort((char *)Blk(BlkD(d,List)->listhead,Lelem)->lslots, + (int)size,sizeof(struct descrip),(QSortFncCast)anycmp); return d; } @@ -907,10 +907,10 @@ function{1} sort(t, i) register dptr d1; register word size; register int j, k, n; - tended struct b_table *bp; + tended struct b_table *bp; tended struct b_list *lp, *tp; tended union block *ep; - tended struct b_slots *seg; + tended struct b_slots *seg; switch ((int)i) { @@ -919,7 +919,7 @@ function{1} sort(t, i) */ case 1: case 2: - { + { /* * The list resulting from the sort will have as many elements * as the table has, so get that value and also make a valid @@ -927,23 +927,23 @@ function{1} sort(t, i) */ size = BlkD(t,Table)->size; - /* - * Make sure, now, that there's enough room for all the - * allocations we're going to need. - */ - if (!reserve(Blocks, (word)(sizeof(struct b_list) - + sizeof(struct b_lelem) + (size - 1) * sizeof(struct descrip) - + size * sizeof(struct b_list) - + size * (sizeof(struct b_lelem) + sizeof(struct descrip))))) - runerr(0); + /* + * Make sure, now, that there's enough room for all the + * allocations we're going to need. + */ + if (!reserve(Blocks, (word)(sizeof(struct b_list) + + sizeof(struct b_lelem) + (size - 1) * sizeof(struct descrip) + + size * sizeof(struct b_list) + + size * (sizeof(struct b_lelem) + sizeof(struct descrip))))) + runerr(0); /* * Point bp at the table header block of the table to be sorted * and point lp at a newly allocated list * that will hold the the result of sorting the table. - * - * alclist_raw normally cannot be used if more allocations - * may occur before the list is initialized. The reason it is - * OK here is because of the reserve(). + * + * alclist_raw normally cannot be used if more allocations + * may occur before the list is initialized. The reason it is + * OK here is because of the reserve(). */ bp = (struct b_table *)BlkLoc(t); Protect(lp = alclist_raw(size, size), runerr(0)); @@ -962,12 +962,12 @@ function{1} sort(t, i) * list of two-element lists is complete, but unsorted. */ - n = 0; /* list index */ + n = 0; /* list index */ for (j = 0; j < HSegs && (seg = bp->hdir[j]) != NULL; j++) for (k = segsize[j] - 1; k >= 0; k--) for (ep= seg->hslots[k]; - BlkType(ep) == T_Telem; - ep = Blk(ep,Telem)->clink){ + BlkType(ep) == T_Telem; + ep = Blk(ep,Telem)->clink){ Protect(tp = alclist_raw(2, 2), runerr(0)); Blk(tp->listhead,Lelem)->lslots[0]=Blk(ep,Telem)->tref; Blk(tp->listhead,Lelem)->lslots[1]=Blk(ep,Telem)->tval; @@ -985,7 +985,7 @@ function{1} sort(t, i) else qsort((char *)Blk(lp->listhead,Lelem)->lslots, (int)size, sizeof(struct descrip), (QSortFncCast)tvalcmp); - break; /* from cases 1 and 2 */ + break; /* from cases 1 and 2 */ } /* * Cases 3 and 4 were introduced in Version 5.10. @@ -1030,8 +1030,8 @@ function{1} sort(t, i) for (j = 0; j < HSegs && (seg = bp->hdir[j]) != NULL; j++) for (k = segsize[j] - 1; k >= 0; k--) for (ep = seg->hslots[k]; - BlkType(ep) == T_Telem; - ep = Blk(ep,Telem)->clink) { + BlkType(ep) == T_Telem; + ep = Blk(ep,Telem)->clink) { *d1++ = Blk(ep,Telem)->tref; *d1++ = Blk(ep,Telem)->tval; } @@ -1065,10 +1065,10 @@ function{1} sort(t, i) } default: - runerr(115, t); /* structure expected */ + runerr(115, t); /* structure expected */ } end - + /* * trefcmp(d1,d2) - compare two-element lists on first field. */ @@ -1080,7 +1080,7 @@ dptr d1, d2; #ifdef DeBug if (d1->dword != D_List || d2->dword != D_List) syserr("trefcmp: internal consistency check fails."); -#endif /* DeBug */ +#endif /* DeBug */ return (anycmp(&(Blk(BlkD(*d1,List)->listhead,Lelem)->lslots[0]), &(Blk(BlkD(*d2,List)->listhead,Lelem)->lslots[0]))); @@ -1097,7 +1097,7 @@ dptr d1, d2; #ifdef DeBug if (d1->dword != D_List || d2->dword != D_List) syserr("tvalcmp: internal consistency check fails."); -#endif /* DeBug */ +#endif /* DeBug */ return (anycmp(&(Blk(BlkD(*d1,List)->listhead,Lelem)->lslots[1]), &(Blk(BlkD(*d2,List)->listhead,Lelem)->lslots[1]))); @@ -1125,7 +1125,7 @@ struct dpair *dp1,*dp2; { return (anycmp(&((*dp1).dv),&((*dp2).dv))); } - + "sortf(x,i) - sort list or set x on field i of each member" @@ -1251,14 +1251,14 @@ function{1} sortf(t, i) } default: - runerr(125, t); /* list, record, or set expected */ + runerr(125, t); /* list, record, or set expected */ } end - + /* * nthcmp(d1,d2) - compare two descriptors on their nth fields. */ -word sort_field; /* field number, set by sort function */ +word sort_field; /* field number, set by sort function */ static dptr nth (dptr d); int nthcmp(d1,d2) @@ -1270,18 +1270,18 @@ dptr d1, d2; t1 = Type(*d1); t2 = Type(*d2); if (t1 == t2 && (t1 == T_Record || t1 == T_List)) { - e1 = nth(d1); /* get nth field, or NULL if none such */ + e1 = nth(d1); /* get nth field, or NULL if none such */ e2 = nth(d2); if (e1 == NULL) { if (e2 != NULL) - return -1; /* no-nth-field is < any nth field */ + return -1; /* no-nth-field is < any nth field */ } else if (e2 == NULL) - return 1; /* any nth field is > no-nth-field */ + return 1; /* any nth field is > no-nth-field */ else { - /* - * Both had an nth field. If they're unequal, that decides. - */ + /* + * Both had an nth field. If they're unequal, that decides. + */ rv = anycmp(nth(d1), nth(d2)); if (rv != 0) return rv; @@ -1342,7 +1342,7 @@ dptr d; } return rv; } - + "type(x) - return type of x as a string." @@ -1357,37 +1357,37 @@ function{1} type(x) real: inline { return C_string "real"; } cset: inline { return C_string "cset"; } file: - inline { + inline { #ifdef Graphics - if (BlkD(x,File)->status & Fs_Window) - return C_string "window"; -#endif /* Graphics */ - return C_string "file"; - } + if (BlkD(x,File)->status & Fs_Window) + return C_string "window"; +#endif /* Graphics */ + return C_string "file"; + } proc: inline { return C_string "procedure"; } list: inline { return C_string "list"; } table: inline { return C_string "table"; } set: inline { return C_string "set"; } record: inline { return Blk(BlkD(x,Record)->recdesc,Proc)->recname; } - coexpr: inline { + coexpr: inline { #ifdef Concurrent - if (IS_TS_THREAD(BlkD(x, Coexpr)->status)) - return C_string "thread"; -#endif /* Concurrent */ - return C_string "co-expression"; - } + if (IS_TS_THREAD(BlkD(x, Coexpr)->status)) + return C_string "thread"; +#endif /* Concurrent */ + return C_string "co-expression"; + } #ifdef PatternType pattern: inline { return C_string "pattern"; } -#endif /* PatternType */ +#endif /* PatternType */ #ifdef EventMon - tvmonitored: + tvmonitored: body { if (is:string(*(VarLoc(BlkD(x,Tvmonitored)->tv)))) return C_string "foreign-local-string"; - else switch(Type(*(VarLoc(BlkD(x,Tvmonitored)->tv)))) { + else switch(Type(*(VarLoc(BlkD(x,Tvmonitored)->tv)))) { case T_Null: { return C_string "foreign-local-null"; } - case T_Integer:{ return C_string "foreign-local-integer"; } + case T_Integer:{ return C_string "foreign-local-integer"; } case T_Real: { return C_string "foreign-local-real"; } case T_Cset: { return C_string "foreign-local-cset"; } case T_File: { return C_string "foreign-local-file"; } @@ -1397,15 +1397,15 @@ function{1} type(x) case T_Set: { return C_string "foreign-local-set"; } case T_Record: { return C_string "foreign-local-record"; } case T_Coexpr: { return C_string "foreign-local-co-expression";} - default: { return C_string "foreign-local-??"; } - } - /* - * won't get here; this silences a bogus rtt warning, but some - * C compilers may be smart enough to notice and complain. - */ - fail; + default: { return C_string "foreign-local-??"; } + } + /* + * won't get here; this silences a bogus rtt warning, but some + * C compilers may be smart enough to notice and complain. + */ + fail; } -#endif /* EventMon */ +#endif /* EventMon */ default: inline { #if !COMPILER @@ -1413,21 +1413,21 @@ function{1} type(x) return C_string "external"; } else -#endif /* !COMPILER */ +#endif /* !COMPILER */ runerr(123,x); - } + } } end - + "variable(s) - find the variable with name s and return a" " variable descriptor which points to its value." #ifdef MultiProgram function{0,1} variable(s,c,i,trap_local) -#else /* MultiProgram */ +#else /* MultiProgram */ function{0,1} variable(s) -#endif /* MultiProgram */ +#endif /* MultiProgram */ if !cnv:C_string(s) then runerr(103, s) @@ -1437,7 +1437,7 @@ function{0,1} variable(s) runerr(101,i) if !def:C_integer(trap_local,0) then runerr(101,trap_local) -#endif /* MultiProgram */ +#endif /* MultiProgram */ abstract { return variable @@ -1449,7 +1449,7 @@ function{0,1} variable(s) struct progstate *prog, *savedprog=NULL; struct pf_marker *tmp_pfp; dptr tmp_argp; -#endif /* MultiProgram */ +#endif /* MultiProgram */ CURTSTATE_AND_CE(); #ifdef MultiProgram @@ -1465,58 +1465,58 @@ function{0,1} variable(s) tmp_argp = glbl_argp; if (is:null(c)) c = k_current; else if (!is:coexpr(c)){ - runerr(118, c); - } + runerr(118, c); + } else if (BlkLoc(c) != BlkLoc(k_current)) { - /* - * Save global variables needed by getvar() and temporarily set them - * to the "context" where getvar() will work. - */ - savedprog = curpstate; - prog = BlkD(c,Coexpr)->program; - pfp = BlkD(c,Coexpr)->es_pfp; - glbl_argp = BlkD(c,Coexpr)->es_argp; - ENTERPSTATE(prog); - } + /* + * Save global variables needed by getvar() and temporarily set them + * to the "context" where getvar() will work. + */ + savedprog = curpstate; + prog = BlkD(c,Coexpr)->program; + pfp = BlkD(c,Coexpr)->es_pfp; + glbl_argp = BlkD(c,Coexpr)->es_argp; + ENTERPSTATE(prog); + } while (i--) { - if (pfp == NULL) { - pfp = tmp_pfp; - glbl_argp = tmp_argp; - if (savedprog) - ENTERPSTATE(savedprog); - fail; - } - pfp = pfp->pf_pfp; + if (pfp == NULL) { + pfp = tmp_pfp; + glbl_argp = tmp_argp; + if (savedprog) + ENTERPSTATE(savedprog); + fail; + } + pfp = pfp->pf_pfp; } if (pfp) - glbl_argp = &((dptr)pfp)[-(pfp->pf_nargs) - 1]; + glbl_argp = &((dptr)pfp)[-(pfp->pf_nargs) - 1]; else glbl_argp = NULL; -#endif /* MultiProgram */ +#endif /* MultiProgram */ rv = getvar(s, &result); - + #ifdef MultiProgram if (savedprog) - ENTERPSTATE(savedprog); + ENTERPSTATE(savedprog); pfp = tmp_pfp; glbl_argp = tmp_argp; if ((rv == LocalName) || (rv == StaticName)) { #ifdef MonitoredTrappedVar - if (trap_local) { + if (trap_local) { result.dword = D_Tvmonitored; - VarLoc(result) = + VarLoc(result) = (dptr) alctvmonitored(&result, BlkD(c,Coexpr)->actv_count); - } - else + } + else #endif /* MonitoredTrappedVar */ - if (BlkLoc(c) != BlkLoc(k_current)) { - Deref(result); - } - } -#endif /* MultiProgram */ + if (BlkLoc(c) != BlkLoc(k_current)) { + Deref(result); + } + } +#endif /* MultiProgram */ if (rv != Failed) return result; @@ -1524,7 +1524,7 @@ function{0,1} variable(s) fail; } end - + "fieldnames(r) - generate the fieldnames of record r" @@ -1537,7 +1537,7 @@ function{*} fieldnames(r) int i, sz = Blk(BlkD(r,Record)->recdesc,Proc)->nfields; CURTSTATVAR(); for(i=0;irecdesc,Proc)->lnames[i]; + suspend Blk(BlkD(r,Record)->recdesc,Proc)->lnames[i]; fail; } end @@ -1551,18 +1551,18 @@ function{0,1} cofail(CE) if is:null(CE) then body { #ifdef CoExpr - struct b_coexpr *ce; - CURTSTATE(); - ce = topact(BlkD(k_current,Coexpr)); - if (ce != NULL) { - CE.dword = D_Coexpr; - BlkLoc(CE) = (union block *)ce; - } - else runerr(118,CE); -#else /* CoExpr */ - runerr(118, CE); -#endif /* CoExpr */ - } + struct b_coexpr *ce; + CURTSTATE(); + ce = topact(BlkD(k_current,Coexpr)); + if (ce != NULL) { + CE.dword = D_Coexpr; + BlkLoc(CE) = (union block *)ce; + } + else runerr(118,CE); +#else /* CoExpr */ + runerr(118, CE); +#endif /* CoExpr */ + } else if !is:coexpr(CE) then runerr(118,CE) body { @@ -1570,13 +1570,13 @@ function{0,1} cofail(CE) struct b_coexpr *ncp = BlkD(CE, Coexpr); if (co_chng(ncp, NULL, &result, A_Cofail, 1) == A_Cofail) fail; return result; -#else /* CoExpr */ +#else /* CoExpr */ runerr(118, CE); -#endif /* CoExpr */ +#endif /* CoExpr */ } end - + #ifdef MultiProgram "localnames(ce,i) - produce the names of local variables" @@ -1597,8 +1597,8 @@ function{*} localnames(ce,i) struct b_proc *cproc = BlkD(ce, Proc); np = abs((int)cproc->nparam); for(j = 0; j < cproc->ndynam; j++) { - result = cproc->lnames[j + np]; - suspend result; + result = cproc->lnames[j + np]; + suspend result; } fail; } @@ -1617,7 +1617,7 @@ function{*} localnames(ce,i) struct pf_marker *thePfp = BlkD(d,Coexpr)->es_pfp; if (thePfp == NULL) fail; - + /* * Produce error if i is negative */ @@ -1627,23 +1627,23 @@ function{*} localnames(ce,i) } while (i--) { - thePfp = thePfp->pf_pfp; - if (thePfp == NULL) fail; + thePfp = thePfp->pf_pfp; + if (thePfp == NULL) fail; } arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1]; cproc = BlkD(arg[0], Proc); np = abs((int)cproc->nparam); for(j = 0; j < cproc->ndynam; j++) { - result = cproc->lnames[j + np]; - suspend result; + result = cproc->lnames[j + np]; + suspend result; } -#endif /* !COMPILER */ +#endif /* !COMPILER */ fail; } end - + "staticnames(ce,i) - produce the names of static variables" " in the current procedure activation in ce" @@ -1666,12 +1666,12 @@ function{*} staticnames(ce,i) we_have_proc: ndynam = cproc->ndynam; if(ndynam < 0) { /* C function */ - runerr(118,ce); - } + runerr(118,ce); + } absnparam = abs((int)cproc->nparam); for(j = 0; j < cproc->nstatic; j++) { - result = cproc->lnames[j + absnparam + ndynam]; - suspend result; + result = cproc->lnames[j + absnparam + ndynam]; + suspend result; } fail; } @@ -1697,14 +1697,14 @@ function{*} staticnames(ce,i) } while (i--) { - thePfp = thePfp->pf_pfp; - if (thePfp == NULL) fail; + thePfp = thePfp->pf_pfp; + if (thePfp == NULL) fail; } arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1]; cproc = BlkD(arg[0], Proc); goto we_have_proc; -#endif /* !COMPILER */ +#endif /* !COMPILER */ fail; } end @@ -1729,8 +1729,8 @@ function{1,*} paramnames(ce,i) /* do built-ins (ndynam < 0) have readable parameter names? maybe not.*/ np = abs((int)cproc->nparam); for(j = 0; j < np; j++) { - result = cproc->lnames[j]; - suspend result; + result = cproc->lnames[j]; + suspend result; } fail; } @@ -1759,18 +1759,18 @@ function{1,*} paramnames(ce,i) } while (i--) { - thePfp = thePfp->pf_pfp; - if (thePfp == NULL) fail; + thePfp = thePfp->pf_pfp; + if (thePfp == NULL) fail; } arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1]; cproc = BlkD(arg[0], Proc); np = abs((int)cproc->nparam); for(j = 0; j < np; j++) { - result = cproc->lnames[j]; - suspend result; + result = cproc->lnames[j]; + suspend result; } -#endif /* !COMPILER */ +#endif /* !COMPILER */ fail; } end @@ -1780,7 +1780,7 @@ end " a program corresponding to string s as a co-expression." function{1} load(s,arglist,infile,outfile,errfile, - blocksize, stringsize, stacksize) + blocksize, stringsize, stacksize) declare { tended char *loadstring; C_integer _bs_, _ss_, _stk_; @@ -1828,7 +1828,7 @@ function{1} load(s,arglist,infile,outfile,errfile, *tipc.op++ = Op_Agoto; *tipc.opnd = (word)lterm; - prog_name = loadstring; /* set up for &progname */ + prog_name = loadstring; /* set up for &progname */ /* * arglist must be a list @@ -1840,32 +1840,32 @@ function{1} load(s,arglist,infile,outfile,errfile, * input, output, and error must be files */ if (is:null(infile)) - theInput = &(curpstate->K_input); + theInput = &(curpstate->K_input); else { - if (!is:file(infile)) - runerr(105,infile); - else theInput = &(BlkLoc(infile)->File); + if (!is:file(infile)) + runerr(105,infile); + else theInput = &(BlkLoc(infile)->File); } if (is:null(outfile)) - theOutput = &(curpstate->K_output); + theOutput = &(curpstate->K_output); else { - if (!is:file(outfile)) - runerr(105,outfile); - else theOutput = &(BlkLoc(outfile)->File); + if (!is:file(outfile)) + runerr(105,outfile); + else theOutput = &(BlkLoc(outfile)->File); } if (is:null(errfile)) - theError = &(curpstate->K_errout); + theError = &(curpstate->K_errout); else { - if (!is:file(errfile)) - runerr(105,errfile); - else theError = &(BlkLoc(errfile)->File); /* could check harder */ + if (!is:file(errfile)) + runerr(105,errfile); + else theError = &(BlkLoc(errfile)->File); /* could check harder */ } stack_tmp = - (word *)(sblkp = loadicode(loadstring,theInput,theOutput,theError, - _bs_,_ss_,_stk_)); + (word *)(sblkp = loadicode(loadstring,theInput,theOutput,theError, + _bs_,_ss_,_stk_)); if(!stack_tmp) { - fail; + fail; } pstate = sblkp->program; pstate->parent = curpstate; @@ -1884,17 +1884,17 @@ function{1} load(s,arglist,infile,outfile,errfile, ((word)((char *)sblkp + (mstksize - (sizeof(*sblkp)+sizeof(struct progstate)+ pstate->hsize))/2) &~((word)WordSize*StackAlign-1)); -#else /* UpStack */ +#else /* UpStack */ sblkp->cstate[0] = - ((word)((char *)sblkp + mstksize - WordSize + sizeof(struct progstate) + + ((word)((char *)sblkp + mstksize - WordSize + sizeof(struct progstate) + pstate->hsize) &~((word)WordSize*StackAlign-1)); -#endif /* UpStack */ +#endif /* UpStack */ sblkp->es_argp = NULL; sblkp->es_gfp = NULL; pstate->Mainhead->freshblk = nulldesc;/* &main has no refresh block. */ - /* This really is a bug. */ + /* This really is a bug. */ /* * Set up expression frame marker to contain execution of the @@ -1904,9 +1904,9 @@ function{1} load(s,arglist,infile,outfile,errfile, newefp = (struct ef_marker *)(sp+1); #if IntBits != WordBits newefp->ef_failure.op = (int *)lterm; -#else /* IntBits != WordBits */ +#else /* IntBits != WordBits */ newefp->ef_failure.op = lterm; -#endif /* IntBits != WordBits */ +#endif /* IntBits != WordBits */ newefp->ef_gfp = 0; newefp->ef_efp = 0; @@ -1931,11 +1931,11 @@ function{1} load(s,arglist,infile,outfile,errfile, */ if (!is:null(arglist)) { PushDesc(arglist); - pstate->tstate->Glbl_argp = (dptr)(sp - 1); + pstate->tstate->Glbl_argp = (dptr)(sp - 1); } else { PushNull; - pstate->tstate->Glbl_argp = (dptr)(sp - 1); + pstate->tstate->Glbl_argp = (dptr)(sp - 1); { dptr tmpargp = (dptr) (sp - 1); Ollist(0, tmpargp); @@ -1951,7 +1951,7 @@ function{1} load(s,arglist,infile,outfile,errfile, return result; } end - + "parent(ce) - given a ce, return &main for that ce's parent" @@ -1971,11 +1971,11 @@ function{1} parent(ce) result.dword = D_Coexpr; BlkLoc(result) = - (union block *)(BlkD(ce,Coexpr)->program->parent->Mainhead); + (union block *)(BlkD(ce,Coexpr)->program->parent->Mainhead); return result; } end - + #ifdef MultiProgram "eventmask(ce,cs) - given a ce, get or set that program's event mask" @@ -1996,23 +1996,23 @@ function{1} eventmask(ce,cs,vmask) return cset } body { - struct progstate *p = BlkD(ce,Coexpr)->program; - if (BlkLoc(cs) != BlkLoc(p->eventmask)) { - p->eventmask = cs; - assign_event_functions(p, cs); - } + struct progstate *p = BlkD(ce,Coexpr)->program; + if (BlkLoc(cs) != BlkLoc(p->eventmask)) { + p->eventmask = cs; + assign_event_functions(p, cs); + } - if (!is:null(vmask)) { + if (!is:null(vmask)) { if (!is:table(vmask)) runerr(124,vmask); - BlkD(ce,Coexpr)->program->valuemask = vmask; - } + BlkD(ce,Coexpr)->program->valuemask = vmask; + } return cs; } } end -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - "globalnames(ce) - produce the names of identifiers global to ce" @@ -2021,7 +2021,7 @@ function{*} globalnames(ce) declare { struct progstate *ps; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ abstract { return string } @@ -2030,17 +2030,17 @@ function{*} globalnames(ce) else if is:coexpr(ce) then inline { ps = BlkD(ce,Coexpr)->program; } else runerr(118,ce) -#else /* MultiProgram */ +#else /* MultiProgram */ if not (is:null(ce) || is:coexpr(ce)) runerr(118, ce) -#endif /* MultiProgram */ +#endif /* MultiProgram */ body { struct descrip *dp; CURTSTATVAR(); #ifdef MultiProgram for (dp = ps->Gnames; dp != ps->Egnames; dp++) { -#else /* MultiProgram */ +#else /* MultiProgram */ for (dp = gnames; dp != egnames; dp++) { -#endif /* MultiProgram */ +#endif /* MultiProgram */ suspend *dp; } fail; @@ -2079,25 +2079,25 @@ function{*} keyword(keyname,ce,i) /* set prog to ce's program. */ /* try &eventsource if available, then ¤t, then search */ if (!is:null(curpstate->eventsource) && - (ptmp = BlkD(curpstate->eventsource,Coexpr)->program) && - InRange(ptmp->Code, w, ptmp->Ecode)) { - d = curpstate->eventsource; - } + (ptmp = BlkD(curpstate->eventsource,Coexpr)->program) && + InRange(ptmp->Code, w, ptmp->Ecode)) { + d = curpstate->eventsource; + } else if (InRange(curpstate->Code, w, curpstate->Ecode)) { d = k_current; - } + } else { /* search for program in which (procedure) ce is located */ - struct progstate *p; - d = nulldesc; - for (p = &rootpstate; p != NULL; p = p->next) { - if (InRange(p->Code, w, p->Ecode)) { - d.dword = D_Coexpr; - d.vword.bptr = (union block *)p->Mainhead; - break; - } - } - if (is:null(d)) runerr(118, ce); - } + struct progstate *p; + d = nulldesc; + for (p = &rootpstate; p != NULL; p = p->next) { + if (InRange(p->Code, w, p->Ecode)) { + d.dword = D_Coexpr; + d.vword.bptr = (union block *)p->Mainhead; + break; + } + } + if (is:null(d)) runerr(118, ce); + } } else runerr(118, ce) inline { @@ -2128,13 +2128,13 @@ static stringint siKeywords[] = { #ifdef Concurrent struct threadstate *tstate; if (BlkD(d,Coexpr)->tstate) - tstate = BlkD(d,Coexpr)->tstate; + tstate = BlkD(d,Coexpr)->tstate; else - tstate = p->tstate; - -#else /* Concurrent */ + tstate = p->tstate; + +#else /* Concurrent */ struct threadstate *tstate = p->tstate; -#endif /* Concurrent */ +#endif /* Concurrent */ if (kname[0] == '&') kname++; @@ -2144,19 +2144,19 @@ static stringint siKeywords[] = { /* It will be plug-and-chug to move to this implementation. */ switch(k) { case K_ALLOCATED: - fprintf(stderr, "keyword called on &allocated\n"); - fflush(stderr); - break; + fprintf(stderr, "keyword called on &allocated\n"); + fflush(stderr); + break; /* ... */ case K_LINE: - fprintf(stderr, "keyword called on &line\n"); - fflush(stderr); - break; + fprintf(stderr, "keyword called on &line\n"); + fflush(stderr); + break; /* ... */ default: - fprintf(stderr, "keyword called on ??\n"); - fflush(stderr); - } + fprintf(stderr, "keyword called on ??\n"); + fflush(stderr); + } #endif if (strcmp(kname,"allocated") == 0) { @@ -2190,260 +2190,260 @@ static stringint siKeywords[] = { } else if (strcmp(kname,"tallocated") == 0) { #ifdef Concurrent - /* - * Preliminary version just reports space used in current regions. - */ - suspend C_integer (tstate->Curstring->free - tstate->Curstring->base) + - (tstate->Curblock->free - tstate->Curblock->base); - suspend C_integer (tstate->Curstring->free - tstate->Curstring->base); - suspend C_integer (tstate->Curblock->free - tstate->Curblock->base); -#endif /* Concurrent */ - fail; - } + /* + * Preliminary version just reports space used in current regions. + */ + suspend C_integer (tstate->Curstring->free - tstate->Curstring->base) + + (tstate->Curblock->free - tstate->Curblock->base); + suspend C_integer (tstate->Curstring->free - tstate->Curstring->base); + suspend C_integer (tstate->Curblock->free - tstate->Curblock->base); +#endif /* Concurrent */ + fail; + } else if (strcmp(kname,"collections") == 0) { - suspend C_integer p->colltot; - suspend C_integer p->collstat; - suspend C_integer p->collstr; - return C_integer p->collblk; - } + suspend C_integer p->colltot; + suspend C_integer p->collstat; + suspend C_integer p->collstr; + return C_integer p->collblk; + } else if (strcmp(kname,"column") == 0) { - struct progstate *savedp = curpstate; - int col; - ENTERPSTATE(p); - col = findcol(BlkD(d,Coexpr)->es_ipc.opnd); + struct progstate *savedp = curpstate; + int col; + ENTERPSTATE(p); + col = findcol(BlkD(d,Coexpr)->es_ipc.opnd); if (col == 0){ /* fixing returned column zero */ - col = findcol(BlkD(d,Coexpr)->es_oldipc.opnd); + col = findcol(BlkD(d,Coexpr)->es_oldipc.opnd); } - ENTERPSTATE(savedp); - return C_integer col; - } + ENTERPSTATE(savedp); + return C_integer col; + } else if (strcmp(kname,"current") == 0) { - return tstate->K_current; - } + return tstate->K_current; + } else if (strcmp(kname,"error") == 0) { - return kywdint(&(p->Kywd_err)); - } + return kywdint(&(p->Kywd_err)); + } else if (strcmp(kname,"errornumber") == 0) { - return C_integer tstate->K_errornumber; - } + return C_integer tstate->K_errornumber; + } else if (strcmp(kname,"errortext") == 0) { - return tstate->K_errortext; - } + return tstate->K_errortext; + } else if (strcmp(kname,"errorvalue") == 0) { - return tstate->K_errorvalue; - } + return tstate->K_errorvalue; + } #ifdef PatternType else if (strcmp(kname,"patindex") == 0) { return C_integer tstate->K_patindex; } -#endif /* PatternType */ +#endif /* PatternType */ else if (strcmp(kname,"errout") == 0) { - return file(&(p->K_errout)); - } + return file(&(p->K_errout)); + } else if (strcmp(kname,"eventcode") == 0) { - return kywdevent(&(p->eventcode)); - } + return kywdevent(&(p->eventcode)); + } else if (strcmp(kname,"eventcount") == 0) { - return kywdevent(&(p->eventcount)); - } + return kywdevent(&(p->eventcount)); + } else if (strcmp(kname,"eventsource") == 0) { - return kywdevent(&(p->eventsource)); - } + return kywdevent(&(p->eventsource)); + } else if (strcmp(kname,"eventvalue") == 0) { - return kywdevent(&(p->eventval)); - } + return kywdevent(&(p->eventval)); + } else if (strcmp(kname,"file") == 0) { - struct progstate *savedp = curpstate; - struct descrip s; + struct progstate *savedp = curpstate; + struct descrip s; word * ipc_opnd; - if (is:proc(ce)) { - struct b_proc *proc = BlkD(ce,Proc); - StrLoc(s) = findfile_p((word *)proc->entryp.icode, p); - if (!strcmp(StrLoc(s), "?")) { - fail; - } - else { - StrLen(s) = strlen(StrLoc(s)); - return s; - } - } + if (is:proc(ce)) { + struct b_proc *proc = BlkD(ce,Proc); + StrLoc(s) = findfile_p((word *)proc->entryp.icode, p); + if (!strcmp(StrLoc(s), "?")) { + fail; + } + else { + StrLen(s) = strlen(StrLoc(s)); + return s; + } + } else /* remaining cases are keyword("file",ce,...) */ - if (i > 0){ + if (i > 0){ ipc_opnd = findoldipc(BlkD(d,Coexpr),i); - ENTERPSTATE(p); - StrLoc(s) = findfile(ipc_opnd); - StrLen(s) = strlen(StrLoc(s)); + ENTERPSTATE(p); + StrLoc(s) = findfile(ipc_opnd); + StrLen(s) = strlen(StrLoc(s)); } else{ - ENTERPSTATE(p); - StrLoc(s) = findfile(BlkD(d,Coexpr)->es_ipc.opnd); - StrLen(s) = strlen(StrLoc(s)); - } - ENTERPSTATE(savedp); - if (!strcmp(StrLoc(s),"?")) fail; - return s; - } + ENTERPSTATE(p); + StrLoc(s) = findfile(BlkD(d,Coexpr)->es_ipc.opnd); + StrLen(s) = strlen(StrLoc(s)); + } + ENTERPSTATE(savedp); + if (!strcmp(StrLoc(s),"?")) fail; + return s; + } else if (strcmp(kname,"input") == 0) { - return file(&(p->K_input)); - } + return file(&(p->K_input)); + } else if (strcmp(kname,"level") == 0) { - return C_integer tstate->K_level; - } + return C_integer tstate->K_level; + } else if (strcmp(kname,"line") == 0) { - struct progstate *savedp = curpstate; - int ln; + struct progstate *savedp = curpstate; + int ln; word * ipc_opnd; - if (is:proc(ce)) { - struct b_proc *proc = BlkD(ce,Proc); - int i; - i = findline_p((word *)proc->entryp.icode, p); - if (i == 0) { - fail; - } - else { - return C_integer i; - } - } - else /* remaining cases are keyword("line",ce,...) */ + if (is:proc(ce)) { + struct b_proc *proc = BlkD(ce,Proc); + int i; + i = findline_p((word *)proc->entryp.icode, p); + if (i == 0) { + fail; + } + else { + return C_integer i; + } + } + else /* remaining cases are keyword("line",ce,...) */ if (i > 0){ ipc_opnd = findoldipc(BlkD(d,Coexpr),i); - ENTERPSTATE(p); + ENTERPSTATE(p); ln = findline(ipc_opnd); } else{ - ENTERPSTATE(p); - ln = findline(BlkD(d,Coexpr)->es_ipc.opnd); + ENTERPSTATE(p); + ln = findline(BlkD(d,Coexpr)->es_ipc.opnd); if (ln == 0){ /* fixing returned line zero */ - ln = findline(BlkD(d,Coexpr)->es_oldipc.opnd); + ln = findline(BlkD(d,Coexpr)->es_oldipc.opnd); } - } - ENTERPSTATE(savedp); - return C_integer ln; - } + } + ENTERPSTATE(savedp); + return C_integer ln; + } else if (strcmp(kname,"syntax") == 0) { struct progstate *savedp = curpstate; - int syn; - ENTERPSTATE(p); - syn = findsyntax(BlkD(d,Coexpr)->es_ipc.opnd); - ENTERPSTATE(savedp); - return C_integer syn; - } + int syn; + ENTERPSTATE(p); + syn = findsyntax(BlkD(d,Coexpr)->es_ipc.opnd); + ENTERPSTATE(savedp); + return C_integer syn; + } else if (strcmp(kname,"main") == 0) { - return p->K_main; - } + return p->K_main; + } else if (strcmp(kname,"output") == 0) { - return file(&(p->K_output)); - } + return file(&(p->K_output)); + } else if (strcmp(kname,"pos") == 0) { - return kywdpos(&(tstate->Kywd_pos)); - } + return kywdpos(&(tstate->Kywd_pos)); + } else if (strcmp(kname,"progname") == 0) { - return kywdstr(&(p->Kywd_prog)); - } + return kywdstr(&(p->Kywd_prog)); + } else if (strcmp(kname,"random") == 0) { - return kywdint(&(tstate->Kywd_ran)); - } + return kywdint(&(tstate->Kywd_ran)); + } else if (strcmp(kname,"regions") == 0) { word allRegions = 0; struct region *rp; suspend C_integer 0; - for (rp = p->stringregion; rp; rp = rp->next) - allRegions += DiffPtrs(rp->end,rp->base); - for (rp = p->stringregion->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->end,rp->base); - suspend C_integer allRegions; - - allRegions = 0; - for (rp = p->blockregion; rp; rp = rp->next) - allRegions += DiffPtrs(rp->end,rp->base); - for (rp = p->blockregion->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->end,rp->base); - return C_integer allRegions; - } + for (rp = p->stringregion; rp; rp = rp->next) + allRegions += DiffPtrs(rp->end,rp->base); + for (rp = p->stringregion->prev; rp; rp = rp->prev) + allRegions += DiffPtrs(rp->end,rp->base); + suspend C_integer allRegions; + + allRegions = 0; + for (rp = p->blockregion; rp; rp = rp->next) + allRegions += DiffPtrs(rp->end,rp->base); + for (rp = p->blockregion->prev; rp; rp = rp->prev) + allRegions += DiffPtrs(rp->end,rp->base); + return C_integer allRegions; + } else if (strcmp(kname,"source") == 0) { #ifdef CoExpr - return coexpr(topact( - BlkD(tstate->K_current,Coexpr))); -#else /* CoExpr */ - fail; -#endif /* CoExpr */ + return coexpr(topact( + BlkD(tstate->K_current,Coexpr))); +#else /* CoExpr */ + fail; +#endif /* CoExpr */ /* - if (BlkLoc(d)->coexpr.es_actstk) - return coexpr(topact((struct b_coexpr *)BlkLoc(d))); - else return BlkLoc(d)->coexpr.program->parent->K_main; + if (BlkLoc(d)->coexpr.es_actstk) + return coexpr(topact((struct b_coexpr *)BlkLoc(d))); + else return BlkLoc(d)->coexpr.program->parent->K_main; */ - } + } else if (strcmp(kname,"storage") == 0) { - word allRegions = 0; - struct region *rp; - suspend C_integer 0; - for (rp = p->stringregion; rp; rp = rp->next) - allRegions += DiffPtrs(rp->free,rp->base); - for (rp = p->stringregion->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->free,rp->base); - suspend C_integer allRegions; - - allRegions = 0; - for (rp = p->blockregion; rp; rp = rp->next) - allRegions += DiffPtrs(rp->free,rp->base); - for (rp = p->blockregion->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->free,rp->base); - return C_integer allRegions; - } + word allRegions = 0; + struct region *rp; + suspend C_integer 0; + for (rp = p->stringregion; rp; rp = rp->next) + allRegions += DiffPtrs(rp->free,rp->base); + for (rp = p->stringregion->prev; rp; rp = rp->prev) + allRegions += DiffPtrs(rp->free,rp->base); + suspend C_integer allRegions; + + allRegions = 0; + for (rp = p->blockregion; rp; rp = rp->next) + allRegions += DiffPtrs(rp->free,rp->base); + for (rp = p->blockregion->prev; rp; rp = rp->prev) + allRegions += DiffPtrs(rp->free,rp->base); + return C_integer allRegions; + } else if (strcmp(kname,"subject") == 0) { - return kywdsubj(&(tstate->ksub)); - } + return kywdsubj(&(tstate->ksub)); + } else if (strcmp(kname,"time") == 0) { - /* - * &time in this program = total time - time spent in other programs - */ - if (p != curpstate) - return C_integer p->Kywd_time_out - p->Kywd_time_elsewhere; - else - return C_integer millisec() - p->Kywd_time_elsewhere; - } + /* + * &time in this program = total time - time spent in other programs + */ + if (p != curpstate) + return C_integer p->Kywd_time_out - p->Kywd_time_elsewhere; + else + return C_integer millisec() - p->Kywd_time_elsewhere; + } else if (strcmp(kname,"trace") == 0) { - return kywdint(&(p->Kywd_trc)); - } + return kywdint(&(p->Kywd_trc)); + } #ifdef Graphics else if (strcmp(kname,"window") == 0) { - return kywdwin(&(p->Kywd_xwin[XKey_Window])); - } + return kywdwin(&(p->Kywd_xwin[XKey_Window])); + } else if (strcmp(kname,"col") == 0) { - return kywdint(&(p->AmperCol)); - } + return kywdint(&(p->AmperCol)); + } else if (strcmp(kname,"row") == 0) { - return kywdint(&(p->AmperRow)); - } + return kywdint(&(p->AmperRow)); + } else if (strcmp(kname,"x") == 0) { - return kywdint(&(p->AmperX)); - } + return kywdint(&(p->AmperX)); + } else if (strcmp(kname,"y") == 0) { - return kywdint(&(p->AmperY)); - } + return kywdint(&(p->AmperY)); + } else if (strcmp(kname,"interval") == 0) { - return kywdint(&(p->AmperInterval)); - } + return kywdint(&(p->AmperInterval)); + } else if (strcmp(kname,"control") == 0) { - if (p->Xmod_Control) - return nulldesc; - else - fail; - } + if (p->Xmod_Control) + return nulldesc; + else + fail; + } else if (strcmp(kname,"shift") == 0) { - if (p->Xmod_Shift) - return nulldesc; - else - fail; - } + if (p->Xmod_Shift) + return nulldesc; + else + fail; + } else if (strcmp(kname,"meta") == 0) { - if (p->Xmod_Meta) - return nulldesc; - else - fail; - } -#endif /* Graphics */ + if (p->Xmod_Meta) + return nulldesc; + else + fail; + } +#endif /* Graphics */ runerr(205, keyname); } end @@ -2471,11 +2471,11 @@ function {*} structure(x) theregion = curblock; #endif for(rp = theregion; rp; rp = rp->next) { - bp = rp->base; - free = rp->free; - while (bp < free) { - type = BlkType(bp); - switch (type) { + bp = rp->base; + free = rp->free; + while (bp < free) { + type = BlkType(bp); + switch (type) { case T_List: case T_Set: case T_Table: @@ -2484,16 +2484,16 @@ function {*} structure(x) descr.dword = type | F_Ptr | D_Typecode; suspend descr; } - } - bp += BlkSize(bp); - } - } + } + bp += BlkSize(bp); + } + } for(rp = theregion->prev; rp; rp = rp->prev) { - bp = rp->base; - free = rp->free; - while (bp < free) { - type = BlkType(bp); - switch (type) { + bp = rp->base; + free = rp->free; + while (bp < free) { + type = BlkType(bp); + switch (type) { case T_List: case T_Set: case T_Table: @@ -2502,16 +2502,16 @@ function {*} structure(x) descr.dword = type | F_Ptr | D_Typecode; suspend descr; } - } - bp += BlkSize(bp); - } - } + } + bp += BlkSize(bp); + } + } fail; } end -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef Concurrent @@ -2519,27 +2519,27 @@ end * These symbols should match those in uni/lib/threadh.icn */ -#define OFF 0 -#define ON 1 +#define OFF 0 +#define ON 1 -#define INBOX 1000 -#define OUTBOX 1001 -#define INBOX_SIZE 1002 -#define OUTBOX_SIZE 1003 -#define INBOX_LIMIT 1004 -#define OUTBOX_LIMIT 1005 -#define INBOX_CV_FULL 1006 -#define INBOX_CV_EMPTY 1007 -#define OUTBOX_CV_FULL 1008 -#define OUTBOX_CV_EMPTY 1009 +#define INBOX 1000 +#define OUTBOX 1001 +#define INBOX_SIZE 1002 +#define OUTBOX_SIZE 1003 +#define INBOX_LIMIT 1004 +#define OUTBOX_LIMIT 1005 +#define INBOX_CV_FULL 1006 +#define INBOX_CV_EMPTY 1007 +#define OUTBOX_CV_FULL 1008 +#define OUTBOX_CV_EMPTY 1009 -#define CHANNEL_SIZE 1010 -#define CHANNEL_LIMIT 1011 +#define CHANNEL_SIZE 1010 +#define CHANNEL_LIMIT 1011 -#define MUTEX 1050 -#define CV 1051 -#define CV_FULL 1052 -#define CV_EMPTY 1053 +#define MUTEX 1050 +#define CV 1051 +#define CV_FULL 1052 +#define CV_EMPTY 1053 #define GETCVMUTEXID(x,y){ \ @@ -2582,17 +2582,17 @@ word get_cv(word mtx){ condvars=realloc(condvars, maxcondvars * sizeof(pthread_cond_t *)); condvarsmtxs=realloc(condvarsmtxs, maxcondvars * WordSize); if (condvars==NULL || condvarsmtxs==NULL) - syserr("get_cv(): out of memory for condition variables!"); + syserr("get_cv(): out of memory for condition variables!"); RESUME_THREADS(); } condvars[ncondvars] = malloc(sizeof(pthread_cond_t)); \ pthread_cond_init(condvars[ncondvars], NULL); - if(mtx<0) + if(mtx<0) condvarsmtxs[ncondvars]=get_mutex(&rmtx_attr); else condvarsmtxs[ncondvars]=mtx; - + n = ncondvars++; MUTEX_UNLOCKID(MTX_CONDVARS); return n; @@ -2605,23 +2605,23 @@ function{1} condvar(x) abstract { return list } inline{ tended struct b_list *hp = BlkD(x, List); - TURN_ON_CONCURRENT(); - CV_INITBLK(hp); - return x; - } + TURN_ON_CONCURRENT(); + CV_INITBLK(hp); + return x; + } } else if def:C_integer(x,-1) then{ abstract { return integer } - inline { - TURN_ON_CONCURRENT(); - if (x>0) - return C_integer -2 - get_cv(x-1); - else - return C_integer -2 - get_cv(x); - } + inline { + TURN_ON_CONCURRENT(); + if (x>0) + return C_integer -2 - get_cv(x-1); + else + return C_integer -2 - get_cv(x); + } } else runerr(180,x) - + end "signal(x, y) - signal the condition variable x y times. Default y is 1, y=0 means broadcast" @@ -2631,20 +2631,20 @@ function{0,1} signal(x, y) if is:coexpr(x) then { abstract { return coexpr } body { - /* - * Transmit whatever is needed to wake it up. - */ + /* + * Transmit whatever is needed to wake it up. + */ #ifdef PthreadCoswitch - if (BlkD(x, Coexpr)->alive == 0) - fail; + if (BlkD(x, Coexpr)->alive == 0) + fail; - sem_post(BlkD(x, Coexpr)->semp); + sem_post(BlkD(x, Coexpr)->semp); - return x; + return x; #else - fail; -#endif /* PthreadCoswitch */ - } + fail; +#endif /* PthreadCoswitch */ + } } else { if !cnv:C_integer(x) then @@ -2658,19 +2658,19 @@ function{0,1} signal(x, y) int rv; word i, x1 = -x-2; if (x1<0 || x1>=ncondvars) - irunerr(181, x); + irunerr(181, x); if (Y == 0) { - if ((rv=pthread_cond_broadcast(condvars[x1])) != 0) { - } - } + if ((rv=pthread_cond_broadcast(condvars[x1])) != 0) { + } + } else for (i=0; i < Y; i++) if ((rv=pthread_cond_signal(condvars[x1])) != 0){ - char cvwf[64]; - sprintf(cvwf, "condition variable wait failure %d\n", rv); - syserr(cvwf); - exit(-1); - } + char cvwf[64]; + sprintf(cvwf, "condition variable wait failure %d\n", rv); + syserr(cvwf); + exit(-1); + } return C_integer 1; } } @@ -2685,9 +2685,9 @@ function{1} mutex(x, y) abstract { return integer } inline { if (!is:null(y)) - runerr(180, x); - TURN_ON_CONCURRENT(); - return C_integer get_mutex(&rmtx_attr)+1; + runerr(180, x); + TURN_ON_CONCURRENT(); + return C_integer get_mutex(&rmtx_attr)+1; } } set: @@ -2698,57 +2698,57 @@ function{1} mutex(x, y) type_case y of { null:{ inline { - if ((BlkMask(x))->shared) - runerr(184, x); - TURN_ON_CONCURRENT(); - MUTEX_INITBLK(BlkMask(x)); - return x; - } - } - integer: { - if !cnv:C_integer(y) then runerr(180, y); + if ((BlkMask(x))->shared) + runerr(184, x); + TURN_ON_CONCURRENT(); + MUTEX_INITBLK(BlkMask(x)); + return x; + } + } + integer: { + if !cnv:C_integer(y) then runerr(180, y); inline { - word y1; - TURN_ON_CONCURRENT(); - GETMUTEXID(y, y1); + word y1; + TURN_ON_CONCURRENT(); + GETMUTEXID(y, y1); - if ((BlkMask(x))->shared) - runerr(184, x); + if ((BlkMask(x))->shared) + runerr(184, x); - MUTEX_INITBLKID(BlkMask(x), y1); - return x; - } - } + MUTEX_INITBLKID(BlkMask(x), y1); + return x; + } + } file:{ inline { - if ((BlkMask(x))->shared) - runerr(184, x); - TURN_ON_CONCURRENT(); - MUTEX_INITBLKID(BlkMask(x), BlkD(y, File)->mutexid); + if ((BlkMask(x))->shared) + runerr(184, x); + TURN_ON_CONCURRENT(); + MUTEX_INITBLKID(BlkMask(x), BlkD(y, File)->mutexid); return x; - } - } + } + } set: table: record: list:{ inline { - struct b_mask *bp = BlkMask(y); - TURN_ON_CONCURRENT(); - if (!bp->shared) - MUTEX_INITBLK(bp); + struct b_mask *bp = BlkMask(y); + TURN_ON_CONCURRENT(); + if (!bp->shared) + MUTEX_INITBLK(bp); - if ((BlkMask(x))->shared) - runerr(184, x); + if ((BlkMask(x))->shared) + runerr(184, x); - MUTEX_INITBLKID(BlkMask(x), bp->mutexid); + MUTEX_INITBLKID(BlkMask(x), bp->mutexid); return x; - } - } + } + } default: runerr(122, x) - } - } + } + } default: runerr(122, x) } @@ -2778,20 +2778,20 @@ function{1} lock(x) record: list:{ inline { - struct b_mask *bp = BlkMask(x); - if (bp->shared){ - MUTEX_LOCKBLK_CONTROLLED_NOCHK(bp, "lock(struct)"); + struct b_mask *bp = BlkMask(x); + if (bp->shared){ + MUTEX_LOCKBLK_CONTROLLED_NOCHK(bp, "lock(struct)"); return x; - } - runerr(180, x); - } - } + } + runerr(180, x); + } + } file:{ inline { - MUTEX_LOCKID_CONTROLLED(BlkD(x, File)->mutexid); + MUTEX_LOCKID_CONTROLLED(BlkD(x, File)->mutexid); return x; - } - } + } + } default: runerr(180, x) } @@ -2817,24 +2817,24 @@ function{0,1} trylock(x) record: list:{ body { - struct b_mask *bp = BlkMask(x); - if (bp->shared){ - int rv = 0; - MUTEX_TRYLOCKBLK(bp, rv, "trylock(structure) function"); - if (rv == 0) return x; - fail; - } - runerr(180, x); - } - } + struct b_mask *bp = BlkMask(x); + if (bp->shared){ + int rv = 0; + MUTEX_TRYLOCKBLK(bp, rv, "trylock(structure) function"); + if (rv == 0) return x; + fail; + } + runerr(180, x); + } + } file:{ inline { int rv; MUTEX_TRYLOCKID(BlkD(x, File)->mutexid, rv); if (rv == 0) return x; fail; - } - } + } + } default: runerr(180, x) } @@ -2859,20 +2859,20 @@ function{1} unlock(x) record: list:{ body { - struct b_mask *bp = BlkMask(x); - if (bp->shared){ - MUTEX_UNLOCKBLK_NOCHK(bp, "unlock(structure) function"); + struct b_mask *bp = BlkMask(x); + if (bp->shared){ + MUTEX_UNLOCKBLK_NOCHK(bp, "unlock(structure) function"); return x; - } - runerr(180, x); - } - } + } + runerr(180, x); + } + } file:{ inline { - MUTEX_UNLOCKID(BlkD(x, File)->mutexid); + MUTEX_UNLOCKID(BlkD(x, File)->mutexid); return x; - } - } + } + } default: runerr(180, x) } @@ -2902,147 +2902,147 @@ function{0,1} spawn(x, blocksize, stringsize, stacksize, soft) if is:coexpr(x) then { abstract { return coexpr } body { - struct b_coexpr *cp = BlkD(x, Coexpr); - int i; + struct b_coexpr *cp = BlkD(x, Coexpr); + int i; #if !ConcurrentCOMPILER - if (!is:null(curpstate->eventmask)) { - fprintf(stderr, - "monitoring of concurrent programs is not yet supported."); - runerr(183, x); - } + if (!is:null(curpstate->eventmask)) { + fprintf(stderr, + "monitoring of concurrent programs is not yet supported."); + runerr(183, x); + } #endif /* ConcurrentCOMPILER */ - TURN_ON_CONCURRENT(); + TURN_ON_CONCURRENT(); #if ConcurrentCOMPILER || defined(SoftThreads) - CURTSTATE(); + CURTSTATE(); #endif /* ConcurrentCOMPILER */ - if (IS_TS_THREAD(cp->status)) return x; + if (IS_TS_THREAD(cp->status)) return x; #ifdef SoftThreads if (isoft) { - if (IS_TS_SOFTTHREAD(cp->status)) return x; + if (IS_TS_SOFTTHREAD(cp->status)) return x; if (curtstate->sthrd_size+1>=SOFT_THREADS_SIZE) /* for now */ - syserr("now space for soft threads"); - curtstate->sthrds[curtstate->sthrd_size++] = cp; - SET_FLAG(cp->status, Ts_SoftThread); - SET_FLAG(cp->status, Ts_Thread); - cp->parent = curtstate->c; - curtstate->c->sthrd_tick /= 10; - /* - * Set the parent of the new thread. - */ -/* if (cp->es_actstk == NULL) - Protect(cp->es_actstk = alcactiv(),runerr(0,x)); - - if (pushact(cp, (struct b_coexpr *)BlkLoc(k_current)) == RunError) - runerr(0,x); -*/ - return x; - } -#endif /* SoftThreads */ + syserr("now space for soft threads"); + curtstate->sthrds[curtstate->sthrd_size++] = cp; + SET_FLAG(cp->status, Ts_SoftThread); + SET_FLAG(cp->status, Ts_Thread); + cp->parent = curtstate->c; + curtstate->c->sthrd_tick /= 10; + /* + * Set the parent of the new thread. + */ +/* if (cp->es_actstk == NULL) + Protect(cp->es_actstk = alcactiv(),runerr(0,x)); + + if (pushact(cp, (struct b_coexpr *)BlkLoc(k_current)) == RunError) + runerr(0,x); +*/ + return x; + } +#endif /* SoftThreads */ #ifdef PthreadCoswitch - if (cp->alive == 1) { - /* - * The co-expression has already been Activated! - * spawning an active co-expression is not yet supported - */ - runerr(185, x); - } -#endif /* PthreadCoswitch */ + if (cp->alive == 1) { + /* + * The co-expression has already been Activated! + * spawning an active co-expression is not yet supported + */ + runerr(185, x); + } +#endif /* PthreadCoswitch */ if (!_bs_) - _bs_ = rootblock.size/10 ; - else if (_bs_ < MinAbrSize) - _bs_ = MinAbrSize; - - if (!_ss_) - _ss_ = rootstring.size/10; - else if (_ss_ < MinStrSpace) - _ss_ = MinStrSpace; - - cp->ini_blksize = _bs_; - cp->ini_ssize = _ss_; - - /* - * Loop until I aquire the mutex. - */ - do { - MUTEX_TRYLOCKID(MTX_THREADCONTROL, i); - if (i==EBUSY) { - /* - * Check to see if another thread has already requested a GC. - * OR: another thread is in a critical region and locked - * MTX_THREADCONTROL. - */ - if (thread_call) { - /* I'm part of the GC party now! Sleeping!!*/ - thread_control(TC_ANSWERCALL); - } - else - idelay(1); - } - } while (i); - - if (cp->alive == 0) { - /* - * Activate thread x for the first time. - */ - CREATE_CE_THREAD(cp, _stks_, "spawn()"); - } - - /* - * Turn on Thread, Async... flags - */ + _bs_ = rootblock.size/10 ; + else if (_bs_ < MinAbrSize) + _bs_ = MinAbrSize; + + if (!_ss_) + _ss_ = rootstring.size/10; + else if (_ss_ < MinStrSpace) + _ss_ = MinStrSpace; + + cp->ini_blksize = _bs_; + cp->ini_ssize = _ss_; + + /* + * Loop until I aquire the mutex. + */ + do { + MUTEX_TRYLOCKID(MTX_THREADCONTROL, i); + if (i==EBUSY) { + /* + * Check to see if another thread has already requested a GC. + * OR: another thread is in a critical region and locked + * MTX_THREADCONTROL. + */ + if (thread_call) { + /* I'm part of the GC party now! Sleeping!!*/ + thread_control(TC_ANSWERCALL); + } + else + idelay(1); + } + } while (i); + + if (cp->alive == 0) { + /* + * Activate thread x for the first time. + */ + CREATE_CE_THREAD(cp, _stks_, "spawn()"); + } + + /* + * Turn on Thread, Async... flags + */ SET_FLAG(cp->status, Ts_Thread); SET_FLAG(cp->status, Ts_Async); - /* - * assign the correct "call" level to the new thread. - */ - /* cp->tstate->K_level = k_level+1;*/ + /* + * assign the correct "call" level to the new thread. + */ + /* cp->tstate->K_level = k_level+1;*/ - /* - * Activate co-expression x, having changed it to Asynchronous. - * but firt Set the activator/parent of the new thread. - */ - if (cp->es_actstk == NULL) - Protect(cp->es_actstk = alcactiv(),runerr(0,x)); + /* + * Activate co-expression x, having changed it to Asynchronous. + * but firt Set the activator/parent of the new thread. + */ + if (cp->es_actstk == NULL) + Protect(cp->es_actstk = alcactiv(),runerr(0,x)); - if (pushact(cp, (struct b_coexpr *)BlkLoc(k_current)) == RunError) - runerr(0,x); + if (pushact(cp, (struct b_coexpr *)BlkLoc(k_current)) == RunError) + runerr(0,x); - /* - * wake the new thread up. - */ - sem_post(cp->semp); + /* + * wake the new thread up. + */ + sem_post(cp->semp); - /* - * Increment the counter of the Async running threads. - */ - INC_LOCKID(NARthreads, MTX_NARTHREADS); - MUTEX_UNLOCKID(MTX_THREADCONTROL); + /* + * Increment the counter of the Async running threads. + */ + INC_LOCKID(NARthreads, MTX_NARTHREADS); + MUTEX_UNLOCKID(MTX_THREADCONTROL); #if ConcurrentCOMPILER - if (improbable) fail; + if (improbable) fail; #endif /* ConcurrentCOMPILER*/ - return x; - } + return x; + } } else if is:proc(x) then { abstract { return coexpr } body { - tended struct descrip d; - d = nulldesc; - TURN_ON_CONCURRENT(); - /* - * Create a thread, similar to creating a (pthreads-based) - * co-expression, except with the Cs_Concurrent flag on. - * Build the icode to call Invoke on procedure x. - */ - return d; - } + tended struct descrip d; + d = nulldesc; + TURN_ON_CONCURRENT(); + /* + * Create a thread, similar to creating a (pthreads-based) + * co-expression, except with the Cs_Concurrent flag on. + * Build the icode to call Invoke on procedure x. + */ + return d; + } } else { runerr(106,x) } @@ -3060,7 +3060,7 @@ function{1} Attrib(argv[argc]) * TODO: Generalize Attrib() to accept data of other types * such as arrays, and query/change their attributes. */ - + struct b_coexpr *ccp; struct b_list *hp; word base=0, q, n; @@ -3068,94 +3068,94 @@ function{1} Attrib(argv[argc]) if (argc == 0) runerr(130, nulldesc); if (is:coexpr(argv[0])) { - if (argc == 1) runerr(130, nulldesc); + if (argc == 1) runerr(130, nulldesc); ccp = BlkD(argv[0], Coexpr); - base = 1; - } + base = 1; + } else if (is:list(argv[0])) { - if (argc == 1) runerr(130, nulldesc); - base = 1; - hp = BlkD(argv[0], List); - if (!cnv:C_integer(argv[base], q)) runerr(101, argv[base]); - if (argc-base==1){ - switch (q) { - case CHANNEL_SIZE: - return C_integer hp->size; - break; - case CHANNEL_LIMIT: - return C_integer hp->max; - break; - default: runerr(101, argv[base]); - } - } + if (argc == 1) runerr(130, nulldesc); + base = 1; + hp = BlkD(argv[0], List); + if (!cnv:C_integer(argv[base], q)) runerr(101, argv[base]); + if (argc-base==1){ + switch (q) { + case CHANNEL_SIZE: + return C_integer hp->size; + break; + case CHANNEL_LIMIT: + return C_integer hp->max; + break; + default: runerr(101, argv[base]); + } + } if ((argc-base) != 2) runerr(130, nulldesc); - if (!cnv:C_integer(argv[base+1], n)) runerr(101, argv[base+1]); + if (!cnv:C_integer(argv[base+1], n)) runerr(101, argv[base+1]); - switch (q) { - case CHANNEL_LIMIT: - return C_integer (hp->max = n); - break; - default: runerr(101, argv[base]); - } + switch (q) { + case CHANNEL_LIMIT: + return C_integer (hp->max = n); + break; + default: runerr(101, argv[base]); + } fail; - - } /* if is list*/ + + } /* if is list*/ else { - CURTSTATE(); + CURTSTATE(); ccp = BlkD(k_current, Coexpr); - base = 0; - } + base = 0; + } if (argc-base==1){ /* for now, it is a query, and the only form suported */ if (!cnv:C_integer(argv[base], q)) runerr(101, argv[base]); - switch (q) { - case INBOX_SIZE: - return C_integer BlkD(ccp->inbox, List)->size; - break; - case OUTBOX_SIZE: - return C_integer BlkD(ccp->outbox, List)->size; - break; - case INBOX_LIMIT: - return C_integer BlkD(ccp->inbox, List)->max; - break; - case OUTBOX_LIMIT: - return C_integer BlkD(ccp->outbox, List)->max; - break; - default: runerr(101, argv[base]); - } + switch (q) { + case INBOX_SIZE: + return C_integer BlkD(ccp->inbox, List)->size; + break; + case OUTBOX_SIZE: + return C_integer BlkD(ccp->outbox, List)->size; + break; + case INBOX_LIMIT: + return C_integer BlkD(ccp->inbox, List)->max; + break; + case OUTBOX_LIMIT: + return C_integer BlkD(ccp->outbox, List)->max; + break; + default: runerr(101, argv[base]); + } } /* must have pairs of attribute and their values to continue */ if ((argc-base)%2 != 0) runerr(130, nulldesc); for (; base < argc; base+=2){ - if (!cnv:C_integer(argv[base], q)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], n)) runerr(101, argv[base+1]); - switch (q) { - case INBOX_SIZE: - return C_integer (BlkD(ccp->inbox, List)->size = n); - break; - case OUTBOX_SIZE: - return C_integer (BlkD(ccp->outbox, List)->size = n); - break; - case INBOX_LIMIT: - return C_integer (BlkD(ccp->inbox, List)->max = n); - break; - case OUTBOX_LIMIT: - return C_integer (BlkD(ccp->outbox, List)->max = n); - break; - default: runerr(101, argv[base]); - } - } + if (!cnv:C_integer(argv[base], q)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], n)) runerr(101, argv[base+1]); + switch (q) { + case INBOX_SIZE: + return C_integer (BlkD(ccp->inbox, List)->size = n); + break; + case OUTBOX_SIZE: + return C_integer (BlkD(ccp->outbox, List)->size = n); + break; + case INBOX_LIMIT: + return C_integer (BlkD(ccp->inbox, List)->max = n); + break; + case OUTBOX_LIMIT: + return C_integer (BlkD(ccp->outbox, List)->max = n); + break; + default: runerr(101, argv[base]); + } + } fail; } /* body*/ end -#else /* Concurrent */ +#else /* Concurrent */ MissingFuncV(mutex) MissingFuncV(lock) @@ -3165,7 +3165,7 @@ MissingFuncV(condvar) MissingFuncV(spawn) MissingFuncV(signal) MissingFuncV(Attrib) -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef HAVE_LIBCL @@ -3177,7 +3177,7 @@ MissingFuncV(Attrib) #define CL_DEVICE_VERSION 0x102F #define CL_DEVICE_VENDOR 0x102C #define CL_DRIVER_VERSION 0x102D - + "opencl(argv[]) - get devices info and their attributes" @@ -3187,7 +3187,7 @@ function{1} opencl(argv[argc]) } body { /* - * Code borrowed from: + * Code borrowed from: * http://dhruba.name/2012/08/14/opencl-cookbook-listing-all-devices-and-their-critical-attributes */ int i, j; @@ -3205,7 +3205,7 @@ function{1} opencl(argv[argc]) clGetPlatformIDs(0, NULL, &platformCount); platforms = (cl_platform_id*) malloc(sizeof(cl_platform_id) * platformCount); clGetPlatformIDs(platformCount, platforms, NULL); - + printf("platfom count=%d\n", platformCount); for (i = 0; i < platformCount; i++) { @@ -3217,7 +3217,7 @@ function{1} opencl(argv[argc]) /* for each device print critical attributes */ for (j = 0; j < deviceCount; j++) { - /* print device name */ + /* print device name */ clGetDeviceInfo(devices[j], CL_DEVICE_NAME, 0, NULL, &valueSize); value = (char*) malloc(valueSize); clGetDeviceInfo(devices[j], CL_DEVICE_NAME, valueSize, value, NULL); @@ -3261,4 +3261,4 @@ function{1} opencl(argv[argc]) } /* body*/ end -#endif /* HAVE_LIBCL */ +#endif /* HAVE_LIBCL */ diff --git a/src/runtime/fmonitr.r b/src/runtime/fmonitr.r index 49403da3c..ad10db372 100644 --- a/src/runtime/fmonitr.r +++ b/src/runtime/fmonitr.r @@ -25,11 +25,11 @@ function{0,1} EvSend(x,y,ce) struct progstate *dest = NULL; if (is:null(x)) { - x = curpstate->eventcode; - if (is:null(y)) y = curpstate->eventval; - } + x = curpstate->eventcode; + if (is:null(y)) y = curpstate->eventval; + } if (is:null(ce) && is:coexpr(curpstate->parentdesc)) - ce = curpstate->parentdesc; + ce = curpstate->parentdesc; else if (!is:coexpr(ce)) runerr(118,ce); dest = BlkD(ce,Coexpr)->program; dest->eventcode = x; @@ -39,7 +39,7 @@ function{0,1} EvSend(x,y,ce) return result; } end - + void assign_event_functions(struct progstate *p, struct descrip cs) { p->eventmask = cs; @@ -58,7 +58,7 @@ void assign_event_functions(struct progstate *p, struct descrip cs) #ifdef LargeInts p->Alcbignum = ((Testb((word)ToAscii(E_Lrgint),cs)) ? alcbignum_1:alcbignum_0); -#endif /* LargeInts */ +#endif /* LargeInts */ p->Alccset = ((Testb((word)ToAscii(E_Cset), cs)) ? alccset_1 : alccset_0); #undef alcfile @@ -71,12 +71,12 @@ void assign_event_functions(struct progstate *p, struct descrip cs) ((Testb((word)ToAscii(E_Pattern), cs)) ? alcpattern_1 : alcpattern_0); p->Alcpelem = ((Testb((word)ToAscii(E_Pelem), cs)) ? alcpelem_1 : alcpelem_0); -#endif /* PatternType */ +#endif /* PatternType */ #undef alcreal #ifndef DescriptorDouble p->Alcreal = ((Testb((word)ToAscii(E_Real), cs)) ? alcreal_1 : alcreal); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ p->Alcrecd = ((Testb((word)ToAscii(E_Record), cs)) ? alcrecd_1 : alcrecd_0); p->Alcrefresh = @@ -100,15 +100,15 @@ void assign_event_functions(struct progstate *p, struct descrip cs) */ p->EVstralc = (((Testb((word)ToAscii(E_String), cs)) || - (Testb((word)ToAscii(E_StrDeAlc), cs))) + (Testb((word)ToAscii(E_StrDeAlc), cs))) ? EVStrAlc_1 : EVStrAlc_0); p->Alchash = (((Testb((word)ToAscii(E_Table), cs)) || - (Testb((word)ToAscii(E_Set), cs))) + (Testb((word)ToAscii(E_Set), cs))) ? alchash_1 : alchash_0); p->Reserve = (((Testb((word)ToAscii(E_TenureString), cs)) || - (Testb((word)ToAscii(E_TenureBlock), cs))) + (Testb((word)ToAscii(E_TenureBlock), cs))) ? reserve_1 : reserve_0); /* @@ -141,7 +141,7 @@ void assign_event_functions(struct progstate *p, struct descrip cs) p->Cnvtstr = cnv_tstr_1; #ifdef PatternTypexb p->Cnvpattern = cnv_pattern_1; -#endif /* PatternType */ +#endif /* PatternType */ } else { p->Cnvcset = cnv_cset_0; @@ -155,10 +155,10 @@ void assign_event_functions(struct progstate *p, struct descrip cs) p->Cnvtstr = cnv_tstr_0; #ifdef PatternType if (Testb((word)ToAscii(E_PatCode), cs)) - p->Cnvpattern = cnv_pattern_1; + p->Cnvpattern = cnv_pattern_1; else - p->Cnvpattern = cnv_pattern_0; -#endif /* PatternType */ + p->Cnvpattern = cnv_pattern_0; +#endif /* PatternType */ } #ifdef PatternType @@ -178,8 +178,8 @@ void assign_event_functions(struct progstate *p, struct descrip cs) p->Internalmatch = internal_match_1; } else p->Internalmatch = internal_match_0; -#endif /* PatternType */ - +#endif /* PatternType */ + /* * interp() is the monster case: @@ -190,7 +190,7 @@ void assign_event_functions(struct progstate *p, struct descrip cs) if ( #if WordBits == 64 *(((uword *)cs.vword.bptr->Cset.bits)+2) -#else /* WordBits == 64 */ +#else /* WordBits == 64 */ Testb((word)ToAscii(E_Intcall), cs) || Testb((word)ToAscii(E_Stack), cs) || Testb((word)ToAscii(E_Fsusp), cs) || @@ -225,7 +225,7 @@ void assign_event_functions(struct progstate *p, struct descrip cs) Testb((word)ToAscii(E_Operand), cs) || Testb((word)ToAscii(E_Syntax), cs) || Testb((word)ToAscii(E_Cstack), cs) -#endif /* WordBits == 64 */ +#endif /* WordBits == 64 */ ) { p->Interp = interp_1; } @@ -258,9 +258,9 @@ function{0,1} EvGet(cs,vmask,flag) struct progstate *p = NULL; #ifdef Concurrent - if (is_concurrent) - is_concurrent = 0; -#endif Concurrent /* Concurrent */ + if (is_concurrent) + is_concurrent = 0; +#endif Concurrent /* Concurrent */ /* * Be sure an eventsource is available @@ -275,80 +275,80 @@ function{0,1} EvGet(cs,vmask,flag) */ p = BlkD(curpstate->eventsource,Coexpr)->program; if (p->parent == curpstate) { - if (BlkLoc(p->eventmask) != BlkLoc(cs)) { - assign_event_functions(p, cs); - } - } + if (BlkLoc(p->eventmask) != BlkLoc(cs)) { + assign_event_functions(p, cs); + } + } #ifdef Graphics if (Testb((word)ToAscii(E_MXevent), cs) && - is:file(kywd_xwin[XKey_Window])) { - wbp _w_ = BlkD(kywd_xwin[XKey_Window],File)->fd.wb; + is:file(kywd_xwin[XKey_Window])) { + wbp _w_ = BlkD(kywd_xwin[XKey_Window],File)->fd.wb; #ifdef GraphicsGL - if (_w_->window->is_gl) - gl_wsync(_w_); - else -#endif /* GraphicsGL */ - wsync(_w_); - pollctr = pollevent(); - if (pollctr == -1) - fatalerr(141, NULL); - if (BlkD(_w_->window->listp,List)->size > 0) { - register int c; - c = wgetevent(_w_, &curpstate->eventval, -1); - if (c == 0) { - StrLen(curpstate->eventcode) = 1; - StrLoc(curpstate->eventcode) = - (char *)&allchars[FromAscii(E_MXevent) & 0xFF]; - return curpstate->eventcode; - } - else if (c == -1) - runerr(141); - else - runerr(143); - } - } -#endif /* Graphics */ + if (_w_->window->is_gl) + gl_wsync(_w_); + else +#endif /* GraphicsGL */ + wsync(_w_); + pollctr = pollevent(); + if (pollctr == -1) + fatalerr(141, NULL); + if (BlkD(_w_->window->listp,List)->size > 0) { + register int c; + c = wgetevent(_w_, &curpstate->eventval, -1); + if (c == 0) { + StrLen(curpstate->eventcode) = 1; + StrLoc(curpstate->eventcode) = + (char *)&allchars[FromAscii(E_MXevent) & 0xFF]; + return curpstate->eventcode; + } + else if (c == -1) + runerr(141); + else + runerr(143); + } + } +#endif /* Graphics */ /* * Loop until we read an event allowed. */ while (1) { - int rv; + int rv; /* * Activate the event source to produce the next event. */ - dummy = cs; - if ((rv=mt_activate(&dummy, &curpstate->eventcode, - BlkD(curpstate->eventsource, Coexpr))) == A_Cofail) - fail; - /* - * why would we ever need to dereference &eventcode? - */ - /* deref(&curpstate->eventcode, &curpstate->eventcode); */ - if (!is:string(curpstate->eventcode) || - StrLen(curpstate->eventcode) != 1) { - /* - * this event is out-of-band data; return or reject it - * depending on whether flag is null. - */ - if (!is:null(flag)) - return curpstate->eventcode; - else continue; - } + dummy = cs; + if ((rv=mt_activate(&dummy, &curpstate->eventcode, + BlkD(curpstate->eventsource, Coexpr))) == A_Cofail) + fail; + /* + * why would we ever need to dereference &eventcode? + */ + /* deref(&curpstate->eventcode, &curpstate->eventcode); */ + if (!is:string(curpstate->eventcode) || + StrLen(curpstate->eventcode) != 1) { + /* + * this event is out-of-band data; return or reject it + * depending on whether flag is null. + */ + if (!is:null(flag)) + return curpstate->eventcode; + else continue; + } #if E_Cofail || E_Coret - switch(*StrLoc(curpstate->eventcode)) { - case E_Cofail: case E_Coret: { - if (BlkD(curpstate->eventsource,Coexpr)->id == 1) { - fail; - } - } - } -#endif /* E_Cofail || E_Coret */ - - return curpstate->eventcode; - } + switch(*StrLoc(curpstate->eventcode)) { + case E_Cofail: case E_Coret: { + if (BlkD(curpstate->eventsource,Coexpr)->id == 1) { + fail; + } + } + } +#endif /* E_Cofail || E_Coret */ + + return curpstate->eventcode; + } } end @@ -364,10 +364,10 @@ function{*} istate(ce,attrib) word *ipc_opnd; if (!cnv:C_string(attrib, field)) - runerr(103,attrib); - + runerr(103,attrib); + if (!is:null(ce)){ - if (is:coexpr(ce)){ + if (is:coexpr(ce)){ if (!strcmp(field, "count")) return C_integer (word) BlkD(ce,Coexpr)->actv_count; if (!strcmp(field, "ilevel")) @@ -386,36 +386,36 @@ function{*} istate(ce,attrib) return C_integer (word) BlkD(ce,Coexpr)->es_efp; else if (!strcmp(field, "gfp")) return C_integer (word) BlkD(ce,Coexpr)->es_gfp; - else fail; - } - else - runerr(118, ce); - } + else fail; + } + else + runerr(118, ce); + } fail; } end - -char typech[MaxType+1]; /* output character for each type */ -int noMTevents; /* don't produce events in EVAsgn */ +char typech[MaxType+1]; /* output character for each type */ + +int noMTevents; /* don't produce events in EVAsgn */ #if HAVE_PROFIL -union { /* clock ticker -- keep in sync w/ interp.r */ - unsigned short s[16]; /* four counters */ - unsigned long l[8]; /* two longs are easier to check */ +union { /* clock ticker -- keep in sync w/ interp.r */ + unsigned short s[16]; /* four counters */ + unsigned long l[8]; /* two longs are easier to check */ } ticker; -unsigned long oldtick; /* previous sum of the two longs */ -#endif /* HAVE_PROFIL */ +unsigned long oldtick; /* previous sum of the two longs */ +#endif /* HAVE_PROFIL */ #if UNIX /* * Global state used by EVTick() */ word oldsum = 0; -#endif /* UNIX */ - +#endif /* UNIX */ + static char scopechars[] = "+:^-"; @@ -442,9 +442,9 @@ void EVVariable(dptr dx, int eventcode) #if COMPILER procname = &(PFDebug(*pfp)->proc->pname); -#else /* COMPILER */ +#else /* COMPILER */ procname = &(BlkD(*glbl_argp,Proc)->pname); -#endif /* COMPILER */ +#endif /* COMPILER */ /* * call get_name, allocating out of the monitor if necessary. */ @@ -457,24 +457,24 @@ void EVVariable(dptr dx, int eventcode) if (i == GlobalName) { if (reserve(Strings, StrLen(parent->eventval) + 1) == NULL) { - fprintf(stderr, "failed to reserve %ld bytes for global\n", - (long)(StrLen(parent->eventval)+1)); - syserr("monitoring out-of-memory error"); - } + fprintf(stderr, "failed to reserve %ld bytes for global\n", + (long)(StrLen(parent->eventval)+1)); + syserr("monitoring out-of-memory error"); + } StrLoc(parent->eventval) = - alcstr(StrLoc(parent->eventval), StrLen(parent->eventval)); + alcstr(StrLoc(parent->eventval), StrLen(parent->eventval)); alcstr("+",1); StrLen(parent->eventval)++; } else if ((i == StaticName) || (i == LocalName) || (i == ParamName)) { if (!reserve(Strings, StrLen(parent->eventval) + StrLen(*procname) + 1)) { - fprintf(stderr,"failed to reserve %ld bytes for %d, %ld+%ld\n", - (long)(StrLen(parent->eventval)+StrLen(*procname)+1), i, - (long)StrLen(parent->eventval), (long)StrLen(*procname)); - syserr("monitoring out-of-memory error"); - } + fprintf(stderr,"failed to reserve %ld bytes for %d, %ld+%ld\n", + (long)(StrLen(parent->eventval)+StrLen(*procname)+1), i, + (long)StrLen(parent->eventval), (long)StrLen(*procname)); + syserr("monitoring out-of-memory error"); + } StrLoc(parent->eventval) = - alcstr(StrLoc(parent->eventval), StrLen(parent->eventval)); + alcstr(StrLoc(parent->eventval), StrLen(parent->eventval)); alcstr(scopechars+i,1); alcstr(StrLoc(*procname), StrLen(*procname)); StrLen(parent->eventval) += StrLen(*procname) + 1; @@ -501,11 +501,11 @@ void EVVariable(dptr dx, int eventcode) MUTEX_UNLOCKID(MTX_NOMTEVENTS); if (!is:null(curpstate->valuemask) && (invaluemask(curpstate, eventcode, &(parent->eventval)) != Succeeded)) - return; + return; actparent(eventcode); } - + /* * EVInit() - initialization. */ @@ -520,28 +520,28 @@ void EVInit() */ for (i = 0; i <= MaxType; i++) - typech[i] = '?'; /* initialize with error character */ + typech[i] = '?'; /* initialize with error character */ #ifdef LargeInts - typech[T_Lrgint] = E_Lrgint; /* long integer */ -#endif /* LargeInts */ - - typech[T_Real] = E_Real; /* real number */ - typech[T_Cset] = E_Cset; /* cset */ - typech[T_File] = E_File; /* file block */ - typech[T_Record] = E_Record; /* record block */ - typech[T_Tvsubs] = E_Tvsubs; /* substring trapped variable */ - typech[T_External]= E_External; /* external block */ - typech[T_List] = E_List; /* list header block */ - typech[T_Lelem] = E_Lelem; /* list element block */ - typech[T_Table] = E_Table; /* table header block */ - typech[T_Telem] = E_Telem; /* table element block */ - typech[T_Tvtbl] = E_Tvtbl; /* table elem trapped variable*/ - typech[T_Set] = E_Set; /* set header block */ - typech[T_Selem] = E_Selem; /* set element block */ - typech[T_Slots] = E_Slots; /* set/table hash slots */ - typech[T_Coexpr] = E_Coexpr; /* co-expression block (static) */ - typech[T_Refresh] = E_Refresh; /* co-expression refresh block */ + typech[T_Lrgint] = E_Lrgint; /* long integer */ +#endif /* LargeInts */ + + typech[T_Real] = E_Real; /* real number */ + typech[T_Cset] = E_Cset; /* cset */ + typech[T_File] = E_File; /* file block */ + typech[T_Record] = E_Record; /* record block */ + typech[T_Tvsubs] = E_Tvsubs; /* substring trapped variable */ + typech[T_External]= E_External; /* external block */ + typech[T_List] = E_List; /* list header block */ + typech[T_Lelem] = E_Lelem; /* list element block */ + typech[T_Table] = E_Table; /* table header block */ + typech[T_Telem] = E_Telem; /* table element block */ + typech[T_Tvtbl] = E_Tvtbl; /* table elem trapped variable*/ + typech[T_Set] = E_Set; /* set header block */ + typech[T_Selem] = E_Selem; /* set element block */ + typech[T_Slots] = E_Slots; /* set/table hash slots */ + typech[T_Coexpr] = E_Coexpr; /* co-expression block (static) */ + typech[T_Refresh] = E_Refresh; /* co-expression refresh block */ /* @@ -572,15 +572,15 @@ void EVInit() #if HAVE_PROFIL #ifdef PROFIL_CHAR_P profil((char *)(ticker.s), sizeof(ticker.s), (long) EVInit & ~0x3FFFF, 2); -#else /* PROFIL_CHAR_P */ +#else /* PROFIL_CHAR_P */ profil((unsigned short *)(ticker.s), sizeof(ticker.s), - (long) EVInit & ~0x3FFFF, 2); -#endif /* PROFIL_CHAR_P */ -#endif /* HAVE_PROFIL */ -#endif /* UNIX */ + (long) EVInit & ~0x3FFFF, 2); +#endif /* PROFIL_CHAR_P */ +#endif /* HAVE_PROFIL */ +#endif /* UNIX */ } - + /* * mmrefresh() - redraw screen, initially or after garbage collection. */ @@ -598,12 +598,12 @@ void mmrefresh() if (!is:null(curpstate->eventmask) && Testb((word)ToAscii(E_EndCollect), curpstate->eventmask)) { for (p = blkbase; p < blkfree; p += n) { - n = BlkSize(p); + n = BlkSize(p); #if E_Lrgint || E_Real || E_Cset || E_File || E_Record || E_Tvsubs || E_External || E_List || E_Lelem || E_Table || E_Telem || E_Tvtbl || E_Set || E_Selem || E_Slots || E_Coexpr || E_Refresh - RealEVVal(n, typech[(int)BlkType(p)],/*noop*/,/*noop*/);/* block reg.*/ -#endif /* instrument allocation events */ - } - EVVal(DiffPtrs(strfree, strbase), E_String); /* string region */ + RealEVVal(n, typech[(int)BlkType(p)],/*noop*/,/*noop*/);/* block reg.*/ +#endif /* instrument allocation events */ + } + EVVal(DiffPtrs(strfree, strbase), E_String); /* string region */ } } @@ -632,6 +632,6 @@ void EVStrAlc_1(word n) int t_errornumber, t_have_val; struct descrip t_errorvalue; -#else /* MultiProgram */ -/* static char xjunk; /* avoid empty module */ -#endif /* MultiProgram */ +#else /* MultiProgram */ +/* static char xjunk; /* avoid empty module */ +#endif /* MultiProgram */ diff --git a/src/runtime/fscan.r b/src/runtime/fscan.r index 2f9690b8d..5b91c0719 100644 --- a/src/runtime/fscan.r +++ b/src/runtime/fscan.r @@ -63,7 +63,7 @@ function{0,1+} move(i) fail; } end - + "pos(i) - test if &pos is at position i in &subject." @@ -86,7 +86,7 @@ function{0,1} pos(i) return C_integer i; } end - + "tab(i) - set &pos to i, return substring of &subject spanned." "Reverses effects if resumed." diff --git a/src/runtime/fstr.r b/src/runtime/fstr.r index bb4b3f86e..2069ffa8a 100644 --- a/src/runtime/fstr.r +++ b/src/runtime/fstr.r @@ -38,7 +38,7 @@ s2 = blank; /* } must be supplied */ #enddef - + "center(s1,i,s2) - pad s1 on left and right with s2 to length i." @@ -117,7 +117,7 @@ function{1} center(s1,n,s2) return string(n, sbuf); } } end - + "detab(s,i,...) - replace tabs with spaces, with stops at columns indicated." @@ -144,9 +144,9 @@ function{1} detab(s,i[n]) reserve(Strings, StrLen(s) * 8); for (j=0; j0) && IntVal(i[j])<=IntVal(i[j-1])) + if ((j>0) && IntVal(i[j])<=IntVal(i[j-1])) runerr(210, i[j]); } @@ -213,15 +213,15 @@ function{1} detab(s,i[n]) if (is_expanded) return result; else { - long n = DiffPtrs(StrLoc(result),strfree); /* note deallocation */ - EVStrAlc(n); - strtotal += n; - strfree = StrLoc(result); /* reset the free pointer */ - return s; /* return original string */ + long n = DiffPtrs(StrLoc(result),strfree); /* note deallocation */ + EVStrAlc(n); + strtotal += n; + strfree = StrLoc(result); /* reset the free pointer */ + return s; /* return original string */ } } end - + "entab(s,i,...) - replace spaces with tabs, with stops at columns indicated." @@ -244,10 +244,10 @@ function{1} entab(s,i[n]) CURTSTATE(); for (j=0; j0) && IntVal(i[j])<=IntVal(i[j-1])) + if ((j>0) && IntVal(i[j])<=IntVal(i[j-1])) runerr(210, i[j]); } @@ -303,22 +303,22 @@ function{1} entab(s,i[n]) nt1 = nt; nxttab(&nt1, &tablst, endlst, &last, &interval); if (nt1 > target) { - col++; /* keep space to avoid 1-col tab then spaces */ + col++; /* keep space to avoid 1-col tab then spaces */ nt = nt1; } else - out--; /* back up to begin tabbing */ + out--; /* back up to begin tabbing */ } else - out--; /* back up to begin tabbing */ + out--; /* back up to begin tabbing */ while (nt <= target) { inserted = 1; - *out++ = '\t'; /* put tabs to tab positions */ + *out++ = '\t'; /* put tabs to tab positions */ col = nt; nxttab(&nt, &tablst, endlst, &last, &interval); } while (col++ < target) - *out++ = ' '; /* complete gap with spaces */ + *out++ = ' '; /* complete gap with spaces */ } col = target; break; @@ -332,24 +332,24 @@ function{1} entab(s,i[n]) * original string (and reset strfree) to conserve memory. */ if (inserted) { - long n; + long n; StrLen(result) = DiffPtrs(out,StrLoc(result)); - n = DiffPtrs(out,strfree); /* note the deallocation */ - EVStrAlc(n); - strtotal += n; - strfree = out; /* give back unused space */ - return result; /* return new string */ + n = DiffPtrs(out,strfree); /* note the deallocation */ + EVStrAlc(n); + strtotal += n; + strfree = out; /* give back unused space */ + return result; /* return new string */ } else { - long n = DiffPtrs(StrLoc(result),strfree); /* note the deallocation */ - EVStrAlc(n); - strtotal += n; - strfree = StrLoc(result); /* reset free pointer */ - return s; /* return original string */ - } + long n = DiffPtrs(StrLoc(result),strfree); /* note the deallocation */ + EVStrAlc(n); + strtotal += n; + strfree = StrLoc(result); /* reset free pointer */ + return s; /* return original string */ + } } end - + /* * nxttab -- helper routine for entab and detab, returns next tab * beyond col @@ -378,7 +378,7 @@ C_integer *interval; else *col = IntVal((*tablst)[0]); } - + "left(s1,i,s2) - pad s1 on right with s2 to length i." @@ -390,7 +390,7 @@ function{1} left(s1,n,s2) * just construct a descriptor. */ if (n <= StrLen(s1)) { - return string(n, StrLoc(s1)); + return string(n, StrLoc(s1)); } /* @@ -426,7 +426,7 @@ function{1} left(s1,n,s2) return string(n, sbuf); } end - + /* * What we know about map: @@ -450,7 +450,7 @@ function{1} map(s1,s2,s3) runerr(103,s2) if !def:string(s3, lcase) then runerr(103,s3) -#endif /* COMPILER */ +#endif /* COMPILER */ abstract { return string @@ -461,7 +461,7 @@ function{1} map(s1,s2,s3) register char *str1, *str2, *str3; #ifndef Concurrent static char maptab[256]; -#endif /* Concurrent */ +#endif /* Concurrent */ CURTSTATE(); #if !COMPILER @@ -474,18 +474,18 @@ function{1} map(s1,s2,s3) * Short-cut conversions of &lcase and &ucase. */ else { - struct descrip _k_lcase_, _k_ucase_; - Klcase(&_k_lcase_); - Kucase(&_k_ucase_); - if (s2.dword == D_Cset) { - if (BlkLoc(s2) == BlkLoc(_k_lcase_)) { - s2 = lcase; - } - else if (BlkLoc(s2) == BlkLoc(_k_ucase_)) { - s2 = ucase; - } - } - } + struct descrip _k_lcase_, _k_ucase_; + Klcase(&_k_lcase_); + Kucase(&_k_ucase_); + if (s2.dword == D_Cset) { + if (BlkLoc(s2) == BlkLoc(_k_lcase_)) { + s2 = lcase; + } + else if (BlkLoc(s2) == BlkLoc(_k_ucase_)) { + s2 = ucase; + } + } + } if (is:null(s3)) s3 = lcase; @@ -493,19 +493,19 @@ function{1} map(s1,s2,s3) * Short-cut conversions of &lcase and &ucase. */ else { - struct descrip _k_lcase_, _k_ucase_; - Klcase(&_k_lcase_); - Kucase(&_k_ucase_); - if (s3.dword == D_Cset) { - if (BlkLoc(s3) == BlkLoc(_k_lcase_)) { - s3 = lcase; - } - else if (BlkLoc(s3) == BlkLoc(_k_ucase_)) { - s3 = ucase; - } - } - } -#endif /* !COMPILER */ + struct descrip _k_lcase_, _k_ucase_; + Klcase(&_k_lcase_); + Kucase(&_k_ucase_); + if (s3.dword == D_Cset) { + if (BlkLoc(s3) == BlkLoc(_k_lcase_)) { + s3 = lcase; + } + else if (BlkLoc(s3) == BlkLoc(_k_ucase_)) { + s3 = ucase; + } + } + } +#endif /* !COMPILER */ /* * If s2 and s3 are the same as for the last call of map, @@ -521,7 +521,7 @@ function{1} map(s1,s2,s3) runerr(103,s2); if (!cnv:string(s3,s3)) runerr(103,s3); -#endif /* !COMPILER */ +#endif /* !COMPILER */ /* * s2 and s3 must be of the same length */ @@ -547,12 +547,12 @@ function{1} map(s1,s2,s3) slen = StrLen(s1); if (slen == 0) { - return emptystr; - } + return emptystr; + } else if (slen == 1) { - char c = maptab[*(StrLoc(s1)) & 0xFF]; - return string(1, (char *)&allchars[FromAscii(c) & 0xFF]); - } + char c = maptab[*(StrLoc(s1)) & 0xFF]; + return string(1, (char *)&allchars[FromAscii(c) & 0xFF]); + } /* * The result is a string the size of s1; create the result @@ -573,7 +573,7 @@ function{1} map(s1,s2,s3) return result; } end - + "repl(s,i) - concatenate i copies of string s." @@ -588,20 +588,20 @@ function{1} repl(s,n) if is:list(s) then { abstract { return type(s) } body { - register struct b_list *bp1; - register struct b_lelem *lp1; - word i, size1, size2; - size1 = BlkD(s,List)->size; - size2 = size1 * n; - Protect(bp1 = (struct b_list *)alclist_raw(size2, size2), runerr(0)); - lp1 = (struct b_lelem *) (bp1->listhead); - - for(i=0; ilslots + i*size1, (word)1, size1+1); - } - BlkLoc(s) = (union block *)bp1; - return s; - } + register struct b_list *bp1; + register struct b_lelem *lp1; + word i, size1, size2; + size1 = BlkD(s,List)->size; + size2 = size1 * n; + Protect(bp1 = (struct b_list *)alclist_raw(size2, size2), runerr(0)); + lp1 = (struct b_lelem *) (bp1->listhead); + + for(i=0; ilslots + i*size1, (word)1, size1+1); + } + BlkLoc(s) = (union block *)bp1; + return s; + } } else if cnv:string(s) then { @@ -660,7 +660,7 @@ function{1} repl(s,n) } else runerr(103,s) end - + "reverse(s) - reverse string s." @@ -671,17 +671,17 @@ function{1} reverse(x) return type(x) } body { - int i=0, size = BlkD(x,List)->size; - struct descrip temp; - dptr dp; - cplist(&x, &result, 1, size+1); - dp = Blk(BlkD(result,List)->listhead,Lelem)->lslots; - while (isize; + struct descrip temp; + dptr dp; + cplist(&x, &result, 1, size+1); + dp = Blk(BlkD(result,List)->listhead,Lelem)->lslots; + while (iclink; - BlkD(s, Set)->size--; - } - EVValD(&s, E_Sdelete); - EVValD(x+argc, E_Sval); - } - MUTEX_UNLOCKBLK(BlkD(s, Set), "delete(): unlock set"); + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Set), "delete(): lock set"); + for (argc = 0; argc < n; argc++) { + hn = hash(x+argc); + pd = memb(BlkLoc(s), x + argc, hn, &res); + if (res == 1) { + /* + * The element is there so delete it. + */ + *pd = Blk(*pd, Selem)->clink; + BlkD(s, Set)->size--; + } + EVValD(&s, E_Sdelete); + EVValD(x+argc, E_Sval); + } + MUTEX_UNLOCKBLK(BlkD(s, Set), "delete(): unlock set"); return s; - } + } table: body { register union block **pd; register uword hn; int res, argc; - MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Table), "delete(): lock table"); - for (argc = 0; argc < n; argc++) { - hn = hash(x+argc); - pd = memb(BlkLoc(s), x+argc, hn, &res); - if (res == 1) { - /* - * The element is there so delete it. - */ - *pd = Blk(*pd,Telem)->clink; - BlkD(s,Table)->size--; - } - EVValD(&s, E_Tdelete); - EVValD(x+argc, E_Tsub); - } - MUTEX_UNLOCKBLK(BlkD(s, Table), "delete(): unlock table"); + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Table), "delete(): lock table"); + for (argc = 0; argc < n; argc++) { + hn = hash(x+argc); + pd = memb(BlkLoc(s), x+argc, hn, &res); + if (res == 1) { + /* + * The element is there so delete it. + */ + *pd = Blk(*pd,Telem)->clink; + BlkD(s,Table)->size--; + } + EVValD(&s, E_Tdelete); + EVValD(x+argc, E_Tsub); + } + MUTEX_UNLOCKBLK(BlkD(s, Table), "delete(): unlock table"); return s; } list: body { - tended struct b_list *hp; /* work in progress */ - tended struct descrip d; + tended struct b_list *hp; /* work in progress */ + tended struct descrip d; C_integer cnv_x; - int i, size, argc; + int i, size, argc; #ifdef Arrays - if (BlkD(s,List)->listtail==NULL) - if (arraytolist(&s)!=Succeeded) fail; -#endif /* Arrays*/ - - MUTEX_LOCKBLK_CONTROLLED(BlkD(s, List), "delete(): lock list"); - - for (argc = 0; argc < n; argc++) { - if (!cnv:C_integer(x[argc], cnv_x)) runerr(101, x[argc]); - hp = BlkD(s, List); - size = hp->size; - if (cnv_x < 0 ) - cnv_x = size + cnv_x + 1; - for (i = 1; i <= size; i++) { - c_get(hp, &d); - if (i != cnv_x) - c_put(&s, &d); - } - EVValD(&s, E_Ldelete); - EVVal(cnv_x, E_Lsub); - } - MUTEX_UNLOCKBLK(BlkD(s, List), "delete(): unlock list"); - return s; - } + if (BlkD(s,List)->listtail==NULL) + if (arraytolist(&s)!=Succeeded) fail; +#endif /* Arrays*/ + + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, List), "delete(): lock list"); + + for (argc = 0; argc < n; argc++) { + if (!cnv:C_integer(x[argc], cnv_x)) runerr(101, x[argc]); + hp = BlkD(s, List); + size = hp->size; + if (cnv_x < 0 ) + cnv_x = size + cnv_x + 1; + for (i = 1; i <= size; i++) { + c_get(hp, &d); + if (i != cnv_x) + c_put(&s, &d); + } + EVValD(&s, E_Ldelete); + EVVal(cnv_x, E_Lsub); + } + MUTEX_UNLOCKBLK(BlkD(s, List), "delete(): unlock list"); + return s; + } #if defined(Dbm) || defined(Messaging) file: - body { - C_integer cnv_x; - int argc; + body { + C_integer cnv_x; + int argc; #ifdef Dbm - if (BlkD(s,File)->status & Fs_Dbm) { - DBM *db; - datum key; - db = BlkD(s,File)->fd.dbm; - for (argc = 0; argc < n; argc++) { - key.dsize = StrLen(x[argc]); key.dptr = StrLoc(x[argc]); - dbm_delete(db, key); - } - return s; - } - else + if (BlkD(s,File)->status & Fs_Dbm) { + DBM *db; + datum key; + db = BlkD(s,File)->fd.dbm; + for (argc = 0; argc < n; argc++) { + key.dsize = StrLen(x[argc]); key.dptr = StrLoc(x[argc]); + dbm_delete(db, key); + } + return s; + } + else #endif #ifdef Messaging if ((BlkD(s,File)->status & Fs_Messaging)) { - struct MFile *mf = BlkD(s,File)->fd.mf; - if (strcmp(mf->tp->uri.scheme, "pop") != 0) { - runerr(1213, s); - } - for (argc=0; argcfd.mf; + if (strcmp(mf->tp->uri.scheme, "pop") != 0) { + runerr(1213, s); + } + for (argc=0; argclisttail==NULL) - if (arraytolist(&x)!=Succeeded) fail; -#endif /* Arrays*/ - hp = BlkD(x, List); - MUTEX_LOCKBLK_CONTROLLED(hp, "get() lock list"); - for(j=0;jlisttail==NULL) + if (arraytolist(&x)!=Succeeded) fail; +#endif /* Arrays*/ + hp = BlkD(x, List); + MUTEX_LOCKBLK_CONTROLLED(hp, "get() lock list"); + for(j=0;jstatus & Fs_Messaging)) { - runerr(1213, x); - } - mf = BlkD(x,File)->fd.mf; - if (strcmp(mf->tp->uri.scheme, "pop") != 0) { - runerr(1213, x); - } - - /* Determine the next undeleted message */ - mpl = (struct Mpoplist*)mf->data; - if (mpl == NULL || mpl->next == mpl) { - fail; - } - msgnum = mpl->next->msgnum; - - req.args = buf; - snprintf(req.args, sizeof(buf), "%d", msgnum); - if (mf->resp != NULL) { - tp_freeresp(mf->tp, mf->resp); - } - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) { - fail; - } - if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) { - runerr(1212, x); - } - tp_freeresp(mf->tp, mf->resp); - - Protect(reserve(Strings, msglen), runerr(0)); - StrLen(result) = msglen; - StrLoc(result) = alcstr(NULL, msglen); - - req.type = RETR; - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) { - runerr(1212, x); - } - tp_read(mf->tp, StrLoc(result), (size_t)msglen); - while (buf[0] != '.') { - tp_readln(mf->tp, buf, sizeof(buf)); - } - - /* Delete the message we just read */ - Mpop_delete(mf, 1); - - return result; - } - } + abstract { + return string + } + body { + char buf[100]; + struct MFile* mf; + Tprequest_t req = { LIST, NULL, 0 }; + struct Mpoplist* mpl; + unsigned int msgnum; + long int msglen; + + if (!(BlkD(x,File)->status & Fs_Messaging)) { + runerr(1213, x); + } + mf = BlkD(x,File)->fd.mf; + if (strcmp(mf->tp->uri.scheme, "pop") != 0) { + runerr(1213, x); + } + + /* Determine the next undeleted message */ + mpl = (struct Mpoplist*)mf->data; + if (mpl == NULL || mpl->next == mpl) { + fail; + } + msgnum = mpl->next->msgnum; + + req.args = buf; + snprintf(req.args, sizeof(buf), "%d", msgnum); + if (mf->resp != NULL) { + tp_freeresp(mf->tp, mf->resp); + } + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) { + fail; + } + if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) { + runerr(1212, x); + } + tp_freeresp(mf->tp, mf->resp); + + Protect(reserve(Strings, msglen), runerr(0)); + StrLen(result) = msglen; + StrLoc(result) = alcstr(NULL, msglen); + + req.type = RETR; + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) { + runerr(1212, x); + } + tp_read(mf->tp, StrLoc(result), (size_t)msglen); + while (buf[0] != '.') { + tp_readln(mf->tp, buf, sizeof(buf)); + } + + /* Delete the message we just read */ + Mpop_delete(mf, 1); + + return result; + } + } #endif /* Messaging */ default: - runerr(108, x) + runerr(108, x) } end #enddef GetOrPop(get) /* get(x) - get an element from the left end of list x. */ GetOrPop(pop) /* pop(x) - pop an element from the left end of list x. */ - + "key(T) - generate successive keys (entry values) from table T." function{*} key(t) type_case t of { table: { - abstract { - return store[type(t).tbl_key] - } - inline { - tended union block *ep; - struct hgstate state; - - EVValD(&t, E_Tkey); - for (ep = hgfirst(BlkLoc(t), &state); ep != 0; - ep = hgnext(BlkLoc(t), &state, ep)) { - EVValD(&(Blk(ep,Telem)->tref), E_Tsub); - suspend ep->Telem.tref; + abstract { + return store[type(t).tbl_key] + } + inline { + tended union block *ep; + struct hgstate state; + + EVValD(&t, E_Tkey); + for (ep = hgfirst(BlkLoc(t), &state); ep != 0; + ep = hgnext(BlkLoc(t), &state, ep)) { + EVValD(&(Blk(ep,Telem)->tref), E_Tsub); + suspend ep->Telem.tref; + } + fail; } - fail; - } } list: { - abstract { return integer } - inline { - C_integer i; - for(i=1; i<=BlkD(t, List)->size; i++) suspend C_integer i; - fail; - } - } + abstract { return integer } + inline { + C_integer i; + for(i=1; i<=BlkD(t, List)->size; i++) suspend C_integer i; + fail; + } + } record: { - abstract { return string } - inline { - C_integer i=0, sz = Blk(BlkD(t,Record)->recdesc,Proc)->nfields; - if (sz > 0) { - struct descrip d; - d = Blk(BlkD(t,Record)->recdesc,Proc)->lnames[0]; - if ((StrLen(d) != 3) || strncmp(StrLoc(d),"__s",3)) - suspend d; - if (sz > 1) { - d = Blk(BlkD(t,Record)->recdesc,Proc)->lnames[1]; - if ((StrLen(d) != 3) || strncmp(StrLoc(d),"__m",3)) - suspend Blk(BlkD(t,Record)->recdesc,Proc)->lnames[1]; - i = 2; - while(irecdesc,Proc)->lnames[i]; - i++; - } - } - } - fail; - } - } + abstract { return string } + inline { + C_integer i=0, sz = Blk(BlkD(t,Record)->recdesc,Proc)->nfields; + if (sz > 0) { + struct descrip d; + d = Blk(BlkD(t,Record)->recdesc,Proc)->lnames[0]; + if ((StrLen(d) != 3) || strncmp(StrLoc(d),"__s",3)) + suspend d; + if (sz > 1) { + d = Blk(BlkD(t,Record)->recdesc,Proc)->lnames[1]; + if ((StrLen(d) != 3) || strncmp(StrLoc(d),"__m",3)) + suspend Blk(BlkD(t,Record)->recdesc,Proc)->lnames[1]; + i = 2; + while(irecdesc,Proc)->lnames[i]; + i++; + } + } + } + fail; + } + } #if defined(Dbm) || defined(Messaging) file: { - abstract { - return string - } - inline { - word status; - status = BlkD(t,File)->status; + abstract { + return string + } + inline { + word status; + status = BlkD(t,File)->status; #ifdef Dbm - if (status & Fs_Dbm) { - DBM *db; - datum key; - db = BlkD(t,File)->fd.dbm; - for (key = dbm_firstkey(db); key.dptr != NULL; - key = dbm_nextkey(db)) { - Protect(StrLoc(result) = alcstr(key.dptr, key.dsize),runerr(0)); - StrLen(result) = key.dsize; - suspend result; - } - fail; - } + if (status & Fs_Dbm) { + DBM *db; + datum key; + db = BlkD(t,File)->fd.dbm; + for (key = dbm_firstkey(db); key.dptr != NULL; + key = dbm_nextkey(db)) { + Protect(StrLoc(result) = alcstr(key.dptr, key.dsize),runerr(0)); + StrLen(result) = key.dsize; + suspend result; + } + fail; + } #endif /* Dbm */ #ifdef Messaging - else if (status & Fs_Messaging) { - struct MFile *mf = BlkD(t,File)->fd.mf; - char *field, *end; - - if ((mf->resp == NULL) && !MFIN(mf, READING)){ - Mstartreading(mf); - } - - if (mf->resp == NULL) - fail; - - Protect(StrLoc(result) = alcstr("Status-Code", 11),runerr(0)); - StrLen(result) = 11; - suspend result; - - if (mf->resp->msg != NULL && strlen(mf->resp->msg) > 0){ - Protect(StrLoc(result) = alcstr("Reason-Phrase", 13),runerr(0)); - StrLen(result) = 13; - suspend result; - } - - if (mf->resp->header == NULL) - fail; - - for (field = mf->resp->header; - field != NULL; - field = strchr(field, '\r')) { - - /* Skip to first letter of field name */ - while (strchr(" \r\n", *field)) { - field++; - } - - end = strchr(field, ':'); - Protect(StrLoc(result) = alcstr(field, end - field),runerr(0)); - StrLen(result) = end - field; - suspend result; - } - fail; - } + else if (status & Fs_Messaging) { + struct MFile *mf = BlkD(t,File)->fd.mf; + char *field, *end; + + if ((mf->resp == NULL) && !MFIN(mf, READING)){ + Mstartreading(mf); + } + + if (mf->resp == NULL) + fail; + + Protect(StrLoc(result) = alcstr("Status-Code", 11),runerr(0)); + StrLen(result) = 11; + suspend result; + + if (mf->resp->msg != NULL && strlen(mf->resp->msg) > 0){ + Protect(StrLoc(result) = alcstr("Reason-Phrase", 13),runerr(0)); + StrLen(result) = 13; + suspend result; + } + + if (mf->resp->header == NULL) + fail; + + for (field = mf->resp->header; + field != NULL; + field = strchr(field, '\r')) { + + /* Skip to first letter of field name */ + while (strchr(" \r\n", *field)) { + field++; + } + + end = strchr(field, ':'); + Protect(StrLoc(result) = alcstr(field, end - field),runerr(0)); + StrLen(result) = end - field; + suspend result; + } + fail; + } #endif /* Messaging */ - else - runerr(122, t); - } - } -#endif /* Dbm || Messaging */ + else + runerr(122, t); + } + } +#endif /* Dbm || Messaging */ default: { runerr(124, t) } } end - + /* * Insert an array of alternating keys and values into a table. @@ -449,31 +449,31 @@ int c_inserttable(union block **pbp, int n, dptr x) /* get this now because can't tend pd */ Protect(te = alctelem(), return -1); - pd = memb(*pbp, x+argc, hn, &res); /* search table for key */ + pd = memb(*pbp, x+argc, hn, &res); /* search table for key */ if (res == 0) { - /* - * The element is not in the table - insert it. - */ - Blk(*pbp, Table)->size++; - te->clink = *pd; - *pd = (union block *)te; - te->hashnum = hn; - te->tref = x[argc]; - if (argc+1tval = x[argc+1]; - else /* if n is odd, a null is used as a default value */ - te->tval = nulldesc; - if (TooCrowded(*pbp)) - hgrow(*pbp); - } + /* + * The element is not in the table - insert it. + */ + Blk(*pbp, Table)->size++; + te->clink = *pd; + *pd = (union block *)te; + te->hashnum = hn; + te->tref = x[argc]; + if (argc+1tval = x[argc+1]; + else /* if n is odd, a null is used as a default value */ + te->tval = nulldesc; + if (TooCrowded(*pbp)) + hgrow(*pbp); + } else { - /* - * We found an existing entry; just change its value. - */ - deallocate((union block *)te); - te = (struct b_telem *) *pd; - te->tval = x[argc+1]; - } + /* + * We found an existing entry; just change its value. + */ + deallocate((union block *)te); + te = (struct b_telem *) *pd; + te->tval = x[argc+1]; + } EVValD(&s, E_Tinsert); EVValD(x+argc, E_Tsub); } @@ -500,111 +500,111 @@ function{1} insert(s, x[n]) struct b_selem *se; register union block **pd; - MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Set), "insert(): lock set"); - - for(argc=0;argclisttail==NULL) - if (arraytolist(&s)!=Succeeded) fail; -#endif /* Arrays*/ - - MUTEX_LOCKBLK_CONTROLLED(BlkD(s, List), "insert(): lock list"); - - for(argc=0;argcsize; - i = cvpos((long)cnv_x, size); - if (i == CvtFail || i > size+1){ - MUTEX_UNLOCKBLK(BlkD(s, List), "insert(): unlock list"); - fail; - } - - /* - * Perform i-1 rotations so that the position to be inserted - * is at the front/back - */ - for (j = 1; j < i; j++) { - c_get(hp, &d); - c_put(&s, &d); - } - - /* - * Put the element to insert on the back - */ - if (argc+1 < n) - c_put(&s, x+argc+1); - else - c_put(&s, &nulldesc); - - /* - * Perform size - (i-1) more rotations to slide everything back - * where it was originally - */ - for (j = i; j <= size; j++) { - c_get(hp, &d); - c_put(&s, &d); - } - } - MUTEX_UNLOCKBLK(BlkD(s, List), "insert(): unlock list"); - return s; - } + if (BlkD(s,List)->listtail==NULL) + if (arraytolist(&s)!=Succeeded) fail; +#endif /* Arrays*/ + + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, List), "insert(): lock list"); + + for(argc=0;argcsize; + i = cvpos((long)cnv_x, size); + if (i == CvtFail || i > size+1){ + MUTEX_UNLOCKBLK(BlkD(s, List), "insert(): unlock list"); + fail; + } + + /* + * Perform i-1 rotations so that the position to be inserted + * is at the front/back + */ + for (j = 1; j < i; j++) { + c_get(hp, &d); + c_put(&s, &d); + } + + /* + * Put the element to insert on the back + */ + if (argc+1 < n) + c_put(&s, x+argc+1); + else + c_put(&s, &nulldesc); + + /* + * Perform size - (i-1) more rotations to slide everything back + * where it was originally + */ + for (j = i; j <= size; j++) { + c_get(hp, &d); + c_put(&s, &d); + } + } + MUTEX_UNLOCKBLK(BlkD(s, List), "insert(): unlock list"); + return s; + } } table: { abstract { @@ -614,11 +614,11 @@ function{1} insert(s, x[n]) } body { - tended union block *bp; - MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Table), "insert(): lock table"); - bp = BlkLoc(s); - if (c_inserttable(&bp, n, x) == -1) runerr(0); - MUTEX_UNLOCKBLK(BlkD(s, Table), "insert(): unlock table"); + tended union block *bp; + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, Table), "insert(): lock table"); + bp = BlkLoc(s); + if (c_inserttable(&bp, n, x) == -1) runerr(0); + MUTEX_UNLOCKBLK(BlkD(s, Table), "insert(): unlock table"); return s; } } @@ -627,36 +627,36 @@ function{1} insert(s, x[n]) abstract { return string } - body { - DBM *db; - datum key, content; - word status; - int argc, rv; - - for(argc=0; argcfd.dbm; - status = BlkD(s,File)->status; - if (!(status & Fs_Dbm)) - runerr(122, s); - key.dptr = StrLoc(x[argc]); - key.dsize = StrLen(x[argc]); - content.dptr = StrLoc(x[argc+1]); - content.dsize = StrLen(x[argc+1]); - if ((rv=dbm_store(db, key, content, DBM_REPLACE)) < 0) { - fprintf(stderr, "dbm_store returned %d\n", rv); - fflush(stderr); - fail; - } - } - return s; - } + body { + DBM *db; + datum key, content; + word status; + int argc, rv; + + for(argc=0; argcfd.dbm; + status = BlkD(s,File)->status; + if (!(status & Fs_Dbm)) + runerr(122, s); + key.dptr = StrLoc(x[argc]); + key.dsize = StrLen(x[argc]); + content.dptr = StrLoc(x[argc+1]); + content.dsize = StrLen(x[argc+1]); + if ((rv=dbm_store(db, key, content, DBM_REPLACE)) < 0) { + fprintf(stderr, "dbm_store returned %d\n", rv); + fflush(stderr); + fail; + } + } + return s; + } } -#endif /* Dbm */ +#endif /* Dbm */ default: runerr(122, s); } @@ -683,13 +683,13 @@ function{0,1} classname(r) struct b_record * br; if (!is:record(r)) { - fail; - } + fail; + } br = BlkD(r, Record); recnm_bgn = StrLoc(Blk(br->recdesc,Proc)->recname); if ((first__ = strstr(recnm_bgn, "__")) == NULL) - fail; + fail; recnm_end = strstr(recnm_bgn, ClsInstSuffix); if (recnm_end > recnm_bgn) { StrLen(result) = recnm_end - recnm_bgn; @@ -705,68 +705,68 @@ end function{0,1} membernames(r) if is:string(r) then { abstract { - return new list(string) - } + return new list(string) + } body { - /* construct the string for the class instance vector in sbuf */ - char sbuf[MaxCvtLen]; - tended struct b_list * p; - tended struct descrip d; - tended struct b_proc *pr; - register struct b_lelem * bp; - int i, j, n_flds; - - for(i=0;infields; - j = 0; - if (strcmp("__s",StrLoc(pr->lnames[j])) == 0) { - j++; n_flds--; - } - if (strcmp("__m",StrLoc(pr->lnames[j])) == 0) { - j++; n_flds--; - } - - Protect(p = alclist_raw(n_flds, n_flds), runerr(0)); - bp = Blk(p->listhead,Lelem); - - for (i=0 ; i < n_flds; i++, j++) { - bp->lslots[i] = pr->lnames[j]; - } - return list(p); - } - else { - fail; - } - } + /* construct the string for the class instance vector in sbuf */ + char sbuf[MaxCvtLen]; + tended struct b_list * p; + tended struct descrip d; + tended struct b_proc *pr; + register struct b_lelem * bp; + int i, j, n_flds; + + for(i=0;infields; + j = 0; + if (strcmp("__s",StrLoc(pr->lnames[j])) == 0) { + j++; n_flds--; + } + if (strcmp("__m",StrLoc(pr->lnames[j])) == 0) { + j++; n_flds--; + } + + Protect(p = alclist_raw(n_flds, n_flds), runerr(0)); + bp = Blk(p->listhead,Lelem); + + for (i=0 ; i < n_flds; i++, j++) { + bp->lslots[i] = pr->lnames[j]; + } + return list(p); + } + else { + fail; + } + } } else if !is:record(r) then runerr(107, r) else { abstract { - return new list(string) - } + return new list(string) + } body { - register word i, n_flds; - tended struct b_list * p; - tended struct b_record * br; - register struct b_lelem * bp; - - br = BlkD(r, Record); - n_flds = Blk(br->recdesc,Proc)->nfields; - Protect(p = alclist_raw(n_flds, n_flds), runerr(0)); - bp = Blk(p->listhead,Lelem); - for (i=0; ilslots[i] = br->recdesc->Proc.lnames[i]; - return list(p); - } + register word i, n_flds; + tended struct b_list * p; + tended struct b_record * br; + register struct b_lelem * bp; + + br = BlkD(r, Record); + n_flds = Blk(br->recdesc,Proc)->nfields; + Protect(p = alclist_raw(n_flds, n_flds), runerr(0)); + bp = Blk(p->listhead,Lelem); + for (i=0; ilslots[i] = br->recdesc->Proc.lnames[i]; + return list(p); + } } end @@ -812,7 +812,7 @@ function{1} methodnames(r, cooked_names) suffix += (recnm_end - s); if (strcmp(suffix, "__state") == 0 || strcmp(suffix, "__methods") ==0) continue; -#endif /* COMPILER */ +#endif /* COMPILER */ n_mthds++; } Protect(p = alclist_raw(n_mthds, n_mthds), runerr(0)); @@ -828,7 +828,7 @@ function{1} methodnames(r, cooked_names) suffix += (recnm_end - s); if (strcmp(suffix, "__state") == 0 || strcmp(suffix, "__methods") ==0) continue; -#endif /* COMPILER */ +#endif /* COMPILER */ if (cooked_names.vword.integr) { bp->lslots[k].dword = StrLen(blk->Proc.pname) - len; bp->lslots[k].vword.sptr = StrLoc(blk->Proc.pname) + len; @@ -841,7 +841,7 @@ function{1} methodnames(r, cooked_names) } else { if (!cnv:C_string(r, s)) - runerr(103,r); + runerr(103,r); len = strlen(s); n_glbls = egnames - gnames; @@ -911,7 +911,7 @@ function{1} methods(r) type_case r of { record: - body { + body { #if !COMPILER char * suffix; #endif /* COMPILER */ @@ -960,13 +960,13 @@ function{1} methods(r) return list(p); } string: - body { + body { word len; char * procname; tended char *s; if (!cnv:C_string(r, s)) - runerr(103, r); + runerr(103, r); len = StrLen(r); n_glbls = egnames - gnames; for (i=0,n_mthds=0; irecdesc,Proc)->recname); - recnm_end = strstr(s, ClsInstSuffix); - len = recnm_end - s; - } + char * recnm_end; + struct b_record * br; + br = BlkD(r, Record); + s = StrLoc(Blk(br->recdesc,Proc)->recname); + recnm_end = strstr(s, ClsInstSuffix); + len = recnm_end - s; + } else { - if (!cnv:C_string(r, s)) - runerr(103, r); - len = strlen(s); - } + if (!cnv:C_string(r, s)) + runerr(103, r); + len = strlen(s); + } n_glbls = egnames - gnames; for (i=0; isize; - for(argc=0; argc size)) { - MUTEX_UNLOCKBLK(BlkD(s, List), "member(): unlock list"); - fail; - } - } - MUTEX_UNLOCKBLK(BlkD(s, List), "member(): unlock list"); - return x[n-1]; - } - } + abstract { + return store[type(x).lst_elem] + } + inline { + int argc, size; + C_integer cnv_x; + + MUTEX_LOCKBLK_CONTROLLED(BlkD(s, List), "member(): lock list"); + size = BlkD(s,List)->size; + for(argc=0; argc size)) { + MUTEX_UNLOCKBLK(BlkD(s, List), "member(): unlock list"); + fail; + } + } + MUTEX_UNLOCKBLK(BlkD(s, List), "member(): unlock list"); + return x[n-1]; + } + } cset: { - abstract { - return cset - } - body { + abstract { + return cset + } + body { int argc, i; - for(argc=0; argcstatus; - if (!(status & Fs_Dbm)) - runerr(122, s); - db = BlkD(s,File)->fd.dbm; - key.dptr = StrLoc(x[argc]); - key.dsize = StrLen(x[argc]); - content = dbm_fetch(db, key); - if (content.dptr == NULL) - fail; - } - return x[n-1]; - } + DBM *db; + datum key, content; + word status, argc; + + for(argc=0; argcstatus; + if (!(status & Fs_Dbm)) + runerr(122, s); + db = BlkD(s,File)->fd.dbm; + key.dptr = StrLoc(x[argc]); + key.dsize = StrLen(x[argc]); + content = dbm_fetch(db, key); + if (content.dptr == NULL) + fail; + } + return x[n-1]; + } } -#endif /* Dbm */ +#endif /* Dbm */ default: runerr(122, s) } end - + "pull(L,n) - pull an element from end of list L." @@ -1405,55 +1405,55 @@ function{0,1} pull(x,n) register struct b_lelem *bp; if (n <= 0) - fail; + fail; #ifdef Arrays if (BlkD(x,List)->listtail==NULL) - if (arraytolist(&x)!=Succeeded) fail; -#endif /* Arrays*/ + if (arraytolist(&x)!=Succeeded) fail; +#endif /* Arrays*/ MUTEX_LOCKBLK_CONTROLLED(BlkD(x, List), "pull(): lock list"); for(j=0;jsize <= 0){ - MUTEX_UNLOCKBLK(hp, "pull(): unlock list"); - fail; - } - - /* - * Point bp at the last list element block. If the last block has no - * elements in use, point bp at the previous list element block. - */ - bp = (struct b_lelem *) hp->listtail; - if (bp->nused <= 0) { - bp = (struct b_lelem *) bp->listprev; - hp->listtail = (union block *) bp; - bp->listnext = (union block *) hp; - } - - /* - * Set i to position of last element and assign the element to - * result for return. Decrement the usage count for the block - * and the size of the list. - */ - i = bp->first + bp->nused - 1; - if (i >= bp->nslots) - i -= bp->nslots; - result = bp->lslots[i]; - bp->nused--; - hp->size--; - } + if (hp->size <= 0){ + MUTEX_UNLOCKBLK(hp, "pull(): unlock list"); + fail; + } + + /* + * Point bp at the last list element block. If the last block has no + * elements in use, point bp at the previous list element block. + */ + bp = (struct b_lelem *) hp->listtail; + if (bp->nused <= 0) { + bp = (struct b_lelem *) bp->listprev; + hp->listtail = (union block *) bp; + bp->listnext = (union block *) hp; + } + + /* + * Set i to position of last element and assign the element to + * result for return. Decrement the usage count for the block + * and the size of the list. + */ + i = bp->first + bp->nused - 1; + if (i >= bp->nslots) + i -= bp->nslots; + result = bp->lslots[i]; + bp->nused--; + hp->size--; + } MUTEX_UNLOCKBLK(hp, "pull(): unlock list"); return result; } end - + /* * c_push - C-level, nontending push operation @@ -1464,12 +1464,12 @@ dptr val; { register word i = 0; register struct b_lelem *bp; /* does not need to be tended */ - static int two = 2; /* some compilers generate bad code for - division by a constant that's a power of 2*/ + static int two = 2; /* some compilers generate bad code for + division by a constant that's a power of 2*/ #ifdef Arrays if (BlkD(*l,List)->listtail==NULL) if (arraytolist(l)!=Succeeded) return; -#endif /* Arrays*/ +#endif /* Arrays*/ /* * Point bp at the first list-element block. @@ -1493,7 +1493,7 @@ dptr val; #ifdef MaxListSlots if (i > MaxListSlots) i = MaxListSlots; -#endif /* MaxListSlots */ +#endif /* MaxListSlots */ /* * Allocate a new list element block. If the block can't @@ -1527,7 +1527,7 @@ dptr val; BlkLoc(*l)->List.size++; } - + "push(L, x1, ..., xN) - push x onto beginning of list L." @@ -1547,89 +1547,89 @@ function{1} push(x, vals[n]) dptr dp; register word i, val, num; register struct b_lelem *bp; /* does not need to be tended */ - static int two = 2; /* some compilers generate bad code for - division by a constant that's a power of 2*/ + static int two = 2; /* some compilers generate bad code for + division by a constant that's a power of 2*/ #ifdef Arrays if (BlkD(x,List)->listtail==NULL) - if (arraytolist(&x)!=Succeeded) fail; -#endif /* Arrays*/ + if (arraytolist(&x)!=Succeeded) fail; +#endif /* Arrays*/ if (n == 0) { - dp = &nulldesc; - num = 1; - } + dp = &nulldesc; + num = 1; + } else { - dp = vals; - num = n; - } + dp = vals; + num = n; + } MUTEX_LOCKBLK_CONTROLLED(BlkD(x, List), "push(): lock list"); for (val = 0; val < num; val++) { - /* - * Point hp at the list-header block and bp at the first - * list-element block. - */ - hp = BlkD(x, List); - bp = Blk(hp->listhead, Lelem); - - /* - * Initialize i so it's 0 if first list-element. - */ - i = 0; /* block isn't full */ - - /* - * If the first list-element block is full, allocate a new - * list-element block, make it the first list-element block, - * and make it the previous block of the former first list-element - * block. - */ - if (bp->nused >= bp->nslots) { - /* - * Set i to the size of block to allocate. - */ - i = hp->size / two; - if (i < MinListSlots) - i = MinListSlots; + /* + * Point hp at the list-header block and bp at the first + * list-element block. + */ + hp = BlkD(x, List); + bp = Blk(hp->listhead, Lelem); + + /* + * Initialize i so it's 0 if first list-element. + */ + i = 0; /* block isn't full */ + + /* + * If the first list-element block is full, allocate a new + * list-element block, make it the first list-element block, + * and make it the previous block of the former first list-element + * block. + */ + if (bp->nused >= bp->nslots) { + /* + * Set i to the size of block to allocate. + */ + i = hp->size / two; + if (i < MinListSlots) + i = MinListSlots; #ifdef MaxListSlots - if (i > MaxListSlots) - i = MaxListSlots; -#endif /* MaxListSlots */ - - /* - * Allocate a new list element block. If the block can't - * be allocated, try smaller blocks. - */ - while ((bp = alclstb(i, (word)0, (word)0)) == NULL) { - i /= 4; - if (i < MinListSlots) - runerr(0); - } - - Blk(hp->listhead, Lelem)->listprev = (union block *)bp; - bp->listprev = (union block *) hp; - bp->listnext = hp->listhead; - hp->listhead = (union block *) bp; - } - - /* - * Set i to position of new first element and assign val to - * that element. - */ - i = bp->first - 1; - if (i < 0) - i = bp->nslots - 1; - bp->lslots[i] = dp[val]; - /* - * Adjust value of location of first element, block usage count, - * and current list size. - */ - bp->first = i; - bp->nused++; - hp->size++; - } + if (i > MaxListSlots) + i = MaxListSlots; +#endif /* MaxListSlots */ + + /* + * Allocate a new list element block. If the block can't + * be allocated, try smaller blocks. + */ + while ((bp = alclstb(i, (word)0, (word)0)) == NULL) { + i /= 4; + if (i < MinListSlots) + runerr(0); + } + + Blk(hp->listhead, Lelem)->listprev = (union block *)bp; + bp->listprev = (union block *) hp; + bp->listnext = hp->listhead; + hp->listhead = (union block *) bp; + } + + /* + * Set i to position of new first element and assign val to + * that element. + */ + i = bp->first - 1; + if (i < 0) + i = bp->nslots - 1; + bp->lslots[i] = dp[val]; + /* + * Adjust value of location of first element, block usage count, + * and current list size. + */ + bp->first = i; + bp->nused++; + hp->size++; + } MUTEX_UNLOCKBLK(hp, "push(): unlock list"); @@ -1641,7 +1641,7 @@ function{1} push(x, vals[n]) return x; } end - + /* * c_put - C-level, nontending list put function @@ -1650,8 +1650,8 @@ void c_put(struct descrip *l, struct descrip *val) { register word i = 0; register struct b_lelem *bp; /* does not need to be tended */ - static int two = 2; /* some compilers generate bad code for - division by a constant that's a power of 2*/ + static int two = 2; /* some compilers generate bad code for + division by a constant that's a power of 2*/ /* * Point bp at the last list-element block. @@ -1675,7 +1675,7 @@ void c_put(struct descrip *l, struct descrip *val) #ifdef MaxListSlots if (i > MaxListSlots) i = MaxListSlots; -#endif /* MaxListSlots */ +#endif /* MaxListSlots */ /* * Allocate a new list element block. If the block @@ -1708,7 +1708,7 @@ void c_put(struct descrip *l, struct descrip *val) BlkD(*l, List)->size++; } - + "put(L, x1, ..., xN) - put elements onto end of list L." function{1} put(x, vals[n]) @@ -1727,21 +1727,21 @@ function{1} put(x, vals[n]) dptr dp; register word i, val, num; register struct b_lelem *bp; /* does not need to be tended */ - static int two = 2; /* some compilers generate bad code for - division by a constant that's a power of 2*/ + static int two = 2; /* some compilers generate bad code for + division by a constant that's a power of 2*/ #ifdef Arrays - if (BlkD(x,List)->listtail==NULL) - if (arraytolist(&x)!=Succeeded) fail; -#endif /* Arrays*/ + if (BlkD(x,List)->listtail==NULL) + if (arraytolist(&x)!=Succeeded) fail; +#endif /* Arrays*/ if (n == 0) { - dp = &nulldesc; - num = 1; - } + dp = &nulldesc; + num = 1; + } else { - dp = vals; - num = n; - } + dp = vals; + num = n; + } MUTEX_LOCKBLK_CONTROLLED(BlkD(x,List), "put(): lock list"); @@ -1750,65 +1750,65 @@ function{1} put(x, vals[n]) * list-element block. */ for(val = 0; val < num; val++) { - hp = BlkD(x, List); - bp = Blk(hp->listtail, Lelem); - - i = 0; /* block isn't full */ - - /* - * If the last list-element block is full, allocate a new - * list-element block, make it the last list-element block, - * and make it the next block of the former last list-element - * block. - */ - if (bp->nused >= bp->nslots) { - /* - * Set i to the size of block to allocate. - * Add half the size of the present list, subject to - * minimum and maximum and including enough space for - * the rest of this call to put() if called with varargs. - */ - i = hp->size / two; - if (i < MinListSlots) - i = MinListSlots; - if (i < n - val) - i = n - val; + hp = BlkD(x, List); + bp = Blk(hp->listtail, Lelem); + + i = 0; /* block isn't full */ + + /* + * If the last list-element block is full, allocate a new + * list-element block, make it the last list-element block, + * and make it the next block of the former last list-element + * block. + */ + if (bp->nused >= bp->nslots) { + /* + * Set i to the size of block to allocate. + * Add half the size of the present list, subject to + * minimum and maximum and including enough space for + * the rest of this call to put() if called with varargs. + */ + i = hp->size / two; + if (i < MinListSlots) + i = MinListSlots; + if (i < n - val) + i = n - val; #ifdef MaxListSlots - if (i > MaxListSlots) - i = MaxListSlots; -#endif /* MaxListSlots */ - /* - * Allocate a new list element block. If the block can't - * be allocated, try smaller blocks. - */ - while ((bp = alclstb(i, (word)0, (word)0)) == NULL) { - i /= 4; - if (i < MinListSlots) - runerr(0); - } - - Blk(hp->listtail, Lelem)->listnext = (union block *) bp; - bp->listprev = hp->listtail; - bp->listnext = (union block *) hp; - hp->listtail = (union block *) bp; - } - - /* - * Set i to position of new last element and assign val to - * that element. - */ - i = bp->first + bp->nused; - if (i >= bp->nslots) - i -= bp->nslots; - bp->lslots[i] = dp[val]; - - /* - * Adjust block usage count and current list size. - */ - bp->nused++; - hp->size++; - - } + if (i > MaxListSlots) + i = MaxListSlots; +#endif /* MaxListSlots */ + /* + * Allocate a new list element block. If the block can't + * be allocated, try smaller blocks. + */ + while ((bp = alclstb(i, (word)0, (word)0)) == NULL) { + i /= 4; + if (i < MinListSlots) + runerr(0); + } + + Blk(hp->listtail, Lelem)->listnext = (union block *) bp; + bp->listprev = hp->listtail; + bp->listnext = (union block *) hp; + hp->listtail = (union block *) bp; + } + + /* + * Set i to position of new last element and assign val to + * that element. + */ + i = bp->first + bp->nused; + if (i >= bp->nslots) + i -= bp->nslots; + bp->lslots[i] = dp[val]; + + /* + * Adjust block usage count and current list size. + */ + bp->nused++; + hp->size++; + + } MUTEX_UNLOCKBLK(hp, "put(): unlock list"); @@ -1821,7 +1821,7 @@ function{1} put(x, vals[n]) } end - + /* * C language set insert. pps must point to a tended block pointer. * pe can't be tended, so allocate before, and deallocate if unused. @@ -1831,14 +1831,14 @@ end { register uword hn; union block **pe; - struct b_selem *ne; /* does not need to be tended */ + struct b_selem *ne; /* does not need to be tended */ tended struct descrip d; d = *pd; if ((ne = alcselem(&nulldesc, (uword)0))) { pe = memb(ps, &d, hn = hash(&d), &res); if (res==0) { - ne->setmem = d; /* add new element */ + ne->setmem = d; /* add new element */ ne->hashnum = hn; addmem((struct b_set *)ps, ne, pe); } @@ -1872,7 +1872,7 @@ function{1} set(x[n]) ps = hmake(T_Set, (word)0, (word)0); if (ps == NULL) runerr(0); - Desc_EVValD(ps, E_Screate, D_Set); + Desc_EVValD(ps, E_Screate, D_Set); return set(ps); } } @@ -1886,10 +1886,10 @@ function{1} set(x[n]) body { tended union block *pb, *ps; word i, j; - int arg, res; + int arg, res; - /* - * Make a set. + /* + * Make a set. */ if (is:list(x[0])) i = BlkD(x[0],List)->size; else i = n; @@ -1898,51 +1898,51 @@ function{1} set(x[n]) runerr(0); } - for (arg = 0; arg < n; arg++) { - if (is:list(x[arg])) { - pb = BlkLoc(x[arg]); + for (arg = 0; arg < n; arg++) { + if (is:list(x[arg])) { + pb = BlkLoc(x[arg]); if(!(reserve(Blocks, Blk(pb,List)->size * (2*sizeof(struct b_selem))))){ runerr(0); } - /* - * Chain through each list block and for - * each element contained in the block - * insert the element into the set if not there. - */ - for (pb = Blk(pb,List)->listhead; - pb && (BlkType(pb) == T_Lelem); - pb = Blk(pb,Lelem)->listnext) { - for (i = 0; i < Blk(pb,Lelem)->nused; i++) { + /* + * Chain through each list block and for + * each element contained in the block + * insert the element into the set if not there. + */ + for (pb = Blk(pb,List)->listhead; + pb && (BlkType(pb) == T_Lelem); + pb = Blk(pb,Lelem)->listnext) { + for (i = 0; i < Blk(pb,Lelem)->nused; i++) { #ifdef Polling if (!pollctr--) { pollctr = pollevent(); - if (pollctr == -1) fatalerr(141, NULL); - } -#endif /* Polling */ - j = Blk(pb,Lelem)->first + i; - if (j >= Blk(pb,Lelem)->nslots) - j -= pb->Lelem.nslots; - C_SETINSERT(ps, &(pb->Lelem.lslots[j]), res); + if (pollctr == -1) fatalerr(141, NULL); + } +#endif /* Polling */ + j = Blk(pb,Lelem)->first + i; + if (j >= Blk(pb,Lelem)->nslots) + j -= pb->Lelem.nslots; + C_SETINSERT(ps, &(pb->Lelem.lslots[j]), res); if (res == -1) { runerr(0); } } - } - } - else { - if (c_insertset(&ps, & (x[arg])) == -1) { + } + } + else { + if (c_insertset(&ps, & (x[arg])) == -1) { runerr(0); } - } - } - Desc_EVValD(ps, E_Screate, D_Set); + } + } + Desc_EVValD(ps, E_Screate, D_Set); return set(ps); - } + } } } end - + "table(k, v, ..., x) - create a table with default value x." @@ -1957,14 +1957,14 @@ function{1} table(x[n]) if (bp == NULL) runerr(0); if (n > 1) { - /* - * if n is odd then the last value is the table's default value - * the actual key-value pairs end at n-1 (n-n%2 below) - */ - if (c_inserttable(&bp, n - n % 2, x) == -1) runerr(0); - } + /* + * if n is odd then the last value is the table's default value + * the actual key-value pairs end at n-1 (n-n%2 below) + */ + if (c_inserttable(&bp, n - n % 2, x) == -1) runerr(0); + } if (n % 2) - bp->Table.defvalue = x[n-1]; + bp->Table.defvalue = x[n-1]; else bp->Table.defvalue = nulldesc; Desc_EVValD(bp, E_Tcreate, D_Table); @@ -1978,7 +1978,7 @@ end function{1} constructor(s, x[n]) abstract { return proc - } + } if !cnv:string(s) then runerr(103,s) inline { int i; @@ -2012,9 +2012,9 @@ function{1} array(x[n]) int i_or_real = 0; if( n>2 ){ - fprintf(stderr, - "multi-dimensional array support has not been added yet\n"); - runerr(101, x[2]); + fprintf(stderr, + "multi-dimensional array support has not been added yet\n"); + runerr(101, x[2]); } /* @@ -2022,30 +2022,30 @@ function{1} array(x[n]) * Calculate total # of elements for n-dimensional array. */ for(i=0;isize, 0) != - Succeeded) - runerr(102, x[n-1]); - return d; - } + /* get the first element of x[n-1], use it to set i_or_real */ + if (cplist2realarray(&x[n-1], &d, 0, BlkD(x[n-1],List)->size, 0) != + Succeeded) + runerr(102, x[n-1]); + return d; + } else runerr(102, x[n-1]); /* @@ -2055,30 +2055,30 @@ function{1} array(x[n]) d.vword.bptr = (union block *) alclisthdr(num, ((i_or_real == 1) ? ((union block *)alcintarray(num)) : - ((union block *)alcrealarray(num)))); + ((union block *)alcrealarray(num)))); d.dword = D_List; if (n>2) { - dims = alcintarray(n-1); - for (i=0;ia[i] = IntVal(x[i]); - if (i_or_real == 1) - d.vword.bptr->List.listhead->Intarray.dims = (union block *)dims; - else - d.vword.bptr->List.listhead->Realarray.dims = (union block *)dims; - } + dims = alcintarray(n-1); + for (i=0;ia[i] = IntVal(x[i]); + if (i_or_real == 1) + d.vword.bptr->List.listhead->Intarray.dims = (union block *)dims; + else + d.vword.bptr->List.listhead->Realarray.dims = (union block *)dims; + } if (i_or_real == 1) { - a_ip = d.vword.bptr->List.listhead->Intarray.a; - for(i=0; iList.listhead->Intarray.a; + for(i=0; iList.listhead->Realarray.a; - for(i=0; iList.listhead->Realarray.a; + for(i=0; ifd.fp; int status = BlkD(f,File)->status; CURTSTATE(); @@ -53,80 +53,80 @@ function{0,1} close(f) */ #ifdef Messaging if (status & Fs_Messaging) { - BlkLoc(f)->File.status = 0; - return C_integer Mclose(BlkD(f,File)->fd.mf); - } + BlkLoc(f)->File.status = 0; + return C_integer Mclose(BlkD(f,File)->fd.mf); + } #endif /* Messaging */ #ifdef PosixFns if (BlkD(f,File)->status & Fs_Socket) { #if HAVE_LIBSSL - if(status & Fs_Encrypt) { - int fd; - fd = SSL_get_fd(BlkD(f,File)->fd.ssl); - SSL_shutdown(BlkLoc(f)->File.fd.ssl); + if(status & Fs_Encrypt) { + int fd; + fd = SSL_get_fd(BlkD(f,File)->fd.ssl); + SSL_shutdown(BlkLoc(f)->File.fd.ssl); SSL_CTX_free(SSL_get_SSL_CTX(BlkLoc(f)->File.fd.ssl)); - SSL_free(BlkLoc(f)->File.fd.ssl); - BlkLoc(f)->File.fd.fd = fd; + SSL_free(BlkLoc(f)->File.fd.ssl); + BlkLoc(f)->File.fd.fd = fd; } -#endif /* LIBSSL */ - BlkLoc(f)->File.status = 0; - StrLoc(BlkLoc(f)->File.fname) = "closed socket"; - StrLen(BlkLoc(f)->File.fname) = 13; +#endif /* LIBSSL */ + BlkLoc(f)->File.status = 0; + StrLoc(BlkLoc(f)->File.fname) = "closed socket"; + StrLen(BlkLoc(f)->File.fname) = 13; #if NT - return C_integer closesocket((SOCKET)BlkLoc(f)->File.fd.fd); -#else /* NT */ - return C_integer close(BlkLoc(f)->File.fd.fd); -#endif /* NT */ - } -#endif /* PosixFns */ + return C_integer closesocket((SOCKET)BlkLoc(f)->File.fd.fd); +#else /* NT */ + return C_integer close(BlkLoc(f)->File.fd.fd); +#endif /* NT */ + } +#endif /* PosixFns */ #ifdef ReadDirectory #if !NT || defined(NTGCC) if (BlkD(f,File)->status & Fs_Directory) { - BlkLoc(f)->File.status = 0; - closedir((DIR *)fp); - return f; + BlkLoc(f)->File.status = 0; + closedir((DIR *)fp); + return f; } #endif -#endif /* ReadDirectory */ +#endif /* ReadDirectory */ #if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { - int rv; - BlkLoc(f)->File.status = 0; - rv = gzclose((gzFile) fp); - if (rv) { - if (rv == Z_ERRNO) set_syserrortext(errno); - /* could also be Z_STREAM_ERROR or Z_BUF_ERROR */ - fail; - } - return C_integer 0; - } -#endif /* HAVE_LIBZ */ + int rv; + BlkLoc(f)->File.status = 0; + rv = gzclose((gzFile) fp); + if (rv) { + if (rv == Z_ERRNO) set_syserrortext(errno); + /* could also be Z_STREAM_ERROR or Z_BUF_ERROR */ + fail; + } + return C_integer 0; + } +#endif /* HAVE_LIBZ */ #ifdef ISQL if (BlkD(f,File)->status & Fs_ODBC) { - BlkLoc(f)->File.status = 0; - if (dbclose((struct ISQLFile *)fp)) fail; /* sets errornumber/text*/ - return C_integer 0; - } -#endif /* ISQL */ + BlkLoc(f)->File.status = 0; + if (dbclose((struct ISQLFile *)fp)) fail; /* sets errornumber/text*/ + return C_integer 0; + } +#endif /* ISQL */ #ifdef PseudoPty if (BlkD(f,File)->status & Fs_Pty) { - ptclose(BlkLoc(f)->File.fd.pt); - return C_integer 0; - } -#endif /* PseudoPty */ + ptclose(BlkLoc(f)->File.fd.pt); + return C_integer 0; + } +#endif /* PseudoPty */ #ifdef Dbm if (BlkD(f,File)->status & Fs_Dbm) { - BlkLoc(f)->File.status = 0; - dbm_close((DBM *)fp); - return f; + BlkLoc(f)->File.status = 0; + dbm_close((DBM *)fp); + return f; } -#endif /* Dbm */ +#endif /* Dbm */ #ifdef Graphics @@ -137,37 +137,37 @@ function{0,1} close(f) pollctr >>= 1; pollctr++; if (BlkD(f,File)->status & Fs_Window) { - if (BlkLoc(f)->File.status != Fs_Window) { /* not already closed? */ - BlkLoc(f)->File.status = Fs_Window; - SETCLOSED((wbp) fp); + if (BlkLoc(f)->File.status != Fs_Window) { /* not already closed? */ + BlkLoc(f)->File.status = Fs_Window; + SETCLOSED((wbp) fp); #ifdef GraphicsGL - if (((wbp)fp)->window->is_gl) - gl_wclose((wbp) fp); - else -#endif /* GraphicsGL */ - wclose((wbp) fp); - } - return f; - } + if (((wbp)fp)->window->is_gl) + gl_wclose((wbp) fp); + else +#endif /* GraphicsGL */ + wclose((wbp) fp); + } + return f; + } else -#endif /* Graphics */ +#endif /* Graphics */ #ifdef HAVE_VOICE - if(BlkD(f,File)->status & Fs_Voice) { - /* PVSESSION Ptr; */ - Ptr = (PVSESSION)BlkLoc(f)->File.fd.fp; - CloseVoiceSession(Ptr); - return C_integer 1; - } - else -#endif /* HAVE_VOICE */ + if(BlkD(f,File)->status & Fs_Voice) { + /* PVSESSION Ptr; */ + Ptr = (PVSESSION)BlkLoc(f)->File.fd.fp; + CloseVoiceSession(Ptr); + return C_integer 1; + } + else +#endif /* HAVE_VOICE */ #if NT #ifndef NTGCC -// FIXME: the following two lines are no longer needed with recent APIs +// FIXME: the following two lines are no longer needed with recent APIs //#define pclose _pclose //#define popen _popen -#endif /* NTGCC */ -#endif /* NT */ +#endif /* NTGCC */ +#endif /* NT */ #if UNIX || VMS || NT /* @@ -175,20 +175,20 @@ function{0,1} close(f) * should we consider treating Fs_BPipe in the same way?! */ if ((BlkD(f,File)->status & Fs_Pipe) /*|| (BlkD(f,File)->status & Fs_BPipe)*/) { - int rv; - BlkLoc(f)->File.status = 0; - if ((rv = pclose(fp)) == -1) { - IntVal(amperErrno) = errno; - fail; - } - return C_integer((rv >> 8) & 0377); - } + int rv; + BlkLoc(f)->File.status = 0; + if ((rv = pclose(fp)) == -1) { + IntVal(amperErrno) = errno; + fail; + } + return C_integer((rv >> 8) & 0377); + } else -#endif /* UNIX || ... */ +#endif /* UNIX || ... */ if (fclose(fp) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } BlkLoc(f)->File.status = 0; @@ -212,7 +212,7 @@ function{} exit(status) #ifdef Concurrent /* * exit if this is a thread. - * May want to check/fix thread activator initialization + * May want to check/fix thread activator initialization * depending on desired join semantics. * coclean calls pthread_exit() in case of threads. */ @@ -222,19 +222,19 @@ function{} exit(status) * does not preserve the { } that would allow redundancy. */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #ifdef CoClean coclean(BlkD(k_current, Coexpr)); - #endif /* CoClean */ + #endif /* CoClean */ } -#endif /* Concurrent */ +#endif /* Concurrent */ c_exit((int)status); #if !COMPILER - fail; /* avoid spurious warning message */ -#endif /* COMPILER */ + fail; /* avoid spurious warning message */ +#endif /* COMPILER */ } end - + "getenv(s) - return contents of environment variable s." @@ -252,29 +252,29 @@ function{0,1} getenv(s) inline { char *p, *sbuf; long l; - + if ( (sbuf = getenv_var(s)) != NULL) { - l = strlen(sbuf); - Protect(p = alcstr(sbuf,l),runerr(0)); - free(sbuf); - return string(l,p); - } - else { /* fail if not in environment */ - set_syserrortext(errno); - fail; - } + l = strlen(sbuf); + Protect(p = alcstr(sbuf,l),runerr(0)); + free(sbuf); + return string(l,p); + } + else { /* fail if not in environment */ + set_syserrortext(errno); + fail; + } } end - + #if defined(Graphics) || defined(Messaging) || defined(ISQL) "open(s1, s2, ...) - open file named s1 with options s2" " and attributes given in trailing arguments." function{0,1} open(fname, spec, attr[n]) -#else /* Graphics */ +#else /* Graphics */ "open(fname, spec) - open file fname with specification spec." function{0,1} open(fname, spec) -#endif /* Graphics */ +#endif /* Graphics */ declare { tended struct descrip filename; } @@ -311,12 +311,12 @@ function{0,1} open(fname, spec) tended struct b_file *fl; #ifdef PosixFns struct stat st; -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Graphics int j, err_index = -1; tended struct b_list *hp; -#endif /* Graphics */ +#endif /* Graphics */ #ifdef Messaging int is_shortreq = 0; @@ -330,24 +330,24 @@ function{0,1} open(fname, spec) #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || MVS || VM /* nothing is needed */ -#endif /* MSDOS || ... */ +#endif /* MSDOS || ... */ #ifdef PosixFns - int is_udp_or_listener = 0; /* UDP = 1, listener = 2 */ -#endif /* PosixFns */ + int is_udp_or_listener = 0; /* UDP = 1, listener = 2 */ +#endif /* PosixFns */ #if defined(PosixFns) || defined(Messaging) int is_ipv4 = 0; int is_ipv6 = 0; int af_fam; -#endif /* PosixFns || Messaging */ +#endif /* PosixFns || Messaging */ #if UNIX || VMS || NT extern FILE *popen(); -#endif /* UNIX || VMS || NT */ +#endif /* UNIX || VMS || NT */ /* * End of operating-system specific code. @@ -362,13 +362,13 @@ Deliberate Syntax Error * get a C string for the file name */ if (!cnv:C_string(fname, fnamestr)) - runerr(103,fname); + runerr(103,fname); /* poison NUL resistance. */ if (strlen(fnamestr) != StrLen(fname)) { - set_errortext(218); - fail; - } + set_errortext(218); + fail; + } /* * TODO: Preliminary tilde $HOME support. Need to extend to Windows, @@ -376,12 +376,12 @@ Deliberate Syntax Error * about whether further is needed for multi-arg fnamestr e.g. mode "p" */ if (fnamestr[0] == '~') { - if (fnamestr[1] == '/') { - getenv_r("HOME", home_sbuf, 1023); - strcat(home_sbuf, fnamestr+1); - fnamestr = home_sbuf; - } - } + if (fnamestr[1] == '/') { + getenv_r("HOME", home_sbuf, 1023); + strcat(home_sbuf, fnamestr+1); + fnamestr = home_sbuf; + } + } status = 0; @@ -393,206 +393,206 @@ Deliberate Syntax Error slen = StrLen(spec); for (i = 0; i < slen; i++) { - switch (*s++) { - case 'e': - case 'E': + switch (*s++) { + case 'e': + case 'E': #if HAVE_LIBSSL - status |= Fs_Encrypt; -#endif /* HAVE_LIBSSL */ - continue; - case 'a': - case 'A': - status |= Fs_Write|Fs_Append; - continue; - case 'b': - case 'B': - status |= Fs_Read|Fs_Write; - continue; - case 'c': - case 'C': - status |= Fs_Create|Fs_Write; - continue; - case 'r': - case 'R': - status |= Fs_Read; - continue; - case 'w': - case 'W': - status |= Fs_Write; - continue; - case '-': - do_verify = 0; - continue; - case 's': - case 'S': + status |= Fs_Encrypt; +#endif /* HAVE_LIBSSL */ + continue; + case 'a': + case 'A': + status |= Fs_Write|Fs_Append; + continue; + case 'b': + case 'B': + status |= Fs_Read|Fs_Write; + continue; + case 'c': + case 'C': + status |= Fs_Create|Fs_Write; + continue; + case 'r': + case 'R': + status |= Fs_Read; + continue; + case 'w': + case 'W': + status |= Fs_Write; + continue; + case '-': + do_verify = 0; + continue; + case 's': + case 'S': #ifdef Messaging - if (status & Fs_Messaging) { - is_shortreq = 1; - continue; - } + if (status & Fs_Messaging) { + is_shortreq = 1; + continue; + } #endif /* Messaging */ - continue; + continue; - case 't': - case 'T': - status &= ~Fs_Untrans; - continue; + case 't': + case 'T': + status &= ~Fs_Untrans; + continue; - case '6': + case '6': #if defined(PosixFns) || defined(Messaging) - is_ipv6 = 1; - continue; -#endif /* PosixFns || Messaging */ - case '4': + is_ipv6 = 1; + continue; +#endif /* PosixFns || Messaging */ + case '4': #if defined(PosixFns) || defined(Messaging) - is_ipv4 = 1; - continue; -#endif /* PosixFns || Messaging */ + is_ipv4 = 1; + continue; +#endif /* PosixFns || Messaging */ - case 'u': - case 'U': + case 'u': + case 'U': #ifdef PosixFns - is_udp_or_listener = 1; -#endif /* PosixFns */ - if ((status & Fs_Socket)==0) - status |= Fs_Untrans; - continue; + is_udp_or_listener = 1; +#endif /* PosixFns */ + if ((status & Fs_Socket)==0) + status |= Fs_Untrans; + continue; #if UNIX || VMS || NT - case 'p': - case 'P': - status |= Fs_Pipe; - continue; -#endif /* UNIX ... */ - - case 'x': - case 'X': - case 'g': - case 'G': + case 'p': + case 'P': + status |= Fs_Pipe; + continue; +#endif /* UNIX ... */ + + case 'x': + case 'X': + case 'g': + case 'G': #ifdef Graphics - status |= Fs_Window | Fs_Read | Fs_Write; + status |= Fs_Window | Fs_Read | Fs_Write; #ifdef XWindows - XInitThreads(); -#endif /* XWindows */ + XInitThreads(); +#endif /* XWindows */ #ifdef GraphicsGL - /* + /* * For now, having FreeType is a requirement for the OpenGL - * 2D and 2D/3D implementation + * 2D and 2D/3D implementation */ #if HAVE_LIBFREETYPE - /* for enabling OpenGL 2D implementation in a convenient way */ - if (!getenv("UNICONGL2D")) -#endif /* HAVE_LIBFREETYPE */ -#endif /* GraphicsGL */ - continue; -#else /* Graphics */ - set_errortext(148); - fail; -#endif /* Graphics */ + /* for enabling OpenGL 2D implementation in a convenient way */ + if (!getenv("UNICONGL2D")) +#endif /* HAVE_LIBFREETYPE */ +#endif /* GraphicsGL */ + continue; +#else /* Graphics */ + set_errortext(148); + fail; +#endif /* Graphics */ #ifdef GraphicsGL - /* OpenGL 2D implementation */ - if (status & Fs_Window) { - status |= Fs_WinGL2D; - continue; - } + /* OpenGL 2D implementation */ + if (status & Fs_Window) { + status |= Fs_WinGL2D; + continue; + } #else - /* Does it need a specific code? */ - set_errortext(1045); - fail; -#endif /* GraphicsGL */ - case 'l': - case 'L': + /* Does it need a specific code? */ + set_errortext(1045); + fail; +#endif /* GraphicsGL */ + case 'l': + case 'L': #ifdef PosixFns - if (status & Fs_Socket) { - status |= Fs_Listen | Fs_Append; - is_udp_or_listener = 2; - continue; - } -#endif /* PosixFns */ + if (status & Fs_Socket) { + status |= Fs_Listen | Fs_Append; + is_udp_or_listener = 2; + continue; + } +#endif /* PosixFns */ #ifdef Graphics3D - if (status & Fs_Window) { - status |= Fs_Window3D; - continue; - } -#else /* Graphics3D */ - set_errortext(1045); - fail; -#endif /* Graphics3D */ - - - case 'd': - case 'D': + if (status & Fs_Window) { + status |= Fs_Window3D; + continue; + } +#else /* Graphics3D */ + set_errortext(1045); + fail; +#endif /* Graphics3D */ + + + case 'd': + case 'D': #ifdef Dbm - status |= Fs_Dbm; - continue; + status |= Fs_Dbm; + continue; #else - set_errortext(1045); - fail; -#endif /* DBM */ + set_errortext(1045); + fail; +#endif /* DBM */ - case 'm': - case 'M': + case 'm': + case 'M': #ifdef Messaging - status |= Fs_Messaging|Fs_Read|Fs_Write; - continue; + status |= Fs_Messaging|Fs_Read|Fs_Write; + continue; #else - set_errortext(1045); - fail; + set_errortext(1045); + fail; #endif /* Messaging */ - case 'n': - case 'N': + case 'n': + case 'N': #ifdef PosixFns - status |= Fs_Socket|Fs_Read|Fs_Write|Fs_Unbuf; - continue; + status |= Fs_Socket|Fs_Read|Fs_Write|Fs_Unbuf; + continue; -#else /* PosixFns */ - set_errortext(1045); - fail; -#endif /* PosixFns */ +#else /* PosixFns */ + set_errortext(1045); + fail; +#endif /* PosixFns */ - case 'o': - case 'O': + case 'o': + case 'O': #ifdef ISQL - status |= Fs_ODBC; - continue; - -#else /* ISQL */ - set_errortext(1045); - fail; -#endif /* ISQL */ - case 'v': - case 'V': + status |= Fs_ODBC; + continue; + +#else /* ISQL */ + set_errortext(1045); + fail; +#endif /* ISQL */ + case 'v': + case 'V': #ifdef Messaging - if (status & Fs_Messaging) { - status |= Fs_Verify; - continue; - } + if (status & Fs_Messaging) { + status |= Fs_Verify; + continue; + } #endif /* Messaging */ #ifdef HAVE_VOICE - status |= Fs_Voice; - continue; -#else /* HAVE_VOICE */ - set_errortext(1045); - fail; -#endif /* HAVE_VOICE */ + status |= Fs_Voice; + continue; +#else /* HAVE_VOICE */ + set_errortext(1045); + fail; +#endif /* HAVE_VOICE */ case 'z': - case 'Z': + case 'Z': -#if HAVE_LIBZ - status |= Fs_Compress; - continue; -#else /* HAVE_LIBZ */ - set_errortext(1045); - fail; -#endif /* HAVE_LIBZ */ +#if HAVE_LIBZ + status |= Fs_Compress; + continue; +#else /* HAVE_LIBZ */ + set_errortext(1045); + fail; +#endif /* HAVE_LIBZ */ - default: - runerr(209, spec); - } - } + default: + runerr(209, spec); + } + } /* * Construct a mode field for fopen/popen. @@ -606,22 +606,22 @@ Deliberate Syntax Error /* If we're opening a dbm database, the default is set further down to "rw" */ if (!(status & Fs_Dbm)) -#endif /* Dbm */ +#endif /* Dbm */ #ifdef ISQL /* If we're opening a sql database, modes are not used */ if (!(status & Fs_ODBC)) -#endif /* ISQL */ +#endif /* ISQL */ - if ((status & (Fs_Read|Fs_Write)) == 0) /* default: read only */ - status |= Fs_Read; + if ((status & (Fs_Read|Fs_Write)) == 0) /* default: read only */ + status |= Fs_Read; if (status & Fs_Create) - mode[0] = 'w'; + mode[0] = 'w'; else if (status & Fs_Append) - mode[0] = 'a'; + mode[0] = 'a'; else if (status & Fs_Read) - mode[0] = 'r'; + mode[0] = 'r'; else - mode[0] = 'w'; + mode[0] = 'w'; /* * The following code is operating-system dependent [@fsys.05]. Handle open @@ -630,30 +630,30 @@ Deliberate Syntax Error #if PORT if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) - mode[1] = '+'; + mode[1] = '+'; Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if UNIX || VMS if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) - mode[1] = '+'; -#endif /* UNIX || VMS */ + mode[1] = '+'; +#endif /* UNIX || VMS */ #if MSDOS if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) { - mode[1] = '+'; - mode[2] = ((status & Fs_Untrans) != 0) ? 'b' : 't'; - } + mode[1] = '+'; + mode[2] = ((status & Fs_Untrans) != 0) ? 'b' : 't'; + } else mode[1] = ((status & Fs_Untrans) != 0) ? 'b' : 't'; -#endif /* MSDOS */ +#endif /* MSDOS */ #if MVS || VM if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) { - mode[1] = '+'; - mode[2] = ((status & Fs_Untrans) != 0) ? 'b' : 0; - } + mode[1] = '+'; + mode[2] = ((status & Fs_Untrans) != 0) ? 'b' : 0; + } else mode[1] = ((status & Fs_Untrans) != 0) ? 'b' : 0; -#endif /* MVS || VM */ +#endif /* MVS || VM */ /* * End of operating-system specific code. @@ -666,145 +666,145 @@ Deliberate Syntax Error #ifdef Graphics if (status & Fs_Window) { - /* - * allocate an empty event queue for the window - */ - Protect(hp = alclist(0, MinListSlots), runerr(0)); - - /* - * loop through attributes, checking validity - */ - for (j = 0; j < n; j++) { - if (is:null(attr[j])) - attr[j] = emptystr; - if (!is:string(attr[j])) - runerr(109, attr[j]); - } + /* + * allocate an empty event queue for the window + */ + Protect(hp = alclist(0, MinListSlots), runerr(0)); + + /* + * loop through attributes, checking validity + */ + for (j = 0; j < n; j++) { + if (is:null(attr[j])) + attr[j] = emptystr; + if (!is:string(attr[j])) + runerr(109, attr[j]); + } #ifdef Graphics3D - if (status & Fs_Window3D) - f = gl_wopen(fnamestr, hp, attr, n, &err_index, 1); + if (status & Fs_Window3D) + f = gl_wopen(fnamestr, hp, attr, n, &err_index, 1); + else +#endif /* Graphics3D */ +#ifdef GraphicsGL + if (status & Fs_WinGL2D) + f = gl_wopen(fnamestr, hp, attr, n, &err_index, 0); else -#endif /* Graphics3D */ -#ifdef GraphicsGL - if (status & Fs_WinGL2D) - f = gl_wopen(fnamestr, hp, attr, n, &err_index, 0); - else -#endif /* GraphicsGL */ - f = wopen(fnamestr, hp, attr, n, &err_index, 0, 0); - if (f == NULL) { - if (err_index >= 0) runerr(145, attr[err_index]); - else if (err_index == -1) { - /* count on wopen() to set &errortext */ - fail; - } - else runerr(305); - } - } else -#endif /* Graphics */ +#endif /* GraphicsGL */ + f = wopen(fnamestr, hp, attr, n, &err_index, 0, 0); + if (f == NULL) { + if (err_index >= 0) runerr(145, attr[err_index]); + else if (err_index == -1) { + /* count on wopen() to set &errortext */ + fail; + } + else runerr(305); + } + } else +#endif /* Graphics */ #ifdef Messaging - if (status & Fs_Messaging) { + if (status & Fs_Messaging) { C_integer timeout = 0, timeout_set = 0; - extern int Merror; - if (do_verify != 0) - status |= Fs_Verify; - if (status & ~(Fs_Messaging|Fs_Read|Fs_Write|Fs_Untrans|Fs_Verify)) { - runerr(209, spec); - } - else { - URI *puri; - register int a; - - /* Check attributes (stolen from above) */ - for (a=0; astatus) { - case URI_OK: - break; - case URI_EMALFORMED: - runerr(1201, fname); - break; - case URI_ENOUSER: - runerr(1202, fname); - break; - case URI_EUNKNOWNSCHEME: - runerr(1203, fname); - break; - case URI_ECHECKERRNO: - default: + { + char *tmps; + if (cnv:C_string(attr[a], tmps)) { + fprintf(stderr, "header: %s\n", tmps); + fflush(stderr); + + } + } +#endif /* MDEBUG */ + } + + if (is_ipv4 && is_ipv6) + af_fam = AF_UNSPEC; + else if (is_ipv6) + af_fam = AF_INET6; + else if (is_ipv4) + af_fam = AF_INET; + else + af_fam = AF_UNSPEC; + + /* Try to parse the filename as a URL and set the protocol family */ + puri = uri_parse(fnamestr, af_fam); + switch (puri->status) { + case URI_OK: + break; + case URI_EMALFORMED: + runerr(1201, fname); + break; + case URI_ENOUSER: + runerr(1202, fname); + break; + case URI_EUNKNOWNSCHEME: + runerr(1203, fname); + break; + case URI_ECHECKERRNO: + default: #ifdef PosixFns - if (errno != 0) { - set_syserrortext(errno); - } + if (errno != 0) { + set_syserrortext(errno); + } #endif /* PosixFns */ - runerr(1204, fname); - } - - f = (FILE *)Mopen(puri, &attr[timeout_set], n-timeout_set, is_shortreq, status); - if (Merror > 1200) { - uri_free(puri); - runerr(Merror, fname); - } - uri_free(puri); - switch (Merror) { - case 0: - break; - case TP_ECONNECT: - set_errortext(1205); - fail; - case TP_EHOST: - set_errortext(1206); - fail; - case TP_ESERVER: - runerr(1212, fname); - break; - case TP_ETRUST: - set_errortext(1214); - fail; - case TP_EVERIFY: - set_errortext(1215); - fail; - case TP_EMEM: - case TP_EOPEN: - default: - runerr(1200, fname); - break; - } - } - } - else + runerr(1204, fname); + } + + f = (FILE *)Mopen(puri, &attr[timeout_set], n-timeout_set, is_shortreq, status); + if (Merror > 1200) { + uri_free(puri); + runerr(Merror, fname); + } + uri_free(puri); + switch (Merror) { + case 0: + break; + case TP_ECONNECT: + set_errortext(1205); + fail; + case TP_EHOST: + set_errortext(1206); + fail; + case TP_ESERVER: + runerr(1212, fname); + break; + case TP_ETRUST: + set_errortext(1214); + fail; + case TP_EVERIFY: + set_errortext(1215); + fail; + case TP_EMEM: + case TP_EOPEN: + default: + runerr(1200, fname); + break; + } + } + } + else #endif /* Messaging */ #ifdef ISQL @@ -813,132 +813,132 @@ Deliberate Syntax Error if (!is:string(attr[0])) runerr(103, attr[0]); if (!is:string(attr[1])) runerr(103, attr[1]); if (n >= 3) { - if (!is:string(attr[2])) runerr(103, attr[2]); - f = isql_open(fnamestr, attr, attr+1, attr+2); - } + if (!is:string(attr[2])) runerr(103, attr[2]); + f = isql_open(fnamestr, attr, attr+1, attr+2); + } else { /* n == 2, treat as omitting table; user, password required */ - f = isql_open(fnamestr, NULL, attr, attr+1); - } + f = isql_open(fnamestr, NULL, attr, attr+1); + } } else -#endif /* ISQL */ +#endif /* ISQL */ #ifdef HAVE_VOICE if (status & Fs_Voice) { /* check arguments, number and type */ /* attr[0] is a destination */ if (n > 0) { - tended char *tmps; - - if (is:null(attr[0])) - attr[0] = emptystr; - - if (!is:string(attr[0])) - runerr(109, attr[0]); - - if (cnv:C_string(attr[0], tmps)) - f = (FILE*) CreateVoiceSession(fnamestr,tmps); - else { - set_errortext(306); - fail; - } + tended char *tmps; + + if (is:null(attr[0])) + attr[0] = emptystr; + + if (!is:string(attr[0])) + runerr(109, attr[0]); + + if (cnv:C_string(attr[0], tmps)) + f = (FILE*) CreateVoiceSession(fnamestr,tmps); + else { + set_errortext(306); + fail; + } } else - f = (FILE*) CreateVoiceSession(fnamestr,NULL); + f = (FILE*) CreateVoiceSession(fnamestr,NULL); } else -#endif /* HAVE_VOICE */ +#endif /* HAVE_VOICE */ /* a bidirectional pipe can mean only one thing: pseudotty */ if (status == (Fs_Pipe | Fs_Read | Fs_Write)) { #ifdef PseudoPty - status = Fs_Pty | Fs_Read | Fs_Write; - f = (FILE*) ptopen(fnamestr); + status = Fs_Pty | Fs_Read | Fs_Write; + f = (FILE*) ptopen(fnamestr); #else - set_errortext(1045); - fail; + set_errortext(1045); + fail; #endif - } + } else #if UNIX || VMS || NT if (status & Fs_Pipe) { - tended char *sbuf, *sbuf2, *my_s = NULL; - int c, fnamestrlen = strlen(fnamestr); - if ((status != (Fs_Read|Fs_Pipe)) && (status != (Fs_Write|Fs_Pipe))) - runerr(209, spec); - /* - * fnamestr is a program command line. Extract its first - * argument (the command) and expand that with a path search. - * FIXME: Windows and DOS, etc. should check current dir (.) FIRST. - */ - Protect(reserve(Strings, (fnamestrlen<<1)+PATH_MAX+2), runerr(0)); - sbuf = alcstr(fnamestr, fnamestrlen+1); - sbuf[fnamestrlen] = '\0'; - /* what if it was a tab, instead of a space character? */ - if ((my_s = strchr(sbuf, ' ')) != NULL) *my_s = '\0'; - if (!strchr(sbuf,'\\') && !strchr(sbuf, '/')) { - sbuf2 = alcstr(NULL, PATH_MAX+fnamestrlen+3); - if (findonpath(sbuf, sbuf2, PATH_MAX) == NULL) { - set_errortext(1050); - fail; - } - fnamestr = sbuf2; + tended char *sbuf, *sbuf2, *my_s = NULL; + int c, fnamestrlen = strlen(fnamestr); + if ((status != (Fs_Read|Fs_Pipe)) && (status != (Fs_Write|Fs_Pipe))) + runerr(209, spec); + /* + * fnamestr is a program command line. Extract its first + * argument (the command) and expand that with a path search. + * FIXME: Windows and DOS, etc. should check current dir (.) FIRST. + */ + Protect(reserve(Strings, (fnamestrlen<<1)+PATH_MAX+2), runerr(0)); + sbuf = alcstr(fnamestr, fnamestrlen+1); + sbuf[fnamestrlen] = '\0'; + /* what if it was a tab, instead of a space character? */ + if ((my_s = strchr(sbuf, ' ')) != NULL) *my_s = '\0'; + if (!strchr(sbuf,'\\') && !strchr(sbuf, '/')) { + sbuf2 = alcstr(NULL, PATH_MAX+fnamestrlen+3); + if (findonpath(sbuf, sbuf2, PATH_MAX) == NULL) { + set_errortext(1050); + fail; + } + fnamestr = sbuf2; #if NT /* - * if the path search came up with a space in the command name, - * double quote the command. Maybe relevant for Macs, etc. - */ - if (strchr(fnamestr, ' ')) { - char *q = strdup(fnamestr); - strcpy(fnamestr, "\""); - strcat(fnamestr, q); - strcat(fnamestr, "\""); - free(q); - } -#endif /* NT */ - if (my_s) { - strcat(fnamestr, " "); - strcat(fnamestr, my_s+1); - } - } - - f = popen(fnamestr, mode); + * if the path search came up with a space in the command name, + * double quote the command. Maybe relevant for Macs, etc. + */ + if (strchr(fnamestr, ' ')) { + char *q = strdup(fnamestr); + strcpy(fnamestr, "\""); + strcat(fnamestr, q); + strcat(fnamestr, "\""); + free(q); + } +#endif /* NT */ + if (my_s) { + strcat(fnamestr, " "); + strcat(fnamestr, my_s+1); + } + } + + f = popen(fnamestr, mode); if (NULL == f) {set_errortext(1052); fail;} - if (!strcmp(mode,"r")) { - /* Try to read a byte. If we can't, treat it as "empty pipe" or "bad command" */ + if (!strcmp(mode,"r")) { + /* Try to read a byte. If we can't, treat it as "empty pipe" or "bad command" */ - if ((c = getc(f)) == EOF) { + if ((c = getc(f)) == EOF) { if (0 == pclose(f)) {set_errortext(1053);} else {set_errortext(1050);} fail; } - else - ungetc(c, f); - } - } + else + ungetc(c, f); + } + } else -#endif /* UNIX || ... */ +#endif /* UNIX || ... */ #ifdef Dbm if (status & Fs_Dbm) { - int mode; - if ((status & Fs_Read && status & Fs_Write) || status == Fs_Dbm) { - mode = O_RDWR|O_CREAT; - status |= Fs_Read|Fs_Write; - } - else if (status & Fs_Write) { - mode = O_WRONLY|O_CREAT; - } - else - mode = O_RDONLY; - - if ((f = (FILE *)dbm_open(fnamestr, mode, 0666)) == NULL) { - set_errortext(191); - fail; - } + int mode; + if ((status & Fs_Read && status & Fs_Write) || status == Fs_Dbm) { + mode = O_RDWR|O_CREAT; + status |= Fs_Read|Fs_Write; + } + else if (status & Fs_Write) { + mode = O_WRONLY|O_CREAT; + } + else + mode = O_RDONLY; + + if ((f = (FILE *)dbm_open(fnamestr, mode, 0666)) == NULL) { + set_errortext(191); + fail; + } } else -#endif /* DBM */ +#endif /* DBM */ #if HAVE_LIBZ if (status & Fs_Compress) { @@ -946,292 +946,292 @@ Deliberate Syntax Error f = (FILE *)gzopen(fnamestr, mode); } else -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #ifdef PosixFns { #if HAVE_LIBSSL - SSL *ssl; -#endif /* HAVE_LIBSSL */ - if (status & Fs_Socket) { - if (is_ipv4 && is_ipv6) - af_fam = AF_UNSPEC; - else if (is_ipv6) - af_fam = AF_INET6; - else if (is_ipv4) - af_fam = AF_INET; - else - af_fam = AF_UNSPEC; - - /* The only allowed values for flags are "n" and "na" */ - if (status & ~(Fs_Read|Fs_Write|Fs_Socket|Fs_Append|Fs_Unbuf|Fs_Listen + SSL *ssl; +#endif /* HAVE_LIBSSL */ + if (status & Fs_Socket) { + if (is_ipv4 && is_ipv6) + af_fam = AF_UNSPEC; + else if (is_ipv6) + af_fam = AF_INET6; + else if (is_ipv4) + af_fam = AF_INET; + else + af_fam = AF_UNSPEC; + + /* The only allowed values for flags are "n" and "na" */ + if (status & ~(Fs_Read|Fs_Write|Fs_Socket|Fs_Append|Fs_Unbuf|Fs_Listen #if HAVE_LIBSSL - |Fs_Encrypt -#endif /* HAVE_LIBSSL */ + |Fs_Encrypt +#endif /* HAVE_LIBSSL */ )) - runerr(209, spec); - if (status & Fs_Append) { + runerr(209, spec); + if (status & Fs_Append) { #if HAVE_LIBSSL - SSL_CTX *ctx; - if(status & Fs_Encrypt) { - ctx = create_ssl_context(attr, n, TLS_SERVER); - if (ctx == NULL) { - // errortext is already set - fail; - } - } -#endif /* HAVE_LIBSSL */ - - /* "na" => listen for connections */ - DEC_NARTHREADS; - fd = sock_listen(fnamestr, is_udp_or_listener, af_fam); - INC_NARTHREADS_CONTROLLED; + SSL_CTX *ctx; + if(status & Fs_Encrypt) { + ctx = create_ssl_context(attr, n, TLS_SERVER); + if (ctx == NULL) { + // errortext is already set + fail; + } + } +#endif /* HAVE_LIBSSL */ + + /* "na" => listen for connections */ + DEC_NARTHREADS; + fd = sock_listen(fnamestr, is_udp_or_listener, af_fam); + INC_NARTHREADS_CONTROLLED; #if HAVE_LIBSSL - if(fd > 0 && status & Fs_Encrypt) { - int err; - ssl = SSL_new(ctx); - if (ssl == NULL) { - set_ssl_context_errortext(0, NULL); - close(fd); - SSL_CTX_free(ctx); - fail; - } - SSL_set_fd(ssl, fd); - DEC_NARTHREADS; - err = SSL_accept(ssl); - INC_NARTHREADS_CONTROLLED; - - /*Check for error in accept.*/ - if (err<1) { - set_ssl_connection_errortext(ssl, err); - close(fd); - SSL_free(ssl); - SSL_CTX_free(ctx); - fail; - } - - } -#endif /* HAVE_LIBSSL */ - } - else { - C_integer timeout = 0; + if(fd > 0 && status & Fs_Encrypt) { + int err; + ssl = SSL_new(ctx); + if (ssl == NULL) { + set_ssl_context_errortext(0, NULL); + close(fd); + SSL_CTX_free(ctx); + fail; + } + SSL_set_fd(ssl, fd); + DEC_NARTHREADS; + err = SSL_accept(ssl); + INC_NARTHREADS_CONTROLLED; + + /*Check for error in accept.*/ + if (err<1) { + set_ssl_connection_errortext(ssl, err); + close(fd); + SSL_free(ssl); + SSL_CTX_free(ctx); + fail; + } + + } +#endif /* HAVE_LIBSSL */ + } + else { + C_integer timeout = 0; #if HAVE_LIBSSL - SSL_CTX *ctx; - if(status & Fs_Encrypt) { - ctx = create_ssl_context(attr, n, TLS_CLIENT); - if (ctx == NULL) { - // errortext is already set - fail; - } - } -#endif /* HAVE_LIBSSL */ + SSL_CTX *ctx; + if(status & Fs_Encrypt) { + ctx = create_ssl_context(attr, n, TLS_CLIENT); + if (ctx == NULL) { + // errortext is already set + fail; + } + } +#endif /* HAVE_LIBSSL */ #if defined(Graphics) || defined(Messaging) || defined(ISQL) - if (n > 0 && !is:null(attr[0])) { + if (n > 0 && !is:null(attr[0])) { if (!cnv:C_integer(attr[0], timeout)) runerr(101, attr[0]); } -#endif /* Graphics || Messaging || ISQL */ - /* connect to a port */ - DEC_NARTHREADS; - fd = sock_connect(fnamestr, is_udp_or_listener == 1, timeout, af_fam); - INC_NARTHREADS_CONTROLLED; +#endif /* Graphics || Messaging || ISQL */ + /* connect to a port */ + DEC_NARTHREADS; + fd = sock_connect(fnamestr, is_udp_or_listener == 1, timeout, af_fam); + INC_NARTHREADS_CONTROLLED; #if HAVE_LIBSSL - if(fd > 0 && status & Fs_Encrypt){ - int err; - ssl = SSL_new(ctx); - if (ssl == NULL) { - set_ssl_context_errortext(0, NULL); - close(fd); - SSL_CTX_free(ctx); - fail; - } - SSL_set_fd(ssl, fd); - err = SSL_connect(ssl); - - /*Check for error in connect.*/ - if (err<1) { - set_ssl_connection_errortext(ssl, err); - close(fd); - SSL_free(ssl); - SSL_CTX_free(ctx); - fail; - } - } -#endif /* HAVE_LIBSSL */ - - - } - /* - * read/reads is not allowed on a listener socket, only select - * read/reads is not allowed on a UDP socket, only receive - */ - if (is_udp_or_listener == 2) - status |= Fs_Socket | Fs_Listen; - else if (is_udp_or_listener == 1) - status |= Fs_Socket | Fs_Write; - else - status |= Fs_Socket | Fs_Read | Fs_Write; - - if (!fd) { - set_syserrortext(errno); - fail; - } - - /* - * Although filename is a unicon value, it is used by - * image, which in the case of a socket means sock_name, which - * assumes it is a C string. Preserve its C string-ness. - */ - StrLen(filename) = strlen(fnamestr)+1; - StrLoc(filename) = fnamestr; - Protect(fl = alcfile(0, status, &filename), runerr(0)); + if(fd > 0 && status & Fs_Encrypt){ + int err; + ssl = SSL_new(ctx); + if (ssl == NULL) { + set_ssl_context_errortext(0, NULL); + close(fd); + SSL_CTX_free(ctx); + fail; + } + SSL_set_fd(ssl, fd); + err = SSL_connect(ssl); + + /*Check for error in connect.*/ + if (err<1) { + set_ssl_connection_errortext(ssl, err); + close(fd); + SSL_free(ssl); + SSL_CTX_free(ctx); + fail; + } + } +#endif /* HAVE_LIBSSL */ + + + } + /* + * read/reads is not allowed on a listener socket, only select + * read/reads is not allowed on a UDP socket, only receive + */ + if (is_udp_or_listener == 2) + status |= Fs_Socket | Fs_Listen; + else if (is_udp_or_listener == 1) + status |= Fs_Socket | Fs_Write; + else + status |= Fs_Socket | Fs_Read | Fs_Write; + + if (!fd) { + set_syserrortext(errno); + fail; + } + + /* + * Although filename is a unicon value, it is used by + * image, which in the case of a socket means sock_name, which + * assumes it is a C string. Preserve its C string-ness. + */ + StrLen(filename) = strlen(fnamestr)+1; + StrLoc(filename) = fnamestr; + Protect(fl = alcfile(0, status, &filename), runerr(0)); #if HAVE_LIBSSL - if (status & Fs_Encrypt) - fl->fd.ssl = ssl; - else -#endif /* HAVE_LIBSSL */ - fl->fd.fd = fd; + if (status & Fs_Encrypt) + fl->fd.ssl = ssl; + else +#endif /* HAVE_LIBSSL */ + fl->fd.fd = fd; - return file(fl); - } - else if (stat(fnamestr, &st) < 0) { - /* stat reported an error; file does not exist */ + return file(fl); + } + else if (stat(fnamestr, &st) < 0) { + /* stat reported an error; file does not exist */ if (strchr(fnamestr, '*') || strchr(fnamestr, '?')) { - char tempbuf[1024]; + char tempbuf[1024]; #if UNIX - /* - * attempted to open a wildcard. used to use ls(1) output. - * Now using shell for-loop and echo in order to avoid bad - * answers when no match is found. - */ - sprintf(tempbuf, "for i in %s; do if [ \"$i\" != \"%s\" ]; then echo \"$i\"; fi; done", fnamestr, fnamestr); - status |= Fs_Pipe; - f = popen(tempbuf, "r"); -#endif /* UNIX */ + /* + * attempted to open a wildcard. used to use ls(1) output. + * Now using shell for-loop and echo in order to avoid bad + * answers when no match is found. + */ + sprintf(tempbuf, "for i in %s; do if [ \"$i\" != \"%s\" ]; then echo \"$i\"; fi; done", fnamestr, fnamestr); + status |= Fs_Pipe; + f = popen(tempbuf, "r"); +#endif /* UNIX */ #if NT - /* - * attempted to open a wildcard, do file completion - */ - strcpy(tempbuf, fnamestr); - if (*tempbuf) { - struct b_cons *flnk; - FINDDATA_T fd; - if (!FINDFIRST(tempbuf, &fd)) { - set_errortext(218); - fail; - } - if ((f = mstmpfile()) == NULL) { - set_errortext(1051); - fail; - } - do { - fprintf(f, "%s\n", FILENAME(&fd)); - } while (FINDNEXT(&fd)); - FINDCLOSE(&fd); - fflush(f); - fseek(f, 0, SEEK_SET); - /* - * yet another special case: the tmpfile must be linked - * in to a list in order to be closed/deleted. - */ - StrLen(filename) = strlen(fnamestr); - StrLoc(filename) = fnamestr; - Protect(fl = alcfile(f, status, &filename), runerr(0)); - Protect(flnk = alccons((union block *)fl), runerr(0)); - flnk->next = (union block *)LstTmpFiles; - LstTmpFiles = flnk; - return file(fl); - } -#endif /* NT */ - /* - * Return the resulting file value. Duplicate of code below, - * because rtt does not support goto statements. - */ - if (f == NULL) { - set_syserrortext(errno); - fail; - } - StrLen(filename) = strlen(fnamestr); - StrLoc(filename) = fnamestr; - Protect(fl = alcfile(f, status, &filename), runerr(0)); + /* + * attempted to open a wildcard, do file completion + */ + strcpy(tempbuf, fnamestr); + if (*tempbuf) { + struct b_cons *flnk; + FINDDATA_T fd; + if (!FINDFIRST(tempbuf, &fd)) { + set_errortext(218); + fail; + } + if ((f = mstmpfile()) == NULL) { + set_errortext(1051); + fail; + } + do { + fprintf(f, "%s\n", FILENAME(&fd)); + } while (FINDNEXT(&fd)); + FINDCLOSE(&fd); + fflush(f); + fseek(f, 0, SEEK_SET); + /* + * yet another special case: the tmpfile must be linked + * in to a list in order to be closed/deleted. + */ + StrLen(filename) = strlen(fnamestr); + StrLoc(filename) = fnamestr; + Protect(fl = alcfile(f, status, &filename), runerr(0)); + Protect(flnk = alccons((union block *)fl), runerr(0)); + flnk->next = (union block *)LstTmpFiles; + LstTmpFiles = flnk; + return file(fl); + } +#endif /* NT */ + /* + * Return the resulting file value. Duplicate of code below, + * because rtt does not support goto statements. + */ + if (f == NULL) { + set_syserrortext(errno); + fail; + } + StrLen(filename) = strlen(fnamestr); + StrLoc(filename) = fnamestr; + Protect(fl = alcfile(f, status, &filename), runerr(0)); #ifdef Graphics - /* - * link in the Icon file value so this window can find it - */ - if (status & Fs_Window) { - linkfiletowindow((wbp)f, fl); - } -#endif /* Graphics */ - return file(fl); - } - else - if (errno == ENOENT && (status & Fs_Read)) { - set_syserrortext(errno); - fail; - } - else { - f = fopen(fnamestr, mode); - } - } - else { - /* - * check and see if the file was actually a directory - */ - if (S_ISDIR(st.st_mode)) { - if (status & Fs_Write) - runerr(173, fname); - else { + /* + * link in the Icon file value so this window can find it + */ + if (status & Fs_Window) { + linkfiletowindow((wbp)f, fl); + } +#endif /* Graphics */ + return file(fl); + } + else + if (errno == ENOENT && (status & Fs_Read)) { + set_syserrortext(errno); + fail; + } + else { + f = fopen(fnamestr, mode); + } + } + else { + /* + * check and see if the file was actually a directory + */ + if (S_ISDIR(st.st_mode)) { + if (status & Fs_Write) + runerr(173, fname); + else { #if !NT || defined(NTGCC) - f = (FILE *)opendir(fnamestr); - status |= Fs_Directory; -#else /* !NT */ - char tempbuf[512]; - strcpy(tempbuf, fnamestr); - if (tempbuf[strlen(tempbuf)-1] != '\\') - strcat(tempbuf, "\\"); - strcat(tempbuf, "*.*"); - if (*tempbuf) { - FINDDATA_T fd; - if (!FINDFIRST(tempbuf, &fd)) { - set_errortext(218); - fail; - } - if ((f = mstmpfile()) == NULL) { - set_errortext(1051); - fail; - } - do { - fprintf(f, "%s\n", FILENAME(&fd)); - } - while (FINDNEXT(&fd)); - FINDCLOSE(&fd); - fflush(f); - fseek(f, 0, SEEK_SET); - } -#endif /* NT */ - } - } - else { - f = fopen(fnamestr, mode); - } - } - } -#else /* PosixFns */ - f = fopen(fnamestr, mode); -#endif /* PosixFns */ + f = (FILE *)opendir(fnamestr); + status |= Fs_Directory; +#else /* !NT */ + char tempbuf[512]; + strcpy(tempbuf, fnamestr); + if (tempbuf[strlen(tempbuf)-1] != '\\') + strcat(tempbuf, "\\"); + strcat(tempbuf, "*.*"); + if (*tempbuf) { + FINDDATA_T fd; + if (!FINDFIRST(tempbuf, &fd)) { + set_errortext(218); + fail; + } + if ((f = mstmpfile()) == NULL) { + set_errortext(1051); + fail; + } + do { + fprintf(f, "%s\n", FILENAME(&fd)); + } + while (FINDNEXT(&fd)); + FINDCLOSE(&fd); + fflush(f); + fseek(f, 0, SEEK_SET); + } +#endif /* NT */ + } + } + else { + f = fopen(fnamestr, mode); + } + } + } +#else /* PosixFns */ + f = fopen(fnamestr, mode); +#endif /* PosixFns */ /* * Fail if the file cannot be opened. */ if (f == NULL) { - set_syserrortext(errno); - fail; - } + set_syserrortext(errno); + fail; + } /* * Return the resulting file value. @@ -1246,13 +1246,13 @@ Deliberate Syntax Error * link in the Icon file value so this window can find it */ if (status & Fs_Window) { - linkfiletowindow((wbp)f, fl); - } -#endif /* Graphics */ + linkfiletowindow((wbp)f, fl); + } +#endif /* Graphics */ return file(fl); } end - + "read(f) - read line on file f." function{0,1} read(f) @@ -1261,9 +1261,9 @@ function{0,1} read(f) */ if is:null(f) then inline { - f.dword = D_File; - BlkLoc(f) = (union block *)&k_input; - } + f.dword = D_File; + BlkLoc(f) = (union block *)&k_input; + } else if !is:file(f) then runerr(105, f) @@ -1288,8 +1288,8 @@ function{0,1} read(f) status = BlkLoc(f)->File.status; if ((status & Fs_Read) == 0) { if (status & Fs_Pipe) fail; - runerr(212, f); - } + runerr(212, f); + } /* * Should probably move these cases into getstrg() in rsys.r, where @@ -1298,69 +1298,69 @@ function{0,1} read(f) #ifdef PosixFns if (status & Fs_Socket) { - StrLen(s) = 0; + StrLen(s) = 0; do { - DEC_NARTHREADS; - if ((slen = sock_getstrg(sbuf, MaxReadStr, &f)) == -1) { - /* EOF is no error */ - INC_NARTHREADS_CONTROLLED; - fail; - } - INC_NARTHREADS_CONTROLLED; - if (slen == -3) { - /* sock_getstrg sets errornumber/text */ - fail; - } - if (slen == 1 && *sbuf == '\n') - break; - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, rlen), runerr(0)); - if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) { - Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); - Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0)); - } - - Protect(sptr = alcstr(sbuf,rlen), runerr(0)); - if (StrLen(s) == 0) - StrLoc(s) = sptr; - StrLen(s) += rlen; - if (StrLoc(s) [ StrLen(s) - 1 ] == '\n') { StrLen(s)--; break; } - else { - /* no newline to trim; EOF? */ - } - } - while (slen > 0); + DEC_NARTHREADS; + if ((slen = sock_getstrg(sbuf, MaxReadStr, &f)) == -1) { + /* EOF is no error */ + INC_NARTHREADS_CONTROLLED; + fail; + } + INC_NARTHREADS_CONTROLLED; + if (slen == -3) { + /* sock_getstrg sets errornumber/text */ + fail; + } + if (slen == 1 && *sbuf == '\n') + break; + rlen = slen < 0 ? (word)MaxReadStr : slen; + + Protect(reserve(Strings, rlen), runerr(0)); + if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) { + Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); + Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0)); + } + + Protect(sptr = alcstr(sbuf,rlen), runerr(0)); + if (StrLen(s) == 0) + StrLoc(s) = sptr; + StrLen(s) += rlen; + if (StrLoc(s) [ StrLen(s) - 1 ] == '\n') { StrLen(s)--; break; } + else { + /* no newline to trim; EOF? */ + } + } + while (slen > 0); return s; - } + } /* * well.... switching from unbuffered to buffered actually works so * we will allow it except for sockets. */ if ((status & Fs_Unbuf) && (!(status & Fs_Messaging))) { - if (status & Fs_Socket) - runerr(1048, f); - status &= ~Fs_Unbuf; + if (status & Fs_Socket) + runerr(1048, f); + status &= ~Fs_Unbuf; #ifdef Graphics - /* windows never turn on buffering */ - if (! (status & Fs_Window)) -#endif /* Graphics */ - status |= Fs_Buff; - BlkLoc(f)->File.status = status; - } -#endif /* PosixFns */ + /* windows never turn on buffering */ + if (! (status & Fs_Window)) +#endif /* Graphics */ + status |= Fs_Buff; + BlkLoc(f)->File.status = status; + } +#endif /* PosixFns */ /* add more restriction on non-seekable entities. */ if ((status & Fs_Writing) && !(status & Fs_BPipe)) { - if (fseek(fp, 0L, SEEK_CUR) != 0) { - /* errors, e.g. EBADF not-seekable */ - set_syserrortext(errno); - fail; - } - BlkLoc(f)->File.status &= ~Fs_Writing; - } + if (fseek(fp, 0L, SEEK_CUR) != 0) { + /* errors, e.g. EBADF not-seekable */ + set_syserrortext(errno); + fail; + } + BlkLoc(f)->File.status &= ~Fs_Writing; + } BlkLoc(f)->File.status |= Fs_Reading; #ifdef ConsoleWindow @@ -1375,7 +1375,7 @@ function{0,1} read(f) status = Fs_Window | Fs_Read | Fs_Write; } -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ /* * Use getstrg to read a line from the file, failing if getstrg * encounters end of file. [[ What about -2?]] @@ -1385,136 +1385,136 @@ function{0,1} read(f) do { #ifdef Graphics - pollctr >>= 1; - pollctr++; - if (status & Fs_Window) { - DEC_NARTHREADS; - slen = wgetstrg(sbuf,MaxReadStr,fp); - INC_NARTHREADS_CONTROLLED; - if (slen == -1) - runerr(141); - else if (slen == -2) - runerr(143); - else if (slen == -3) /* EOF */ + pollctr >>= 1; + pollctr++; + if (status & Fs_Window) { + DEC_NARTHREADS; + slen = wgetstrg(sbuf,MaxReadStr,fp); + INC_NARTHREADS_CONTROLLED; + if (slen == -1) + runerr(141); + else if (slen == -2) + runerr(143); + else if (slen == -3) /* EOF */ fail; - } - else -#endif /* Graphics */ + } + else +#endif /* Graphics */ #ifdef PosixFns #if !NT || defined(NTGCC) - if (status & Fs_Directory) { - struct dirent *d; - char *s, *p=sbuf; - IntVal(amperErrno) = 0; - slen = 0; - DEC_NARTHREADS; - d = readdir((DIR *)fp); - INC_NARTHREADS_CONTROLLED; - if (!d) { - set_syserrortext(errno); - fail; - } - s = d->d_name; - while(*s && slen++ < MaxReadStr) - *p++ = *s++; - if (slen == MaxReadStr) - slen = -2; - } - else + if (status & Fs_Directory) { + struct dirent *d; + char *s, *p=sbuf; + IntVal(amperErrno) = 0; + slen = 0; + DEC_NARTHREADS; + d = readdir((DIR *)fp); + INC_NARTHREADS_CONTROLLED; + if (!d) { + set_syserrortext(errno); + fail; + } + s = d->d_name; + while(*s && slen++ < MaxReadStr) + *p++ = *s++; + if (slen == MaxReadStr) + slen = -2; + } + else #endif -#endif /* PosixFns */ +#endif /* PosixFns */ #if HAVE_LIBZ /* - * Read a line from a compressed file - */ - if (status & Fs_Compress) { - + * Read a line from a compressed file + */ + if (status & Fs_Compress) { + if (gzeof(fp)) fail; - DEC_NARTHREADS; + DEC_NARTHREADS; if (gzgets((gzFile)fp,sbuf,MaxReadStr+1) == Z_NULL) { - INC_NARTHREADS_CONTROLLED; - runerr(214); + INC_NARTHREADS_CONTROLLED; + runerr(214); } - INC_NARTHREADS_CONTROLLED; - slen = strlen(sbuf); + INC_NARTHREADS_CONTROLLED; + slen = strlen(sbuf); if (slen==MaxReadStr && sbuf[slen-1]!='\n') slen = -2; - else if (sbuf[slen-1] == '\n') { + else if (sbuf[slen-1] == '\n') { sbuf[slen-1] = '\0'; slen--; } - - } - - else -#endif /* HAVE_LIBZ */ + + } + + else +#endif /* HAVE_LIBZ */ #ifdef PseudoPty - if (status & Fs_Pty) { -/* struct timeval timeout; - timeout.tv_sec = 1L; - timeout.tv_usec = 0L; */ - DEC_NARTHREADS; - if ((slen = ptgetstr(sbuf, MaxReadStr, (struct ptstruct *)fp, 0)) - == -1){ - INC_NARTHREADS_CONTROLLED; - set_errortext(214); - fail; - } - INC_NARTHREADS_CONTROLLED; - } - else -#endif /* PseudoPty */ - - if ((slen = getstrg(sbuf, MaxReadStr, BlkD(f,File))) == -1) { + if (status & Fs_Pty) { +/* struct timeval timeout; + timeout.tv_sec = 1L; + timeout.tv_usec = 0L; */ + DEC_NARTHREADS; + if ((slen = ptgetstr(sbuf, MaxReadStr, (struct ptstruct *)fp, 0)) + == -1){ + INC_NARTHREADS_CONTROLLED; + set_errortext(214); + fail; + } + INC_NARTHREADS_CONTROLLED; + } + else +#endif /* PseudoPty */ + + if ((slen = getstrg(sbuf, MaxReadStr, BlkD(f,File))) == -1) { #ifdef PosixFns - set_syserrortext(errno); -#endif /* PosixFns */ - fail; - } - - /* - * Allocate the string read and make s a descriptor for it. - */ - if ((status & Fs_Messaging) && (slen == -2)) rlen = MaxReadStr-1; - else - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, rlen), runerr(0)); - /* - * If extending our read string bumped us into a new heap... - */ - if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) { - /* - * Copy the prefix into the new heap, followed by the new part. - * Start by reserving enough space for the whole thing. - */ - Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); - /* - * recast this as a single call to alcstr(NULL, StrLen(s)+rlen) - * followed by two copies. - */ - { int i, j; - sptr = alcstr(NULL, StrLen(s)+rlen); - for(i=0; i 0 && !InRange(strbase,StrLoc(s),strfree)) { + /* + * Copy the prefix into the new heap, followed by the new part. + * Start by reserving enough space for the whole thing. + */ + Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); + /* + * recast this as a single call to alcstr(NULL, StrLen(s)+rlen) + * followed by two copies. + */ + { int i, j; + sptr = alcstr(NULL, StrLen(s)+rlen); + for(i=0; i7) #passthru #define stat _stat64i32 #passthru #endif -#endif /* NTGCC && WordBits==32*/ +#endif /* NTGCC && WordBits==32*/ struct stat statbuf; /* @@ -1563,140 +1563,140 @@ function{0,1} reads(f,i) */ status = BlkD(f,File)->status; if ((status & Fs_Read) == 0) - runerr(212, f); + runerr(212, f); #ifdef Messaging if (status & Fs_Messaging) { - struct MFile *mf = BlkLoc(f)->File.fd.mf; - /* Casting to unsigned lets us use reads(f, -1) */ - - Maxread = (unsigned)i <= MaxReadStr ? i : MaxReadStr; - - StrLoc(s) = NULL; - StrLen(s) = 0; - if (!MFIN(mf, READING)) { - Mstartreading(mf); - } - nbytes = 0; - do { - if (bytesread > 0) { - if (i>=0 && i - bytesread <= MaxReadStr) - Maxread = i - bytesread; - else - Maxread = MaxReadStr; - } - DEC_NARTHREADS; - slen = tp_read(mf->tp, sbuf, Maxread); - INC_NARTHREADS_CONTROLLED; - - if (slen <= 0) { - extern int Merror; - if (Merror >= 1200) { - runerr(Merror, f); - } - if (bytesread == 0) - fail; - else return s; - } - bytesread += slen; - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); - if (StrLen(s) > 0 && !InRange(strbase, StrLoc(s), strfree)) { - Protect((StrLoc(s) = + struct MFile *mf = BlkLoc(f)->File.fd.mf; + /* Casting to unsigned lets us use reads(f, -1) */ + + Maxread = (unsigned)i <= MaxReadStr ? i : MaxReadStr; + + StrLoc(s) = NULL; + StrLen(s) = 0; + if (!MFIN(mf, READING)) { + Mstartreading(mf); + } + nbytes = 0; + do { + if (bytesread > 0) { + if (i>=0 && i - bytesread <= MaxReadStr) + Maxread = i - bytesread; + else + Maxread = MaxReadStr; + } + DEC_NARTHREADS; + slen = tp_read(mf->tp, sbuf, Maxread); + INC_NARTHREADS_CONTROLLED; + + if (slen <= 0) { + extern int Merror; + if (Merror >= 1200) { + runerr(Merror, f); + } + if (bytesread == 0) + fail; + else return s; + } + bytesread += slen; + rlen = slen < 0 ? (word)MaxReadStr : slen; + + Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); + if (StrLen(s) > 0 && !InRange(strbase, StrLoc(s), strfree)) { + Protect((StrLoc(s) = alcstr(StrLoc(s), StrLen(s))), runerr(0)); - } + } - Protect(sptr = alcstr(sbuf, rlen), runerr(0)); - if (StrLen(s) == 0) - StrLoc(s) = sptr; - StrLen(s) += rlen; + Protect(sptr = alcstr(sbuf, rlen), runerr(0)); + if (StrLen(s) == 0) + StrLoc(s) = sptr; + StrLen(s) += rlen; - } while ((i == -1) || (bytesread < i)); + } while ((i == -1) || (bytesread < i)); - return s; - } + return s; + } else #endif /* Messaging */ #ifdef PseudoPty if (status & Fs_Pty) { - struct ptstruct *p = (struct ptstruct *)BlkLoc(f)->File.fd.fp; - tended char *s = alcstr(NULL, i); - DEC_NARTHREADS; - if ((slen = ptlongread(s, i, p)) == -1) { - INC_NARTHREADS_CONTROLLED; - set_errortext(214); - fail; - } - INC_NARTHREADS_CONTROLLED; - return string(slen, s); - } + struct ptstruct *p = (struct ptstruct *)BlkLoc(f)->File.fd.fp; + tended char *s = alcstr(NULL, i); + DEC_NARTHREADS; + if ((slen = ptlongread(s, i, p)) == -1) { + INC_NARTHREADS_CONTROLLED; + set_errortext(214); + fail; + } + INC_NARTHREADS_CONTROLLED; + return string(slen, s); + } else #endif /* PseudoPty */ #ifdef PosixFns if (status & Fs_Socket) { - StrLen(s) = 0; - Maxread = (i <= MaxReadStr)? i : MaxReadStr; - do { - if (bytesread > 0) { - if (i - bytesread <= MaxReadStr) - Maxread = i - bytesread; - else - Maxread = MaxReadStr; - } - DEC_NARTHREADS; - if ((slen = sock_getstrg(sbuf, Maxread, &f)) == -1) { - /*IntVal(amperErrno) = errno; */ - INC_NARTHREADS_CONTROLLED; - if (bytesread == 0) - fail; - else - return s; - } - INC_NARTHREADS_CONTROLLED; - if (slen == -3) { - /* sock_getstrg sets errortext */ - fail; - } - - if (slen > 0) - bytesread += slen; - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); - if (StrLen(s) > 0 && !InRange(strbase, StrLoc(s), strfree)) { - Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); - Protect((StrLoc(s) = + StrLen(s) = 0; + Maxread = (i <= MaxReadStr)? i : MaxReadStr; + do { + if (bytesread > 0) { + if (i - bytesread <= MaxReadStr) + Maxread = i - bytesread; + else + Maxread = MaxReadStr; + } + DEC_NARTHREADS; + if ((slen = sock_getstrg(sbuf, Maxread, &f)) == -1) { + /*IntVal(amperErrno) = errno; */ + INC_NARTHREADS_CONTROLLED; + if (bytesread == 0) + fail; + else + return s; + } + INC_NARTHREADS_CONTROLLED; + if (slen == -3) { + /* sock_getstrg sets errortext */ + fail; + } + + if (slen > 0) + bytesread += slen; + rlen = slen < 0 ? (word)MaxReadStr : slen; + + Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); + if (StrLen(s) > 0 && !InRange(strbase, StrLoc(s), strfree)) { + Protect(reserve(Strings, StrLen(s) + rlen), runerr(0)); + Protect((StrLoc(s) = alcstr(StrLoc(s), StrLen(s))), runerr(0)); - } - - Protect(sptr = alcstr(sbuf, rlen), runerr(0)); - if (StrLen(s) == 0) - StrLoc(s) = sptr; - StrLen(s) += rlen; - } while ((i == -1) || (bytesread < i)); - return s; - } + } + + Protect(sptr = alcstr(sbuf, rlen), runerr(0)); + if (StrLen(s) == 0) + StrLoc(s) = sptr; + StrLen(s) += rlen; + } while ((i == -1) || (bytesread < i)); + return s; + } /* FIXME: This is a hack to fix things for the release. The solution to be - * implemented after release: all I/O is low-level, no stdio. This - * makes the Fs_Buff/Fs_Unbuf go away and select will work -- - * correctly. */ + * implemented after release: all I/O is low-level, no stdio. This + * makes the Fs_Buff/Fs_Unbuf go away and select will work -- + * correctly. */ if (strcmp(StrLoc(BlkD(f,File)->fname), "pipe") != 0) { - status |= Fs_Buff; - BlkLoc(f)->File.status = status; - } -#endif /* PosixFns */ + status |= Fs_Buff; + BlkLoc(f)->File.status = status; + } +#endif /* PosixFns */ fp = BlkD(f,File)->fd.fp; if (status & Fs_Writing) { - fseek(fp, 0L, SEEK_CUR); - BlkLoc(f)->File.status &= ~Fs_Writing; - } + fseek(fp, 0L, SEEK_CUR); + BlkLoc(f)->File.status &= ~Fs_Writing; + } BlkLoc(f)->File.status |= Fs_Reading; #ifdef ConsoleWindow @@ -1710,7 +1710,7 @@ function{0,1} reads(f,i) fp = OpenConsole(); status = Fs_Read | Fs_Write | Fs_Window; } -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef ReadDirectory /* @@ -1718,60 +1718,60 @@ function{0,1} reads(f,i) */ if ((BlkD(f,File)->status & Fs_Directory) != 0) { char *sptr; - struct dirent *de; - DEC_NARTHREADS; + struct dirent *de; + DEC_NARTHREADS; de = readdir((DIR*) fp); - INC_NARTHREADS_CONTROLLED; + INC_NARTHREADS_CONTROLLED; if (de == NULL) { - set_syserrortext(errno); + set_syserrortext(errno); fail; - } + } nbytes = strlen(de->d_name); if (nbytes > i) nbytes = i; Protect(sptr = alcstr(de->d_name, nbytes), runerr(0)); return string(nbytes, sptr); } -#endif /* ReadDirectory */ +#endif /* ReadDirectory */ /* * For ordinary files, reads -1 means the whole file. * In all cases, Ignore the 'translation' bit */ if ((i == -1) && ((status & ~Fs_Untrans) == (Fs_Read|Fs_Buff))) { - if ((fd = fileno(fp)) == -1) { set_syserrortext(errno); fail; } - if ((kk = fstat(fd, &statbuf)) == -1) { set_syserrortext(errno); fail;} - i = statbuf.st_size; - } + if ((fd = fileno(fp)) == -1) { set_syserrortext(errno); fail; } + if ((kk = fstat(fd, &statbuf)) == -1) { set_syserrortext(errno); fail;} + i = statbuf.st_size; + } /* * For suspiciously large reads on normal files, cap at file size. */ else if ((i >= 65535) && ((status & ~Fs_Untrans) == (Fs_Read|Fs_Buff))) { - if ((fd = fileno(fp)) == -1) { set_syserrortext(errno); fail; } - if ((kk = fstat(fd, &statbuf)) == -1) { set_syserrortext(errno); fail;} - if (i > statbuf.st_size) i = statbuf.st_size; - } + if ((fd = fileno(fp)) == -1) { set_syserrortext(errno); fail; } + if ((kk = fstat(fd, &statbuf)) == -1) { set_syserrortext(errno); fail;} + if (i > statbuf.st_size) i = statbuf.st_size; + } /* * Be sure that a positive number of bytes is to be read. */ else if (i <= 0) { - irunerr(205, i); - errorfail; - } + irunerr(205, i); + errorfail; + } #ifdef PosixFns /* Remember, sockets are always unbuffered */ if ((status & Fs_Unbuf) && !(status & Fs_BPipe)) { - /* We do one read(2) call here to avoid interactions with stdio */ - DEC_NARTHREADS; - if (u_read(&f, i, status, &s) == 0) { /* EOF, or sets errortext */ - INC_NARTHREADS_CONTROLLED; - fail; - } - INC_NARTHREADS_CONTROLLED; - return s; + /* We do one read(2) call here to avoid interactions with stdio */ + DEC_NARTHREADS; + if (u_read(&f, i, status, &s) == 0) { /* EOF, or sets errortext */ + INC_NARTHREADS_CONTROLLED; + fail; + } + INC_NARTHREADS_CONTROLLED; + return s; } -#endif /* PosixFns */ +#endif /* PosixFns */ /* * For now, assume we can read the full number of bytes. @@ -1784,47 +1784,47 @@ function{0,1} reads(f,i) * Read characters from a compressed file */ if (status & Fs_Compress) { - if (gzeof(fp)) { - fail; - } - DEC_NARTHREADS; - slen = gzread((gzFile) fp, StrLoc(s), i); - INC_NARTHREADS_CONTROLLED; - if (slen == 0) { - if (gzeof(fp)) fail; - /* an underlying read error, but gzread() returned 0? */ - set_gzerrortext((gzFile) fp); - fail; - } - else if (slen < 0) - runerr(214); - return string(slen, StrLoc(s)); - } -#endif /* HAVE_LIBZ */ + if (gzeof(fp)) { + fail; + } + DEC_NARTHREADS; + slen = gzread((gzFile) fp, StrLoc(s), i); + INC_NARTHREADS_CONTROLLED; + if (slen == 0) { + if (gzeof(fp)) fail; + /* an underlying read error, but gzread() returned 0? */ + set_gzerrortext((gzFile) fp); + fail; + } + else if (slen < 0) + runerr(214); + return string(slen, StrLoc(s)); + } +#endif /* HAVE_LIBZ */ #ifdef Graphics pollctr >>= 1; pollctr++; if (status & Fs_Window) { - tally = wlongread(StrLoc(s),sizeof(char),i,fp); - if (tally == -1) - runerr(141); - else if (tally == -2) - runerr(143); - else if (tally == -3) /* EOF */ + tally = wlongread(StrLoc(s),sizeof(char),i,fp); + if (tally == -1) + runerr(141); + else if (tally == -2) + runerr(143); + else if (tally == -3) /* EOF */ fail; - } + } else { -#endif /* Graphics */ +#endif /* Graphics */ DEC_NARTHREADS; tally = longread(StrLoc(s),sizeof(char),i,fp); INC_NARTHREADS_CONTROLLED; #ifdef Graphics } -#endif /* Graphics */ +#endif /* Graphics */ if (tally == 0) /* EOF */ - fail; + fail; StrLen(s) = tally; /* * We may not have used the entire amount of storage we reserved. @@ -1836,7 +1836,7 @@ function{0,1} reads(f,i) return s; } end - + "remove(s) - remove the file named s." @@ -1857,19 +1857,19 @@ function{0,1} remove(s) #endif /* ConcurrentCOMPILER */ if (remove(s) != 0) { #ifdef PosixFns - IntVal(amperErrno) = 0; + IntVal(amperErrno) = 0; #if NT && !defined(MSWIN64) #define rmdir _rmdir -#endif /* NT */ - if (rmdir(s) == 0) return nulldesc; -#endif /* PosixFns */ - set_syserrortext(errno); - fail; +#endif /* NT */ + if (rmdir(s) == 0) return nulldesc; +#endif /* PosixFns */ + set_syserrortext(errno); + fail; } return nulldesc; } end - + "rename(s1,s2) - rename the file named s1 to have the name s2." @@ -1893,12 +1893,12 @@ function{0,1} rename(s1,s2) /* try again. Windows is difficult. */ remove(s2); if (rename(s1,s2) == 0) return nulldesc; -#endif /* NT */ +#endif /* NT */ set_syserrortext(errno); fail; } end - + #ifdef ExecImages "save(s) - save the run-time system in file s" @@ -1922,26 +1922,26 @@ function{0,1} save(s) * Open the file for the executable image. */ if ((f = creat(s, 0777)) == -1) { - set_errortext(1051); - fail; - } + set_errortext(1051); + fail; + } fsz = wrtexec(f); /* * It happens that most wrtexecs don't check the system call return * codes and thus they'll never return -1. Nonetheless... */ if (fsz == -1) { - set_errortext(214); - fail; - } + set_errortext(214); + fail; + } /* * Return the size of the data space. */ return C_integer fsz; } end -#endif /* ExecImages */ - +#endif /* ExecImages */ + "seek(f,i) - seek to offset i in file f." " [[ What about seek error ? ]] " @@ -1968,86 +1968,86 @@ function{0,1} seek(f,o) FILE *fd; #ifdef Graphics CURTSTATE(); -#endif /* Graphics */ +#endif /* Graphics */ fd = BlkD(f,File)->fd.fp; if (BlkLoc(f)->File.status == 0) { - set_errortext(214); - fail; - } + set_errortext(214); + fail; + } #ifdef ReadDirectory if (BlkLoc(f)->File.status & Fs_Directory) { - set_errortext(174); - fail; - } -#endif /* ReadDirectory */ + set_errortext(174); + fail; + } +#endif /* ReadDirectory */ #ifdef Graphics pollctr >>= 1; pollctr++; if (BlkD(f,File)->status & Fs_Window) { - set_errortext(174); - fail; - } -#endif /* Graphics */ + set_errortext(174); + fail; + } +#endif /* Graphics */ #if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { - if (o<0) { - set_errortext(214); - } - if (gzseek(fd, o - 1, SEEK_SET) == -1) { - if (gzeof(fd)) fail; - set_gzerrortext((gzFile) fd); - fail; - } - else - return f; - } + if (o<0) { + set_errortext(214); + } + if (gzseek(fd, o - 1, SEEK_SET) == -1) { + if (gzeof(fd)) fail; + set_gzerrortext((gzFile) fd); + fail; + } + else + return f; + } #endif /* HAVE_LIBZ */ if (o > 0) { /* fseek returns a non-zero value on error for CSET2, not -1 */ #if CSET2 - if (fseek(fd, o - 1, SEEK_SET)) { + if (fseek(fd, o - 1, SEEK_SET)) { #else - if (fseek(fd, o - 1, SEEK_SET) == -1) { -#endif /* CSET2 */ - set_syserrortext(errno); - fail; - } + if (fseek(fd, o - 1, SEEK_SET) == -1) { +#endif /* CSET2 */ + set_syserrortext(errno); + fail; + } - } + } else { #if CSET2 /* unreliable seeking from the end in CSet/2 on a text stream, so we will fixup seek-from-end to seek-from-beginning */ - long size; - long save_pos; - - /* save the position in case we have to reset it */ - save_pos = ftell(fd); - /* seek to the end and get the file size */ - fseek(fd, 0, SEEK_END); - size = ftell(fd); - /* try to accomplish the fixed-up seek */ - if (fseek(fd, size + o, SEEK_SET)) { - set_syserrortext(errno); - fseek(fd, save_pos, SEEK_SET);/* huh? */ - fail; - } /* End of if - seek failed, reset position */ + long size; + long save_pos; + + /* save the position in case we have to reset it */ + save_pos = ftell(fd); + /* seek to the end and get the file size */ + fseek(fd, 0, SEEK_END); + size = ftell(fd); + /* try to accomplish the fixed-up seek */ + if (fseek(fd, size + o, SEEK_SET)) { + set_syserrortext(errno); + fseek(fd, save_pos, SEEK_SET);/* huh? */ + fail; + } /* End of if - seek failed, reset position */ #else - if (fseek(fd, o, SEEK_END) == -1) { - set_syserrortext(errno); - fail; - } -#endif /* CSET2 */ + if (fseek(fd, o, SEEK_END) == -1) { + set_syserrortext(errno); + fail; + } +#endif /* CSET2 */ - } + } BlkLoc(f)->File.status &= ~(Fs_Reading | Fs_Writing); return f; } @@ -2059,24 +2059,24 @@ end function{0,1} system(argv, d_stdin, d_stdout, d_stderr, mode) if !is:file(d_stdin) then if !is:string(d_stdin) then - if !is:null(d_stdin) then - runerr(105, d_stdin) + if !is:null(d_stdin) then + runerr(105, d_stdin) if !is:file(d_stdout) then if !is:string(d_stdout) then - if !is:null(d_stdout) then - runerr(105, d_stdout) + if !is:null(d_stdout) then + runerr(105, d_stdout) if !is:file(d_stderr) then if !is:string(d_stderr) then - if !is:null(d_stderr) then - runerr(105, d_stderr) + if !is:null(d_stderr) then + runerr(105, d_stderr) if !is:list(argv) then if !is:string(argv) then runerr(110, argv) if !is:string(mode) then if !is:integer(mode) then - if !is:file(mode) then - if !is:null(mode) then - runerr(170, mode) + if !is:file(mode) then + if !is:null(mode) then + runerr(170, mode) abstract { return null ++ integer } @@ -2087,7 +2087,7 @@ function{0,1} system(argv, d_stdin, d_stdout, d_stderr, mode) int i, j, n, is_argv_str=0; C_integer i_mode=0; tended union block *ep; - + /* * We are subverting the RTT type system here w.r.t. garbage * collection but we're going to be doing an exec() so ... @@ -2099,144 +2099,144 @@ function{0,1} system(argv, d_stdin, d_stdout, d_stderr, mode) /* Decode the mode */ if (is:integer(mode)) { - if (!cnv:C_integer(mode, i_mode)) runerr(101, mode); - } + if (!cnv:C_integer(mode, i_mode)) runerr(101, mode); + } else if (is:string(mode)) { - tended char *s_mode; - if (!cnv:C_string(mode, s_mode)) runerr(103, mode); - i_mode = (strcmp(s_mode, "nowait") == 0); - } + tended char *s_mode; + if (!cnv:C_string(mode, s_mode)) runerr(103, mode); + i_mode = (strcmp(s_mode, "nowait") == 0); + } if (is:list(argv)) { margv = (char **)malloc((BlkD(argv,List)->size+3) * sizeof(char *)); if (margv == NULL) runerr(305); - n = 0; - /* Traverse the list */ - for (ep = BlkD(argv,List)->listhead; BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext) { - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - dptr f; - j = Blk(ep,Lelem)->first + i; - if (j >= Blk(ep,Lelem)->nslots) - j -= Blk(ep,Lelem)->nslots; - f = &Blk(ep,Lelem)->lslots[j]; - - if (!cnv:C_string((*f), p)) - runerr(103, *f); + n = 0; + /* Traverse the list */ + for (ep = BlkD(argv,List)->listhead; BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext) { + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + dptr f; + j = Blk(ep,Lelem)->first + i; + if (j >= Blk(ep,Lelem)->nslots) + j -= Blk(ep,Lelem)->nslots; + f = &Blk(ep,Lelem)->lslots[j]; + + if (!cnv:C_string((*f), p)) + runerr(103, *f); #if NT - if ((n == 0) && is_internal(p)) { - margv[n++] = "cmd"; /* on Win9x this should be command */ - margv[n++] = "/C"; - margv[n++] = p; - } - else { - margv[n++] = p; - } + if ((n == 0) && is_internal(p)) { + margv[n++] = "cmd"; /* on Win9x this should be command */ + margv[n++] = "/C"; + margv[n++] = p; + } + else { + margv[n++] = p; + } #else - margv[n++] = p; + margv[n++] = p; #endif - } - } - margv[n] = 0; + } + } + margv[n] = 0; } else if (is:string(argv)) { - is_argv_str = 1; + is_argv_str = 1; cnv:C_string(argv, cmdline); #if !NT - { - char *s = cmdline; - - /* - * If we have a string it may have redirection orders. - * Since execl("/bin/sh"...) doesn't seem to handle those - * redirections for us, figure out how to do them ourselves. - * This is a lame hack. Someone needs to think through - * a general solution and rewrite it. Worst case (at present) - * that we are planning for is >filename 2>&1. - */ - while ((s = strstr(s, ">")) != NULL) { - /* - * If &> or >& then redirect both stdout and stderr. - */ - if (((s - cmdline > 0) && s[-1] == '&') || (s[1]=='&')) { - - if ((s - cmdline > 0) && s[-1] == '&') { /* &> */ - s[-1] = '\0'; - s++; - } - else { /* >& */ - *s = '\0'; - s += 2; - } - - while (*s == ' ') s++; - StrLoc(d_stdout) = StrLoc(d_stderr) = s; - while (*s) { - if (*s == ' ') { - *s++ = '\0'; - break; - } - s++; - } - StrLen(d_stdout) = StrLen(d_stderr) = strlen(StrLoc(d_stdout)); - } - else if ((s - cmdline > 0) && s[-1] == '2') { /* 2> */ - s[-1] = '\0'; - s++; - while (*s == ' ') s++; - StrLoc(d_stderr) = s; - while (*s) { - if (*s == ' ') { - *s++ = '\0'; - break; - } - s++; - } - StrLen(d_stderr) = strlen(StrLoc(d_stderr)); - if (!strcmp(StrLoc(d_stderr), "&1")) { - d_stderr = d_stdout; - } - } - else if (s[1] == '>') { /* >> */ - *s = '\0'; - s += 2; /* skip over >> */ - while (*s == ' ') s++; - StrLoc(d_stdout) = s; - while (*s) { - if (*s == ' ') { - *s++ = '\0'; - break; - } - s++; - } - StrLen(d_stdout) = strlen(StrLoc(d_stdout)); - - d_stdout.dword = D_Integer; - d_stdout.vword.integr = + { + char *s = cmdline; + + /* + * If we have a string it may have redirection orders. + * Since execl("/bin/sh"...) doesn't seem to handle those + * redirections for us, figure out how to do them ourselves. + * This is a lame hack. Someone needs to think through + * a general solution and rewrite it. Worst case (at present) + * that we are planning for is >filename 2>&1. + */ + while ((s = strstr(s, ">")) != NULL) { + /* + * If &> or >& then redirect both stdout and stderr. + */ + if (((s - cmdline > 0) && s[-1] == '&') || (s[1]=='&')) { + + if ((s - cmdline > 0) && s[-1] == '&') { /* &> */ + s[-1] = '\0'; + s++; + } + else { /* >& */ + *s = '\0'; + s += 2; + } + + while (*s == ' ') s++; + StrLoc(d_stdout) = StrLoc(d_stderr) = s; + while (*s) { + if (*s == ' ') { + *s++ = '\0'; + break; + } + s++; + } + StrLen(d_stdout) = StrLen(d_stderr) = strlen(StrLoc(d_stdout)); + } + else if ((s - cmdline > 0) && s[-1] == '2') { /* 2> */ + s[-1] = '\0'; + s++; + while (*s == ' ') s++; + StrLoc(d_stderr) = s; + while (*s) { + if (*s == ' ') { + *s++ = '\0'; + break; + } + s++; + } + StrLen(d_stderr) = strlen(StrLoc(d_stderr)); + if (!strcmp(StrLoc(d_stderr), "&1")) { + d_stderr = d_stdout; + } + } + else if (s[1] == '>') { /* >> */ + *s = '\0'; + s += 2; /* skip over >> */ + while (*s == ' ') s++; + StrLoc(d_stdout) = s; + while (*s) { + if (*s == ' ') { + *s++ = '\0'; + break; + } + s++; + } + StrLen(d_stdout) = strlen(StrLoc(d_stdout)); + + d_stdout.dword = D_Integer; + d_stdout.vword.integr = #if UNIX - open(StrLoc(d_stdout), O_WRONLY|O_CREAT|O_APPEND, S_IRUSR|S_IWUSR); + open(StrLoc(d_stdout), O_WRONLY|O_CREAT|O_APPEND, S_IRUSR|S_IWUSR); #endif #if NT - _open(StrLoc(d_stdout), O_WRONLY|O_CREAT|O_APPEND, _S_IWRITE|_S_IREAD); + _open(StrLoc(d_stdout), O_WRONLY|O_CREAT|O_APPEND, _S_IWRITE|_S_IREAD); #endif - } - else { /* > */ - *s = '\0'; - s++; - while (*s == ' ') s++; - StrLoc(d_stdout) = s; - while (*s) { - if (*s == ' ') { - *s++ = '\0'; - break; - } - s++; - } - StrLen(d_stdout) = strlen(StrLoc(d_stdout)); - } - } - } + } + else { /* > */ + *s = '\0'; + s++; + while (*s == ' ') s++; + StrLoc(d_stdout) = s; + while (*s) { + if (*s == ' ') { + *s++ = '\0'; + break; + } + s++; + } + StrLen(d_stdout) = strlen(StrLoc(d_stdout)); + } + } + } #endif } @@ -2245,125 +2245,125 @@ function{0,1} system(argv, d_stdin, d_stdout, d_stderr, mode) * Open in the parent, fork/exec, close (in the parent). */ if (is:string(d_stdin)) { - tended char *s_stdin; + tended char *s_stdin; cnv:C_string(d_stdin, s_stdin); - d_stdin.dword = D_Integer; - d_stdin.vword.integr = open(s_stdin, O_RDONLY); - } + d_stdin.dword = D_Integer; + d_stdin.vword.integr = open(s_stdin, O_RDONLY); + } if (is:string(d_stdout) && is:string(d_stderr) && - (StrLen(d_stdout) == StrLen(d_stderr)) && - !strncmp(StrLoc(d_stdout), StrLoc(d_stderr), StrLen(d_stdout))) { - /* special case: stderr/stdout to same file */ - tended char *s_stdouterr; + (StrLen(d_stdout) == StrLen(d_stderr)) && + !strncmp(StrLoc(d_stdout), StrLoc(d_stderr), StrLen(d_stdout))) { + /* special case: stderr/stdout to same file */ + tended char *s_stdouterr; cnv:C_string(d_stdout, s_stdouterr); - d_stdout.dword = d_stderr.dword = D_Integer; - d_stdout.vword.integr = + d_stdout.dword = d_stderr.dword = D_Integer; + d_stdout.vword.integr = #if UNIX - open(s_stdouterr, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); + open(s_stdouterr, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); #endif #if NT - _open(s_stdouterr, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); + _open(s_stdouterr, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); #endif - d_stderr.vword.integr = d_stdout.vword.integr; - } + d_stderr.vword.integr = d_stdout.vword.integr; + } else { if (is:string(d_stdout)) { - tended char *s_stdout; + tended char *s_stdout; cnv:C_string(d_stdout, s_stdout); - d_stdout.dword = D_Integer; - d_stdout.vword.integr = + d_stdout.dword = D_Integer; + d_stdout.vword.integr = #if UNIX - open(s_stdout, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); + open(s_stdout, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); #endif #if NT - _open(s_stdout, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); + _open(s_stdout, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); #endif - } + } if (is:string(d_stderr)) { - tended char *s_stderr; + tended char *s_stderr; cnv:C_string(d_stderr, s_stderr); - d_stderr.dword = D_Integer; - d_stderr.vword.integr = + d_stderr.dword = D_Integer; + d_stderr.vword.integr = #if UNIX - open(s_stderr, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); + open(s_stderr, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IWUSR); #endif #if NT - _open(s_stderr, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); + _open(s_stderr, O_WRONLY|O_CREAT|O_TRUNC, _S_IWRITE|_S_IREAD); #endif - } + } } #if !NT - /* + /* * We don't use system(3) any more since the program is allowed to * re-map the files even for foreground execution */ #ifdef HAVE_WORKING_VFORK switch (pid = vfork()) { -#else /* HAVE_WORKING_VFORK */ +#else /* HAVE_WORKING_VFORK */ switch (pid = fork()) { -#endif /* HAVE_WORKING_VFORK */ +#endif /* HAVE_WORKING_VFORK */ case 0: - dup_fds(&d_stdin, &d_stdout, &d_stderr); + dup_fds(&d_stdin, &d_stdout, &d_stderr); - if (is_argv_str) { - execl("/bin/sh", "sh", "-c", cmdline, (char *)0); - } - else { - if (execvp(margv[0], margv) == -1) { - free(margv); - } + if (is_argv_str) { + execl("/bin/sh", "sh", "-c", cmdline, (char *)0); + } + else { + if (execvp(margv[0], margv) == -1) { + free(margv); + } } - /* - * If we returned.... this is the child, so failure is no good; - * stop with a runtime error so at least the user will get some - * indication of the problem. - */ - IntVal(amperErrno) = errno; - runerr(500); - break; + /* + * If we returned.... this is the child, so failure is no good; + * stop with a runtime error so at least the user will get some + * indication of the problem. + */ + IntVal(amperErrno) = errno; + runerr(500); + break; case -1: if (margv) free(margv); - set_syserrortext(errno); - fail; - break; + set_syserrortext(errno); + fail; + break; default: #if UNIX && defined(HAVE_WORKING_VFORK) if (!is:null(d_stdin) && is:file(d_stdin)){ if (BlkD(d_stdin,File)->status & Fs_BPipe) - push_filepid(pid, BlkD(d_stdin,File)->fd.fp, Fs_BPipe); - } + push_filepid(pid, BlkD(d_stdin,File)->fd.fp, Fs_BPipe); + } if (!is:null(d_stdout) && is:file(d_stdout)){ if (BlkD(d_stdout,File)->status & Fs_BPipe) - push_filepid(pid, BlkD(d_stdout,File)->fd.fp, Fs_BPipe); - } -#endif /* UNIX && defined(HAVE_WORKING_VFORK) */ + push_filepid(pid, BlkD(d_stdout,File)->fd.fp, Fs_BPipe); + } +#endif /* UNIX && defined(HAVE_WORKING_VFORK) */ if (margv) free(margv); - if (is:integer(d_stdin) &&IntVal(d_stdin)>-1) close(IntVal(d_stdin)); - if (is:integer(d_stdout)&&IntVal(d_stdout)>-1) close(IntVal(d_stdout)); - if (is:integer(d_stderr) && (IntVal(d_stderr)>-1) && - ((!is:integer(d_stdout))||(IntVal(d_stdout)!=IntVal(d_stderr)))) - close(IntVal(d_stderr)); - if (!i_mode) { - int status; - waitpid(pid, &status, 0); - if (WIFEXITED(status)) - return C_integer WEXITSTATUS(status); - else - return C_integer status; - - } - else { - return C_integer pid; + if (is:integer(d_stdin) &&IntVal(d_stdin)>-1) close(IntVal(d_stdin)); + if (is:integer(d_stdout)&&IntVal(d_stdout)>-1) close(IntVal(d_stdout)); + if (is:integer(d_stderr) && (IntVal(d_stderr)>-1) && + ((!is:integer(d_stdout))||(IntVal(d_stdout)!=IntVal(d_stderr)))) + close(IntVal(d_stderr)); + if (!i_mode) { + int status; + waitpid(pid, &status, 0); + if (WIFEXITED(status)) + return C_integer WEXITSTATUS(status); + else + return C_integer status; + + } + else { + return C_integer pid; } } -#else /* NT */ +#else /* NT */ /* * We might want to use CreateProcess and pass the file handles * for stdin/stdout/stderr to the child process. Another candidate @@ -2371,89 +2371,89 @@ function{0,1} system(argv, d_stdin, d_stdout, d_stderr, mode) */ if (i_mode) { _flushall(); - if (is:string(argv)) { - int argc; - char **garbage; - argc = CmdParamToArgv(cmdline, &garbage, 0); - if (is_internal(garbage[0])) { - int jj; - argc += 2; - garbage = realloc(garbage, (sizeof (char *)) * (argc+1)); - garbage[argc] = NULL; - for(jj = argc-1; jj >= 2; jj--) - garbage[jj] = garbage[jj-2]; - garbage[0] = "cmd"; - garbage[1] = "/C"; - } - i = (C_integer)_spawnvp(_P_NOWAITO, garbage[0], (const char* const*) garbage); - free(garbage); - } - else { - i = (C_integer)_spawnvp(_P_NOWAITO, margv[0], (const char* const*) margv); - free(margv); + if (is:string(argv)) { + int argc; + char **garbage; + argc = CmdParamToArgv(cmdline, &garbage, 0); + if (is_internal(garbage[0])) { + int jj; + argc += 2; + garbage = realloc(garbage, (sizeof (char *)) * (argc+1)); + garbage[argc] = NULL; + for(jj = argc-1; jj >= 2; jj--) + garbage[jj] = garbage[jj-2]; + garbage[0] = "cmd"; + garbage[1] = "/C"; + } + i = (C_integer)_spawnvp(_P_NOWAITO, garbage[0], (const char* const*) garbage); + free(garbage); + } + else { + i = (C_integer)_spawnvp(_P_NOWAITO, margv[0], (const char* const*) margv); + free(margv); + } + if (i != 0) { + set_syserrortext(errno); + fail; } - if (i != 0) { - set_syserrortext(errno); - fail; - } } else { - /* Sigh... old "system". Collect all args into a string. */ - if (is_argv_str) { - int argc; - char **garbage, *g2; + /* Sigh... old "system". Collect all args into a string. */ + if (is_argv_str) { + int argc; + char **garbage, *g2; extern char *ArgvToCmdline(char **); - argc = CmdParamToArgv(cmdline, &garbage, 0); - if (is_internal(garbage[0])) { - int jj; - argc += 2; - garbage = realloc(garbage, (sizeof (char *)) * (argc+1)); - garbage[argc] = NULL; - for(jj = argc-1; jj >= 2; jj--) - garbage[jj] = garbage[jj-2]; - garbage[0] = "cmd"; - garbage[1] = "/C"; - } + argc = CmdParamToArgv(cmdline, &garbage, 0); + if (is_internal(garbage[0])) { + int jj; + argc += 2; + garbage = realloc(garbage, (sizeof (char *)) * (argc+1)); + garbage[argc] = NULL; + for(jj = argc-1; jj >= 2; jj--) + garbage[jj] = garbage[jj-2]; + garbage[0] = "cmd"; + garbage[1] = "/C"; + } g2 = ArgvToCmdline(garbage); #ifdef MSWindows - i = (C_integer)mswinsystem(g2); -#else /* MSWindows */ - i = (C_integer)system(g2); -#endif /* MSWindows */ - free(garbage); - free(g2); - return C_integer i; - } - else { - int i, total = 0, n; - tended char *s; - i = 0; - while (margv[i]) { - total += strlen(margv[i]) + 1; - i++; - } - n = i; - /* We use Icon's allocator, it's the only safe way. */ - Protect(s = alcstr(0, total), runerr(0)); - p = s; - for (i = 0; i < n; i++) { - strcpy(p, margv[i]); - p += strlen(margv[i]); - *p++ = ' '; - } + i = (C_integer)mswinsystem(g2); +#else /* MSWindows */ + i = (C_integer)system(g2); +#endif /* MSWindows */ + free(garbage); + free(g2); + return C_integer i; + } + else { + int i, total = 0, n; + tended char *s; + i = 0; + while (margv[i]) { + total += strlen(margv[i]) + 1; + i++; + } + n = i; + /* We use Icon's allocator, it's the only safe way. */ + Protect(s = alcstr(0, total), runerr(0)); + p = s; + for (i = 0; i < n; i++) { + strcpy(p, margv[i]); + p += strlen(margv[i]); + *p++ = ' '; + } --p; - *p = '\0'; + *p = '\0'; #ifdef MSWindows - i = (C_integer)mswinsystem(s); -#else /* MSWindows */ - i = (C_integer)system(s); -#endif /* MSWindows */ - free(margv); - return C_integer i; - } - } -#endif /* NT */ + i = (C_integer)mswinsystem(s); +#else /* MSWindows */ + i = (C_integer)system(s); +#endif /* MSWindows */ + free(margv); + return C_integer i; + } + } +#endif /* NT */ /*NOTREACHED*/ return nulldesc; @@ -2493,29 +2493,29 @@ function{1} system(s, o) #ifdef Graphics pollctr >>= 1; pollctr++; -#endif /* Graphics */ +#endif /* Graphics */ #if NT if (o == 0) { /* nowait, or 0, for second argument */ cmdname = strtok(s, " "); for(j = 0; j<256; j++) if ((args[j] = strtok(NULL, " ")) == NULL) - break; - args[j] = NULL; + break; + args[j] = NULL; _flushall(); i = (C_integer)_spawnvp(_P_NOWAITO, cmdname, args); } else - i = mswinsystem(s); -#else /*NT*/ + i = mswinsystem(s); +#else /*NT*/ i = (C_integer)system(s); -#endif /*NT*/ +#endif /*NT*/ return C_integer i; } end -#endif /* PosixFns */ - +#endif /* PosixFns */ + "where(f) - return current offset position in file f." @@ -2534,41 +2534,41 @@ function{0,1} where(f) long pos; #ifdef Graphics CURTSTATE(); -#endif /* Graphics */ +#endif /* Graphics */ fd = BlkD(f,File)->fd.fp; if (BlkLoc(f)->File.status == 0) { - set_errortext(212); - fail; - } + set_errortext(212); + fail; + } #ifdef ReadDirectory if ((BlkLoc(f)->File.status & Fs_Directory) != 0) { - set_errortext(174); + set_errortext(174); fail; - } -#endif /* ReadDirectory */ + } +#endif /* ReadDirectory */ #ifdef Graphics pollctr >>= 1; pollctr++; if (BlkLoc(f)->File.status & Fs_Window) { - set_errortext(214); - fail; - } -#endif /* Graphics */ + set_errortext(214); + fail; + } +#endif /* Graphics */ pos = ftell(fd) + 1; if (pos == 0) { - set_syserrortext(errno); - fail; /* may only be effective on ANSI systems */ + set_syserrortext(errno); + fail; /* may only be effective on ANSI systems */ } return C_integer pos; } end - + /* * stop(), write(), and writes() differ in whether they stop the program * and whether they output newlines. The macro GenWrite is used to @@ -2581,40 +2581,40 @@ end inline { #if error_out #ifdef Concurrent - fblk = &k_errout; + fblk = &k_errout; MUTEX_LOCKID_CONTROLLED(fblk->mutexid); -#endif /* Concurrent */ +#endif /* Concurrent */ if ((k_errout.status & Fs_Write) == 0){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(213); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(213); + } else { #ifndef ConsoleWindow - f.fp = k_errout.fd.fp; -#else /* ConsoleWindow */ + f.fp = k_errout.fd.fp; +#else /* ConsoleWindow */ f.fp=(ConsoleFlags & StdErrRedirect) ? k_errout.fd.fp : OpenConsole(); -#endif /* ConsoleWindow */ - } -#else /* error_out */ +#endif /* ConsoleWindow */ + } +#else /* error_out */ #ifdef Concurrent - fblk = &k_output; + fblk = &k_output; MUTEX_LOCKID_CONTROLLED(fblk->mutexid); -#endif /* Concurrent */ +#endif /* Concurrent */ if ((k_output.status & Fs_Write) == 0){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(213); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(213); + } else { #ifndef ConsoleWindow - f.fp = k_output.fd.fp; -#else /* ConsoleWindow */ + f.fp = k_output.fd.fp; +#else /* ConsoleWindow */ f.fp=(ConsoleFlags & StdOutRedirect) ? k_output.fd.fp : OpenConsole(); -#endif /* ConsoleWindow */ - } -#endif /* error_out */ +#endif /* ConsoleWindow */ + } +#endif /* error_out */ } -#enddef /* DefaultFile */ +#enddef /* DefaultFile */ #begdef Finish(retvalue, nl, terminate) #if nl @@ -2629,18 +2629,18 @@ end if (f.wb->window->is_gl) gl_wputc('\n', f.wb); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wputc('\n', f.wb); } else -#endif /* Graphics */ +#endif /* Graphics */ #ifdef PseudoPty - if (status & Fs_Pty) { - ptputc('\n', f.pt); - } - else -#endif /* PseudoPty */ + if (status & Fs_Pty) { + ptputc('\n', f.pt); + } + else +#endif /* PseudoPty */ #if HAVE_LIBZ if (status & Fs_Compress) { @@ -2648,154 +2648,154 @@ end runerr(214); } else -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #ifdef Messaging if (status & Fs_Messaging) { - struct MFile *mf = f.mf; - extern int Merror; - if (!MFIN(mf, WRITING)){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(213); - } - if (tp_write(mf->tp, "\n", 1) < 0) { - MUTEX_UNLOCKID(fblk->mutexid); + struct MFile *mf = f.mf; + extern int Merror; + if (!MFIN(mf, WRITING)){ + MUTEX_UNLOCKID(fblk->mutexid); + runerr(213); + } + if (tp_write(mf->tp, "\n", 1) < 0) { + MUTEX_UNLOCKID(fblk->mutexid); #if terminate - syserr("tp_write failed in stop()"); + syserr("tp_write failed in stop()"); #else - /* tp_write has failed in write() or writes() */ - set_errortext(214); - fail; + /* tp_write has failed in write() or writes() */ + set_errortext(214); + fail; #endif - } - if (Merror != 0) { - MUTEX_UNLOCKID(fblk->mutexid); - runerr(Merror); - } - } + } + if (Merror != 0) { + MUTEX_UNLOCKID(fblk->mutexid); + runerr(Merror); + } + } else #endif /* Messaging */ #ifdef PosixFns if (status & Fs_Socket) { - if (sock_write(f.fd, "\n", 1) < 0){ - MUTEX_UNLOCKID(fblk->mutexid); + if (sock_write(f.fd, "\n", 1) < 0){ + MUTEX_UNLOCKID(fblk->mutexid); #if terminate - syserr("sock_write failed in stop()"); + syserr("sock_write failed in stop()"); #else - set_syserrortext(errno); - fail; + set_syserrortext(errno); + fail; #endif - } + } } else -#endif /* PosixFns */ - putc('\n', f.fp); +#endif /* PosixFns */ + putc('\n', f.fp); -#endif /* nl */ +#endif /* nl */ /* * Flush the file. */ #ifdef Messaging if (!(status & Fs_Messaging)) { -#endif /* Messaging */ +#endif /* Messaging */ #ifdef Graphics if (!(status & Fs_Window)) { -#endif /* Graphics */ +#endif /* Graphics */ #ifdef PseudoPty if (!(status & Fs_Pty)) { #endif #ifdef PosixFns if (!(status & Fs_Socket)) { -#endif /* PosixFns */ +#endif /* PosixFns */ #if HAVE_LIBZ if (status & (Fs_Compress - )) { + )) { /*if (ferror(f)){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(214); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(214); + } gzflush(f, Z_SYNC_FLUSH); */ } else{ if (ferror(f.fp)){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(214); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(214); + } fflush(f.fp); } -#else /* HAVE_LIBZ */ +#else /* HAVE_LIBZ */ if (ferror(f.fp)){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(214); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(214); + } fflush(f.fp); - -#endif /* HAVE_LIBZ */ + +#endif /* HAVE_LIBZ */ #ifdef PosixFns } -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Graphics } -#endif /* Graphics */ +#endif /* Graphics */ #ifdef PseudoPty } -#endif /* PseudoPty */ +#endif /* PseudoPty */ #ifdef Messaging } -#endif /* Messaging */ - MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Messaging */ + MUTEX_UNLOCKID(fblk->mutexid); #if terminate - c_exit(EXIT_FAILURE); + c_exit(EXIT_FAILURE); #if !COMPILER return retvalue; /* avoid spurious warning message */ -#endif /* except on the COMPILER... */ -#else /* terminate */ - return retvalue; -#endif /* terminate */ -#enddef /* Finish */ +#endif /* except on the COMPILER... */ +#else /* terminate */ + return retvalue; +#endif /* terminate */ +#enddef /* Finish */ #begdef GenWrite(name, nl, terminate) #name "(a,b,...) - write arguments" #if !nl " without newline terminator" -#endif /* nl */ +#endif /* nl */ #if terminate " (starting on error output) and stop" -#endif /* terminate */ +#endif /* terminate */ "." #if terminate function {} name(x[nargs]) -#else /* terminate */ +#else /* terminate */ function {1} name(x[nargs]) -#endif /* terminate */ +#endif /* terminate */ declare { union f f; #ifdef Concurrent tended struct b_file *fblk = NULL; -#endif /* terminate */ +#endif /* terminate */ word status = #if terminate #ifndef ConsoleWindow - k_errout.status; -#else /* ConsoleWindow */ + k_errout.status; +#else /* ConsoleWindow */ (ConsoleFlags & StdErrRedirect) ? k_errout.status : Fs_Read | Fs_Write | Fs_Window; -#endif /* ConsoleWindow */ -#else /* terminate */ +#endif /* ConsoleWindow */ +#else /* terminate */ #ifndef ConsoleWindow - k_output.status; -#else /* ConsoleWindow */ + k_output.status; +#else /* ConsoleWindow */ (ConsoleFlags & StdOutRedirect) ? k_output.status : Fs_Read | Fs_Write | Fs_Window; -#endif /* ConsoleWindow */ -#endif /* terminate */ +#endif /* ConsoleWindow */ +#endif /* terminate */ } @@ -2803,185 +2803,185 @@ function {1} name(x[nargs]) abstract { return empty_type } -#endif /* terminate */ +#endif /* terminate */ len_case nargs of { 0: { #if !terminate - abstract { - return null - } -#endif /* terminate */ - DefaultFile(terminate) - body { + abstract { + return null + } +#endif /* terminate */ + DefaultFile(terminate) + body { #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ - Finish(nulldesc, nl, terminate) - } - } + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ + Finish(nulldesc, nl, terminate) + } + } default: { #if !terminate - abstract { - return type(x) - } -#endif /* terminate */ - /* - * See if we need to start with the default file. - */ - if !is:file(x[0]) then - DefaultFile(terminate) - - body { - tended struct descrip t; - register word n; - - /* - * Loop through the arguments. - */ - for (n = 0; n < nargs; n++) { - if (is:file(x[n])) { /* Current argument is a file */ + abstract { + return type(x) + } +#endif /* terminate */ + /* + * See if we need to start with the default file. + */ + if !is:file(x[0]) then + DefaultFile(terminate) + + body { + tended struct descrip t; + register word n; + + /* + * Loop through the arguments. + */ + for (n = 0; n < nargs; n++) { + if (is:file(x[n])) { /* Current argument is a file */ #if nl - /* - * If this is not the first argument, output a newline to the - * current file and flush it. - */ - if (n > 0) { - - /* - * Append a newline to the file and flush it. - */ + /* + * If this is not the first argument, output a newline to the + * current file and flush it. + */ + if (n > 0) { + + /* + * Append a newline to the file and flush it. + */ #ifdef Graphics - pollctr >>= 1; - pollctr++; - if (status & Fs_Window) { + pollctr >>= 1; + pollctr++; + if (status & Fs_Window) { #ifdef GraphicsGL - if ((f.wb)->window->is_gl) { - gl_wputc('\n', f.wb); - gl_wflush(f.wb); - } - else -#endif /* GraphicsGL */ - wputc('\n', f.wb); - wflush(f.wb); - } - else { -#endif /* Graphics */ + if ((f.wb)->window->is_gl) { + gl_wputc('\n', f.wb); + gl_wflush(f.wb); + } + else +#endif /* GraphicsGL */ + wputc('\n', f.wb); + wflush(f.wb); + } + else { +#endif /* Graphics */ #ifdef PseudoPty - if (status & Fs_Pty) { - ptputc('\n', f.pt); - } - else -#endif /* PseudoPty */ + if (status & Fs_Pty) { + ptputc('\n', f.pt); + } + else +#endif /* PseudoPty */ #if HAVE_LIBZ if (status & Fs_Compress) { - if (gzputc(f.fp,'\n')==-1){ -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ + if (gzputc(f.fp,'\n')==-1){ +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ runerr(214); - } -/* gzflush(f.fp,4); */ - } - else { + } +/* gzflush(f.fp,4); */ + } + else { } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #ifdef Messaging if (status & Fs_Messaging) { - struct MFile *mf = f.mf; - extern int Merror; - if (!MFIN(mf, WRITING)) { -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ - runerr(213); - } - if (tp_write(mf->tp, "\n", 1) < 0) { -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ + struct MFile *mf = f.mf; + extern int Merror; + if (!MFIN(mf, WRITING)) { +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ + runerr(213); + } + if (tp_write(mf->tp, "\n", 1) < 0) { +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ #if terminate - syserr("tp_write failed in stop()"); + syserr("tp_write failed in stop()"); #else - set_errortext(214); - fail; + set_errortext(214); + fail; #endif - } - if (Merror != 0) { -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ - runerr(Merror, x[n]); - } - } - else + } + if (Merror != 0) { +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ + runerr(Merror, x[n]); + } + } + else #endif /* Messaging */ #ifdef PosixFns - if (status & Fs_Socket) { - if (sock_write(f.fd, "\n", 1) < 0){ -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ + if (status & Fs_Socket) { + if (sock_write(f.fd, "\n", 1) < 0){ +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ #if terminate - syserr("sock_write failed in stop()"); + syserr("sock_write failed in stop()"); #else - set_syserrortext(errno); - fail; + set_syserrortext(errno); + fail; #endif - } - } - else { -#endif /* PosixFns */ - putc('\n', f.fp); - if (ferror(f.fp)){ -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ - runerr(214); - } - fflush(f.fp); + } + } + else { +#endif /* PosixFns */ + putc('\n', f.fp); + if (ferror(f.fp)){ +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ + runerr(214); + } + fflush(f.fp); #ifdef PosixFns } -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Graphics - } -#endif /* Graphics */ -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ - } -#endif /* nl */ - - /* - * Switch the current file to the file named by the current - * argument providing it is a file. - */ - status = BlkD(x[n],File)->status; - if ((status & Fs_Write) == 0){ -#ifdef Concurrent - if (fblk) - MUTEX_UNLOCKID(fblk->mutexid); -#endif /* Concurrent */ - runerr(213, x[n]); - } - f.fp = BlkLoc(x[n])->File.fd.fp; -#ifdef Concurrent - fblk = BlkD(x[n], File); - MUTEX_LOCKID_CONTROLLED(fblk->mutexid); -#endif /* Concurrent */ + } +#endif /* Graphics */ +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ + } +#endif /* nl */ + + /* + * Switch the current file to the file named by the current + * argument providing it is a file. + */ + status = BlkD(x[n],File)->status; + if ((status & Fs_Write) == 0){ +#ifdef Concurrent + if (fblk) + MUTEX_UNLOCKID(fblk->mutexid); +#endif /* Concurrent */ + runerr(213, x[n]); + } + f.fp = BlkLoc(x[n])->File.fd.fp; +#ifdef Concurrent + fblk = BlkD(x[n], File); + MUTEX_LOCKID_CONTROLLED(fblk->mutexid); +#endif /* Concurrent */ #ifdef ConsoleWindow if ((f.fp == stdout && !(ConsoleFlags & StdOutRedirect)) || @@ -2989,102 +2989,102 @@ function {1} name(x[nargs]) f.fp = OpenConsole(); status = Fs_Read | Fs_Write | Fs_Window; } -#endif /* ConsoleWindow */ - } - else { - /* - * Convert the argument to a string, defaulting to a empty - * string. - */ - if (!def:tmp_string(x[n],emptystr,t)){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(109, x[n]); - } - - /* - * Output the string. - */ +#endif /* ConsoleWindow */ + } + else { + /* + * Convert the argument to a string, defaulting to a empty + * string. + */ + if (!def:tmp_string(x[n],emptystr,t)){ + MUTEX_UNLOCKID(fblk->mutexid); + runerr(109, x[n]); + } + + /* + * Output the string. + */ #ifdef Graphics - if (status & Fs_Window) - wputstr(f.wb, StrLoc(t), StrLen(t)); - else -#endif /* Graphics */ + if (status & Fs_Window) + wputstr(f.wb, StrLoc(t), StrLen(t)); + else +#endif /* Graphics */ #ifdef PseudoPty - if (status & Fs_Pty) - ptputstr(f.pt, StrLoc(t), StrLen(t)); - else + if (status & Fs_Pty) + ptputstr(f.pt, StrLoc(t), StrLen(t)); + else #endif #if HAVE_LIBZ - if (status & Fs_Compress){ + if (status & Fs_Compress){ if (gzputs(f.fp, StrLoc(t))==-1){ - MUTEX_UNLOCKID(fblk->mutexid); - runerr(214); - } + MUTEX_UNLOCKID(fblk->mutexid); + runerr(214); + } } - else -#endif /* HAVE_LIBZ */ + else +#endif /* HAVE_LIBZ */ #ifdef Messaging if (status & Fs_Messaging) { - struct MFile *mf = f.mf; - extern int Merror; - Merror = 0; - tp_write(mf->tp, StrLoc(t), StrLen(t)); - if (Merror > 1200) { - MUTEX_UNLOCKID(fblk->mutexid); - runerr(Merror); - } - } - else + struct MFile *mf = f.mf; + extern int Merror; + Merror = 0; + tp_write(mf->tp, StrLoc(t), StrLen(t)); + if (Merror > 1200) { + MUTEX_UNLOCKID(fblk->mutexid); + runerr(Merror); + } + } + else #endif /* Messaging */ #ifdef PosixFns - if (status & Fs_Socket) { + if (status & Fs_Socket) { #if HAVE_LIBSSL - if(status & Fs_Encrypt) { - SSL_write(f.ssl, StrLoc(t), StrLen(t)); - } - else{ -#endif /* HAVE_LIBSSL */ - if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { - MUTEX_UNLOCKID(fblk->mutexid); + if(status & Fs_Encrypt) { + SSL_write(f.ssl, StrLoc(t), StrLen(t)); + } + else{ +#endif /* HAVE_LIBSSL */ + if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { + MUTEX_UNLOCKID(fblk->mutexid); #if terminate - syserr("sock_write failed in stop()"); + syserr("sock_write failed in stop()"); #else - set_syserrortext(errno); - fail; + set_syserrortext(errno); + fail; #endif - } + } #if HAVE_LIBSSL - } -#endif /* HAVE_LIBSSL */ - } else { -#endif /* PosixFns */ - if (putstr(f.fp, &t) == Failed) - { - MUTEX_UNLOCKID(fblk->mutexid); - runerr(214, x[n]); - } + } +#endif /* HAVE_LIBSSL */ + } else { +#endif /* PosixFns */ + if (putstr(f.fp, &t) == Failed) + { + MUTEX_UNLOCKID(fblk->mutexid); + runerr(214, x[n]); + } #ifdef PosixFns - } + } #endif - } - } + } + } - Finish(x[n-1], nl, terminate) - } - } + Finish(x[n-1], nl, terminate) + } + } } end -#enddef /* GenWrite */ +#enddef /* GenWrite */ -GenWrite(stop, True, True) /* stop(s, ...) - write message and stop */ -GenWrite(write, True, False) /* write(s, ...) - write with new-line */ +GenWrite(stop, True, True) /* stop(s, ...) - write message and stop */ +GenWrite(write, True, False) /* write(s, ...) - write with new-line */ GenWrite(writes, False, False) /* writes(s, ...) - write with no new-line */ - + #ifdef KeyboardFncs "getch() - return a character from console." @@ -3097,17 +3097,17 @@ function{0,1} getch() int i; #ifndef ConsoleWindow i = getch(); -#else /* ConsoleWindow */ +#else /* ConsoleWindow */ struct descrip res; if (wgetchne((wbp)OpenConsole(), &res) < 0) fail; i = *StrLoc(res); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ if (i<0 || i>255) - fail; + fail; return string(1, (char *)&allchars[FromAscii(i) & 0xFF]); } end - + "getche() -- return a character from console with echo." function{0,1} getche() @@ -3118,17 +3118,17 @@ function{0,1} getche() int i; #ifndef ConsoleWindow i = getche(); -#else /* ConsoleWindow */ +#else /* ConsoleWindow */ struct descrip res; if (wgetche((wbp)OpenConsole(), &res) < 0) fail; i = *StrLoc(res); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ if (i<0 || i>255) - fail; + fail; return string(1, (char *)&allchars[FromAscii(i) & 0xFF]); } end - + "kbhit() -- Check to see if there is a keyboard character waiting to be read." @@ -3139,30 +3139,30 @@ function{0,1} kbhit() inline { #ifndef ConsoleWindow if (kbhit()) - return nulldesc; + return nulldesc; else fail; -#else /* ConsoleWindow */ +#else /* ConsoleWindow */ /* make sure we're up-to-date event wise */ if (ConsoleBinding) { pollevent(); /* - * perhaps should look in the console's icon event list for a keypress; - * either a string or event > 60k; presently, succeed for all events - */ + * perhaps should look in the console's icon event list for a keypress; + * either a string or event > 60k; presently, succeed for all events + */ if (BlkD(((wbp)ConsoleBinding)->window->listp,List)->size > 0) - return nulldesc; + return nulldesc; } fail; -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ } end -#endif /* KeyboardFncs */ +#endif /* KeyboardFncs */ "chdir(s) - change working directory to s." function{0,1} chdir(s) if !cnv:string(s) then if !is:null(s) then - runerr(103, s) + runerr(103, s) abstract { return string } @@ -3186,32 +3186,32 @@ function{0,1} chdir(s) int len; if (is:string(s)) { - tended char *dir; - cnv:C_string(s, dir); - - /* - * Preliminary tilde $HOME support. Need to extend to Windows, - * and flesh out support for tilde-based syntax. - */ - if (strlen(dir)>2 && dir[0] == '~' && dir[1] == '/') { - getenv_r("HOME", path, 1023); - strcat(path, dir+1); - dir = path; - } - - if (chdir(dir) != 0) { - set_syserrortext(errno); - fail; - } - } + tended char *dir; + cnv:C_string(s, dir); + + /* + * Preliminary tilde $HOME support. Need to extend to Windows, + * and flesh out support for tilde-based syntax. + */ + if (strlen(dir)>2 && dir[0] == '~' && dir[1] == '/') { + getenv_r("HOME", path, 1023); + strcat(path, dir+1); + dir = path; + } + + if (chdir(dir) != 0) { + set_syserrortext(errno); + fail; + } + } #ifndef PATH_MAX #define PATH_MAX 512 -#endif /* PATH_MAX */ +#endif /* PATH_MAX */ if (getcwd(path, PATH_MAX) == NULL) { - set_syserrortext(errno); - fail; - } + set_syserrortext(errno); + fail; + } len = strlen(path); Protect(StrLoc(result) = alcstr(path, len), runerr(0)); @@ -3237,8 +3237,8 @@ rv = GetEnvironmentVariable(s, tmp, 1536); if (rv > 0) return tmp; return NULL; } -#endif /* NTGCC */ -#endif /* MSWindows */ +#endif /* NTGCC */ +#endif /* MSWindows */ #ifndef NTGCC #undef chdir @@ -3247,8 +3247,8 @@ int nt_chdir(char *s) return chdir(s); } #endif -#endif /* NT */ - +#endif /* NT */ + "delay(i) - delay for i milliseconds." function{0,1} delay(n) @@ -3264,17 +3264,17 @@ function{0,1} delay(n) fail; #ifdef Graphics { -#if !ConcurrentCOMPILER +#if !ConcurrentCOMPILER CURTSTATE(); #endif /* ConcurrentCOMPILER */ pollctr >>= 1; pollctr++; } -#endif /* Graphics */ +#endif /* Graphics */ return nulldesc; } end - + "flush(f) - flush file f." function{1} flush(f) @@ -3289,19 +3289,19 @@ function{1} flush(f) int status = BlkD(f,File)->status; #ifdef Graphics CURTSTATE(); -#endif /* Graphics */ +#endif /* Graphics */ /* * File types for which no flushing is possible, or is a no-op. */ - if (((status & (Fs_Read | Fs_Write)) == 0) /* if already closed */ + if (((status & (Fs_Read | Fs_Write)) == 0) /* if already closed */ #ifdef ReadDirectory - || (status & Fs_Directory) -#endif /* ReadDirectory */ + || (status & Fs_Directory) +#endif /* ReadDirectory */ #ifdef PosixFns - || (status & Fs_Socket) -#endif /* PosixFns */ - ) - return f; + || (status & Fs_Socket) +#endif /* PosixFns */ + ) + return f; #ifdef Graphics pollctr >>= 1; @@ -3309,15 +3309,15 @@ function{1} flush(f) if (status & Fs_Window) { #ifdef GraphicsGL - if (((wbp)fp)->window->is_gl) - gl_wflush((wbp)fp); - else -#endif /* GraphicsGL */ - wflush((wbp)fp); - } + if (((wbp)fp)->window->is_gl) + gl_wflush((wbp)fp); + else +#endif /* GraphicsGL */ + wflush((wbp)fp); + } else -#endif /* Graphics */ - fflush(fp); +#endif /* Graphics */ + fflush(fp); /* * Return the flushed file. diff --git a/src/runtime/fwindow.r b/src/runtime/fwindow.r index 8805bb468..451a5ff73 100644 --- a/src/runtime/fwindow.r +++ b/src/runtime/fwindow.r @@ -4,7 +4,7 @@ * Contents: Active, Bg, Color, CopyArea, Couple, * DrawArc, DrawCircle, DrawCurve, DrawImage, DrawLine, * DrawSegment, DrawPoint, DrawPolygon, DrawString, - * DrawRectangle, DrawTorus, DrawCylinder, DrawDisk, DrawCube, + * DrawRectangle, DrawTorus, DrawCylinder, DrawDisk, DrawCube, * DrawSphere, EraseArea, Event, Fg, FillArc, FillCircle, * FillRectangle, FillPolygon, Font, FreeColor, GotoRC, GotoXY, * NewColor, Pattern, PaletteChars, PaletteColor, PaletteKey, @@ -48,7 +48,7 @@ function{1} Alert(argv[argc]) if (w->window->is_gl) gl_walert(w, volume); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ walert(w, volume); ReturnWindow; } @@ -69,40 +69,40 @@ function{0,1} Bg(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - warg=1; - (void) texhandle; /* silence "not used" compiler warning */ - } -#endif /* Graphics3D */ + warg=1; + (void) texhandle; /* silence "not used" compiler warning */ + } +#endif /* Graphics3D */ /* * If there is a (non-window) argument we are setting by * either a mutable color (negative int) or a string name. */ if (argc - warg > 0) { - if (is:integer(argv[warg])) { /* mutable color or packed RGB */ + if (is:integer(argv[warg])) { /* mutable color or packed RGB */ #ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_isetbg(w, IntVal(argv[warg])) == Failed) fail; - } - else -#endif /* GraphicsGL */ - if (isetbg(w, IntVal(argv[warg])) == Failed) fail; - } - else { - if (!cnv:C_string(argv[warg], tmp)) - runerr(103,argv[warg]); + if (w->window->is_gl) { + if (gl_isetbg(w, IntVal(argv[warg])) == Failed) fail; + } + else +#endif /* GraphicsGL */ + if (isetbg(w, IntVal(argv[warg])) == Failed) fail; + } + else { + if (!cnv:C_string(argv[warg], tmp)) + runerr(103,argv[warg]); #ifdef GraphicsGL if (w->window->is_gl) { - if (gl_setbg(w, tmp) == Failed) fail; + if (gl_setbg(w, tmp) == Failed) fail; } else -#endif /* GraphicsGL */ - if (setbg(w, tmp) == Failed) fail; - } +#endif /* GraphicsGL */ + if (setbg(w, tmp) == Failed) fail; + } } @@ -110,17 +110,17 @@ function{0,1} Bg(argv[argc]) * In any event, this function returns the current background color. */ #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) gl_getbg(w, sbuf1); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ getbg(w, sbuf1); len = strlen(sbuf1); Protect(tmp = alcstr(sbuf1, len), runerr(0)); return string(len, tmp); } end - + "Clip(w, x, y, w, h) - set context clip rectangle" @@ -144,7 +144,7 @@ function{1} Clip(argv[argc]) if (w->window->is_gl) gl_unsetclip(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ unsetclip(w); } else { @@ -159,7 +159,7 @@ function{1} Clip(argv[argc]) if (w->window->is_gl) gl_setclip(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ setclip(w); } @@ -176,7 +176,7 @@ function{1} Clone(argv[argc]) return file ++ record #else return file -#endif /* Graphics3D */ +#endif /* Graphics3D */ } body { wbp w, w2, new_w; @@ -187,36 +187,36 @@ function{1} Clone(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ tended struct descrip f; tended struct b_record *rp; OptTexWindow(w); #if 0 /* Graphics3D */ if (is_texture){ - int nfields, draw_code; - static dptr constr; + int nfields, draw_code; + static dptr constr; - if (texhandle >= w->context->display->ntextures) runerr(101, argv[warg]); + if (texhandle >= w->context->display->ntextures) runerr(101, argv[warg]); - if (!constr && !(constr = rec_structor3d(GL3D_TEXTURE))) - syserr("failed to create opengl record constructor"); - nfields = (int) BlkD(*constr, Proc)->nfields; + if (!constr && !(constr = rec_structor3d(GL3D_TEXTURE))) + syserr("failed to create opengl record constructor"); + nfields = (int) BlkD(*constr, Proc)->nfields; - draw_code = si_s2i(redraw3Dnames, "Texture"); - if (draw_code == -1) - fail; + draw_code = si_s2i(redraw3Dnames, "Texture"); + if (draw_code == -1) + fail; - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - MakeInt(draw_code, &(rp->fields[1])); + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + MakeInt(draw_code, &(rp->fields[1])); MakeStr("Texture", 7, &(rp->fields[0])); - f.dword = D_Record; - f.vword.bptr = (union block *)rp; - - MakeInt(texhandle, &(rp->fields[2])); - } -#endif /* Graphics3D */ + f.dword = D_Record; + f.vword.bptr = (union block *)rp; + + MakeInt(texhandle, &(rp->fields[2])); + } +#endif /* Graphics3D */ Protect(new_w = alc_wbinding(), runerr(0)); @@ -225,49 +225,49 @@ function{1} Clone(argv[argc]) if (StrLen(argv[n])==2 && !strncmp(StrLoc(argv[n]), "gl", 2)){ #ifdef Graphics3D - child_window = CHILD_WIN3D; -#else /* Graphics3D */ - runerr(150, argv[n]); -#endif /* Graphics3D */ - argv[n] = nulldesc; - break; - } - else if (StrLen(argv[n])==2 && !strncmp(StrLoc(argv[n]), "gt", 2)){ + child_window = CHILD_WIN3D; +#else /* Graphics3D */ + runerr(150, argv[n]); +#endif /* Graphics3D */ + argv[n] = nulldesc; + break; + } + else if (StrLen(argv[n])==2 && !strncmp(StrLoc(argv[n]), "gt", 2)){ #ifdef Graphics3D - child_window = CHILD_WINTEXTURE; -#else /* Graphics3D */ - runerr(150, argv[n]); -#endif /* Graphics3D */ - argv[n] = nulldesc; - break; - } + child_window = CHILD_WINTEXTURE; +#else /* Graphics3D */ + runerr(150, argv[n]); +#endif /* Graphics3D */ + argv[n] = nulldesc; + break; + } else if (StrLen(argv[n])==1 && !strncmp(StrLoc(argv[n]), "g", 1)){ - child_window = CHILD_WIN2D; - argv[n] = nulldesc; - break; - } + child_window = CHILD_WIN2D; + argv[n] = nulldesc; + break; + } } #ifdef Graphics3D if (is_texture == TEXTURE_RECORD) { child_window = CHILD_WINTEXTURE + texhandle; } -#endif /* Graphics3D */ - +#endif /* Graphics3D */ + /* check for optional second window arg */ if (argc>warg && is:file(argv[warg])) { - if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); - if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) - runerr(142,argv[warg]); - if (ISCLOSED(BlkLoc(argv[warg])->File.fd.wb)) - runerr(142,argv[warg]); - w2 = (wbp)BlkD(argv[warg],File)->fd.wb; - warg++; - } + if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) + runerr(140,argv[warg]); + if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) + runerr(142,argv[warg]); + if (ISCLOSED(BlkLoc(argv[warg])->File.fd.wb)) + runerr(142,argv[warg]); + w2 = (wbp)BlkD(argv[warg],File)->fd.wb; + warg++; + } else { - w2 = w; + w2 = w; } /* initialize new window's canvas and context */ @@ -276,11 +276,11 @@ function{1} Clone(argv[argc]) new_w->window->refcount++; #ifdef GraphicsGL if (w->window->is_gl) { - Protect(new_w->context = gl_clone_context(w2),runerr(0)); - } - else -#endif /* GraphicsGL */ - Protect(new_w->context = clone_context(w2),runerr(0)); + Protect(new_w->context = gl_clone_context(w2),runerr(0)); + } + else +#endif /* GraphicsGL */ + Protect(new_w->context = clone_context(w2),runerr(0)); } else { #ifdef GraphicsGL @@ -289,53 +289,53 @@ function{1} Clone(argv[argc]) if (!gl_child_window_stuff(new_w, w, child_window)) runerr(0); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (!child_window_stuff(new_w, w, child_window)) runerr(0); } -#ifdef GraphicsGL +#ifdef GraphicsGL if (new_w->window->is_gl) { if (!new_w->window->initAttrs) new_w->window->initAttrs = 1; - else - glprintf("Clone(): need a mutex lock\n"); + else + glprintf("Clone(): need a mutex lock\n"); } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ for (n = warg; n < argc; n++) { - if (!is:null(argv[n])) { - if (!cnv:tmp_string(argv[n], sbuf)) /* sbuf not allocated */ - runerr(109, argv[n]); - switch (wattrib(new_w, StrLoc(argv[n]), StrLen(argv[n]), &sbuf2, answer)) { - case Failed: fail; - case RunError: runerr(0, argv[n]); - } - } - } + if (!is:null(argv[n])) { + if (!cnv:tmp_string(argv[n], sbuf)) /* sbuf not allocated */ + runerr(109, argv[n]); + switch (wattrib(new_w, StrLoc(argv[n]), StrLen(argv[n]), &sbuf2, answer)) { + case Failed: fail; + case RunError: runerr(0, argv[n]); + } + } + } #ifdef GraphicsGL if (new_w->window->is_gl) { if (new_w->window->initAttrs) new_w->window->initAttrs = 0; - else - glprintf("Clone(): need a mutex unlock\n"); + else + glprintf("Clone(): need a mutex unlock\n"); } if (new_w->window->is_gl) { - if (child_window) - gl_wmap(new_w); - else - MakeCurrent(new_w); + if (child_window) + gl_wmap(new_w); + else + MakeCurrent(new_w); } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ Protect(BlkLoc(result) = - (union block *)alcfile((FILE *)new_w, Fs_Window|Fs_Read|Fs_Write + (union block *)alcfile((FILE *)new_w, Fs_Window|Fs_Read|Fs_Write #ifdef Graphics3D - | (w->context->rendermode == UGL3D?Fs_Window3D:0) -#endif /* Graphics3D */ + | (w->context->rendermode == UGL3D?Fs_Window3D:0) +#endif /* Graphics3D */ #ifdef GraphicsGL - | (w->window->is_gl?Fs_WinGL2D:0) -#endif /* GraphicsGL */ - , &emptystr),runerr(0)); + | (w->window->is_gl?Fs_WinGL2D:0) +#endif /* GraphicsGL */ + , &emptystr),runerr(0)); result.dword = D_File; #ifdef GraphicsGL @@ -344,15 +344,15 @@ function{1} Clone(argv[argc]) */ if (new_w->window->is_gl && child_window) linkfiletowindow(new_w, BlkD(result,File)); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #if 0 /* Graphics3D */ if (is_texture){ - rp->fields[3] = result; - return f; - } - -#endif /* Graphics3D */ + rp->fields[3] = result; + return f; + } + +#endif /* Graphics3D */ return result; } @@ -377,7 +377,7 @@ function{0,1} Color(argv[argc]) OptWindow(w); if (argc - warg == 0) runerr(101); - if (argc - warg == 1) { /* if this is a query */ + if (argc - warg == 1) { /* if this is a query */ CnvCInteger(argv[warg], n) #ifdef GraphicsGL if (w->window->is_gl) { @@ -385,7 +385,7 @@ function{0,1} Color(argv[argc]) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if ((colorname = get_mutable_name(w, n)) == NULL) fail; len = strlen(colorname); @@ -401,23 +401,23 @@ function{0,1} Color(argv[argc]) if (w->window->is_gl) { if ((colorname = gl_get_mutable_name(w, n)) == NULL) fail; - } - else -#endif /* GraphicsGL */ + } + else +#endif /* GraphicsGL */ if ((colorname = get_mutable_name(w, n)) == NULL) fail; - if (is:integer(argv[i+1])) { /* copy another mutable */ + if (is:integer(argv[i+1])) { /* copy another mutable */ if (IntVal(argv[i+1]) >= 0) - runerr(205, argv[i+1]); /* must be negative */ + runerr(205, argv[i+1]); /* must be negative */ #ifdef GraphicsGL if (w->window->is_gl) { if ((srcname = gl_get_mutable_name(w, IntVal(argv[i+1]))) == NULL) fail; if (gl_set_mutable(w, n, srcname) == Failed) fail; - } - else -#endif /* GraphicsGL */ + } + else +#endif /* GraphicsGL */ { if ((srcname = get_mutable_name(w, IntVal(argv[i+1]))) == NULL) fail; @@ -425,18 +425,18 @@ function{0,1} Color(argv[argc]) } strcpy(colorname, srcname); } - - else { /* specified by name */ + + else { /* specified by name */ tended char *tmp; if (!cnv:C_string(argv[i+1],tmp)) runerr(103,argv[i+1]); - + #ifdef GraphicsGL if (w->window->is_gl) { if (gl_set_mutable(w, n, tmp) == Failed) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (set_mutable(w, n, tmp) == Failed) fail; strcpy(colorname, tmp); } @@ -462,17 +462,17 @@ function{0,1} ColorValue(argv[argc]) char tmp[32], *t; if (is:file(argv[0]) && (BlkD(argv[0],File)->status & Fs_Window)) { - w = BlkD(argv[0],File)->fd.wb; /* explicit window */ + w = BlkD(argv[0],File)->fd.wb; /* explicit window */ warg = 1; } else if (is:file(kywd_xwin[XKey_Window]) && ((BlkD(kywd_xwin[XKey_Window],File)->status & - (Fs_Window|Fs_Read))==(Fs_Window|Fs_Read))) { - w = BlkD(kywd_xwin[XKey_Window],File)->fd.wb; /* &window */ - } + (Fs_Window|Fs_Read))==(Fs_Window|Fs_Read))) { + w = BlkD(kywd_xwin[XKey_Window],File)->fd.wb; /* &window */ + } else { - w = NULL; /* no window (but proceed anyway) */ - } + w = NULL; /* no window (but proceed anyway) */ + } if (!(warg < argc)) runerr(103); @@ -487,13 +487,13 @@ function{0,1} ColorValue(argv[argc]) runerr(103,argv[warg]); if (parsecolor(w, s, &r, &g, &b, &a) == Succeeded) { - if (a < 65535) + if (a < 65535) sprintf(tmp,"%ld,%ld,%ld,%ld", r, g, b, a); - else + else sprintf(tmp,"%ld,%ld,%ld", r, g, b); - len = strlen(tmp); - Protect(s = alcstr(tmp,len), runerr(306)); - return string(len, s); + len = strlen(tmp); + Protect(s = alcstr(tmp,len), runerr(306)); + return string(len, s); } fail; } @@ -513,7 +513,7 @@ function{0,1} CopyArea(argv[argc]) /* w,w2,x,y,width,height,x2,y2 */ #ifdef Graphics3D int is_texture=0 /* src */, dest_is_texture=0, base=0; int texhandle=0 /* src */, dest_texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); @@ -528,77 +528,77 @@ function{0,1} CopyArea(argv[argc]) /* w,w2,x,y,width,height,x2,y2 */ #ifdef Graphics3D if (w->context->rendermode == UGL3D) { if (argc>warg && is:record(argv[warg])) { - /* set a boolean flag, use a texture */ - dest_is_texture=1; - /* Get the Window from Texture record */ - w2 = BlkD(BlkD(argv[warg],Record)->fields[3],File)->fd.wb; + /* set a boolean flag, use a texture */ + dest_is_texture=1; + /* Get the Window from Texture record */ + w2 = BlkD(BlkD(argv[warg],Record)->fields[3],File)->fd.wb; /* Pull out the texture handler */ - dest_texhandle = IntVal(BlkD(argv[warg],Record)->fields[2]); - /* get the context from the window binding */ - warg++; + dest_texhandle = IntVal(BlkD(argv[warg],Record)->fields[2]); + /* get the context from the window binding */ + warg++; } if (argc-warg<4) /* should have at least 4 int values */ - runerr(146); + runerr(146); /* * This is the: "w2 is a destination texture" case. */ if (dest_is_texture) { - base=warg; - if (dest_texhandle >= w2->context->display->ntextures) runerr(102,argv[base]); - if (!cnv:C_integer(argv[base] , x)) runerr(102, argv[base]); - if (!cnv:C_integer(argv[base+1], y)) runerr(102, argv[base+1]); - if (!cnv:C_integer(argv[base+2], width)) runerr(102, argv[base+2]); - if (!cnv:C_integer(argv[base+3], height)) runerr(102, argv[base+3]); - - if (argc-warg>4){ - if (is:null(argv[base+4])) x2=x; - else if (!cnv:C_integer(argv[base+4], x2)) - runerr(102, argv[base+4]); - } - else x2 = x; - - if (argc-warg>5){ - if (is:null(argv[base+5])) y2=y; - else if (!cnv:C_integer(argv[base+5], y2)) - runerr(102, argv[base+5]); - } - else y2 = y; - - if (is_texture) { - /* texture to texture */ - copyareaTexToTex(w, texhandle, dest_texhandle, - x,y,width,height, x2,y2); - - } - else { - /* window to texture */ - if (TexCopyArea(w, w2, dest_texhandle, x, y, width, height, x2, y2, - width, height)==Failed) - fail; - } - ReturnWindow; - } - } -#endif /* Graphics3D */ + base=warg; + if (dest_texhandle >= w2->context->display->ntextures) runerr(102,argv[base]); + if (!cnv:C_integer(argv[base] , x)) runerr(102, argv[base]); + if (!cnv:C_integer(argv[base+1], y)) runerr(102, argv[base+1]); + if (!cnv:C_integer(argv[base+2], width)) runerr(102, argv[base+2]); + if (!cnv:C_integer(argv[base+3], height)) runerr(102, argv[base+3]); + + if (argc-warg>4){ + if (is:null(argv[base+4])) x2=x; + else if (!cnv:C_integer(argv[base+4], x2)) + runerr(102, argv[base+4]); + } + else x2 = x; + + if (argc-warg>5){ + if (is:null(argv[base+5])) y2=y; + else if (!cnv:C_integer(argv[base+5], y2)) + runerr(102, argv[base+5]); + } + else y2 = y; + + if (is_texture) { + /* texture to texture */ + copyareaTexToTex(w, texhandle, dest_texhandle, + x,y,width,height, x2,y2); + + } + else { + /* window to texture */ + if (TexCopyArea(w, w2, dest_texhandle, x, y, width, height, x2, y2, + width, height)==Failed) + fail; + } + ReturnWindow; + } + } +#endif /* Graphics3D */ /* * 2nd window defaults to value of first window */ if (argc>warg && is:file(argv[warg])) { - if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); - if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) - runerr(142,argv[warg]); - w2 = BlkLoc(argv[warg])->File.fd.wb; - if (ISCLOSED(w2)) - runerr(142,argv[warg]); - warg++; - } + if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) + runerr(140,argv[warg]); + if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) + runerr(142,argv[warg]); + w2 = BlkLoc(argv[warg])->File.fd.wb; + if (ISCLOSED(w2)) + runerr(142,argv[warg]); + warg++; + } else { - w2 = w; - } + w2 = w; + } /* * x1, y1, width, and height follow standard conventions. @@ -622,7 +622,7 @@ function{0,1} CopyArea(argv[argc]) /* w,w2,x,y,width,height,x2,y2 */ runerr(0); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (copyArea(w, w2, x, y, width, height, x2, y2) == Failed) fail; ReturnWindow; @@ -655,34 +655,34 @@ function{0,1} Couple(w,w2) * if w is a file, then we bind to an existing window */ if (is:file(w) && (BlkD(w,File)->status & Fs_Window)) { - wb = BlkLoc(w)->File.fd.wb; - wb_new->window = ws = wb->window; - if (is:file(w2) && (BlkD(w2,File)->status & Fs_Window)) { - /* - * Bind an existing window to an existing context, - * and up the context's reference count. - */ + wb = BlkLoc(w)->File.fd.wb; + wb_new->window = ws = wb->window; + if (is:file(w2) && (BlkD(w2,File)->status & Fs_Window)) { + /* + * Bind an existing window to an existing context, + * and up the context's reference count. + */ #ifdef GraphicsGL - if (wb->window->is_gl) { - if (gl_rebind(wb_new, BlkLoc(w2)->File.fd.wb) == Failed) fail; - } - else -#endif /* GraphicsGL */ - if (rebind(wb_new, BlkLoc(w2)->File.fd.wb) == Failed) fail; - wb_new->context->refcount++; - } - else - runerr(140, w2); - - /* bump up refcount to ws */ - ws->refcount++; - } + if (wb->window->is_gl) { + if (gl_rebind(wb_new, BlkLoc(w2)->File.fd.wb) == Failed) fail; + } + else +#endif /* GraphicsGL */ + if (rebind(wb_new, BlkLoc(w2)->File.fd.wb) == Failed) fail; + wb_new->context->refcount++; + } + else + runerr(140, w2); + + /* bump up refcount to ws */ + ws->refcount++; + } else - runerr(140, w); + runerr(140, w); Protect(BlkLoc(result) = - (union block *)alcfile((FILE *)wb_new, Fs_Window|Fs_Read|Fs_Write, - &emptystr),runerr(0)); + (union block *)alcfile((FILE *)wb_new, Fs_Window|Fs_Read|Fs_Write, + &emptystr),runerr(0)); result.dword = D_File; return result; } @@ -711,11 +711,11 @@ function{1} DrawArc(argv[argc]) if (j == MAXXOBJS) { #ifdef GraphicsGL if (w->window->is_gl) { - if (gl_drawarcs(w, arcs, MAXXOBJS) == RunError) + if (gl_drawarcs(w, arcs, MAXXOBJS) == RunError) runerr(0); } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ drawarcs(w, arcs, MAXXOBJS); j = 0; } @@ -728,12 +728,12 @@ function{1} DrawArc(argv[argc]) ARCWIDTH(arcs[j]) = width; ARCHEIGHT(arcs[j]) = height; - /* - * Angle 1 processing. Computes in radians and 64'ths of a degree, - * bounds checks, and handles wraparound. - */ + /* + * Angle 1 processing. Computes in radians and 64'ths of a degree, + * bounds checks, and handles wraparound. + */ if (i + 4 >= argc || is:null(argv[i + 4])) - a1 = 0.0; + a1 = 0.0; else { if (!cnv:C_double(argv[i + 4], a1)) runerr(102, argv[i + 4]); @@ -742,11 +742,11 @@ function{1} DrawArc(argv[argc]) else a1 = -fmod(-a1, 2 * Pi); } - /* - * Angle 2 processing - */ + /* + * Angle 2 processing + */ if (i + 5 >= argc || is:null(argv[i + 5])) - a2 = 2 * Pi; + a2 = 2 * Pi; else { if (!cnv:C_double(argv[i + 5], a2)) runerr(102, argv[i + 5]); @@ -754,8 +754,8 @@ function{1} DrawArc(argv[argc]) runerr(101, argv[i + 5]); } if (fabs(a2) >= 2 * Pi) { - a2 = 2 * Pi; - } + a2 = 2 * Pi; + } else { if (a2 < 0.0) { a1 += a2; @@ -777,13 +777,13 @@ function{1} DrawArc(argv[argc]) if (gl_drawarcs(w, arcs, j) == RunError) runerr(0); } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ drawarcs(w, arcs, j); ReturnWindow; } end - + /* * DrawCircle(w, x1, y1, r1, angle11, angle21, ...) */ @@ -803,7 +803,7 @@ function{1} DrawCircle(argv[argc]) ReturnWindow; else if (r >= argc - warg) runerr(146); - else + else runerr(102, argv[warg + r]); } end @@ -828,62 +828,62 @@ function{1} DrawCurve(argv[argc]) /* instead of the usual OptWindow(w); allow w/no window arguments */ if (argc>warg && is:file(argv[warg])) { if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); + runerr(140,argv[warg]); if ((BlkD(argv[warg],File)->status & (Fs_Read|Fs_Write)) == 0) - fail; + fail; (w) = BlkD(argv[warg],File)->fd.wb; #ifdef ConsoleWindow - checkOpenConsole((FILE *)(w), NULL); -#endif /* ConsoleWindow */ + checkOpenConsole((FILE *)(w), NULL); +#endif /* ConsoleWindow */ if (ISCLOSED(w)) - fail; + fail; warg++; } else { if (!(is:file(kywd_xwin[XKey_Window]) && - (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) - w = NULL; + (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) + w = NULL; else if (!(BlkD(kywd_xwin[XKey_Window],File)->status & (Fs_Read|Fs_Write))) - fail; + fail; else { - (w) = (wbp)BlkD(kywd_xwin[XKey_Window],File)->fd.fp; - if (ISCLOSED(w)) - fail; - } + (w) = (wbp)BlkD(kywd_xwin[XKey_Window],File)->fd.fp; + if (ISCLOSED(w)) + fail; + } } CheckArgMultiple(2); if (w) { - dx = w->context->dx; - dy = w->context->dy; - } + dx = w->context->dx; + dy = w->context->dy; + } Protect(points = (XPoint *)malloc(sizeof(XPoint) * (n+2)), runerr(305)); if (n > 1) { - CnvCInteger(argv[warg], x0) - CnvCInteger(argv[warg + 1], y0) - CnvCInteger(argv[argc - 2], xN) - CnvCInteger(argv[argc - 1], yN) + CnvCInteger(argv[warg], x0) + CnvCInteger(argv[warg + 1], y0) + CnvCInteger(argv[argc - 2], xN) + CnvCInteger(argv[argc - 1], yN) if ((x0 == xN) && (y0 == yN)) { closed = 1; /* duplicate the next to last point */ - CnvCShort(argv[argc-4], points[0].x); - CnvCShort(argv[argc-3], points[0].y); - points[0].x += dx; - points[0].y += dy; + CnvCShort(argv[argc-4], points[0].x); + CnvCShort(argv[argc-3], points[0].y); + points[0].x += dx; + points[0].y += dy; } else { /* duplicate the first point */ - CnvCShort(argv[warg], points[0].x); - CnvCShort(argv[warg + 1], points[0].y); - points[0].x += dx; - points[0].y += dy; + CnvCShort(argv[warg], points[0].x); + CnvCShort(argv[warg + 1], points[0].y); + points[0].x += dx; + points[0].y += dy; } for (i = 1; i <= n; i++) { - int base = warg + (i-1) * 2; + int base = warg + (i-1) * 2; CnvCShort(argv[base], points[i].x); CnvCShort(argv[base + 1], points[i].y); - points[i].x += dx; - points[i].y += dy; + points[i].x += dx; + points[i].y += dy; } if (closed) { /* duplicate the second point */ points[i] = points[2]; @@ -892,46 +892,46 @@ function{1} DrawCurve(argv[argc]) points[i] = points[i-1]; } - if (w) { - if (n == 2) { + if (w) { + if (n == 2) { #ifdef GraphicsGL - if (w->window->is_gl) - gl_drawlines(w, points+1, 2); - else -#endif /* GraphicsGL */ - drawlines(w, points+1, 2); - } - else { - drawCurve(w, points, n+2); - } - } - else { /* make a list to return instead of drawing */ - struct descrip d; - - /* - * Give an upper bound on number of points in resulting list. - * Every curve being 90 degree angles seems like a worst case. - */ - int sum = n; - for(i=1;iwindow->is_gl) + gl_drawlines(w, points+1, 2); + else +#endif /* GraphicsGL */ + drawlines(w, points+1, 2); + } + else { + drawCurve(w, points, n+2); + } + } + else { /* make a list to return instead of drawing */ + struct descrip d; + + /* + * Give an upper bound on number of points in resulting list. + * Every curve being 90 degree angles seems like a worst case. + */ + int sum = n; + for(i=1;i= 2 && !def:C_integer(argv[warg + 1], -w->context->dy, y)) runerr(101, argv[warg + 1]); if (argc - warg < 3) - runerr(103); /* missing s */ + runerr(103); /* missing s */ if (!cnv:tmp_string(argv[warg+2], d)) /* d is not allocated */ runerr(103, argv[warg + 2]); @@ -975,20 +975,20 @@ function{0,1} DrawImage(argv[argc]) * Extract the Width and skip the following comma. */ s = (unsigned char *)StrLoc(d); - z = s + StrLen(d); /* end+1 of string */ + z = s + StrLen(d); /* end+1 of string */ width = 0; - while (s < z && *s == ' ') /* skip blanks */ - s++; - while (s < z && isdigit(*s)) /* scan number */ + while (s < z && *s == ' ') /* skip blanks */ + s++; + while (s < z && isdigit(*s)) /* scan number */ width = 10 * width + *s++ - '0'; - while (s < z && *s == ' ') /* skip blanks */ - s++; - if (width == 0 || *s++ != ',') /* skip comma */ + while (s < z && *s == ' ') /* skip blanks */ + s++; + if (width == 0 || *s++ != ',') /* skip comma */ + fail; + while (s < z && *s == ' ') /* skip blanks */ + s++; + if (s >= z) /* if end of string */ fail; - while (s < z && *s == ' ') /* skip blanks */ - s++; - if (s >= z) /* if end of string */ - fail; /* * Check for a bilevel format. @@ -998,12 +998,12 @@ function{0,1} DrawImage(argv[argc]) nchars = 0; for (t = s; t < z; t++) if (isxdigit(*t)) - nchars++; /* count hex digits */ + nchars++; /* count hex digits */ else if (*t != PCH1 && *t != PCH2) - fail; /* illegal punctuation */ + fail; /* illegal punctuation */ if (nchars == 0) fail; - row = (width + 3) / 4; /* digits per row */ + row = (width + 3) / 4; /* digits per row */ if (nchars % row != 0) fail; height = nchars / row; @@ -1013,8 +1013,8 @@ function{0,1} DrawImage(argv[argc]) runerr(305); else return nulldesc; } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ if (blimage(w, x, y, width, height, c, s, (word)(z - s)) == RunError) runerr(305); else @@ -1024,50 +1024,50 @@ function{0,1} DrawImage(argv[argc]) /* * Extract the palette name and skip its comma. */ - c = *s++; /* save initial character */ + c = *s++; /* save initial character */ p = 0; - while (s < z && isdigit(*s)) /* scan digits */ + while (s < z && isdigit(*s)) /* scan digits */ p = 10 * p + *s++ - '0'; - while (s < z && *s == ' ') /* skip blanks */ - s++; - if (s >= z || p == 0 || *s++ != ',') /* skip comma */ + while (s < z && *s == ' ') /* skip blanks */ + s++; + if (s >= z || p == 0 || *s++ != ',') /* skip comma */ fail; - if (c == 'g' && p >= 2 && p <= 256) /* validate grayscale number */ + if (c == 'g' && p >= 2 && p <= 256) /* validate grayscale number */ p = -p; - else if (c != 'c' || p < 1 || p > 6) /* validate color number */ + else if (c != 'c' || p < 1 || p > 6) /* validate color number */ fail; /* * Scan the image to see which colors are needed. */ - e = palsetup(p); + e = palsetup(p); if (e == NULL) runerr(305); for (i = 0; i < 256; i++) e[i].used = 0; nchars = 0; for (t = s; t < z; t++) { - c = *t; + c = *t; e[c].used = 1; if (e[c].valid || e[c].transpt) - nchars++; /* valid color, or transparent */ + nchars++; /* valid color, or transparent */ else if (c != PCH1 && c != PCH2) fail; } if (nchars == 0) - fail; /* empty image */ + fail; /* empty image */ if (nchars % width != 0) - fail; /* not rectangular */ + fail; /* not rectangular */ /* * Call platform-dependent code to draw the image. */ height = nchars / width; #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) i = gl_strimage(w, x, y, width, height, e, s, (word)(z - s), 0); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ i = strimage(w, x, y, width, height, e, s, (word)(z - s), 0); if (i == 0) return nulldesc; @@ -1097,66 +1097,66 @@ function{1} DrawLine(argv[argc]) #ifdef Graphics3D int is_texture = 0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - base=warg; - CheckArgMultiple(2); + base=warg; + CheckArgMultiple(2); - if (argc-warg<4) /* first line should have at least 4 int values */ - runerr(146); - - if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); + if (argc-warg<4) /* first line should have at least 4 int values */ + runerr(146); - if (!cnv:C_integer(argv[base] , x1)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y1)) runerr(101, argv[base+1]); + if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); + + if (!cnv:C_integer(argv[base] , x1)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y1)) runerr(101, argv[base+1]); for (base+=2; base < argc; base+=2){ - if (!cnv:C_integer(argv[base], x2)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y2)) runerr(101, argv[base+1]); - TexDrawLine(w, texhandle, x1, y1, x2, y2); - x1=x2; - y1=y2; - } - ReturnWindow; - } + if (!cnv:C_integer(argv[base], x2)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y2)) runerr(101, argv[base+1]); + TexDrawLine(w, texhandle, x1, y1, x2, y2); + x1=x2; + y1=y2; + } + ReturnWindow; + } if (w->context->rendermode == UGL3D) { - word num; + word num; tended struct descrip f; - tended struct descrip d; - tended struct b_realarray *ap; - - /* check if the argument is a list */ - if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; - else { - num = argc-warg; - } - /* Check the number of coordinates*/ - if (num%w->context->dim != 0 || numcontext->dim*2) - runerr(146); + tended struct descrip d; + tended struct b_realarray *ap; + + /* check if the argument is a list */ + if (is:list(argv[warg])) + num = BlkD(argv[warg], List)->size; + else { + num = argc-warg; + } + /* Check the number of coordinates*/ + if (num%w->context->dim != 0 || numcontext->dim*2) + runerr(146); /* create a list to keep track of function information */ - if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); - ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) + runerr(305, argv[warg]); + ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (create3Dlisthdr(&f, "DrawLine", 4)!=Succeeded) - fail; - c_put(&f, &d); + if (create3Dlisthdr(&f, "DrawLine", 4)!=Succeeded) + fail; + c_put(&f, &d); c_put(&(w->window->funclist), &f); - /* draw the lines */ - if (w->window->buffermode == UGL_IMMEDIATE) { - drawpoly(w, ap->a, num, U3D_LINE_STRIP, w->context->dim); - glFlush(); - } + /* draw the lines */ + if (w->window->buffermode == UGL_IMMEDIATE) { + drawpoly(w, ap->a, num, U3D_LINE_STRIP, w->context->dim); + glFlush(); + } return f; } - else -#endif /* Graphics3D */ + else +#endif /* Graphics3D */ { CheckArgMultiple(2); @@ -1164,31 +1164,31 @@ function{1} DrawLine(argv[argc]) dy = w->context->dy; for(i=0, j=0;iwindow->is_gl) { - if (gl_drawlines(w, points, MAXXOBJS) == RunError) - runerr(0); - } - else -#endif /* GraphicsGL */ - drawlines(w, points, MAXXOBJS); - points[0] = points[MAXXOBJS-1]; - j = 1; + if (w->window->is_gl) { + if (gl_drawlines(w, points, MAXXOBJS) == RunError) + runerr(0); + } + else +#endif /* GraphicsGL */ + drawlines(w, points, MAXXOBJS); + points[0] = points[MAXXOBJS-1]; + j = 1; } CnvCShort(argv[base], points[j].x); CnvCShort(argv[base + 1], points[j].y); - points[j].x += dx; - points[j].y += dy; + points[j].x += dx; + points[j].y += dy; } #ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawlines(w, points, j) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawlines(w, points, j); ReturnWindow; } @@ -1214,88 +1214,88 @@ function{1} DrawPoint(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - base=warg; - CheckArgMultiple(2); + base=warg; + CheckArgMultiple(2); - if (texhandle >= w->context->display->ntextures) runerr(102, argv[base]); + if (texhandle >= w->context->display->ntextures) runerr(102, argv[base]); for (; base < argc; base+=2){ - if (!cnv:C_integer(argv[base], x)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); - TexDrawPoint(w, texhandle, x, y); - } - ReturnWindow; - } - + if (!cnv:C_integer(argv[base], x)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); + TexDrawPoint(w, texhandle, x, y); + } + ReturnWindow; + } + if (w->context->rendermode == UGL3D) { - word num; + word num; tended struct descrip f; - tended struct descrip d; - tended struct b_realarray *ap; - - /* check if the argument is a list */ - if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; - else { - num = argc-warg; - } - - /* Check the number of coordinates*/ - if (num%w->context->dim!=0) - runerr(146); - - /* create a list to store function information */ - if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); - ap = (struct b_realarray *) BlkD(d, List)->listhead; - - if (create3Dlisthdr(&f, "DrawPoint", 4)!=Succeeded) - fail; - c_put(&f, &d); + tended struct descrip d; + tended struct b_realarray *ap; + + /* check if the argument is a list */ + if (is:list(argv[warg])) + num = BlkD(argv[warg], List)->size; + else { + num = argc-warg; + } + + /* Check the number of coordinates*/ + if (num%w->context->dim!=0) + runerr(146); + + /* create a list to store function information */ + if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) + runerr(305, argv[warg]); + ap = (struct b_realarray *) BlkD(d, List)->listhead; + + if (create3Dlisthdr(&f, "DrawPoint", 4)!=Succeeded) + fail; + c_put(&f, &d); c_put(&(w->window->funclist), &f); - if (w->window->buffermode == UGL_IMMEDIATE) { - drawpoly(w, ap->a, num, U3D_POINTS, w->context->dim); - glFlush(); - } + if (w->window->buffermode == UGL_IMMEDIATE) { + drawpoly(w, ap->a, num, U3D_POINTS, w->context->dim); + glFlush(); + } return f; - } - else -#endif /* Graphics3D */ + } + else +#endif /* Graphics3D */ { CheckArgMultiple(2); dx = w->context->dx; dy = w->context->dy; for(i=0, j=0; i < n; i++, j++) { - int base = warg + i * 2; + int base = warg + i * 2; if (j == MAXXOBJS) { #ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_drawpoints(w, points, MAXXOBJS) == RunError) - runerr(0); - } - else -#endif /* GraphicsGL */ - drawpoints(w, points, MAXXOBJS); + if (w->window->is_gl) { + if (gl_drawpoints(w, points, MAXXOBJS) == RunError) + runerr(0); + } + else +#endif /* GraphicsGL */ + drawpoints(w, points, MAXXOBJS); j = 0; } CnvCShort(argv[base], points[j].x); CnvCShort(argv[base + 1], points[j].y); - points[j].x += dx; - points[j].y += dy; + points[j].x += dx; + points[j].y += dy; } #ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawpoints(w, points, j) == RunError) - runerr(0); - } - else -#endif /* GraphicsGL */ + runerr(0); + } + else +#endif /* GraphicsGL */ drawpoints(w, points, j); ReturnWindow; @@ -1317,48 +1317,48 @@ function{1} DrawPolygon(argv[argc]) int i, j, n, base, dx, dy, warg = 0; #ifdef GraphicsGL XPoint *points; -#else /* GraphicsGL */ +#else /* GraphicsGL */ XPoint points[MAXXOBJS]; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ OptWindow(w); #ifdef Graphics3D if (w->context->rendermode == UGL3D) { - word num; + word num; tended struct descrip f; - tended struct descrip d; - tended struct b_realarray *ap; - - /* check if the argument is a list */ - if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; - else { - num = argc-warg; - } - - /* Check the number of coordinates*/ - if (num%w->context->dim!=0 || num<3*w->context->dim) - runerr(146); - - /* create a list for function information */ - if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); - ap = (struct b_realarray *) BlkD(d, List)->listhead; - - if (create3Dlisthdr(&f, "DrawPolygon", 4)!=Succeeded) - fail; - c_put(&f, &d); + tended struct descrip d; + tended struct b_realarray *ap; + + /* check if the argument is a list */ + if (is:list(argv[warg])) + num = BlkD(argv[warg], List)->size; + else { + num = argc-warg; + } + + /* Check the number of coordinates*/ + if (num%w->context->dim!=0 || num<3*w->context->dim) + runerr(146); + + /* create a list for function information */ + if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) + runerr(305, argv[warg]); + ap = (struct b_realarray *) BlkD(d, List)->listhead; + + if (create3Dlisthdr(&f, "DrawPolygon", 4)!=Succeeded) + fail; + c_put(&f, &d); c_put(&(w->window->funclist), &f); - + /* draw the polygon */ - if (w->window->buffermode == UGL_IMMEDIATE) { - drawpoly(w, ap->a, num, U3D_LINE_LOOP /* w->context->meshmode*/, w->context->dim); - glFlush(); - } + if (w->window->buffermode == UGL_IMMEDIATE) { + drawpoly(w, ap->a, num, U3D_LINE_LOOP /* w->context->meshmode*/, w->context->dim); + glFlush(); + } return f; - } - else -#endif /* Graphics3D */ + } + else +#endif /* Graphics3D */ { CheckArgMultiple(2); @@ -1374,7 +1374,7 @@ function{1} DrawPolygon(argv[argc]) if ((points = (XPoint *)malloc((MAXXOBJS)*sizeof(XPoint))) == NULL) runerr(305); } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ /* * To make a closed polygon, start with the *last* point. */ @@ -1390,9 +1390,9 @@ function{1} DrawPolygon(argv[argc]) base = warg + i * 2; #ifdef GraphicsGL if (!w->window->is_gl && j == MAXXOBJS) { -#else /* GraphicsGL */ +#else /* GraphicsGL */ if (j == MAXXOBJS) { -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawlines(w, points, MAXXOBJS); points[0] = points[MAXXOBJS-1]; j = 1; @@ -1405,14 +1405,14 @@ function{1} DrawPolygon(argv[argc]) #ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawlines(w, points, j) == RunError) - runerr(0); + runerr(0); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawlines(w, points, j); #ifdef GraphicsGL free(points); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ReturnWindow; } } @@ -1437,26 +1437,26 @@ function{1} DrawRectangle(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - base=warg; - CheckArgMultiple(4); + base=warg; + CheckArgMultiple(4); - if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); + if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); for (; base < argc; base+=4){ - if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); - if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); - if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); - TexDrawRect(w, texhandle, x, y, width, height); - } - ReturnWindow; - } -#endif /* Graphics3D */ + if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); + if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); + if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); + TexDrawRect(w, texhandle, x, y, width, height); + } + ReturnWindow; + } +#endif /* Graphics3D */ j = 0; for (i = warg; i < argc || i == warg; i += 4) { @@ -1464,13 +1464,13 @@ function{1} DrawRectangle(argv[argc]) if (r >= 0) runerr(101, argv[r]); if (j == MAXXOBJS) { -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawrectangles(w,recs,MAXXOBJS) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawrectangles(w,recs,MAXXOBJS); j = 0; } @@ -1481,13 +1481,13 @@ function{1} DrawRectangle(argv[argc]) j++; } -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawrectangles(w,recs,j) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawrectangles(w, recs, j); ReturnWindow; } @@ -1511,59 +1511,59 @@ function{1} DrawSegment(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - base=warg; - CheckArgMultiple(4); - if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); + base=warg; + CheckArgMultiple(4); + if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); for (; base < argc; base+=4){ - if (!cnv:C_integer(argv[base] , x1)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y1)) runerr(101, argv[base+1]); - if (!cnv:C_integer(argv[base+2], x2)) runerr(101, argv[base+2]); - if (!cnv:C_integer(argv[base+3], y2)) runerr(101, argv[base+3]); - TexDrawLine(w, texhandle, x1, y1, x2, y2); - } - ReturnWindow; - } + if (!cnv:C_integer(argv[base] , x1)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y1)) runerr(101, argv[base+1]); + if (!cnv:C_integer(argv[base+2], x2)) runerr(101, argv[base+2]); + if (!cnv:C_integer(argv[base+3], y2)) runerr(101, argv[base+3]); + TexDrawLine(w, texhandle, x1, y1, x2, y2); + } + ReturnWindow; + } if (w->context->rendermode == UGL3D) { - word num; + word num; tended struct descrip f; - tended struct descrip d; - tended struct b_realarray *ap; + tended struct descrip d; + tended struct b_realarray *ap; - /* check if the argument is a list */ - if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; - else { - num = argc-warg; - } + /* check if the argument is a list */ + if (is:list(argv[warg])) + num = BlkD(argv[warg], List)->size; + else { + num = argc-warg; + } - /* Check the number of coordinates*/ - if (num%(2*w->context->dim) != 0) - runerr(146); + /* Check the number of coordinates*/ + if (num%(2*w->context->dim) != 0) + runerr(146); /* create a list for function information */ - if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); - ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) + runerr(305, argv[warg]); + ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (create3Dlisthdr(&f, "DrawSegment", 4)!=Succeeded) - fail; - c_put(&f, &d); + if (create3Dlisthdr(&f, "DrawSegment", 4)!=Succeeded) + fail; + c_put(&f, &d); c_put(&(w->window->funclist), &f); /* draw the line segments */ - if (w->window->buffermode == UGL_IMMEDIATE) { - drawpoly(w, ap->a, argc-warg, U3D_LINES, w->context->dim); - glFlush(); - } - return f; - } + if (w->window->buffermode == UGL_IMMEDIATE) { + drawpoly(w, ap->a, argc-warg, U3D_LINES, w->context->dim); + glFlush(); + } + return f; + } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ { CheckArgMultiple(4); @@ -1571,36 +1571,36 @@ function{1} DrawSegment(argv[argc]) dx = w->context->dx; dy = w->context->dy; for(i=0, j=0; i < n; i++, j++) { - int base = warg + i * 4; + int base = warg + i * 4; if (j == MAXXOBJS) { #ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_drawsegments(w, segs, MAXXOBJS) == RunError) - runerr(0); - } - else -#endif /* GraphicsGL */ - drawsegments(w, segs, MAXXOBJS); + if (w->window->is_gl) { + if (gl_drawsegments(w, segs, MAXXOBJS) == RunError) + runerr(0); + } + else +#endif /* GraphicsGL */ + drawsegments(w, segs, MAXXOBJS); j = 0; } CnvCShort(argv[base], segs[j].x1); CnvCShort(argv[base + 1], segs[j].y1); CnvCShort(argv[base + 2], segs[j].x2); CnvCShort(argv[base + 3], segs[j].y2); - segs[j].x1 += dx; - segs[j].x2 += dx; - segs[j].y1 += dy; - segs[j].y2 += dy; + segs[j].x1 += dx; + segs[j].x2 += dx; + segs[j].y1 += dy; + segs[j].y2 += dy; } #ifdef GraphicsGL if (w->window->is_gl) { if (gl_drawsegments(w, segs, j) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawsegments(w, segs, j); - } + } ReturnWindow; } end @@ -1628,69 +1628,69 @@ function{1} DrawString(argv[argc]) #ifdef Graphics3D if (w->context->rendermode == UGL3D) { - if (argc - warg < 3) fail; + if (argc - warg < 3) fail; - if (!constr) { - if (!(constr = rec_structor3d(GL3D_DRAWSTRING))) - syserr("failed to create opengl record constructor"); - } + if (!constr) { + if (!(constr = rec_structor3d(GL3D_DRAWSTRING))) + syserr("failed to create opengl record constructor"); + } nf = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; - if (!(cnv:C_double(argv[warg], x))) - runerr(102, argv[warg]); - if (!(cnv:C_double(argv[warg+1], y))) - runerr(102, argv[warg+1]); - if (!(cnv:C_double(argv[warg+2], z))) - runerr(102, argv[warg+2]); - if (!(cnv:C_string(argv[warg+3], s))) - runerr(103, argv[warg+3]); + if (!(cnv:C_double(argv[warg], x))) + runerr(102, argv[warg]); + if (!(cnv:C_double(argv[warg+1], y))) + runerr(102, argv[warg+1]); + if (!(cnv:C_double(argv[warg+2], z))) + runerr(102, argv[warg+2]); + if (!(cnv:C_string(argv[warg+3], s))) + runerr(103, argv[warg+3]); if (w->window->buffermode == UGL_IMMEDIATE) { - drawstrng3d(w, (double) x, (double) y, (double) z, s); - glFlush(); - } - //swapbuffers(w, 1); + drawstrng3d(w, (double) x, (double) y, (double) z, s); + glFlush(); + } + //swapbuffers(w, 1); - /* create a record of the graphical object */ + /* create a record of the graphical object */ - Protect(rp = alcrecd(nf, BlkLoc(*constr)), runerr(0)); + Protect(rp = alcrecd(nf, BlkLoc(*constr)), runerr(0)); f.dword = D_Record; f.vword.bptr = (union block *) rp; MakeStr("DrawString3d", 10, &(rp->fields[0])); - draw_code = si_s2i(redraw3Dnames, "DrawString3d"); + draw_code = si_s2i(redraw3Dnames, "DrawString3d"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); for(j = warg; j < warg + 3; j++) - rp->fields[2 + j - warg] = argv[j]; - MakeStr(s, strlen(s), &(rp->fields[5])); + rp->fields[2 + j - warg] = argv[j]; + MakeStr(s, strlen(s), &(rp->fields[5])); c_put(&(w->window->funclist), &f); - - ReturnWindow; - } - else + + ReturnWindow; + } + else #endif /* Graphics3D */ - { + { CheckArgMultiple(3); for(i=0; i < n; i++) { C_integer x, y; - int base = warg + i * 3; + int base = warg + i * 3; CnvCInteger(argv[base], x); CnvCInteger(argv[base + 1], y); - x += w->context->dx; - y += w->context->dy; + x += w->context->dx; + y += w->context->dy; CnvTmpString(argv[base + 2], argv[base + 2]); - s = StrLoc(argv[base + 2]); - len = StrLen(argv[base + 2]); -#ifdef GraphicsGL - if (w->window->is_gl) - gl_drawstrng(w, x, y, s, len); - else -#endif /* GraphicsGL */ - drawstrng(w, x, y, s, len); + s = StrLoc(argv[base + 2]); + len = StrLen(argv[base + 2]); +#ifdef GraphicsGL + if (w->window->is_gl) + gl_drawstrng(w, x, y, s, len); + else +#endif /* GraphicsGL */ + drawstrng(w, x, y, s, len); } ReturnWindow; } @@ -1713,39 +1713,39 @@ function{1} EraseArea(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D wc = w->context; if (is_texture) { - base=warg; - CheckArgMultiple(4); - if (texhandle >= wc->display->ntextures) runerr(102, argv[base]); + base=warg; + CheckArgMultiple(4); + if (texhandle >= wc->display->ntextures) runerr(102, argv[base]); for (; base < argc; base+=4){ - if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); - if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); - if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); - TexFillRect(w, texhandle, x, y, width, height, 0); - } - ReturnWindow; - } + if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); + if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); + if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); + TexFillRect(w, texhandle, x, y, width, height, 0); + } + ReturnWindow; + } if (wc->rendermode == UGL3D) { - if(create_display_list(w, 40000) == Failed) - runerr(0); - + if(create_display_list(w, 40000) == Failed) + runerr(0); + #if HAVE_LIBGL - /* need to free selectionnamelist entries here */ + /* need to free selectionnamelist entries here */ wc->selectionnamecount=0; -#endif /* HAVE_LIBGL */ - erasetocolor(RED(wc->bg), GREEN(wc->bg), BLUE(wc->bg)); - swapbuffers(w, 0); +#endif /* HAVE_LIBGL */ + erasetocolor(RED(wc->bg), GREEN(wc->bg), BLUE(wc->bg)); + swapbuffers(w, 0); ReturnWindow; - } -#endif /* Graphics3D */ + } +#endif /* Graphics3D */ for (i = warg; i < argc || i == warg; i += 4) { r = rectargs(w, argc, argv, i, &x, &y, &width, &height); @@ -1757,7 +1757,7 @@ function{1} EraseArea(argv[argc]) runerr(0); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ eraseArea(w, x, y, width, height); } @@ -1778,29 +1778,29 @@ function{1} Event(argv[argc]) tended struct descrip d; int warg = 0; if (argc>warg && is:file(argv[warg])) { - d = argv[warg++]; + d = argv[warg++]; } else { - d = kywd_xwin[XKey_Window]; - } + d = kywd_xwin[XKey_Window]; + } if (is:null(d) || ((BlkD(d,File)->status & Fs_Window) == 0)) - runerr(140,d); + runerr(140,d); if ((BlkD(d,File)->status & (Fs_Read|Fs_Write)) == 0) - runerr(142,d); + runerr(142,d); w = BlkLoc(d)->File.fd.wb; #ifdef ConsoleWindow checkOpenConsole((FILE *)w, NULL); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ if (ISCLOSED(w) && BlkD(w->window->listp,List)->size == 0) - runerr(142,d); + runerr(142,d); if (argc - warg < 1) - t = -1; + t = -1; else - CnvCInteger(argv[warg], t) + CnvCInteger(argv[warg], t) #ifdef MSWindows if (EVQUEEMPTY(w->window)) - SetFocus(w->window->win); -#endif /* MSWindows */ + SetFocus(w->window->win); +#endif /* MSWindows */ d = nulldesc; i = wgetevent(w, &d, t); if (i == -3) { @@ -1813,9 +1813,9 @@ function{1} Event(argv[argc]) if (i == 0) { if (is:file(kywd_xwin[XKey_Window]) && w == BlkD(kywd_xwin[XKey_Window],File)->fd.wb) - lastEventWin = kywd_xwin[XKey_Window]; - else - lastEventWin = argv[warg-1]; + lastEventWin = kywd_xwin[XKey_Window]; + else + lastEventWin = argv[warg-1]; #ifdef GraphicsGL if (BlkD(lastEventWin,File)->fd.wb->window->is_gl) { lastEvFWidth = GL_FWIDTH(BlkD(lastEventWin,File)->fd.wb); @@ -1823,23 +1823,23 @@ function{1} Event(argv[argc]) lastEvAscent = GL_ASCENT(BlkD(lastEventWin,File)->fd.wb); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { lastEvFWidth = FWIDTH(BlkD(lastEventWin,File)->fd.wb); lastEvLeading = LEADING(BlkD(lastEventWin,File)->fd.wb); lastEvAscent = ASCENT(BlkD(lastEventWin,File)->fd.wb); } - if (is:integer(d) && IntVal(d)==WINDOWCLOSED && - !(w->window->inputmask & WindowClosureMask)) { - /* closed, don't accept more I/O on it */ - BlkLoc(lastEventWin)->File.status &= ~(Fs_Read|Fs_Write); - } - return d; - } + if (is:integer(d) && IntVal(d)==WINDOWCLOSED && + !(w->window->inputmask & WindowClosureMask)) { + /* closed, don't accept more I/O on it */ + BlkLoc(lastEventWin)->File.status &= ~(Fs_Read|Fs_Write); + } + return d; + } else if (i == -1) - runerr(141); + runerr(141); else - runerr(143); + runerr(143); } end @@ -1859,56 +1859,56 @@ function{0,1} Fg(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - warg=1; - (void) texhandle; /* silence "not used" compiler warning */ + warg=1; + (void) texhandle; /* silence "not used" compiler warning */ } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * If there is a (non-window) argument we are setting by * either a mutable color (negative int) or a string name. */ if (argc - warg > 0) { - if (is:integer(argv[warg])) { /* mutable color or packed RGB */ + if (is:integer(argv[warg])) { /* mutable color or packed RGB */ #ifdef GraphicsGL if (w->window->is_gl) { - if (gl_isetfg(w, IntVal(argv[warg])) == Failed) fail; + if (gl_isetfg(w, IntVal(argv[warg])) == Failed) fail; } - else -#endif /* GraphicsGL */ - if (isetfg(w, IntVal(argv[warg])) == Failed) fail; - } - else { - if (!cnv:C_string(argv[warg], tmp)) - runerr(103,argv[warg]); -#ifdef Graphics3D - if (w->context->rendermode == UGL3D) { + else +#endif /* GraphicsGL */ + if (isetfg(w, IntVal(argv[warg])) == Failed) fail; + } + else { + if (!cnv:C_string(argv[warg], tmp)) + runerr(103,argv[warg]); +#ifdef Graphics3D + if (w->context->rendermode == UGL3D) { /* set the material properties */ - if (setmaterials(w, tmp) == Failed) fail; + if (setmaterials(w, tmp) == Failed) fail; } - else -#endif /* Graphics3D */ + else +#endif /* Graphics3D */ { #ifdef GraphicsGL if (w->window->is_gl) { - if (gl_setfg(w, tmp) == Failed) fail; + if (gl_setfg(w, tmp) == Failed) fail; } - else -#endif /* GraphicsGL */ - if (setfg(w, tmp) == Failed) fail; + else +#endif /* GraphicsGL */ + if (setfg(w, tmp) == Failed) fail; } - } + } } /* * In any case, this function returns the current foreground color. */ -#ifdef Graphics3D +#ifdef Graphics3D if (w->context->rendermode == UGL3D) - getmaterials(sbuf1); + getmaterials(sbuf1); else #endif { @@ -1916,7 +1916,7 @@ function{0,1} Fg(argv[argc]) if (w->window->is_gl) gl_getfg(w, sbuf1); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ getfg(w, sbuf1); } @@ -1951,8 +1951,8 @@ function{1} FillArc(argv[argc]) if (gl_fillarcs(w, arcs, MAXXOBJS) == RunError) runerr(0); } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ fillarcs(w, arcs, MAXXOBJS); j = 0; } @@ -1967,7 +1967,7 @@ function{1} FillArc(argv[argc]) if (i + 4 >= argc || is:null(argv[i + 4])) { a1 = 0.0; - } + } else { if (!cnv:C_double(argv[i + 4], a1)) runerr(102, argv[i + 4]); @@ -1977,7 +1977,7 @@ function{1} FillArc(argv[argc]) a1 = -fmod(-a1, 2 * Pi); } if (i + 5 >= argc || is:null(argv[i + 5])) - a2 = 2 * Pi; + a2 = 2 * Pi; else { if (!cnv:C_double(argv[i + 5], a2)) runerr(102, argv[i + 5]); @@ -1985,8 +1985,8 @@ function{1} FillArc(argv[argc]) runerr(101, argv[i + 5]); } if (fabs(a2) >= 2 * Pi) { - a2 = 2 * Pi; - } + a2 = 2 * Pi; + } else { if (a2 < 0.0) { a1 += a2; @@ -2007,8 +2007,8 @@ function{1} FillArc(argv[argc]) if (gl_fillarcs(w, arcs, j) == RunError) runerr(0); } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ fillarcs(w, arcs, j); ReturnWindow; } @@ -2033,7 +2033,7 @@ function{1} FillCircle(argv[argc]) ReturnWindow; else if (r >= argc - warg) runerr(146); - else + else runerr(102, argv[warg + r]); } @@ -2061,38 +2061,38 @@ function{1} FillPolygon(argv[argc]) tended struct descrip d; tended struct b_realarray *ap; - /* check if the argument is a list */ - if (is:list(argv[warg])) { - num = BlkD(argv[warg], List)->size; - } - else { - num = argc-warg; - } + /* check if the argument is a list */ + if (is:list(argv[warg])) { + num = BlkD(argv[warg], List)->size; + } + else { + num = argc-warg; + } - /* Check the number of coordinates*/ - if (num%w->context->dim != 0 || numcontext->dim*3) - runerr(146); + /* Check the number of coordinates*/ + if (num%w->context->dim != 0 || numcontext->dim*3) + runerr(146); /* create a list to store function information */ - if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); - ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) + runerr(305, argv[warg]); + ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (create3Dlisthdr(&f, "FillPolygon", 4)!=Succeeded) - fail; - c_put(&f, &d); + if (create3Dlisthdr(&f, "FillPolygon", 4)!=Succeeded) + fail; + c_put(&f, &d); c_put(&(w->window->funclist), &f); /* draw polygons */ /*CheckArgMultiple(w->context->dim);*/ - if (w->window->buffermode == UGL_IMMEDIATE) { - drawpoly(w, ap->a, num, U3D_POLYGON, w->context->dim); - glFlush(); - } - return f; - } + if (w->window->buffermode == UGL_IMMEDIATE) { + drawpoly(w, ap->a, num, U3D_POLYGON, w->context->dim); + glFlush(); + } + return f; + } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ { CheckArgMultiple(2); @@ -2105,19 +2105,19 @@ function{1} FillPolygon(argv[argc]) dx = w->context->dx; dy = w->context->dy; for(i=0; i < n; i++) { - int base = warg + i * 2; - CnvCShort(argv[base], points[i].x); - CnvCShort(argv[base + 1], points[i].y); - points[i].x += dx; - points[i].y += dy; - } + int base = warg + i * 2; + CnvCShort(argv[base], points[i].x); + CnvCShort(argv[base + 1], points[i].y); + points[i].x += dx; + points[i].y += dy; + } #ifdef GraphicsGL if (w->window->is_gl) { if (gl_fillpolygon(w, points, n) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ fillpolygon(w, points, n); free(points); ReturnWindow; @@ -2125,7 +2125,7 @@ function{1} FillPolygon(argv[argc]) } end - + /* * FillRectangle(w, x1, y1, width1, height1,...,xN, yN, widthN, heightN) */ @@ -2144,27 +2144,27 @@ function{1} FillRectangle(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D if (is_texture) { - base=warg; - CheckArgMultiple(4); + base=warg; + CheckArgMultiple(4); - if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); + if (texhandle >= w->context->display->ntextures) runerr(101, argv[base]); for (; base < argc; base+=4){ - if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); - if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); - if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); - if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); - TexFillRect(w, texhandle, x, y, width, height, 1); - } + if (!cnv:C_integer(argv[base] , x)) runerr(101, argv[base]); + if (!cnv:C_integer(argv[base+1], y)) runerr(101, argv[base+1]); + if (!cnv:C_integer(argv[base+2], width)) runerr(101, argv[base+2]); + if (!cnv:C_integer(argv[base+3], height)) runerr(101, argv[base+3]); + TexFillRect(w, texhandle, x, y, width, height, 1); + } - ReturnWindow; - } -#endif /* Graphics3D */ + ReturnWindow; + } +#endif /* Graphics3D */ j = 0; @@ -2173,13 +2173,13 @@ function{1} FillRectangle(argv[argc]) if (r >= 0) runerr(101, argv[r]); if (j == MAXXOBJS) { -#ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_fillrectangles(w,recs,MAXXOBJS) == RunError) - runerr(0); - } +#ifdef GraphicsGL + if (w->window->is_gl) { + if (gl_fillrectangles(w,recs,MAXXOBJS) == RunError) + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ fillrectangles(w,recs,MAXXOBJS); j = 0; } @@ -2190,13 +2190,13 @@ function{1} FillRectangle(argv[argc]) j++; } -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) { if (gl_fillrectangles(w,recs,j) == RunError) - runerr(0); - } + runerr(0); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ fillrectangles(w, recs, j); ReturnWindow; } @@ -2225,12 +2225,12 @@ function{0,1} Font(argv[argc]) if (warg < argc) { if (!cnv:C_string(argv[warg],tmp)) runerr(103,argv[warg]); -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) { if (gl_setfont(w,&tmp) == Failed) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { if (setfont(w,&tmp) == Failed) fail; }} @@ -2238,17 +2238,17 @@ function{0,1} Font(argv[argc]) if (w->window->is_gl) gl_getfntnam(w, buf); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ getfntnam(w, buf); len = strlen(buf); #ifdef Graphics3D if (w->context->rendermode == UGL3D) { - if (!constr) - if (!(constr = rec_structor3d(GL3D_FONT))) - syserr("failed to create opengl record constructor"); + if (!constr) + if (!(constr = rec_structor3d(GL3D_FONT))) + syserr("failed to create opengl record constructor"); nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); f.dword = D_Record; f.vword.bptr = (union block *) rp; @@ -2256,13 +2256,13 @@ function{0,1} Font(argv[argc]) draw_code = si_s2i(redraw3Dnames, "Font3d"); if (draw_code == -1) - fail; + fail; - MakeInt(draw_code, &rp->fields[1]); - MakeInt(curr_font, &rp->fields[2]); - c_put(&(w->window->funclist), &f); - } -#endif /* Graphics3D */ + MakeInt(draw_code, &rp->fields[1]); + MakeInt(curr_font, &rp->fields[2]); + c_put(&(w->window->funclist), &f); + } +#endif /* Graphics3D */ Protect(tmp = alcstr(buf, len), runerr(0)); return string(len,tmp); } @@ -2290,10 +2290,10 @@ function{1} FreeColor(argv[argc]) CnvCInteger(argv[i], n) if (n < 0) { #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) gl_free_mutable(w, n); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ free_mutable(w, n); } } @@ -2301,10 +2301,10 @@ function{1} FreeColor(argv[argc]) if (!cnv:C_string(argv[i], s)) runerr(103,argv[i]); #ifdef GraphicsGL - if (!w->window->is_gl) + if (!w->window->is_gl) gl_freecolor(w, s); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ freecolor(w, s); } } @@ -2328,13 +2328,13 @@ function{1} GotoRC(argv[argc]) OptWindow(w); if (argc - warg < 1) - r = 1; + r = 1; else - CnvCInteger(argv[warg], r) + CnvCInteger(argv[warg], r) if (argc - warg < 2) - c = 1; + c = 1; else - CnvCInteger(argv[warg + 1], c) + CnvCInteger(argv[warg + 1], c) gotorc(w,r,c); @@ -2356,13 +2356,13 @@ function{1} GotoXY(argv[argc]) OptWindow(w); if (argc - warg < 1) - x = 0; + x = 0; else - CnvCInteger(argv[warg], x) + CnvCInteger(argv[warg], x) if (argc - warg < 2) - y = 0; + y = 0; else - CnvCInteger(argv[warg + 1], y) + CnvCInteger(argv[warg + 1], y) gotoxy(w, x, y); @@ -2385,7 +2385,7 @@ function{1} Lower(argv[argc]) if (w->window->is_gl) gl_lowerWindow(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ lowerWindow(w); ReturnWindow; } @@ -2408,8 +2408,8 @@ function{0,1} NewColor(argv[argc]) if (w->window->is_gl) { if (gl_mutable_color(w, argv+warg, argc-warg, &rv) == Failed) fail; } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ if (mutable_color(w, argv+warg, argc-warg, &rv) == Failed) fail; return C_integer rv; } @@ -2430,21 +2430,21 @@ function{0,1} PaletteChars(argv[argc]) if (is:file(argv[0]) && (BlkD(argv[0],File)->status & Fs_Window)) warg = 1; else - warg = 0; /* window not required */ + warg = 0; /* window not required */ if (argc - warg < 1) n = 1; else n = palnum(&argv[warg]); switch (n) { - case -1: runerr(103, argv[warg]); /* not a string */ - case 0: fail; /* unrecognized */ - case 1: return string(90, c1list); /* c1 */ - case 2: return string(9, c2list); /* c2 */ - case 3: return string(31, c3list); /* c3 */ - case 4: return string(73, c4list); /* c4 */ - case 5: return string(141, (char *)allchars); /* c5 */ - case 6: return string(241, (char *)allchars); /* c6 */ - default: /* gn */ + case -1: runerr(103, argv[warg]); /* not a string */ + case 0: fail; /* unrecognized */ + case 1: return string(90, c1list); /* c1 */ + case 2: return string(9, c2list); /* c2 */ + case 3: return string(31, c3list); /* c3 */ + case 4: return string(73, c4list); /* c4 */ + case 5: return string(141, (char *)allchars); /* c5 */ + case 6: return string(241, (char *)allchars); /* c6 */ + default: /* gn */ if (n >= -64) return string(-n, c4list); else @@ -2471,7 +2471,7 @@ function{0,1} PaletteColor(argv[argc]) if (is:file(argv[0]) && (BlkD(argv[0],File)->status & Fs_Window)) warg = 1; else - warg = 0; /* window not required */ + warg = 0; /* window not required */ if (argc - warg < 2) runerr(103); p = palnum(&argv[warg]); @@ -2483,7 +2483,7 @@ function{0,1} PaletteColor(argv[argc]) runerr(103, argv[warg + 1]); if (StrLen(d) != 1) runerr(205, d); - e = palsetup(p); + e = palsetup(p); if (e == NULL) runerr(305); e += *StrLoc(d) & 0xFF; @@ -2511,14 +2511,14 @@ function{0,1} PaletteKey(argv[argc]) long r, g, b, a; if (is:file(argv[0]) && (BlkD(argv[0],File)->status & Fs_Window)) { - w = BlkLoc(argv[0])->File.fd.wb; /* explicit window */ + w = BlkLoc(argv[0])->File.fd.wb; /* explicit window */ warg = 1; } else if (is:file(kywd_xwin[XKey_Window]) && (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window)) - w = BlkLoc(kywd_xwin[XKey_Window])->File.fd.wb; /* &window */ + w = BlkLoc(kywd_xwin[XKey_Window])->File.fd.wb; /* &window */ else - w = NULL; /* no window (but proceed anyway) */ + w = NULL; /* no window (but proceed anyway) */ if (argc - warg < 2) runerr(103); @@ -2535,7 +2535,7 @@ function{0,1} PaletteKey(argv[argc]) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (w == NULL || (s = get_mutable_name(w, n)) == NULL) fail; } @@ -2568,7 +2568,7 @@ function{1} Pattern(argv[argc]) runerr(103, nulldesc); #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) switch (gl_SetPattern(w, StrLoc(argv[warg]), StrLen(argv[warg]))) { case RunError: runerr(0, argv[warg]); @@ -2576,7 +2576,7 @@ function{1} Pattern(argv[argc]) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ switch (SetPattern(w, StrLoc(argv[warg]), StrLen(argv[warg]))) { case RunError: runerr(0, argv[warg]); @@ -2606,38 +2606,38 @@ function{0,1} Pending(argv[argc]) if (argc>warg && is:file(argv[warg])) { if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); + runerr(140,argv[warg]); if ((BlkD(argv[warg],File)->status & Fs_Write) == 0) - isclosed = 1; + isclosed = 1; w = BlkD(argv[warg],File)->fd.wb; #ifdef ConsoleWindow - checkOpenConsole((FILE *)w, NULL); -#endif /* ConsoleWindow */ + checkOpenConsole((FILE *)w, NULL); +#endif /* ConsoleWindow */ if (ISCLOSED(w)) - isclosed = 1; + isclosed = 1; warg++; } else { if (!(is:file(kywd_xwin[XKey_Window]) && - (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) - runerr(140,kywd_xwin[XKey_Window]); - if ((BlkD(kywd_xwin[XKey_Window],File)->status& (Fs_Read|Fs_Write))==0) - isclosed = 1; + (BlkD(kywd_xwin[XKey_Window],File)->status & Fs_Window))) + runerr(140,kywd_xwin[XKey_Window]); + if ((BlkD(kywd_xwin[XKey_Window],File)->status& (Fs_Read|Fs_Write))==0) + isclosed = 1; w = BlkLoc(kywd_xwin[XKey_Window])->File.fd.wb; if (ISCLOSED(w)) - isclosed = 1; + isclosed = 1; } ws = w->window; if (isclosed == 0) { #ifdef GraphicsGL - if (w->window->is_gl) - gl_wsync(w); - else -#endif /* GraphicsGL */ - wsync(w); - } + if (w->window->is_gl) + gl_wsync(w); + else +#endif /* GraphicsGL */ + wsync(w); + } /* * put additional arguments to Pending on the pending list in @@ -2654,7 +2654,7 @@ function{0,1} Pending(argv[argc]) switch (pollevent()) { case -1: runerr(141); case 0: fail; - } + } return ws->listp; } end @@ -2700,7 +2700,7 @@ function{3} Pixel(argv[argc]) if (gl_getpixel_init(w, &imem) == Failed) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (getpixel_init(w, &imem) == Failed) fail; lastval = emptystr; @@ -2708,10 +2708,10 @@ function{3} Pixel(argv[argc]) for (j=y; j < y + height; j++) { for (i=x; i < x + width; i++) { #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) gl_getpixel(w, i, j, &rv, strout, &imem); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ getpixel(w, i, j, &rv, strout, &imem); slen = strlen(strout); @@ -2722,58 +2722,58 @@ function{3} Pixel(argv[argc]) StrLen(lastval) = slen; } #if COMPILER - suspend lastval; /* memory leak on vanquish */ -#else /* COMPILER */ - /* - * suspend, but free up imem if vanquished; RTL workaround. - * Needs implementing under the compiler iconc. - */ - { - int signal; - r_args[0] = lastval; -#ifdef TSTATARG - if ((signal = interp(G_Fsusp, r_args, CURTSTATARG)) != A_Resume) { -#else /* TSTATARG */ - if ((signal = interp(G_Fsusp, r_args)) != A_Resume) { -#endif /* TSTATARG */ - tend = r_tend.previous; + suspend lastval; /* memory leak on vanquish */ +#else /* COMPILER */ + /* + * suspend, but free up imem if vanquished; RTL workaround. + * Needs implementing under the compiler iconc. + */ + { + int signal; + r_args[0] = lastval; +#ifdef TSTATARG + if ((signal = interp(G_Fsusp, r_args, CURTSTATARG)) != A_Resume) { +#else /* TSTATARG */ + if ((signal = interp(G_Fsusp, r_args)) != A_Resume) { +#endif /* TSTATARG */ + tend = r_tend.previous; #ifdef GraphicsGL - if (w->window->is_gl) - gl_getpixel_term(w, &imem); - else -#endif /* GraphicsGL */ - getpixel_term(w, &imem); - VanquishReturn(signal); - } - } -#endif /* COMPILER */ + if (w->window->is_gl) + gl_getpixel_term(w, &imem); + else +#endif /* GraphicsGL */ + getpixel_term(w, &imem); + VanquishReturn(signal); + } + } +#endif /* COMPILER */ } else { #if COMPILER - suspend C_integer rv; /* memory leak on vanquish */ -#else /* COMPILER */ - int signal; - /* - * suspend, but free up imem if vanquished; RTL workaround - * Needs implementing under the compiler. - */ - r_args[0].dword = D_Integer; - r_args[0].vword.integr = rv; -#ifdef TSTATARG - if ((signal = interp(G_Fsusp, r_args, CURTSTATARG)) != A_Resume) { -#else /* TSTATARG */ - if ((signal = interp(G_Fsusp, r_args)) != A_Resume) { -#endif /* TSTATARG */ - tend = r_tend.previous; + suspend C_integer rv; /* memory leak on vanquish */ +#else /* COMPILER */ + int signal; + /* + * suspend, but free up imem if vanquished; RTL workaround + * Needs implementing under the compiler. + */ + r_args[0].dword = D_Integer; + r_args[0].vword.integr = rv; +#ifdef TSTATARG + if ((signal = interp(G_Fsusp, r_args, CURTSTATARG)) != A_Resume) { +#else /* TSTATARG */ + if ((signal = interp(G_Fsusp, r_args)) != A_Resume) { +#endif /* TSTATARG */ + tend = r_tend.previous; #ifdef GraphicsGL - if (w->window->is_gl) - gl_getpixel_term(w, &imem); - else -#endif /* GraphicsGL */ - getpixel_term(w, &imem); - VanquishReturn(signal); - } -#endif /* COMPILER */ + if (w->window->is_gl) + gl_getpixel_term(w, &imem); + else +#endif /* GraphicsGL */ + getpixel_term(w, &imem); + VanquishReturn(signal); + } +#endif /* COMPILER */ } } } @@ -2781,7 +2781,7 @@ function{3} Pixel(argv[argc]) if (w->window->is_gl) gl_getpixel_term(w, &imem); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ getpixel_term(w, &imem); fail; } @@ -2803,18 +2803,18 @@ function{0,2} QueryPointer(w) CURTSTATVAR(); pollevent(); if (is:null(w)) { - query_rootpointer(&xp); - } + query_rootpointer(&xp); + } else { - if (!is:file(w) || !(BlkD(w,File)->status & Fs_Window)) - runerr(140, w); + if (!is:file(w) || !(BlkD(w,File)->status & Fs_Window)) + runerr(140, w); #ifdef GraphicsGL - if ((BlkD(w,File)->fd.wb)->window->is_gl) - gl_query_pointer(BlkLoc(w)->File.fd.wb, &xp); - else -#endif /* GraphicsGL */ - query_pointer(BlkLoc(w)->File.fd.wb, &xp); - } + if ((BlkD(w,File)->fd.wb)->window->is_gl) + gl_query_pointer(BlkLoc(w)->File.fd.wb, &xp); + else +#endif /* GraphicsGL */ + query_pointer(BlkLoc(w)->File.fd.wb, &xp); + } suspend C_integer xp.x; suspend C_integer xp.y; fail; @@ -2836,7 +2836,7 @@ function{1} Raise(argv[argc]) if (w->window->is_gl) gl_raiseWindow(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ raiseWindow(w); ReturnWindow; } @@ -2860,7 +2860,7 @@ function{0,1} ReadImage(argv[argc]) #ifdef Graphics3D int is_texture=0; int texhandle; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); #ifdef Graphics3D @@ -2870,31 +2870,31 @@ function{0,1} ReadImage(argv[argc]) imd.is_bottom_up = 1; } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ { #if NT imd.format = UCOLOR_BGR; #else imd.format = UCOLOR_RGB; -#endif +#endif imd.is_bottom_up = 0; } if (argc - warg == 0) - runerr(103,nulldesc); + runerr(103,nulldesc); if (!cnv:C_string(argv[warg], tmp)) - runerr(103,argv[warg]); + runerr(103,argv[warg]); /* * x and y must be integers; they default to the upper left pixel. */ if (argc - warg < 2) - x = -w->context->dx; + x = -w->context->dx; else if (!def:C_integer(argv[warg+1], -w->context->dx, x)) - runerr(101, argv[warg+1]); + runerr(101, argv[warg+1]); if (argc - warg < 3) - y = -w->context->dy; + y = -w->context->dy; else if (!def:C_integer(argv[warg+2], -w->context->dy, y)) runerr(101, argv[warg+2]); @@ -2924,21 +2924,21 @@ function{0,1} ReadImage(argv[argc]) if (r == Succeeded) { #ifdef Graphics3D - if (is_texture) { - if (texhandle > w->context->display->ntextures) - runerr(102, argv[warg]); - return C_integer (word) TexReadImage(w, texhandle, x, y, &imd); - } -#endif /* Graphics3D */ + if (is_texture) { + if (texhandle > w->context->display->ntextures) + runerr(102, argv[warg]); + return C_integer (word) TexReadImage(w, texhandle, x, y, &imd); + } +#endif /* Graphics3D */ #ifdef GraphicsGL - if (w->window->is_gl) + if (w->window->is_gl) status = gl_strimage(w, x, y, imd.width, imd.height, imd.paltbl, - imd.data, (word)imd.width * (word)imd.height, 0); + imd.data, (word)imd.width * (word)imd.height, 0); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ status = strimage(w, x, y, imd.width, imd.height, imd.paltbl, - imd.data, (word)imd.width * (word)imd.height, 0); + imd.data, (word)imd.width * (word)imd.height, 0); if (status < 0) r = RunError; free((pointer)imd.paltbl); @@ -2949,7 +2949,7 @@ function{0,1} ReadImage(argv[argc]) if (w->window->is_gl) r = gl_readimage(w, filename, x, y, &status); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ r = readimage(w, filename, x, y, &status); } if (r == RunError) @@ -2976,20 +2976,20 @@ function{1} WSync(w) wbp _w_; if (is:null(w)) { - _w_ = NULL; - } + _w_ = NULL; + } else if (!is:file(w)) runerr(140,w); else { if (!(BlkD(w,File)->status & Fs_Window)) runerr(140,w); _w_ = BlkLoc(w)->File.fd.wb; - } + } #ifdef GraphicsGL if (_w_ != NULL &&_w_->window->is_gl) gl_wsync(_w_); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wsync(_w_); #endif pollevent(); @@ -3012,13 +3012,13 @@ function{1} TextWidth(argv[argc]) if (warg == argc) runerr(103,nulldesc); else if (!cnv:tmp_string(argv[warg],argv[warg])) - runerr(103,argv[warg]); - + runerr(103,argv[warg]); + #ifdef GraphicsGL if (w->window->is_gl) i = GL_TEXTWIDTH(w, StrLoc(argv[warg]), StrLen(argv[warg])); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ i = TEXTWIDTH(w, StrLoc(argv[warg]), StrLen(argv[warg])); return C_integer i; } @@ -3058,7 +3058,7 @@ function{*} WAttrib(argv[argc]) #ifdef Graphics3D int is_texture = 0; int texhandle = 0; -#endif /* Graphics3D */ +#endif /* Graphics3D */ OptTexWindow(w); wsave = w; @@ -3067,16 +3067,16 @@ function{*} WAttrib(argv[argc]) */ for (pass = 1; pass <= 2; pass++) { - w = wsave; - if (config && pass == 2) { + w = wsave; + if (config && pass == 2) { #ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_do_config(w, config) == Failed) fail; - } - else -#endif /* GraphicsGL */ - if (do_config(w, config) == Failed) fail; - } + if (w->window->is_gl) { + if (gl_do_config(w, config) == Failed) fail; + } + else +#endif /* GraphicsGL */ + if (do_config(w, config) == Failed) fail; + } for (n = warg; n < argc; n++) { if (is:file(argv[n])) {/* Current argument is a file */ /* @@ -3087,32 +3087,32 @@ function{*} WAttrib(argv[argc]) if (!(BlkD(argv[n],File)->status & Fs_Window)) runerr(140,argv[n]); w = BlkLoc(argv[n])->File.fd.wb; - if (config && pass == 2) { + if (config && pass == 2) { #ifdef GraphicsGL - if (w->window->is_gl) { - if (gl_do_config(w, config) == Failed) fail; - } - else -#endif /* GraphicsGL */ - if (do_config(w, config) == Failed) fail; - } + if (w->window->is_gl) { + if (gl_do_config(w, config) == Failed) fail; + } + else +#endif /* GraphicsGL */ + if (do_config(w, config) == Failed) fail; + } } - else { /* Current argument should be a string */ - /* - * In pass 1, a null argument is an error; failed attribute - * assignments are turned into null descriptors for pass 2 - * and are ignored. - */ + else { /* Current argument should be a string */ + /* + * In pass 1, a null argument is an error; failed attribute + * assignments are turned into null descriptors for pass 2 + * and are ignored. + */ if (is:null(argv[n])) { - if (pass == 2) - continue; - else runerr(109, argv[n]); - } + if (pass == 2) + continue; + else runerr(109, argv[n]); + } /* * If its an integer or real, it can't be a valid attribute. */ - if (is:integer(argv[n]) || is:real(argv[n])) - runerr(145, argv[n]); + if (is:integer(argv[n]) || is:real(argv[n])) + runerr(145, argv[n]); /* * Convert the argument to a string */ @@ -3122,131 +3122,131 @@ function{*} WAttrib(argv[argc]) * Read/write the attribute */ if (pass == 1) { - - char *tmp_s = StrLoc(sbuf); - char *tmp_s2 = StrLoc(sbuf) + StrLen(sbuf); - for ( ; tmp_s < tmp_s2; tmp_s++) - if (*tmp_s == '=') break; - if (tmp_s < tmp_s2) { + + char *tmp_s = StrLoc(sbuf); + char *tmp_s2 = StrLoc(sbuf) + StrLen(sbuf); + for ( ; tmp_s < tmp_s2; tmp_s++) + if (*tmp_s == '=') break; + if (tmp_s < tmp_s2) { #ifdef Graphics3D - if (is_texture) { - /* For now, no attribute assignments on textures. */ - if (StrLen(sbuf) > 12 && - !strncmp(StrLoc(sbuf), "windowlabel=", 12)) { - fail; - } - else - runerr(0, argv[n]); - } -#endif /* Graphics3D */ - - /* - * pass 1: perform attribute assignments - */ - - - switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf), - &sbuf2, answer)) { - case Failed: - /* - * Mark the attribute so we don't produce a result - */ - argv[n] = nulldesc; - continue; - case RunError: runerr(0, argv[n]); - - - } - if (StrLen(sbuf) > 4) { - if (!strncmp(StrLoc(sbuf), "pos=", 4)) config |= 1; - if (StrLen(sbuf) > 5) { - if (!strncmp(StrLoc(sbuf), "posx=", 5)) config |= 1; - if (!strncmp(StrLoc(sbuf), "posy=", 5)) config |= 1; - if (!strncmp(StrLoc(sbuf), "rows=", 5)) config |= 2; - if (!strncmp(StrLoc(sbuf), "size=", 5)) config |= 2; - if (StrLen(sbuf) > 6) { - if (!strncmp(StrLoc(sbuf), "width=", 6)) - config |= 2; - if (!strncmp(StrLoc(sbuf), "lines=", 6)) - config |= 2; - if (StrLen(sbuf) > 7) { - if (!strncmp(StrLoc(sbuf), "height=", 7)) - config |= 2; - if (!strncmp(StrLoc(sbuf), "resize=", 7)) - config |= 2; - if (StrLen(sbuf) > 8) { - if (!strncmp(StrLoc(sbuf), "columns=", 8)) - config |= 2; - if (StrLen(sbuf) > 9) { - if (!strncmp(StrLoc(sbuf), - "geometry=", 9)) - config |= 3; - } - } - } - } - } - } - } - } - /* - * pass 2: perform attribute queries, suspend result(s) - */ + if (is_texture) { + /* For now, no attribute assignments on textures. */ + if (StrLen(sbuf) > 12 && + !strncmp(StrLoc(sbuf), "windowlabel=", 12)) { + fail; + } + else + runerr(0, argv[n]); + } +#endif /* Graphics3D */ + + /* + * pass 1: perform attribute assignments + */ + + + switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf), + &sbuf2, answer)) { + case Failed: + /* + * Mark the attribute so we don't produce a result + */ + argv[n] = nulldesc; + continue; + case RunError: runerr(0, argv[n]); + + + } + if (StrLen(sbuf) > 4) { + if (!strncmp(StrLoc(sbuf), "pos=", 4)) config |= 1; + if (StrLen(sbuf) > 5) { + if (!strncmp(StrLoc(sbuf), "posx=", 5)) config |= 1; + if (!strncmp(StrLoc(sbuf), "posy=", 5)) config |= 1; + if (!strncmp(StrLoc(sbuf), "rows=", 5)) config |= 2; + if (!strncmp(StrLoc(sbuf), "size=", 5)) config |= 2; + if (StrLen(sbuf) > 6) { + if (!strncmp(StrLoc(sbuf), "width=", 6)) + config |= 2; + if (!strncmp(StrLoc(sbuf), "lines=", 6)) + config |= 2; + if (StrLen(sbuf) > 7) { + if (!strncmp(StrLoc(sbuf), "height=", 7)) + config |= 2; + if (!strncmp(StrLoc(sbuf), "resize=", 7)) + config |= 2; + if (StrLen(sbuf) > 8) { + if (!strncmp(StrLoc(sbuf), "columns=", 8)) + config |= 2; + if (StrLen(sbuf) > 9) { + if (!strncmp(StrLoc(sbuf), + "geometry=", 9)) + config |= 3; + } + } + } + } + } + } + } + } + /* + * pass 2: perform attribute queries, suspend result(s) + */ else if (pass==2) { - char *stmp, *stmp2; - /* - * Turn assignments into queries. - */ - for( stmp = StrLoc(sbuf), - stmp2 = stmp + StrLen(sbuf); stmp < stmp2; stmp++) - if (*stmp == '=') break; - if (stmp < stmp2) - StrLen(sbuf) = stmp - StrLoc(sbuf); + char *stmp, *stmp2; + /* + * Turn assignments into queries. + */ + for( stmp = StrLoc(sbuf), + stmp2 = stmp + StrLen(sbuf); stmp < stmp2; stmp++) + if (*stmp == '=') break; + if (stmp < stmp2) + StrLen(sbuf) = stmp - StrLoc(sbuf); #ifdef Graphics3D - if (is_texture) { - - wdp wd = w->context->display; - /* - * So far, textures support only read-only access to a - * couple common canvas attributes (width and height). - */ - if(StrLen(sbuf)==5 && StrLoc(sbuf)[0]=='w' && - StrLoc(sbuf)[1]=='i' && StrLoc(sbuf)[2]=='d' && - StrLoc(sbuf)[3]=='t' && StrLoc(sbuf)[4]=='h') { - return C_integer wd->stex[texhandle].width; - } - else if (StrLen(sbuf)==6 && - StrLoc(sbuf)[0]=='h' && StrLoc(sbuf)[1]=='e' && - StrLoc(sbuf)[2]=='i' && StrLoc(sbuf)[3]=='g' && - StrLoc(sbuf)[4]=='h' && StrLoc(sbuf)[5]=='t') { - return C_integer wd->stex[texhandle].height; - } - else - - { - /* the default=fail semantics will be clear enough - * to applications on read. - */ - fail; - } - } -#endif /* Graphics3D */ - - switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf), - &sbuf2, answer)) { - case Failed: continue; - case RunError: runerr(0, argv[n]); - } - if (is:string(sbuf2)) { - char *p=StrLoc(sbuf2); - Protect(StrLoc(sbuf2) = alcstr(StrLoc(sbuf2),StrLen(sbuf2)), runerr(0)); + if (is_texture) { + + wdp wd = w->context->display; + /* + * So far, textures support only read-only access to a + * couple common canvas attributes (width and height). + */ + if(StrLen(sbuf)==5 && StrLoc(sbuf)[0]=='w' && + StrLoc(sbuf)[1]=='i' && StrLoc(sbuf)[2]=='d' && + StrLoc(sbuf)[3]=='t' && StrLoc(sbuf)[4]=='h') { + return C_integer wd->stex[texhandle].width; + } + else if (StrLen(sbuf)==6 && + StrLoc(sbuf)[0]=='h' && StrLoc(sbuf)[1]=='e' && + StrLoc(sbuf)[2]=='i' && StrLoc(sbuf)[3]=='g' && + StrLoc(sbuf)[4]=='h' && StrLoc(sbuf)[5]=='t') { + return C_integer wd->stex[texhandle].height; + } + else + + { + /* the default=fail semantics will be clear enough + * to applications on read. + */ + fail; + } + } +#endif /* Graphics3D */ + + switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf), + &sbuf2, answer)) { + case Failed: continue; + case RunError: runerr(0, argv[n]); + } + if (is:string(sbuf2)) { + char *p=StrLoc(sbuf2); + Protect(StrLoc(sbuf2) = alcstr(StrLoc(sbuf2),StrLen(sbuf2)), runerr(0)); if (p != answer) free(p); } suspend sbuf2; } } } - } + } fail; } end @@ -3278,7 +3278,7 @@ function{0,1} WDefault(argv[argc]) if (gl_getdefault(w, prog, opt, sbuf1) == Failed) fail; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (getdefault(w, prog, opt, sbuf1) == Failed) fail; l = strlen(sbuf1); Protect(prog = alcstr(sbuf1,l),runerr(0)); @@ -3301,7 +3301,7 @@ function{1} WFlush(argv[argc]) if (w->window->is_gl) gl_wflush(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wflush(w); ReturnWindow; } @@ -3335,19 +3335,19 @@ function{0,1} WriteImage(argv[argc]) * (the casts to long are necessary to avoid unsigned comparison.) */ if (x < 0) { - width += x; - x = 0; + width += x; + x = 0; } if (y < 0) { - height += y; - y = 0; + height += y; + y = 0; } if (x + width > (long) w->window->width) - width = w->window->width - x; + width = w->window->width - x; if (y + height > (long) w->window->height) - height = w->window->height - y; + height = w->window->height - y; if (width <= 0 || height <= 0) - fail; + fail; /* * try platform-dependent code first; it will reject the call @@ -3357,23 +3357,23 @@ function{0,1} WriteImage(argv[argc]) if (w->window->is_gl) r = gl_dumpimage(w, s, x, y, width, height); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ r = dumpimage(w, s, x, y, width, height); #if HAVE_LIBJPEG if ((r == NoCvt) && - (strcmp(s + strlen(s)-4, ".jpg")==0 || + (strcmp(s + strlen(s)-4, ".jpg")==0 || (strcmp(s + strlen(s)-4, ".JPG")==0))) { - r = writeJPEG(w, s, x, y, width, height); + r = writeJPEG(w, s, x, y, width, height); } -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ #if HAVE_LIBPNG if ((r == NoCvt) && - (strcmp(s + strlen(s)-4, ".png")==0 || + (strcmp(s + strlen(s)-4, ".png")==0 || (strcmp(s + strlen(s)-4, ".PNG")==0))) { - r = writePNG(w, s, x, y, width, height); + r = writePNG(w, s, x, y, width, height); } -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ if (r == NoCvt) r = writeBMP(w, s, x, y, width, height); if (r == NoCvt) @@ -3431,7 +3431,7 @@ function{0,1} WinPlayMedia(argv[argc]) for (n = warg; n < argc; n++) { if (!cnv:C_string(argv[n], tmp)) - runerr(103,argv[warg]); + runerr(103,argv[warg]); if (playmedia(w, tmp) == Failed) fail; } return nulldesc; @@ -3473,22 +3473,22 @@ function{0,1} WinButton(argv[argc]) */ if (i == ws->nChildren) { SUSPEND_THREADS(); - if (i == ws->nChildren) { + if (i == ws->nChildren) { ws->nChildren++; ws->child = realloc(ws->child, - ws->nChildren * sizeof(childcontrol)); - makebutton(ws, ws->child + i, s); - } + ws->nChildren * sizeof(childcontrol)); + makebutton(ws, ws->child + i, s); + } RESUME_THREADS(); } if (warg >= argc) x = 0; else if (!def:C_integer(argv[warg], 0, x)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; if (warg >= argc) y = 0; else if (!def:C_integer(argv[warg], 0, y)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * default width is width of text in system font + 2 chars @@ -3496,7 +3496,7 @@ function{0,1} WinButton(argv[argc]) ii = sysTextWidth(w, s, strlen(s)) + 10; if (warg >= argc) width = ii; else if (!def:C_integer(argv[warg], ii, width)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * default height is height of text in system font * 7/4 @@ -3504,7 +3504,7 @@ function{0,1} WinButton(argv[argc]) i2 = sysFontHeight(w) * 7 / 4; if (warg >= argc) height = i2; else if (!def:C_integer(argv[warg], i2, height)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); movechild(ws->child + i, x, y, width, height); ReturnWindow; @@ -3554,12 +3554,12 @@ function{0,1} WinScrollBar(argv[argc]) */ if (i == ws->nChildren) { SUSPEND_THREADS(); - if (i == ws->nChildren) { + if (i == ws->nChildren) { ws->nChildren++; ws->child = realloc(ws->child, - ws->nChildren * sizeof(childcontrol)); - makescrollbar(ws, ws->child + i, s, i1, i2); - } + ws->nChildren * sizeof(childcontrol)); + makescrollbar(ws, ws->child + i, s, i1, i2); + } RESUME_THREADS(); } @@ -3568,7 +3568,7 @@ function{0,1} WinScrollBar(argv[argc]) */ if (warg >= argc) i3 = 10; else if (!def:C_integer(argv[warg], 10, i3)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * x defaults to the right edge of the window - system scrollbar width @@ -3576,14 +3576,14 @@ function{0,1} WinScrollBar(argv[argc]) ii = ws->width - sysScrollWidth(); if (warg >= argc) x = ii; else if (!def:C_integer(argv[warg], ii, x)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * y defaults to 0 */ if (warg >= argc) y = 0; else if (!def:C_integer(argv[warg], 0, y)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * width defaults to system scrollbar width @@ -3591,14 +3591,14 @@ function{0,1} WinScrollBar(argv[argc]) ii = sysScrollWidth(); if (warg >= argc) width = ii; else if (!def:C_integer(argv[warg], ii, width)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); warg++; /* * height defaults to height of the client window */ if (warg >= argc) height = ws->height; else if (!def:C_integer(argv[warg], ws->height, height)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); movechild(ws->child + i, x, y, width, height); ReturnWindow; @@ -3628,7 +3628,7 @@ function{0,1} WinMenuBar(argv[argc]) for (i = warg; i < argc; i++) { if (!is:list(argv[i])) runerr(108, argv[i]); total += BlkD(argv[i],List)->size; - } + } /* * free up memory for the old menu map */ @@ -3662,7 +3662,7 @@ function{0, 2} WinEditRegion(argv[argc]) ws = w->window; if (warg == argc) fail; if (!cnv:C_string(argv[warg], s)) - runerr(103, argv[warg]); + runerr(103, argv[warg]); warg++; /* * look for an existing edit region with this id. @@ -3676,12 +3676,12 @@ function{0, 2} WinEditRegion(argv[argc]) */ if (i == ws->nChildren) { SUSPEND_THREADS(); - if (i == ws->nChildren) { + if (i == ws->nChildren) { ws->nChildren++; ws->child = realloc(ws->child, - ws->nChildren * sizeof(childcontrol)); - makeeditregion(w, ws->child + i, s); - } + ws->nChildren * sizeof(childcontrol)); + makeeditregion(w, ws->child + i, s); + } RESUME_THREADS(); } @@ -3691,7 +3691,7 @@ function{0, 2} WinEditRegion(argv[argc]) */ else if (warg == argc) { geteditregion(ws->child + i, &result); - return result; + return result; } /* * Assign a value (s2 string contents) or perform editing command @@ -3743,25 +3743,25 @@ function{0, 2} WinEditRegion(argv[argc]) s2 = NULL; } else if (s2 && !strncmp("!font=", s2, 6)) { - if (setchildfont(ws->child + i, s2 + 6) == Succeeded) { + if (setchildfont(ws->child + i, s2 + 6) == Succeeded) { ReturnWindow; - } - else fail; + } + else fail; } else if (s2 && !strcmp("!setsel", s2)) { - setchildselection(ws, ws->child + i, x, y); + setchildselection(ws, ws->child + i, x, y); ReturnWindow; } else if (s2 && !strcmp("!getsel", s2)) { - getchildselection(ws, ws->child + i, &x, &y); - suspend C_integer x + 1; - if (x != y) suspend C_integer y + 1; + getchildselection(ws, ws->child + i, &x, &y); + suspend C_integer x + 1; + if (x != y) suspend C_integer y + 1; fail; } if (s2) { seteditregion(ws->child + i, s2); - } + } movechild(ws->child + i, x, y, width, height); setfocusonchild(ws, ws->child + i, width, height); ReturnWindow; @@ -3788,7 +3788,7 @@ function{0,1} WinColorDialog(argv[argc]) if (warg < argc) { if (is:null(argv[warg])) s = "white"; - else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]); + else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]); } else s = "white"; if (parsecolor(w, s, &r, &g, &b, &a) == Failed) fail; @@ -3816,7 +3816,7 @@ function{0,2} WinFontDialog(argv[argc]) if (warg < argc) { if (is:null(argv[warg])) s = "fixed"; - else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]); + else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]); } else s = "fixed"; @@ -3881,8 +3881,8 @@ function{0,1} WinOpenDialog(argv[argc]) } else { strncpy(buf3, s3, 255); - buf3[255] = '\0'; - s3 = buf3; + buf3[255] = '\0'; + s3 = buf3; } chReplace = s3[strlen(s3)-1]; slen = strlen(s3); @@ -3906,14 +3906,14 @@ function{0,1} WinOpenDialog(argv[argc]) runerr(103, argv[warg]); } else { - strncpy(buf4, s4, 255); - buf4[255] = '\0'; - s4 = buf4; - } + strncpy(buf4, s4, 255); + buf4[255] = '\0'; + s4 = buf4; + } warg++; if ((tmpstr = nativefiledialog(w, s1, s2, s3, s4, i, j, 0)) == NULL) - fail; + fail; len = strlen(tmpstr); StrLoc(result) = tmpstr; StrLen(result) = len; @@ -3950,15 +3950,15 @@ function{0,1} WinSelectDialog(argv[argc]) c_get(hp, &d); if (!cnv:C_string(d, s1)) runerr(103, d); len += strlen(s1)+2; - if (s2) { - s2 = realloc(s2, len); - if (!s2) fail; + if (s2) { + s2 = realloc(s2, len); + if (!s2) fail; strcat(s2, "\r\n"); - strcat(s2, s1); - } - else s2 = salloc(s1); + strcat(s2, s1); + } + else s2 = salloc(s1); c_put(&(argv[warg]), &d); - } + } warg++; if (warg >= argc) { @@ -4032,7 +4032,7 @@ function{0,1} WinSaveDialog(argv[argc]) } else { strcpy(buf3, s3); - s3 = buf3; + s3 = buf3; } chReplace = s3[strlen(s3)-1]; slen = strlen(s3); @@ -4056,14 +4056,14 @@ function{0,1} WinSaveDialog(argv[argc]) runerr(103, argv[warg]); } else { - strncpy(buf4, s4, 255); - buf4[255] = '\0'; - s4 = buf4; - } + strncpy(buf4, s4, 255); + buf4[255] = '\0'; + s4 = buf4; + } warg++; if ((tmpstr = nativefiledialog(w, s1, s2, s3, s4, i, j, 1)) == NULL) - fail; + fail; len = strlen(tmpstr); StrLoc(result) = alcstr(tmpstr, len); StrLen(result) = len; @@ -4082,10 +4082,10 @@ MissingFuncV(WinFontDialog) MissingFuncV(WinOpenDialog) MissingFuncV(WinSelectDialog) MissingFuncV(WinSaveDialog) -#endif /* MSWindows */ +#endif /* MSWindows */ -#else /* Graphics */ +#else /* Graphics */ MissingFunc(Active) MissingFuncV(Alert) MissingFuncV(Bg) @@ -4146,7 +4146,7 @@ MissingFuncV(WinOpenDialog) MissingFuncV(WinSelectDialog) MissingFuncV(WinSaveDialog) -#endif /* Graphics */ +#endif /* Graphics */ #if defined(Graphics) && defined(Graphics3D) @@ -4171,16 +4171,16 @@ function{1} DrawTorus(argv[argc]) OptWindow(w); EnsureWindow3D(w); - + CheckArgMultiple(5); - + wc = w->context; /* tori are not allowed in a 2-dim space */ - if (wc->dim == 2) + if (wc->dim == 2) runerr(150); if (!constr && !(constr = rec_structor3d(GL3D_TORUS))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); @@ -4189,32 +4189,32 @@ function{1} DrawTorus(argv[argc]) for (i = warg; i < argc; i += 5) { - /* convert parameters and draw torus*/ - if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); + /* convert parameters and draw torus*/ + if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); if (!cnv:C_double(argv[i+3], r1)) runerr(102, argv[i+3]); if (!cnv:C_double(argv[i+4], r2)) runerr(102, argv[i+4]); - if (bfmode == UGL_IMMEDIATE) { - torus(r1, r2, x, y, z, - wc->slices, wc->rings, - (wc->texmode?wc->autogen:0)); - glFlush(); - } - /* create a record of the graphical object */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - f.dword = D_Record; - f.vword.bptr = (union block *)rp; + if (bfmode == UGL_IMMEDIATE) { + torus(r1, r2, x, y, z, + wc->slices, wc->rings, + (wc->texmode?wc->autogen:0)); + glFlush(); + } + /* create a record of the graphical object */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *)rp; MakeStr("DrawTorus", 9, &(rp->fields[0])); /* r.name */ draw_code = si_s2i(redraw3Dnames, "DrawTorus"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); for(j = i; j < i + 5; j++) - rp->fields[2 + j-i] = argv[j]; + rp->fields[2 + j-i] = argv[j]; c_put(&(w->window->funclist), &f); } return f; @@ -4239,16 +4239,16 @@ function{1} DrawCube(argv[argc]) char bfmode; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); CheckArgMultiple(4); /* Cubes are not 2-dim objects */ - if (w->context->dim == 2) - runerr(150); + if (w->context->dim == 2) + runerr(150); if (!constr) - if (!(constr = rec_structor3d(GL3D_CUBE))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_CUBE))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); @@ -4256,28 +4256,28 @@ function{1} DrawCube(argv[argc]) bfmode = w->window->buffermode; for(i = warg; i < argc; i += 4) { - - /* convert parameters and draw a cube */ - if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); + + /* convert parameters and draw a cube */ + if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); - if (!cnv:C_double(argv[i+3], l)) runerr(102, argv[i+3]); - if (bfmode == UGL_IMMEDIATE) { - cube(l, x, y, z, (w->context->texmode?w->context->autogen:0)); - glFlush(); - } - - /* - * create a record of the graphical object and its parameters - */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - f.dword = D_Record; - f.vword.bptr = (union block *)rp; + if (!cnv:C_double(argv[i+3], l)) runerr(102, argv[i+3]); + if (bfmode == UGL_IMMEDIATE) { + cube(l, x, y, z, (w->context->texmode?w->context->autogen:0)); + glFlush(); + } + + /* + * create a record of the graphical object and its parameters + */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *)rp; MakeStr("DrawCube", 8, &(rp->fields[0])); draw_code = si_s2i(redraw3Dnames, "DrawCube"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); for(j = i; j < i + 4; j++) @@ -4317,8 +4317,8 @@ function{1} DrawSphere(argv[argc]) if (wc->dim == 2) runerr(150); if (!constr) - if (!(constr = rec_structor3d(GL3D_SPHERE))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_SPHERE))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); @@ -4326,34 +4326,34 @@ function{1} DrawSphere(argv[argc]) bfmode = w->window->buffermode; for(i = warg; i < argc; i += 4) { - /* convert parameters and draw a sphere */ - if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); - if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); - if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); - if (!cnv:C_double(argv[i+3], r)) runerr(102, argv[i+3]); - if (bfmode == UGL_IMMEDIATE) { - sphere(r, x, y, z, wc->slices, wc->rings, (wc->texmode?wc->autogen:0)); - glFlush(); - } - - /* create a record of the graphical object */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - f.dword = D_Record; - f.vword.bptr = (union block *)rp; - MakeStr("DrawSphere", 10, &(rp->fields[0])); /* r.name */ + /* convert parameters and draw a sphere */ + if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); + if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); + if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); + if (!cnv:C_double(argv[i+3], r)) runerr(102, argv[i+3]); + if (bfmode == UGL_IMMEDIATE) { + sphere(r, x, y, z, wc->slices, wc->rings, (wc->texmode?wc->autogen:0)); + glFlush(); + } + + /* create a record of the graphical object */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *)rp; + MakeStr("DrawSphere", 10, &(rp->fields[0])); /* r.name */ draw_code = si_s2i(redraw3Dnames, "DrawSphere"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); - /* put parameter in the list for the function */ - rp->fields[2] = argv[i]; - rp->fields[3] = argv[i+1]; - rp->fields[4] = argv[i+2]; - rp->fields[5] = argv[i+3]; - c_put(&(w->window->funclist), &f); - } + /* put parameter in the list for the function */ + rp->fields[2] = argv[i]; + rp->fields[3] = argv[i+1]; + rp->fields[4] = argv[i+2]; + rp->fields[5] = argv[i+3]; + c_put(&(w->window->funclist), &f); + } return f; } end @@ -4378,7 +4378,7 @@ function{1} DrawCylinder(argv[argc]) char bfmode; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); wc = w->context; CheckArgMultiple(6); @@ -4386,8 +4386,8 @@ function{1} DrawCylinder(argv[argc]) if (wc->dim == 2) runerr(150); if (!constr) - if (!(constr = rec_structor3d(GL3D_CYLINDER))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_CYLINDER))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr,Proc)->nfields; MakeCurrent(w); @@ -4396,19 +4396,19 @@ function{1} DrawCylinder(argv[argc]) for(i = warg; i < argc; i += 6) { - /* convert parameters and draw a cylinder */ - if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); + /* convert parameters and draw a cylinder */ + if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); - if (!cnv:C_double(argv[i+3], h)) runerr(102, argv[i+3]); - if (!cnv:C_double(argv[i+4], r1)) runerr(102, argv[i+4]); - if (!cnv:C_double(argv[i+5], r2)) runerr(102, argv[i+5]); - if (bfmode == UGL_IMMEDIATE) { - cylinder(r1, r2, h, x, y, z, wc->slices, wc->rings, (wc->texmode ? wc->autogen : 0)); - glFlush(); - } - /* create a record of the graphical object */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + if (!cnv:C_double(argv[i+3], h)) runerr(102, argv[i+3]); + if (!cnv:C_double(argv[i+4], r1)) runerr(102, argv[i+4]); + if (!cnv:C_double(argv[i+5], r2)) runerr(102, argv[i+5]); + if (bfmode == UGL_IMMEDIATE) { + cylinder(r1, r2, h, x, y, z, wc->slices, wc->rings, (wc->texmode ? wc->autogen : 0)); + glFlush(); + } + /* create a record of the graphical object */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); f.dword = D_Record; f.vword.bptr = (union block *) rp; MakeStr("DrawCylinder", 12, &(rp->fields[0])); /* r.name */ @@ -4419,9 +4419,9 @@ function{1} DrawCylinder(argv[argc]) MakeInt(draw_code, &(rp->fields[1])); - /* put parameters in the list */ + /* put parameters in the list */ for(j = i; j < i + 6; j++) - rp->fields[2 + j - i] = argv[j]; + rp->fields[2 + j - i] = argv[j]; c_put(&(w->window->funclist), &f); } return f; @@ -4449,11 +4449,11 @@ function{1} DrawDisk(argv[argc]) char bfmode; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); wc = w->context; if (!constr) - if (!(constr = rec_structor3d(GL3D_DISK))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_DISK))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); @@ -4461,52 +4461,52 @@ function{1} DrawDisk(argv[argc]) bfmode = w->window->buffermode; for (i = warg; i < argc; i += 7) { - if (argc-warg <= i+3) - runerr(146); + if (argc-warg <= i+3) + runerr(146); - /* create a record of the graphical object */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - f.dword = D_Record; - f.vword.bptr = (union block *)rp; - MakeStr("DrawDisk", 8, &(rp->fields[0])); /* r.name */ + /* create a record of the graphical object */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *)rp; + MakeStr("DrawDisk", 8, &(rp->fields[0])); /* r.name */ draw_code = si_s2i(redraw3Dnames, "DrawDisk"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); - if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); - if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); - if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); - if (!cnv:C_double(argv[i+3], r1)) runerr(102, argv[i+3]); - if (!cnv:C_double(argv[i+4], r2)) runerr(102, argv[i+4]); - rp->fields[2] = argv[i]; - rp->fields[3] = argv[i+1]; - rp->fields[4] = argv[i+2]; - rp->fields[5] = argv[i+3]; - rp->fields[6] = argv[i+4]; - - if (i+5 >= argc) { - a1 = 0.0; - rp->fields[7] = zerodesc; - } - else { - if (!cnv:C_double(argv[i+5],a1)) runerr(102, argv[i+5]); - rp->fields[7] = argv[i+5]; - } - - if (i+6 >= argc) { - a2 = 360; - MakeInt(360, &(rp->fields[8])); - } - else { - if (!cnv:C_double(argv[i+6], a2)) runerr(102, argv[i+6]); - rp->fields[8] = argv[i+6]; - } - if (bfmode == UGL_IMMEDIATE) { - disk(r1, r2, a1, a2, x, y, z, wc->slices, wc->rings, (wc->texmode ? wc->autogen : 0)); - glFlush(); - } + if (!cnv:C_double(argv[i], x)) runerr(102, argv[i]); + if (!cnv:C_double(argv[i+1], y)) runerr(102, argv[i+1]); + if (!cnv:C_double(argv[i+2], z)) runerr(102, argv[i+2]); + if (!cnv:C_double(argv[i+3], r1)) runerr(102, argv[i+3]); + if (!cnv:C_double(argv[i+4], r2)) runerr(102, argv[i+4]); + rp->fields[2] = argv[i]; + rp->fields[3] = argv[i+1]; + rp->fields[4] = argv[i+2]; + rp->fields[5] = argv[i+3]; + rp->fields[6] = argv[i+4]; + + if (i+5 >= argc) { + a1 = 0.0; + rp->fields[7] = zerodesc; + } + else { + if (!cnv:C_double(argv[i+5],a1)) runerr(102, argv[i+5]); + rp->fields[7] = argv[i+5]; + } + + if (i+6 >= argc) { + a2 = 360; + MakeInt(360, &(rp->fields[8])); + } + else { + if (!cnv:C_double(argv[i+6], a2)) runerr(102, argv[i+6]); + rp->fields[8] = argv[i+6]; + } + if (bfmode == UGL_IMMEDIATE) { + disk(r1, r2, a1, a2, x, y, z, wc->slices, wc->rings, (wc->texmode ? wc->autogen : 0)); + glFlush(); + } c_put(&(w->window->funclist), &f); } return f; @@ -4531,32 +4531,32 @@ function{1} Eye(argv[argc]) char abuf[128]; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); ws = w->window; while (warg+i < argc && i < 9) { - if (!is:null(argv[warg+i])) - if (!cnv:C_double(argv[warg+i], x)) + if (!is:null(argv[warg+i])) + if (!cnv:C_double(argv[warg+i], x)) runerr(102, argv[warg+i]); - switch (i) { - case 0: ws->eyeposx = x; break; - case 1: ws->eyeposy = x; break; - case 2: ws->eyeposz = x; break; - case 3: ws->eyedirx = x; break; - case 4: ws->eyediry = x; break; - case 5: ws->eyedirz = x; break; - case 6: ws->eyeupx = x; break; - case 7: ws->eyeupy = x; break; - case 8: ws->eyeupz = x; break; - } - i++; - } + switch (i) { + case 0: ws->eyeposx = x; break; + case 1: ws->eyeposy = x; break; + case 2: ws->eyeposz = x; break; + case 3: ws->eyedirx = x; break; + case 4: ws->eyediry = x; break; + case 5: ws->eyedirz = x; break; + case 6: ws->eyeupx = x; break; + case 7: ws->eyeupy = x; break; + case 8: ws->eyeupz = x; break; + } + i++; + } if (warg < argc) redraw3D(w); sprintf(abuf,"%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f", - ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, - ws->eyediry, ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); + ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, + ws->eyediry, ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); len = strlen(abuf); StrLoc(result) = alcstr(abuf, len); StrLen(result) = len; @@ -4584,10 +4584,10 @@ function{1} Rotate(argv[argc]) CheckArgMultiple(4); for(i = warg; i < argc-warg; i = i+4) { - if ((j = rotate(w, argv, i, &f))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } + if ((j = rotate(w, argv, i, &f))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } } return f; } @@ -4608,14 +4608,14 @@ function{1} Translate(argv[argc]) tended struct descrip f; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); CheckArgMultiple(3); for(i = warg; i < argc-warg; i = i+3) { - if ((j = translate(w, argv, i, &f))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } + if ((j = translate(w, argv, i, &f))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } } return f; } @@ -4637,15 +4637,15 @@ function{1} Scale(argv[argc]) tended struct descrip f = nulldesc; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); CheckArgMultiple(3); for(i = warg; i < argc-warg; i = i+3) { - if ((j=scale(w, argv, i, &f))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } - } + if ((j=scale(w, argv, i, &f))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } + } return f; } end @@ -4671,38 +4671,38 @@ function{1} PopMatrix(argv[argc]) if (argc == warg) npops = 1; else if (!def:C_integer(argv[warg], 1, npops)) - runerr(101, argv[warg]); + runerr(101, argv[warg]); if (!constr) - if (!(constr = rec_structor3d(GL3D_POPMATRIX))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_POPMATRIX))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); for (i=0; ifields[0])); + /* + * create a record of the graphical object and its parameters + */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *)rp; + MakeStr("PopMatrix", 9, &(rp->fields[0])); draw_code = si_s2i(redraw3Dnames, "PopMatrix"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); - c_put(&(w->window->funclist), &f); - } + c_put(&(w->window->funclist), &f); + } return f; - } + } end @@ -4721,18 +4721,18 @@ function{1} PushMatrix(argv[argc]) tended struct descrip f; tended struct b_record *rp; static dptr constr; - + OptWindow(w); EnsureWindow3D(w); if (!constr && !(constr = rec_structor3d(GL3D_PUSHMATRIX))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; MakeCurrent(w); /* push a copy of the top matrix, if possible */ if (pushmatrix() == Failed) - runerr(151); + runerr(151); /* * create a record of the graphical object @@ -4744,14 +4744,14 @@ function{1} PushMatrix(argv[argc]) draw_code = si_s2i(redraw3Dnames, "PushMatrix"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); - c_put(&(w->window->funclist), &f); + c_put(&(w->window->funclist), &f); return f; } end - + "PushTranslate(argv[]){1} - push a copy of the top matrix onto the matrix stack and apply translations" @@ -4761,21 +4761,21 @@ body { wbp w; int warg = 0, i, j, n; tended struct descrip f, f2; - + OptWindow(w); EnsureWindow3D(w); CheckArgMultiple(3); if ((j = pushmatrix_rd(w, &f))) { - if (j == 151) runerr(j); - else if (j == -1) runerr(0); - } + if (j == 151) runerr(j); + else if (j == -1) runerr(0); + } for(i = warg; i < argc-warg; i = i+3) { - if ((j = translate(w, argv, i, &f2))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } + if ((j = translate(w, argv, i, &f2))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } } suspend f; @@ -4792,21 +4792,21 @@ body { wbp w; int warg = 0, i, j, n; tended struct descrip f, f2; - + OptWindow(w); EnsureWindow3D(w); CheckArgMultiple(4); if ((j = pushmatrix_rd(w, &f))) { - if (j == 151) runerr(j); - else if (j == -1) runerr(0); - } + if (j == 151) runerr(j); + else if (j == -1) runerr(0); + } for(i = warg; i < argc-warg; i = i+4) { - if ((j = rotate(w, argv, i, &f2))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } + if ((j = rotate(w, argv, i, &f2))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } } suspend f; @@ -4823,21 +4823,21 @@ body { wbp w; int warg = 0, i, j, n; tended struct descrip f, f2; - + OptWindow(w); EnsureWindow3D(w); CheckArgMultiple(3); if ((j = pushmatrix_rd(w, &f))) { - if (j == 151) runerr(j); - else if (j == -1) runerr(0); - } + if (j == 151) runerr(j); + else if (j == -1) runerr(0); + } for(i = warg; i < argc-warg; i = i+3) { - if ((j = scale(w, argv, i, &f2))) { - if (j == 1) runerr(0); - else runerr(102, argv[-j-1]); - } + if ((j = scale(w, argv, i, &f2))) { + if (j == 1) runerr(0); + else runerr(102, argv[-j-1]); + } } suspend f; @@ -4863,8 +4863,8 @@ function{1} IdentityMatrix(argv[argc]) EnsureWindow3D(w); if (!constr) - if (!(constr = rec_structor3d(GL3D_IDENTITY))) - syserr("failed to create opengl record constructor"); + if (!(constr = rec_structor3d(GL3D_IDENTITY))) + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; /* @@ -4877,7 +4877,7 @@ function{1} IdentityMatrix(argv[argc]) draw_code = si_s2i(redraw3Dnames, "LoadIdentity"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); c_put(&(w->window->funclist), &f); @@ -4898,18 +4898,18 @@ end function{1} MatrixMode(argv[argc]) abstract { return record } body { - wbp w; + wbp w; int warg = 0, nfields, draw_code; tended char* temp; tended struct descrip f; tended struct b_record *rp; static dptr constr; - + OptWindow(w); EnsureWindow3D(w); - + if (!constr && !(constr = rec_structor3d(GL3D_MATRIXMODE))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; /* @@ -4922,11 +4922,11 @@ function{1} MatrixMode(argv[argc]) draw_code = si_s2i(redraw3Dnames, "MatrixMode"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); - /* convert parameter */ - if (!cnv:C_string(argv[warg],temp)) runerr(103,argv[warg]); + /* convert parameter */ + if (!cnv:C_string(argv[warg],temp)) runerr(103,argv[warg]); /* the only "failure" is: the argument was illegal */ switch (setmatrixmode(temp)) { @@ -4941,7 +4941,7 @@ function{1} MatrixMode(argv[argc]) } end -/* +/* * Texture(x) sets the current texture used in drawing 3D shapes. * Texture(R) reuses an existing texture. * Texture(s) sets a new texture from string s. @@ -4971,10 +4971,10 @@ function{1} Texture(argv[argc]) EnsureWindow3D(w); wc = w->context; if (argc - warg < 1)/* missing texture source */ - runerr(103); - + runerr(103); + if (!constr && !(constr = rec_structor3d(GL3D_TEXTURE))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; /* @@ -4987,18 +4987,18 @@ function{1} Texture(argv[argc]) draw_code = si_s2i(redraw3Dnames, "Texture"); if (draw_code == -1) - fail; + fail; Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); MakeInt(draw_code, &(rp->fields[1])); if (argc > 0 && is:file(argv[0])) - rp->fields[3] = argv[0]; + rp->fields[3] = argv[0]; else - rp->fields[3] = kywd_xwin[XKey_Window]; + rp->fields[3] = kywd_xwin[XKey_Window]; MakeStr("Texture", 7, &(rp->fields[0])); f.dword = D_Record; f.vword.bptr = (union block *)rp; - + saved_tex = wc->curtexture; /* @@ -5008,21 +5008,21 @@ function{1} Texture(argv[argc]) * But the later code would normally put in a new texture. */ if (argc - warg > 1) { - if (is:record(argv[warg+1])) { - if (!cnv:C_string(BlkD(argv[warg],Record)->fields[0], tmp)) - runerr(103, argv[warg]); - if (strcmp(tmp, "Texture")) runerr(103, argv[warg]); - /* Pull out the texture handle */ - theTexture = IntVal(BlkLoc(argv[warg])->Record.fields[2]); - } - else if (!cnv:C_integer(argv[warg + 1], theTexture)) { - runerr(101, argv[warg+1]); - } - if ((theTexture<0) || (theTexture>=wc->display->ntextures)) fail; - theTexture++; /* should be check, probably no need for ++ */ - - wc->curtexture = theTexture; - } + if (is:record(argv[warg+1])) { + if (!cnv:C_string(BlkD(argv[warg],Record)->fields[0], tmp)) + runerr(103, argv[warg]); + if (strcmp(tmp, "Texture")) runerr(103, argv[warg]); + /* Pull out the texture handle */ + theTexture = IntVal(BlkLoc(argv[warg])->Record.fields[2]); + } + else if (!cnv:C_integer(argv[warg + 1], theTexture)) { + runerr(101, argv[warg+1]); + } + if ((theTexture<0) || (theTexture>=wc->display->ntextures)) fail; + theTexture++; /* should be check, probably no need for ++ */ + + wc->curtexture = theTexture; + } /* * Set the current texture. It can either be set to a new texture @@ -5032,74 +5032,74 @@ function{1} Texture(argv[argc]) /* check if the source is a record */ else if (is:record(argv[warg])) { - C_integer texhandle; - - if (!cnv:C_string(BlkD(argv[warg],Record)->fields[0], tmp)) - runerr(103, argv[warg]); - - if (strcmp(tmp, "Texture")) runerr(103, argv[warg]); - - w2 = BlkD(BlkLoc(argv[warg])->Record.fields[3],File)->fd.wb; - rp->fields[3] = BlkLoc(argv[warg])->Record.fields[3]; - wc = w2->context; - - /* Pull out the texture handle */ + C_integer texhandle; + + if (!cnv:C_string(BlkD(argv[warg],Record)->fields[0], tmp)) + runerr(103, argv[warg]); + + if (strcmp(tmp, "Texture")) runerr(103, argv[warg]); + + w2 = BlkD(BlkLoc(argv[warg])->Record.fields[3],File)->fd.wb; + rp->fields[3] = BlkLoc(argv[warg])->Record.fields[3]; + wc = w2->context; + + /* Pull out the texture handle */ texhandle = IntVal(BlkLoc(argv[warg])->Record.fields[2]); - rp->fields[2] = BlkLoc(argv[warg])->Record.fields[2]; - bindtexture(w, texhandle); - c_put(&(w->window->funclist), &f); - return f; - } + rp->fields[2] = BlkLoc(argv[warg])->Record.fields[2]; + bindtexture(w, texhandle); + c_put(&(w->window->funclist), &f); + return f; + } /* * If the source texture is another window's contents... */ if (is:file(argv[warg])) { - if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) - runerr(140,argv[warg]); - if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) - runerr(142,argv[warg]); - w2 = BlkLoc(argv[warg])->File.fd.wb; - if (ISCLOSED(w2)) - runerr(142,argv[warg]); - - if (theTexture==-1){ - if (make_enough_texture_space(wc->display)==Failed) fail; - wc->curtexture = wc->display->ntextures; - } - else - wc->curtexture = theTexture; - - /* convert the window into a texture */ + if ((BlkD(argv[warg],File)->status & Fs_Window) == 0) + runerr(140,argv[warg]); + if ((BlkLoc(argv[warg])->File.status & (Fs_Read|Fs_Write)) == 0) + runerr(142,argv[warg]); + w2 = BlkLoc(argv[warg])->File.fd.wb; + if (ISCLOSED(w2)) + runerr(142,argv[warg]); + + if (theTexture==-1){ + if (make_enough_texture_space(wc->display)==Failed) fail; + wc->curtexture = wc->display->ntextures; + } + else + wc->curtexture = theTexture; + + /* convert the window into a texture */ if (w2->context->rendermode == UGL3D) - i = texwindow3D(w, w2); - else - i = texwindow2D(w, w2); - - if (i==Succeeded) { - if (wc->curtexture == wc->display->ntextures) - wc->display->ntextures++; - MakeInt(wc->curtexture, &(rp->fields[2])); - c_put(&(w->window->funclist), &f); - return f; - } - else { - wc->curtexture = saved_tex; - fail; - } - } + i = texwindow3D(w, w2); + else + i = texwindow2D(w, w2); + + if (i==Succeeded) { + if (wc->curtexture == wc->display->ntextures) + wc->display->ntextures++; + MakeInt(wc->curtexture, &(rp->fields[2])); + c_put(&(w->window->funclist), &f); + return f; + } + else { + wc->curtexture = saved_tex; + fail; + } + } else { - /* - * Otherwise it must be a string (probably, a filename). - */ - if (!cnv:C_string(argv[warg], tmp)) runerr(103, argv[warg]); - i = settexture(w, tmp, strlen(tmp), &f, theTexture, 1); - - if (i==Succeeded) - return f; - else - fail; - } + /* + * Otherwise it must be a string (probably, a filename). + */ + if (!cnv:C_string(argv[warg], tmp)) runerr(103, argv[warg]); + i = settexture(w, tmp, strlen(tmp), &f, theTexture, 1); + + if (i==Succeeded) + return f; + else + fail; + } } end @@ -5120,40 +5120,40 @@ function{1} Texcoord(argv[argc]) tended struct descrip d; #ifdef Arrays tended struct b_realarray *ap; -#endif /* Arrays */ +#endif /* Arrays */ OptWindow(w); EnsureWindow3D(w); wc = w->context; num=argc-warg; if (num < 1) /* missing the texture coordinates */ - runerr(103); + runerr(103); /* create a list */ if (create3Dlisthdr(&f, "Texcoord", 8)!=Succeeded) - fail; + fail; /* check if the argument is a list */ if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; + num = BlkD(argv[warg], List)->size; else { - num = argc-warg; - - if (num == 1) { /* probably "auto" */ - if (!cnv:C_string(argv[warg], tmp)) - runerr(103, argv[warg]); - if (!strcmp(tmp, "auto")) { - wc->autogen = 1; - wc->numtexcoords = 0; - applyAutomaticTextureCoords(1); - mode = onedesc; - c_put(&f, &mode); - c_put(&(w->window->funclist), &f); - return f; - } - else fail; - } - } + num = argc-warg; + + if (num == 1) { /* probably "auto" */ + if (!cnv:C_string(argv[warg], tmp)) + runerr(103, argv[warg]); + if (!strcmp(tmp, "auto")) { + wc->autogen = 1; + wc->numtexcoords = 0; + applyAutomaticTextureCoords(1); + mode = onedesc; + c_put(&f, &mode); + c_put(&(w->window->funclist), &f); + return f; + } + else fail; + } + } applyAutomaticTextureCoords(0); mode = zerodesc; @@ -5161,17 +5161,17 @@ function{1} Texcoord(argv[argc]) wc->autogen = 0; wc->numtexcoords = 0; if (cplist2realarray(&argv[warg], &d, 0, num, 0)!=Succeeded) - runerr(305, argv[warg]); + runerr(305, argv[warg]); #ifdef Arrays ap = (struct b_realarray *) BlkD(d, List)->listhead; wc->texcoords = ap; -#endif /* Arrays */ +#endif /* Arrays */ wc->numtexcoords = num; c_put(&f, &d); /* there must be an even number of arguments */ if (num % 2 != 0) { - runerr(154); + runerr(154); } c_put(&(w->window->funclist), &f); return f; @@ -5192,34 +5192,34 @@ function{1} Normals(argv[argc]) int warg = 0, num; tended struct descrip f; tended struct descrip d; -#ifdef Arrays +#ifdef Arrays tended struct b_realarray *ap; -#endif /* Arrays */ +#endif /* Arrays */ OptWindow(w); EnsureWindow3D(w); wc = w->context; num=argc-warg; if (num < 1) /* missing the normals coordinates */ - runerr(103); + runerr(103); /* create a list */ if (create3Dlisthdr(&f, "Normals", 4)!=Succeeded) - fail; - + fail; + /* check if the argument is a list */ if (is:list(argv[warg])) - num = BlkD(argv[warg], List)->size; + num = BlkD(argv[warg], List)->size; else { - num = argc-warg; - } - + num = argc-warg; + } + if (cplist2realarray(&argv[warg], &d, 0, num, 0) != Succeeded) - runerr(305, argv[warg]); + runerr(305, argv[warg]); #ifdef Arrays ap = (struct b_realarray *) BlkD(d, List)->listhead; wc->normals = ap; -#endif /* Arrays */ +#endif /* Arrays */ wc->numnormals = num; c_put(&f, &d); @@ -5243,47 +5243,47 @@ function{1} MultMatrix(argv[argc]) tended struct descrip d; #ifdef Arrays tended struct b_realarray *ap; -#endif /* Arrays */ +#endif /* Arrays */ OptWindow(w); EnsureWindow3D(w); if (argc-warg < 1) /* missing the matrix elements */ - runerr(103); + runerr(103); /* create a list */ if (create3Dlisthdr(&f, "MultMatrix", 4)!=Succeeded) - fail; - + fail; + /* check if the argument is a list */ if (is:list(argv[warg])) - num= BlkD(argv[warg], List)->size; + num= BlkD(argv[warg], List)->size; else { - num = argc-warg; - } + num = argc-warg; + } /* * transformation matrix must have 16 values */ if (num != 16 ) - runerr(305); - + runerr(305); + if (cplist2realarray(&argv[warg], &d, 0, num, 0) != Succeeded) - runerr(305, argv[warg]); + runerr(305, argv[warg]); #ifdef Arrays ap = (struct b_realarray *) BlkD(d, List)->listhead; -#endif /* Arrays */ +#endif /* Arrays */ c_put(&f, &d); c_put(&(w->window->funclist), &f); #if HAVE_LIBGL glMultMatrixd((GLdouble *)ap->a); -#endif /* HAVE_LIBGL */ +#endif /* HAVE_LIBGL */ return f; } end -/* - * Refresh(w) +/* + * Refresh(w) */ "Refresh(argv[]){1} - redraws the window" @@ -5296,19 +5296,19 @@ function{1} Refresh(argv[argc]) OptWindow(w); if (!w->window->is_gl) { if (warg == 0) - runerr(150, kywd_xwin[XKey_Window]); + runerr(150, kywd_xwin[XKey_Window]); else - runerr(150, argv[0]); + runerr(150, argv[0]); } redraw3D(w); - ReturnWindow; + ReturnWindow; } end -/* - * WindowContents(w) - * +/* + * WindowContents(w) + * */ "WindowContents(argv[]){1} - returns an Icon list of lists, which contains all objects drawn on window" @@ -5321,12 +5321,12 @@ function{1} WindowContents(argv[argc]) OptWindow(w); #ifdef GraphicsGL if (w->context->rendermode == UGL2D) - return w->window->funclist2d; + return w->window->funclist2d; else -#else /* GraphicsGL */ +#else /* GraphicsGL */ EnsureWindow3D(w); -#endif /* GraphicsGL */ - return w->window->funclist; +#endif /* GraphicsGL */ + return w->window->funclist; } end @@ -5349,52 +5349,52 @@ function{1} WSection(argv[argc]) static int section_depth=1; OptWindow(w); - EnsureWindow3D(w); + EnsureWindow3D(w); wc = w->context; - if (argc-warg==0) { /* section ends */ - if (!section_length(w)) - syserr("failed to find the section length"); - section_depth--; - if (!(wc->selectionenabled)) - return C_integer 1; /* selection is off. no record need to be added */ - - /* selection is enabled. add a record to mark the end of the section */ - if (!constr2 && !(constr2 = rec_structor3d(GL3D_ENDMARK))) { - syserr("failed to create opengl record constructor"); - } - nfields = (int) ((struct b_proc *)BlkLoc(*constr2))->nfields; - - /* create a record of the graphical object */ - Protect(rp = alcrecd(nfields, BlkLoc(*constr2)), runerr(0)); - f.dword = D_Record; - f.vword.bptr = (union block *) rp; - MakeStr("EndMark", 7, &(rp->fields[0])); - - draw_code = si_s2i(redraw3Dnames, "EndMark"); - if (draw_code == -1) - fail; - - MakeInt(draw_code, &(rp->fields[1])); - MakeInt(section_depth+1, &(rp->fields[2])); - - c_put(&(w->window->funclist), &f); - - return f; - } - + if (argc-warg==0) { /* section ends */ + if (!section_length(w)) + syserr("failed to find the section length"); + section_depth--; + if (!(wc->selectionenabled)) + return C_integer 1; /* selection is off. no record need to be added */ + + /* selection is enabled. add a record to mark the end of the section */ + if (!constr2 && !(constr2 = rec_structor3d(GL3D_ENDMARK))) { + syserr("failed to create opengl record constructor"); + } + nfields = (int) ((struct b_proc *)BlkLoc(*constr2))->nfields; + + /* create a record of the graphical object */ + Protect(rp = alcrecd(nfields, BlkLoc(*constr2)), runerr(0)); + f.dword = D_Record; + f.vword.bptr = (union block *) rp; + MakeStr("EndMark", 7, &(rp->fields[0])); + + draw_code = si_s2i(redraw3Dnames, "EndMark"); + if (draw_code == -1) + fail; + + MakeInt(draw_code, &(rp->fields[1])); + MakeInt(section_depth+1, &(rp->fields[2])); + + c_put(&(w->window->funclist), &f); + + return f; + } + if (argc - warg != 1) fail; if (!constr && !(constr = rec_structor3d(GL3D_MARK))) { - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); } nfields = (int) BlkD(*constr, Proc)->nfields; if (!cnv:string(argv[warg], argv[warg])) - runerr(103, argv[warg]); + runerr(103, argv[warg]); - /* create a record of the graphical object */ + /* create a record of the graphical object */ Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); f.dword = D_Record; @@ -5403,46 +5403,46 @@ function{1} WSection(argv[argc]) draw_code = si_s2i(redraw3Dnames, "Mark"); if (draw_code == -1) - fail; + fail; MakeInt(draw_code, &(rp->fields[1])); rp->fields[2] = argv[warg]; /* section_name */ rp->fields[3] = zerodesc; /* skip */ rp->fields[4] = zerodesc; /* count */ - + MakeInt(section_depth, &(rp->fields[6])); section_depth++; if (wc->selectionenabled) { - /* integer code for opengl selection */ + /* integer code for opengl selection */ MakeInt(wc->selectionnamecount, &(rp->fields[5])); - - if (wc->selectionnamecount >= wc->selectionnamelistsize) { - SUSPEND_THREADS(); - if (wc->selectionnamecount >= wc->selectionnamelistsize) { - wc->selectionnamelistsize *=2; - wc->selectionnamelist=realloc(wc->selectionnamelist, - wc->selectionnamelistsize*sizeof(char*)); - if (wc->selectionnamelist == NULL) fail; - } - RESUME_THREADS(); - } - - if (!cnv:C_string(argv[warg], tmp)) - runerr(103, argv[warg]); - - wc->selectionnamelist[wc->selectionnamecount] = strdup(tmp); - wc->selectionnamecount++; - } + + if (wc->selectionnamecount >= wc->selectionnamelistsize) { + SUSPEND_THREADS(); + if (wc->selectionnamecount >= wc->selectionnamelistsize) { + wc->selectionnamelistsize *=2; + wc->selectionnamelist=realloc(wc->selectionnamelist, + wc->selectionnamelistsize*sizeof(char*)); + if (wc->selectionnamelist == NULL) fail; + } + RESUME_THREADS(); + } + + if (!cnv:C_string(argv[warg], tmp)) + runerr(103, argv[warg]); + + wc->selectionnamelist[wc->selectionnamecount] = strdup(tmp); + wc->selectionnamecount++; + } else - rp->fields[5]=zerodesc; + rp->fields[5]=zerodesc; c_put(&(w->window->funclist), &f); - return f; + return f; } end -#else /* Graphics3D */ +#else /* Graphics3D */ MissingFuncV(DrawTorus) MissingFuncV(DrawCube) MissingFuncV(DrawSphere) @@ -5466,4 +5466,4 @@ MissingFuncV(Texcoord) MissingFuncV(Refresh) MissingFuncV(WindowContents) MissingFuncV(WSection) -#endif /* Graphics3D */ +#endif /* Graphics3D */ diff --git a/src/runtime/fxaudio.ri b/src/runtime/fxaudio.ri index f02843a74..a7c43f402 100644 --- a/src/runtime/fxaudio.ri +++ b/src/runtime/fxaudio.ri @@ -39,10 +39,10 @@ function{1} StopAudio(f) } end -#else /* Audio */ +#else /* Audio */ MissingFunc1(PlayAudio) MissingFunc1(StopAudio) -#endif /* Audio */ +#endif /* Audio */ #if defined(HAVE_VOICE) || defined(Audio) @@ -55,112 +55,112 @@ function{0,1} VAttrib(argv[argc]) } body { int i,res=0; - tended struct descrip sbuf; + tended struct descrip sbuf; tended char *attrib = NULL; /* Audio Mixer stuff */ if (!is:file(argv[0])) { - for(i = 0 ; i < argc ; i++ ){ - if (!cnv:C_string(argv[i], attrib)) - runerr(103,argv[i]); - if ((res = AudioMixer(attrib)) <= 0) - fail; - } - return C_integer res; - } + for(i = 0 ; i < argc ; i++ ){ + if (!cnv:C_string(argv[i], attrib)) + runerr(103,argv[i]); + if ((res = AudioMixer(attrib)) <= 0) + fail; + } + return C_integer res; + } /* VoIP Stuff */ else { #ifdef HAVE_VOICE - PVSESSION Ptr; - Ptr = (PVSESSION)BlkLoc(argv[0])->file.fd.fp; - if (!cnv:tmp_string(argv[1], sbuf)) /* sbuf not allocated */ - runerr(109, argv[1]); - - attrib = StrLoc(sbuf); - - if (strstr(attrib, "+=") || strstr(attrib, "-=") ) { - SetVoiceAttrib(Ptr, attrib); - return C_integer 1; - } - else { - if (strchr(attrib,'=')){ - /* forming the attrib list */ - int i, k, slen; - char *s, *s2; - tended struct descrip Str; - tended struct descrip L; - /*------- tended struct b_list *hp; */ - - /* create empty list */ - if ((BlkLoc(L)=alclist(0, MinListSlots)) == NULL) fail; - L.dword=D_List; + PVSESSION Ptr; + Ptr = (PVSESSION)BlkLoc(argv[0])->file.fd.fp; + if (!cnv:tmp_string(argv[1], sbuf)) /* sbuf not allocated */ + runerr(109, argv[1]); + + attrib = StrLoc(sbuf); + + if (strstr(attrib, "+=") || strstr(attrib, "-=") ) { + SetVoiceAttrib(Ptr, attrib); + return C_integer 1; + } + else { + if (strchr(attrib,'=')){ + /* forming the attrib list */ + int i, k, slen; + char *s, *s2; + tended struct descrip Str; + tended struct descrip L; + /*------- tended struct b_list *hp; */ + + /* create empty list */ + if ((BlkLoc(L)=alclist(0, MinListSlots)) == NULL) fail; + L.dword=D_List; /* ------ L.vword.bptr=(union block *) hp; */ - /* forming the list */ - k = GetVListSize(Ptr); - if (strstr(attrib,"name") && (!strstr(attrib,"address"))){ - for(i=0; i<= k; ++i){ - s = FetchName(Ptr,i); - if (s != NULL) { - slen = strlen(s); - Protect(s2 = alcstr(s, slen), runerr(0)); - MakeStr(s2,slen,&Str); - c_put(&L, &Str); - } - } - } - else { - if (strstr(attrib,"address") && (!strstr(attrib,"name"))) { - for(i=0; i<= k; ++i){ - s = FetchAddress(Ptr,i); - if (s != NULL) { - slen = strlen(s); - Protect(s2 = alcstr(s, slen), runerr(0)); - MakeStr(s2,slen,&Str); - c_put(&L, &Str); - } - } - } - else - for(i=0; i<= k; ++i) { - s = FetchListener(Ptr,i); - if (s != NULL) { - slen = strlen(s); - Protect(s2 = alcstr(s, slen), runerr(0)); - MakeStr(s2,slen,&Str); - c_put(&L, &Str); - } - }/* end for */ - } /* end else */ - return L; - } - else { /* forming the attrib string */ - char tmpstr[MaxCvtLen],*str; - int i, k = GetVListSize(Ptr), len=0; - tmpstr[0] = '\0'; - for (i=0; i<= k; ++i) { - str = FetchListener(Ptr, i); - if (str != NULL) { - strcat(tmpstr, str); - strcat(tmpstr, ","); - } - } - len = strlen(tmpstr)-1; - tmpstr[len] = '\0'; - slen = strlen(tmpstr); - Protect(s2 = alcstr(tmpstr, slen), runerr(0)); - MakeStr(tmpstr, slen, &Str); - return Str; - } - return C_integer 1; - } + /* forming the list */ + k = GetVListSize(Ptr); + if (strstr(attrib,"name") && (!strstr(attrib,"address"))){ + for(i=0; i<= k; ++i){ + s = FetchName(Ptr,i); + if (s != NULL) { + slen = strlen(s); + Protect(s2 = alcstr(s, slen), runerr(0)); + MakeStr(s2,slen,&Str); + c_put(&L, &Str); + } + } + } + else { + if (strstr(attrib,"address") && (!strstr(attrib,"name"))) { + for(i=0; i<= k; ++i){ + s = FetchAddress(Ptr,i); + if (s != NULL) { + slen = strlen(s); + Protect(s2 = alcstr(s, slen), runerr(0)); + MakeStr(s2,slen,&Str); + c_put(&L, &Str); + } + } + } + else + for(i=0; i<= k; ++i) { + s = FetchListener(Ptr,i); + if (s != NULL) { + slen = strlen(s); + Protect(s2 = alcstr(s, slen), runerr(0)); + MakeStr(s2,slen,&Str); + c_put(&L, &Str); + } + }/* end for */ + } /* end else */ + return L; + } + else { /* forming the attrib string */ + char tmpstr[MaxCvtLen],*str; + int i, k = GetVListSize(Ptr), len=0; + tmpstr[0] = '\0'; + for (i=0; i<= k; ++i) { + str = FetchListener(Ptr, i); + if (str != NULL) { + strcat(tmpstr, str); + strcat(tmpstr, ","); + } + } + len = strlen(tmpstr)-1; + tmpstr[len] = '\0'; + slen = strlen(tmpstr); + Protect(s2 = alcstr(tmpstr, slen), runerr(0)); + MakeStr(tmpstr, slen, &Str); + return Str; + } + return C_integer 1; + } #endif /* HAVE_VOICE */ - return C_integer 1; - } + return C_integer 1; + } } end -#else /* HAVE_VOICE || Audio */ +#else /* HAVE_VOICE || Audio */ MissingFuncV(VAttrib) -#endif /* HAVE_VOICE || Audio */ +#endif /* HAVE_VOICE || Audio */ diff --git a/src/runtime/fxmsdos.ri b/src/runtime/fxmsdos.ri index 31e7162ed..a9e113853 100644 --- a/src/runtime/fxmsdos.ri +++ b/src/runtime/fxmsdos.ri @@ -8,7 +8,7 @@ char *zptr = NULL; * Prototype. */ -int getlist (struct b_lelem *bp,unsigned int *vals, int limit); +int getlist (struct b_lelem *bp,unsigned int *vals, int limit); "Int86(a) - perform an interrupt" @@ -56,7 +56,7 @@ function{1} Int86(a) /* flag = int86x(flag,&inreg,&outreg,&insreg); */ int86x(flag,&inreg,&outreg,&insreg); /* ... this should work for */ - flag = outreg.x.cflag; /* ... both MSC and Turbo C */ + flag = outreg.x.cflag; /* ... both MSC and Turbo C */ /* * Return the values. @@ -82,8 +82,8 @@ function{1} Int86(a) return result; } end -#endif /* MICROSOFT || TURBO ... */ - +#endif /* MICROSOFT || TURBO ... */ + "Peek(addr,len) - read from memory" @@ -114,7 +114,7 @@ function{1} Peek(addr,len) #ifdef LargeInts if (Type(addr) == T_Lrgint) runerr(205,addr); -#endif /* LargeInts */ +#endif /* LargeInts */ return string(_len_,(char *) word2ptr(IntVal(addr))); } @@ -127,16 +127,16 @@ function{1} Peek(addr,len) if (getlist(bp, vals, 2) == Failed) fail; unaddr.Word.s = vals[0]; unaddr.Word.o = vals[1]; - return string(_len_,unaddr.cptr); + return string(_len_,unaddr.cptr); } default: { runerr(101,addr); - } + } } /* NOTREACHED */ } end - + "Poke(addr,s) - write to memory" @@ -166,10 +166,10 @@ function{1} Poke(addr,s) #ifdef LargeInts if (Type(addr) == T_Lrgint) runerr(205, addr); -#endif /* LargeInts */ +#endif /* LargeInts */ unaddr.cptr = (char *)word2ptr(addr.vword.integr); - } + } list: { hp = (struct b_list *) BlkLoc(addr); if (hp->size != 2) { @@ -182,22 +182,22 @@ function{1} Poke(addr,s) } default: { runerr(101,addr); - } + } } l = StrLen(s); s1 = StrLoc(s); s2 = unaddr.cptr; - memcopy(s2,s1,l); /* Copy... */ + memcopy(s2,s1,l); /* Copy... */ return nulldesc; } end - + "GetSpace(i) - allocate memory block" function{1} GetSpace(i) - if !cnv:C_integer(i) then /* should check for small */ + if !cnv:C_integer(i) then /* should check for small */ runerr(101,i) abstract { return integer @@ -213,7 +213,7 @@ function{1} GetSpace(i) return C_integer u; } end - + "FreeSpace(a) - free allocated memory block" @@ -248,25 +248,25 @@ struct b_lelem *bp; i = 0; for(count = 0 ;count bp->nused) { - i = 1; - bp = (struct b_lelem *) bp->listnext; - } - j = bp->first + i - 1; /* Get slot index */ - if( j >= bp->nslots) - j -= bp->nslots; - switch(Type(bp->lslots[j])) { - case T_Integer: /* should check for small */ - vals[count] = (int)IntVal(bp->lslots[j]); - break; - default: - RunErr(101,&bp->lslots[j]); - } + int j; + if( ++i > bp->nused) { + i = 1; + bp = (struct b_lelem *) bp->listnext; + } + j = bp->first + i - 1; /* Get slot index */ + if( j >= bp->nslots) + j -= bp->nslots; + switch(Type(bp->lslots[j])) { + case T_Integer: /* should check for small */ + vals[count] = (int)IntVal(bp->lslots[j]); + break; + default: + RunErr(101,&bp->lslots[j]); + } } return 0; } - + "InPort(i) - return a value from port i" @@ -280,7 +280,7 @@ function{1} InPort(i) return C_integer inp(i); } end - + "OutPort(i1,i2) - write i2 to port i1" diff --git a/src/runtime/fxpattrn.ri b/src/runtime/fxpattrn.ri index 31879266c..26f538412 100644 --- a/src/runtime/fxpattrn.ri +++ b/src/runtime/fxpattrn.ri @@ -11,15 +11,15 @@ dptr processFuncCallList(struct b_list *list); dptr processMethodCallList(struct b_list *list); #ifndef MultiProgram int internal_match(char * pat_sub, int Length, int Pat_S, struct descrip op, - struct b_pelem * pattern, int *Start, int *Stop, - int initial_cursor, int Anchored_Mode); -#endif /* MultiProgram */ + struct b_pelem * pattern, int *Start, int *Stop, + int initial_cursor, int Anchored_Mode); +#endif /* MultiProgram */ struct b_pelem EOP = {T_Pelem, PC_EOP,(union block *)NULL, 0, 0, {D_Null,0}}; struct b_pattern emptypattern = { T_Pattern, 0, 0, (union block *)&EOP }; union block *pattern_make(int stck_size, struct b_pelem * pnext, - int pattern_code, int index, struct descrip param) + int pattern_code, int index, struct descrip param) { tended struct b_pelem *lpnext = pnext; tended struct descrip lparam = param; @@ -28,9 +28,9 @@ union block *pattern_make(int stck_size, struct b_pelem * pnext, bp = (union block *)alcpattern(stck_size); #if COMPILER pelem = alcpelem(pattern_code); -#else /* COMPILER */ +#else /* COMPILER */ pelem = alcpelem(pattern_code, ipc.opnd); -#endif /* COMPILER */ +#endif /* COMPILER */ pelem->pthen = (union block *) lpnext; pelem->parameter = lparam; pelem->index = index; @@ -54,7 +54,7 @@ union block *pattern_make_pelem(int stck_size, struct b_pelem * pe) } union block *pelem_make(struct b_pelem * pnext, int pattern_code, int index, - struct descrip param) + struct descrip param) { struct b_pelem *pelem; union block * bp; @@ -62,9 +62,9 @@ union block *pelem_make(struct b_pelem * pnext, int pattern_code, int index, tended struct descrip lparam = param; #if COMPILER bp = (union block *)alcpelem(pattern_code); -#else /* COMPILER */ +#else /* COMPILER */ bp = (union block *)alcpelem(pattern_code, ipc.opnd); -#endif /* COMPILER */ +#endif /* COMPILER */ pelem = (struct b_pelem *)bp; pelem->pthen =(union block *) lpnext; pelem->parameter = lparam; @@ -79,9 +79,9 @@ union block *pelem_copy(struct b_pelem * p2copy) tended struct b_pelem *lp2copy = p2copy; #if COMPILER bp = (union block *)alcpelem(lp2copy->pcode); -#else /* COMPILER */ +#else /* COMPILER */ bp = (union block *)alcpelem(lp2copy->pcode, lp2copy->origin_ipc); -#endif /* COMPILER */ +#endif /* COMPILER */ pelem = (struct b_pelem *)bp; pelem->pthen = lp2copy->pthen; pelem->parameter = lp2copy->parameter; @@ -114,7 +114,7 @@ void Record_PE (struct b_pelem * E, struct b_pelem *RA[]) RA[E->index] = E; Record_PE ((struct b_pelem *)E->pthen, RA); if (Has_Alt(E->pcode)) - Record_PE ((struct b_pelem *)BlkLoc(E->parameter),RA); + Record_PE ((struct b_pelem *)BlkLoc(E->parameter),RA); } } @@ -170,82 +170,82 @@ struct b_list *ResolveList(struct b_list *lp) /* dptr pvar; No longer used -- see below */ if (is:string(elsrc->lslots[i])) { /* - * if a string constant, drop double quotes, - * else lookup using getvar() - */ - cnv:C_string(elsrc->lslots[i], varname); - if (StrLen(elsrc->lslots[i])>0) { - complement = 0; - if (strcspn(varname, "~") == 0) { - /* resolve complement */ - StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; - StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 1; - cnv:C_string(elsrc->lslots[i], varname); - complement = 1; - } - - if (strcspn(varname, "\"") == 0) { - /* drop the quotes, pass string contents */ - StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; - StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 2; - cnv:string(elsrc->lslots[i], elsrc->lslots[i]); - } - else if (strcspn(varname, "\'") == 0) { - /* drop the quotes, but pass string as a cset */ - StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; - StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 2; - cnv:cset(elsrc->lslots[i], elsrc->lslots[i]); - } - else if (strcspn(varname, "&") == 0) { - if (getkeyword(varname, &parm) == Failed) { - AsgnCStr(proc, varname); - ReturnErrVal(160, proc, NULL); - } - cnv:cset(parm, elsrc->lslots[i]); - if(complement) { - Protect(cp = alccset(), ReturnErrNum(307, NULL)); - cpx = (struct b_cset *)BlkD(elsrc->lslots[i], Cset); - for (b = 0; b < CsetSize; b++) - cp->bits[b] = ~cpx->bits[b]; - elsrc->lslots[i].vword.bptr = (union block *)cp; - } - } - else if (strcspn(varname, "1234567890") == 0) { - cnv:integer(elsrc->lslots[i], elsrc->lslots[i]); - } - else { - if (getvar(varname, &parm) == Failed) { - AsgnCStr(parm, varname); - ReturnErrVal(160, parm, NULL); - } - /* pvar = VarLoc(parm); */ - elsrc->lslots[i] = parm; /* = *pvar too aggressive */ - - if (complement) { - Protect(cp = alccset(), ReturnErrNum(307, NULL)); - cpx = (struct b_cset *)StrLoc(elsrc->lslots[i]); - for (b = 0; b < CsetSize; b++) - cp->bits[b] = ~cpx->bits[b]; - elsrc->lslots[i].vword.bptr = (union block *)cp; - } - } - parm = elsrc->lslots[i]; - } - else { - ReturnErrNum(164, NULL); - } - } + * if a string constant, drop double quotes, + * else lookup using getvar() + */ + cnv:C_string(elsrc->lslots[i], varname); + if (StrLen(elsrc->lslots[i])>0) { + complement = 0; + if (strcspn(varname, "~") == 0) { + /* resolve complement */ + StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; + StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 1; + cnv:C_string(elsrc->lslots[i], varname); + complement = 1; + } + + if (strcspn(varname, "\"") == 0) { + /* drop the quotes, pass string contents */ + StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; + StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 2; + cnv:string(elsrc->lslots[i], elsrc->lslots[i]); + } + else if (strcspn(varname, "\'") == 0) { + /* drop the quotes, but pass string as a cset */ + StrLoc(elsrc->lslots[i]) = StrLoc(elsrc->lslots[i]) + 1; + StrLen(elsrc->lslots[i]) = StrLen(elsrc->lslots[i]) - 2; + cnv:cset(elsrc->lslots[i], elsrc->lslots[i]); + } + else if (strcspn(varname, "&") == 0) { + if (getkeyword(varname, &parm) == Failed) { + AsgnCStr(proc, varname); + ReturnErrVal(160, proc, NULL); + } + cnv:cset(parm, elsrc->lslots[i]); + if(complement) { + Protect(cp = alccset(), ReturnErrNum(307, NULL)); + cpx = (struct b_cset *)BlkD(elsrc->lslots[i], Cset); + for (b = 0; b < CsetSize; b++) + cp->bits[b] = ~cpx->bits[b]; + elsrc->lslots[i].vword.bptr = (union block *)cp; + } + } + else if (strcspn(varname, "1234567890") == 0) { + cnv:integer(elsrc->lslots[i], elsrc->lslots[i]); + } + else { + if (getvar(varname, &parm) == Failed) { + AsgnCStr(parm, varname); + ReturnErrVal(160, parm, NULL); + } + /* pvar = VarLoc(parm); */ + elsrc->lslots[i] = parm; /* = *pvar too aggressive */ + + if (complement) { + Protect(cp = alccset(), ReturnErrNum(307, NULL)); + cpx = (struct b_cset *)StrLoc(elsrc->lslots[i]); + for (b = 0; b < CsetSize; b++) + cp->bits[b] = ~cpx->bits[b]; + elsrc->lslots[i].vword.bptr = (union block *)cp; + } + } + parm = elsrc->lslots[i]; + } + else { + ReturnErrNum(164, NULL); + } + } else if (is:list(elsrc->lslots[i])) { - /* recursively visit sublists, do same stuff */ - lptemp = (struct b_list *)BlkD(elsrc->lslots[i], List); - parm.dword = D_List; - if ((parm.vword.bptr = (union block *)ResolveList(lptemp)) == NULL) - return NULL; - } - else { - /* cset, integer constant, ... */ - parm = elsrc->lslots[i]; - } + /* recursively visit sublists, do same stuff */ + lptemp = (struct b_list *)BlkD(elsrc->lslots[i], List); + parm.dword = D_List; + if ((parm.vword.bptr = (union block *)ResolveList(lptemp)) == NULL) + return NULL; + } + else { + /* cset, integer constant, ... */ + parm = elsrc->lslots[i]; + } eldest->lslots[i] = parm; } return lpdest; @@ -273,7 +273,7 @@ static struct b_pelem * ResolveReferences(struct b_pelem * P ) int J; int RefLen = P->index + 1; if (!reserve(Blocks, RefLen * sizeof(struct b_pelem))) - ReturnErrNum(307, NULL); + ReturnErrNum(307, NULL); Refs = (struct b_pelem **)alloc(RefLen * sizeof(struct b_pelem *)); Copy = (struct b_pelem **)alloc(RefLen * sizeof(struct b_pelem *)); @@ -284,98 +284,98 @@ static struct b_pelem * ResolveReferences(struct b_pelem * P ) * Now copy all nodes */ for(J = 1; J < RefLen; J++) - Copy[J] = (struct b_pelem *)pelem_copy(Refs[J]); + Copy[J] = (struct b_pelem *)pelem_copy(Refs[J]); /* * Adjust all internal references */ for(J = 1; J < RefLen; J++) { - E = Copy[J]; - /* - * Adjust successor pointer to point to copy - */ - if (E->pthen !=(union block *) &EOP) - E->pthen =(union block *) - Copy[((struct b_pelem *)(E->pthen))->index]; - /* - * Adjust Alt pointer if there is one to point to copy - */ - if (Has_Alt(E->pcode) && - ((struct b_pelem *)(BlkLoc(E->parameter)) != &EOP)) - (BlkLoc(E->parameter)) = (union block *) - Copy[((struct b_pelem *)(BlkLoc(E->parameter)))->index]; - /* - * Resolve references - */ - switch(E->pcode){ - case PC_Pos_NP: - case PC_Len_NP: - case PC_RPos_NP: - case PC_RTab_NP: - case PC_Tab_NP: - case PC_Any_VP: - case PC_Break_VP: - case PC_BreakX_VP: - case PC_NotAny_VP: - case PC_NSpan_VP: - case PC_Span_VP: - case PC_Assign_OnM: - case PC_Assign_Imm: - case PC_Rpat:{ - tended char * varname; - if (is:list(E->parameter)) { - /* - * we know our list - * it has only 2 elements object variable name and field name - * so we dont perform all the sanity checks - */ - tended struct b_lelem *ep; - tended struct b_record *rp; - tended struct b_list *lp = (struct b_list *)BlkLoc(E->parameter); - ep = (struct b_lelem *)lp->listhead; - if (is:string(ep->lslots[0])) { - cnv:C_string(ep->lslots[0],varname); - if (getvar(varname, &ep->lslots[0])== Failed) { - AsgnCStr(ep->lslots[0], varname); - ReturnErrVal(160, ep->lslots[0], NULL); - } - } - } - else { - if (is:string(E->parameter)){ - cnv:C_string(E->parameter, varname); - DEBUGF(2, (stdout, "Looking up variable name = %s\n", - varname)); - if (getvar(varname,&E->parameter)== Failed) { - AsgnCStr(E->parameter, varname); - ReturnErrVal(160, E->parameter, NULL); - } - } - } - break; - } - case PC_Pos_NF: - case PC_Len_NF: - case PC_RPos_NF: - case PC_RTab_NF: - case PC_Tab_NF: - case PC_Any_VF: - case PC_Break_VF: - case PC_BreakX_VF: - case PC_NotAny_VF: - case PC_NSpan_VF: - case PC_Span_VF: - case PC_Pred_Func: - case PC_String_VF:{ - tended struct b_list *lpsrc; - tended struct b_list *lpdest; - lpsrc = (struct b_list *)BlkD(E->parameter, List); - if ((lpdest = ResolveList(lpsrc)) == NULL) - return NULL; - E->parameter.dword = D_List; - E->parameter.vword.bptr = (union block *) lpdest; - } - } + E = Copy[J]; + /* + * Adjust successor pointer to point to copy + */ + if (E->pthen !=(union block *) &EOP) + E->pthen =(union block *) + Copy[((struct b_pelem *)(E->pthen))->index]; + /* + * Adjust Alt pointer if there is one to point to copy + */ + if (Has_Alt(E->pcode) && + ((struct b_pelem *)(BlkLoc(E->parameter)) != &EOP)) + (BlkLoc(E->parameter)) = (union block *) + Copy[((struct b_pelem *)(BlkLoc(E->parameter)))->index]; + /* + * Resolve references + */ + switch(E->pcode){ + case PC_Pos_NP: + case PC_Len_NP: + case PC_RPos_NP: + case PC_RTab_NP: + case PC_Tab_NP: + case PC_Any_VP: + case PC_Break_VP: + case PC_BreakX_VP: + case PC_NotAny_VP: + case PC_NSpan_VP: + case PC_Span_VP: + case PC_Assign_OnM: + case PC_Assign_Imm: + case PC_Rpat:{ + tended char * varname; + if (is:list(E->parameter)) { + /* + * we know our list + * it has only 2 elements object variable name and field name + * so we dont perform all the sanity checks + */ + tended struct b_lelem *ep; + tended struct b_record *rp; + tended struct b_list *lp = (struct b_list *)BlkLoc(E->parameter); + ep = (struct b_lelem *)lp->listhead; + if (is:string(ep->lslots[0])) { + cnv:C_string(ep->lslots[0],varname); + if (getvar(varname, &ep->lslots[0])== Failed) { + AsgnCStr(ep->lslots[0], varname); + ReturnErrVal(160, ep->lslots[0], NULL); + } + } + } + else { + if (is:string(E->parameter)){ + cnv:C_string(E->parameter, varname); + DEBUGF(2, (stdout, "Looking up variable name = %s\n", + varname)); + if (getvar(varname,&E->parameter)== Failed) { + AsgnCStr(E->parameter, varname); + ReturnErrVal(160, E->parameter, NULL); + } + } + } + break; + } + case PC_Pos_NF: + case PC_Len_NF: + case PC_RPos_NF: + case PC_RTab_NF: + case PC_Tab_NF: + case PC_Any_VF: + case PC_Break_VF: + case PC_BreakX_VF: + case PC_NotAny_VF: + case PC_NSpan_VF: + case PC_Span_VF: + case PC_Pred_Func: + case PC_String_VF:{ + tended struct b_list *lpsrc; + tended struct b_list *lpdest; + lpsrc = (struct b_list *)BlkD(E->parameter, List); + if ((lpdest = ResolveList(lpsrc)) == NULL) + return NULL; + E->parameter.dword = D_List; + E->parameter.vword.bptr = (union block *) lpdest; + } + } } E = Copy[tP->index]; free(Refs); @@ -408,25 +408,25 @@ struct b_pelem * Copy(struct b_pelem * P) /* Now copy all nodes */ for(J = 1; J < RefLen; J++) - Copy[J] = (struct b_pelem *)pelem_copy(Refs[J]); + Copy[J] = (struct b_pelem *)pelem_copy(Refs[J]); /* Adjust all internal references */ for(J = 1; J < RefLen; J++){ - E = Copy[J]; - /* - * Adjust successor pointer to point to copy - */ - if (E->pthen !=(union block *) &EOP) - E->pthen =(union block *) - Copy[((struct b_pelem *)(E->pthen))->index]; - - /* - * Adjust Alt pointer if there is one to point to copy - */ - if (Has_Alt(E->pcode) && - ((struct b_pelem *)(BlkLoc(E->parameter)) != &EOP)) - (BlkLoc(E->parameter)) = (union block *)Copy[((struct b_pelem *) - (BlkLoc(E->parameter)))->index]; - } + E = Copy[J]; + /* + * Adjust successor pointer to point to copy + */ + if (E->pthen !=(union block *) &EOP) + E->pthen =(union block *) + Copy[((struct b_pelem *)(E->pthen))->index]; + + /* + * Adjust Alt pointer if there is one to point to copy + */ + if (Has_Alt(E->pcode) && + ((struct b_pelem *)(BlkLoc(E->parameter)) != &EOP)) + (BlkLoc(E->parameter)) = (union block *)Copy[((struct b_pelem *) + (BlkLoc(E->parameter)))->index]; + } E = Copy[P->index]; free(Refs); free(Copy); @@ -456,21 +456,21 @@ struct b_pelem * Concat (struct b_pelem * L, struct b_pelem *R, int Incr ) Refs=(struct b_pelem **)alloc(RefLen * sizeof(struct b_pelem *)); Record_PE(lpe, Refs); for (J = 1; J < RefLen;J++) { - P = Refs[J]; - P->index += rpe->index; - if (P->pcode == PC_Arbno_Y){ - IntVal(P->parameter) += Incr; - } - if ((struct b_pelem *)P->pthen == &EOP) - P->pthen = (union block *)rpe; - if (Has_Alt(P->pcode) && - (BlkLoc(P->parameter) == (union block *)&EOP)) { - tended struct descrip param; - param.dword = D_Pelem; - param.vword.bptr = (union block *) rpe; - P->parameter = param; - } - } + P = Refs[J]; + P->index += rpe->index; + if (P->pcode == PC_Arbno_Y){ + IntVal(P->parameter) += Incr; + } + if ((struct b_pelem *)P->pthen == &EOP) + P->pthen = (union block *)rpe; + if (Has_Alt(P->pcode) && + (BlkLoc(P->parameter) == (union block *)&EOP)) { + tended struct descrip param; + param.dword = D_Pelem; + param.vword.bptr = (union block *) rpe; + P->parameter = param; + } + } free(Refs); return lpe; } @@ -496,7 +496,7 @@ struct b_pelem * ResolvePattern(struct b_pattern *pat) { struct descrip key; /* not tended because its always an int */ tended struct b_pattern *tpat; - tended struct descrip val; + tended struct descrip val; int res; uword hn; struct b_telem *te; /* not tended because no gc between def and uses */ @@ -514,14 +514,14 @@ struct b_pelem * ResolvePattern(struct b_pattern *pat) } else { /* we have a table check if the pattern is already resolved */ if ((pfp->pattern_cache)->title != T_Table) { - syserr("corrupt pattern_cache\n"); - } + syserr("corrupt pattern_cache\n"); + } pd = memb( (union block *)pfp->pattern_cache,&key,hn,&res); if (res != 0) { /*the element is in the table*/ - te = (struct b_telem *) *pd; - return (struct b_pelem *)BlkLoc(te->tval); - } + te = (struct b_telem *) *pd; + return (struct b_pelem *)BlkLoc(te->tval); + } } /* if it is not in table, first resolve references */ if ((phead = ResolveReferences(&(tpat->pe->Pelem))) == NULL) return NULL; @@ -553,16 +553,16 @@ function {*} pattern_match(underef psub -> dpsub, pat) */ if is:variable(psub) && is:string(dpsub) then { abstract { - return new tvsubs(type(psub)) - } + return new tvsubs(type(psub)) + } inline { - use_trap = 1; - } + use_trap = 1; + } } else if cnv:tmp_string(dpsub) then abstract { - return string - } + return string + } else runerr(114, dpsub); @@ -573,8 +573,8 @@ function {*} pattern_match(underef psub -> dpsub, pat) int subject_len; #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ - +#endif /* ConcurrentCOMPILER */ + DEBUGF(20,(stdout, "(729)begin pattern_match()\n")); /* * Assign new values to &subject/&pos to execute a match. @@ -586,50 +586,50 @@ function {*} pattern_match(underef psub -> dpsub, pat) subject_len = StrLen(k_subject); if (! cnv_pattern(&pat, &pat)) { - runerr(127, pat); - } + runerr(127, pat); + } if ((phead = ResolvePattern((struct b_pattern *)BlkLoc(pat))) == NULL) runerr(0); while ((k_pos >= 0) && - internal_match(StrLoc(k_subject), subject_len, ((struct b_pattern *)BlkLoc(pat))->stck_size, - pat, phead, &start, &stop, k_pos, 0) - ){ - /* check if psub no longer refers to what k_subject holds. - * if so, we can't suspend a trapped variable reference to it. - */ - if ((use_trap == 1) && - (StrLoc(*(psub.vword.descptr)) == StrLoc(k_subject)) && - (StrLen(*(psub.vword.descptr)) == StrLen(k_subject)) ) { - - /* if it is &subject, we can't make a tvsubs from it. */ - if (psub.vword.descptr == &k_subject) { - suspend string(stop - start, StrLoc(dpsub)+ start); - } - else { - suspend tvsubs(&psub, start+1,stop - start); - } - } - else { - suspend string(stop - start, StrLoc(dpsub)+ start); - } - /* Deref again, in case psub was altered. */ - deref(&psub,&dpsub); + internal_match(StrLoc(k_subject), subject_len, ((struct b_pattern *)BlkLoc(pat))->stck_size, + pat, phead, &start, &stop, k_pos, 0) + ){ + /* check if psub no longer refers to what k_subject holds. + * if so, we can't suspend a trapped variable reference to it. + */ + if ((use_trap == 1) && + (StrLoc(*(psub.vword.descptr)) == StrLoc(k_subject)) && + (StrLen(*(psub.vword.descptr)) == StrLen(k_subject)) ) { + + /* if it is &subject, we can't make a tvsubs from it. */ + if (psub.vword.descptr == &k_subject) { + suspend string(stop - start, StrLoc(dpsub)+ start); + } + else { + suspend tvsubs(&psub, start+1,stop - start); + } + } + else { + suspend string(stop - start, StrLoc(dpsub)+ start); + } + /* Deref again, in case psub was altered. */ + deref(&psub,&dpsub); k_subject = dpsub; - /* - * Someone has monkeyed with the string we are scanning. - * Update &pos, and check that it remains in bounds. - * This interpretation -- that a longer string means - * move pos forward and shorter means move the pos - * backward, is somewhat dubious but could be useful. - */ - if (subject_len != StrLen(dpsub)) { - k_pos += StrLen(dpsub) - subject_len; - subject_len = StrLen(dpsub); - if (k_pos < 1) k_pos = 1; - else if (k_pos > StrLen(dpsub)+1) k_pos = StrLen(dpsub); - EVVal(k_pos, E_Spos); - } + /* + * Someone has monkeyed with the string we are scanning. + * Update &pos, and check that it remains in bounds. + * This interpretation -- that a longer string means + * move pos forward and shorter means move the pos + * backward, is somewhat dubious but could be useful. + */ + if (subject_len != StrLen(dpsub)) { + k_pos += StrLen(dpsub) - subject_len; + subject_len = StrLen(dpsub); + if (k_pos < 1) k_pos = 1; + else if (k_pos > StrLen(dpsub)+1) k_pos = StrLen(dpsub); + EVVal(k_pos, E_Spos); + } } fail; } @@ -663,9 +663,9 @@ int f(dptr s, dptr p) default: { tended union block *bp = NULL; if (!cnv:string(*s, *s)) { - EVValD(s, e_fconv); - return 0; - } + EVValD(s, e_fconv); + return 0; + } bp = pattern_make(0, &EOP,PC_String,1, *s); EVVal(PC_String, e_patcode); p->dword = D_Pattern; @@ -680,9 +680,9 @@ int f(dptr s, dptr p) #ifdef MultiProgram cnv_pattern_macro(cnv_pattern_0,0,0,0,0,0,0) cnv_pattern_macro(cnv_pattern_1,E_Aconv,E_Tconv,E_Nconv,E_Sconv,E_Fconv,E_PatCode) -#else /* MultiProgram */ +#else /* MultiProgram */ cnv_pattern_macro(cnv_pattern,0,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * @@ -712,15 +712,15 @@ static void Set_Successor (struct b_pelem * Pat , struct b_pelem *Succ) Refs = (struct b_pelem **)alloc(RefLen * sizeof(struct b_pelem *)); Record_PE(Pat, Refs); for (J = 1; J < RefLen;J++){ - P = Refs[J]; - if ((struct b_pelem *)P->pthen == &EOP) - P->pthen = (union block *)Succ; - if (Has_Alt(P->pcode) && - ((struct b_pelem *)BlkLoc(P->parameter) == &EOP)){ - P->parameter.dword = D_Pelem; - P->parameter.vword.bptr = (union block *) Succ; - } - } + P = Refs[J]; + if ((struct b_pelem *)P->pthen == &EOP) + P->pthen = (union block *)Succ; + if (Has_Alt(P->pcode) && + ((struct b_pelem *)BlkLoc(P->parameter) == &EOP)){ + P->parameter.dword = D_Pelem; + P->parameter.vword.bptr = (union block *) Succ; + } + } free(Refs); } } @@ -729,7 +729,7 @@ static void Set_Successor (struct b_pelem * Pat , struct b_pelem *Succ) * Bracket */ struct b_pelem *Bracket(struct b_pelem *E,struct b_pelem * P, - struct b_pelem * A) + struct b_pelem * A) { if (P == &EOP) { E->pthen = (union block *)A; @@ -748,37 +748,37 @@ struct b_pelem *Bracket(struct b_pelem *E,struct b_pelem * P, #begdef ConvertPatternArgumentCset(arg, bp, ptype) type_case arg of { pattern: { - struct b_pattern *pat = (struct b_pattern *)BlkLoc(arg); - tended struct b_pelem *pe = (struct b_pelem *)pat->pe; - switch(pe->pcode) { - case PC_Rpat: { - bp = pattern_make(0, &EOP,ptype ## _VP,1, pe->parameter); + struct b_pattern *pat = (struct b_pattern *)BlkLoc(arg); + tended struct b_pelem *pe = (struct b_pelem *)pat->pe; + switch(pe->pcode) { + case PC_Rpat: { + bp = pattern_make(0, &EOP,ptype ## _VP,1, pe->parameter); EVVal(ptype ## _VP, E_PatCode); - break; - } - case PC_Pred_Func: - case PC_String_VF: { - bp = pattern_make(0, &EOP,ptype ## _VF,1, pe->parameter); - EVVal(ptype ## _VF, E_PatCode); - break; - } - case PC_Pred_MF: - case PC_String_MF: { - bp = pattern_make(0, &EOP,ptype ## _MF,1, pe->parameter); - EVVal(ptype ## _MF, E_PatCode); - break; - } - default: { - runerr(127); - } - } - } + break; + } + case PC_Pred_Func: + case PC_String_VF: { + bp = pattern_make(0, &EOP,ptype ## _VF,1, pe->parameter); + EVVal(ptype ## _VF, E_PatCode); + break; + } + case PC_Pred_MF: + case PC_String_MF: { + bp = pattern_make(0, &EOP,ptype ## _MF,1, pe->parameter); + EVVal(ptype ## _MF, E_PatCode); + break; + } + default: { + runerr(127); + } + } + } default: { - if (!cnv_cset(&arg, &arg)) - runerr(104, arg); - bp = pattern_make(0, &EOP, ptype ## _CS,1, arg); + if (!cnv_cset(&arg, &arg)) + runerr(104, arg); + bp = pattern_make(0, &EOP, ptype ## _CS,1, arg); EVVal(ptype ## _CS, E_PatCode); - } + } } #enddef @@ -862,42 +862,42 @@ function {1} Breakx(char_set) struct b_pelem *peBreakx; type_case char_set of { pattern: { - struct b_pattern *pat = (struct b_pattern *)BlkLoc(char_set); - tended struct b_pelem *pe = (struct b_pelem *)pat->pe; - - switch(pe->pcode){ - case PC_Rpat:{ - peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_VP, 3, - pe->parameter); - EVVal(PC_BreakX_VP, E_PatCode); - break; - } - case PC_Pred_Func: - case PC_String_VF: { - peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_VF, 3, - pe->parameter); - EVVal(PC_BreakX_VF, E_PatCode); - break; - } - case PC_Pred_MF: - case PC_String_MF: { - peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_MF, 3, - pe->parameter); - EVVal(PC_BreakX_MF, E_PatCode); - break; - } - default: { - runerr(128); - } - } - } + struct b_pattern *pat = (struct b_pattern *)BlkLoc(char_set); + tended struct b_pelem *pe = (struct b_pelem *)pat->pe; + + switch(pe->pcode){ + case PC_Rpat:{ + peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_VP, 3, + pe->parameter); + EVVal(PC_BreakX_VP, E_PatCode); + break; + } + case PC_Pred_Func: + case PC_String_VF: { + peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_VF, 3, + pe->parameter); + EVVal(PC_BreakX_VF, E_PatCode); + break; + } + case PC_Pred_MF: + case PC_String_MF: { + peBreakx = (struct b_pelem *)pelem_make(NULL, PC_BreakX_MF, 3, + pe->parameter); + EVVal(PC_BreakX_MF, E_PatCode); + break; + } + default: { + runerr(128); + } + } + } default: { - if (!cnv_cset(&char_set, &char_set)) - runerr(104, char_set); - peBreakx = (struct b_pelem *)pelem_make(NULL,PC_BreakX_CS,3,char_set); - EVVal(PC_BreakX_CS, E_PatCode); - } - } + if (!cnv_cset(&char_set, &char_set)) + runerr(104, char_set); + peBreakx = (struct b_pelem *)pelem_make(NULL,PC_BreakX_CS,3,char_set); + EVVal(PC_BreakX_CS, E_PatCode); + } + } bp = (union block *)breakx_make(peBreakx); return pattern(bp); } @@ -921,49 +921,49 @@ end } if is:pattern(arg) then body { union block *bp; - struct b_pattern *pat = (struct b_pattern *)BlkLoc(arg); - tended struct b_pelem *pe = (struct b_pelem *)pat->pe; - switch(pe->pcode){ - case PC_Rpat: { - bp = (union block *)pattern_make(0, &EOP,ptype ## _NP, - 1, pe->parameter); + struct b_pattern *pat = (struct b_pattern *)BlkLoc(arg); + tended struct b_pelem *pe = (struct b_pelem *)pat->pe; + switch(pe->pcode){ + case PC_Rpat: { + bp = (union block *)pattern_make(0, &EOP,ptype ## _NP, + 1, pe->parameter); EVVal(ptype ## _NP, E_PatCode); - break; - } - case PC_Pred_Func: - case PC_String_VF: { - bp = (union block *)pattern_make(0, &EOP,ptype ## _NF, - 1, pe->parameter); + break; + } + case PC_Pred_Func: + case PC_String_VF: { + bp = (union block *)pattern_make(0, &EOP,ptype ## _NF, + 1, pe->parameter); EVVal(ptype ## _NF, E_PatCode); - break; - } - case PC_Pred_MF: - case PC_String_MF: { - bp = (union block *)pattern_make(0, &EOP,ptype ## _NMF, - 1, pe->parameter); + break; + } + case PC_Pred_MF: + case PC_String_MF: { + bp = (union block *)pattern_make(0, &EOP,ptype ## _NMF, + 1, pe->parameter); EVVal(ptype ## _NMF, E_PatCode); - break; - } - default: { - runerr(128); - } - } + break; + } + default: { + runerr(128); + } + } return pattern(bp); } else if cnv:integer(arg) then body { union block *bp; #if negflag if (IntVal(arg) <= 0) { - IntVal(arg) = -IntVal(arg); - bp = (union block *)pattern_make(0, &EOP, negintptype ## _Nat,1, arg); - EVVal(negintptype ## _Nat, E_PatCode); + IntVal(arg) = -IntVal(arg); + bp = (union block *)pattern_make(0, &EOP, negintptype ## _Nat,1, arg); + EVVal(negintptype ## _Nat, E_PatCode); } else #endif - { - bp = (union block *)pattern_make(0, &EOP, ptype ## _Nat,1, arg); - EVVal(ptype ## _Nat, E_PatCode); - } + { + bp = (union block *)pattern_make(0, &EOP, ptype ## _Nat,1, arg); + EVVal(ptype ## _Nat, E_PatCode); + } return pattern(bp); } else runerr(102, arg) @@ -1056,91 +1056,91 @@ function {1} Arbno(ARBPAT) if (!cnv_pattern(&ARBPAT, &ARBPAT)) runerr(127, ARBPAT); if (pattype == 1) { - P = (struct b_pattern *)BlkLoc(ARBPAT); - X = Arbno_Simple((struct b_pelem *)P->pe); - bp = pattern_make_pelem(0,X); - EVVal(PC_Arbno_S, E_PatCode); - return pattern(bp); - } + P = (struct b_pattern *)BlkLoc(ARBPAT); + X = Arbno_Simple((struct b_pelem *)P->pe); + bp = pattern_make_pelem(0,X); + EVVal(PC_Arbno_S, E_PatCode); + return pattern(bp); + } else { - tended struct b_pelem *Pat; - P = (struct b_pattern *)BlkLoc(ARBPAT); - Pat = Copy((struct b_pelem *)P->pe); - if ((P->stck_size == 0) && OK_For_Simple_Arbno(Pat->pcode)) { - /* - * - * Arbno_Simple - * - * - * +-------------+ - * | ^ - * V | - * +---+ | - * | S |----> | - * +---+ | - * . | - * . | - * +---+ | - * | P |---------->+ - * +---+ - * - * The node numbering of the constituent pattern P is not - * affected. The S node has a node number of P.Index + 1. - * - * Note that we know that P cannot be EOP, because a null - * pattern does not meet the requirements for simple Arbno. - */ - X = Arbno_Simple(Pat); - bp = pattern_make_pelem(1,X); - EVVal(PC_Arbno_S, E_PatCode); - return pattern(bp); - } - else { - /* - * This is the complex case, either the pattern makes stack - * entries or it is possible for the pattern to match the null - * string (more accurately, we don't know that this is not the - * case). - * - * +--------------------------+ - * | ^ - * V | - * +---+ | - * | X |----> | - * +---+ | - * . | - * . | - * +---+ +---+ +---+ | - * | E |---->| P |---->| Y |--->+ - * +---+ +---+ +---+ - * - * The node numbering of the constituent pattern P is not - * affected. Where N is the number of nodes in P, the Y node is - * numbered N + 1, the E node is N + 2, and the X node is N + 3. - */ - tended struct b_pelem * E; - tended struct b_pelem * Y; - tended struct b_pelem *EPY; - tended struct descrip var; - E = (struct b_pelem *)pelem_make(&EOP,PC_R_Enter, - 0,nulldesc); - var.dword = D_Pelem; - BlkLoc(var) = (union block *)E; - X = (struct b_pelem *)pelem_make(&EOP,PC_Arbno_X,0,var); - EVVal(PC_Arbno_X, E_PatCode); - var.dword = D_Integer; - IntVal(var) = P->stck_size + 3; - Y = (struct b_pelem *)pelem_make(X,PC_Arbno_Y,0,var); - EVVal(PC_Arbno_X, E_PatCode); - EPY = Bracket (E, Pat, Y); - var.dword = D_Pelem; - BlkLoc(var) = (union block *)EPY; - X->parameter = var; - X->index = EPY->index + 1; - bp = pattern_make_pelem(P->stck_size,X); - return pattern(bp); - } - } + tended struct b_pelem *Pat; + P = (struct b_pattern *)BlkLoc(ARBPAT); + Pat = Copy((struct b_pelem *)P->pe); + if ((P->stck_size == 0) && OK_For_Simple_Arbno(Pat->pcode)) { + /* + * + * Arbno_Simple + * + * + * +-------------+ + * | ^ + * V | + * +---+ | + * | S |----> | + * +---+ | + * . | + * . | + * +---+ | + * | P |---------->+ + * +---+ + * + * The node numbering of the constituent pattern P is not + * affected. The S node has a node number of P.Index + 1. + * + * Note that we know that P cannot be EOP, because a null + * pattern does not meet the requirements for simple Arbno. + */ + X = Arbno_Simple(Pat); + bp = pattern_make_pelem(1,X); + EVVal(PC_Arbno_S, E_PatCode); + return pattern(bp); + } + else { + /* + * This is the complex case, either the pattern makes stack + * entries or it is possible for the pattern to match the null + * string (more accurately, we don't know that this is not the + * case). + * + * +--------------------------+ + * | ^ + * V | + * +---+ | + * | X |----> | + * +---+ | + * . | + * . | + * +---+ +---+ +---+ | + * | E |---->| P |---->| Y |--->+ + * +---+ +---+ +---+ + * + * The node numbering of the constituent pattern P is not + * affected. Where N is the number of nodes in P, the Y node is + * numbered N + 1, the E node is N + 2, and the X node is N + 3. + */ + tended struct b_pelem * E; + tended struct b_pelem * Y; + tended struct b_pelem *EPY; + tended struct descrip var; + E = (struct b_pelem *)pelem_make(&EOP,PC_R_Enter, + 0,nulldesc); + var.dword = D_Pelem; + BlkLoc(var) = (union block *)E; + X = (struct b_pelem *)pelem_make(&EOP,PC_Arbno_X,0,var); + EVVal(PC_Arbno_X, E_PatCode); + var.dword = D_Integer; + IntVal(var) = P->stck_size + 3; + Y = (struct b_pelem *)pelem_make(X,PC_Arbno_Y,0,var); + EVVal(PC_Arbno_X, E_PatCode); + EPY = Bracket (E, Pat, Y); + var.dword = D_Pelem; + BlkLoc(var) = (union block *)EPY; + X->parameter = var; + X->index = EPY->index + 1; + bp = pattern_make_pelem(P->stck_size,X); + return pattern(bp); + } + } } end @@ -1261,7 +1261,7 @@ function {1} pattern_concat(L, R) lpattern = (struct b_pattern *)BlkLoc(L); rpattern = (struct b_pattern *)BlkLoc(R); pe = Concat(Copy((struct b_pelem *)lpattern->pe), - Copy((struct b_pelem *)rpattern->pe), rpattern->stck_size); + Copy((struct b_pelem *)rpattern->pe), rpattern->stck_size); bp = pattern_make_pelem(lpattern->stck_size + rpattern->stck_size,pe); return pattern(bp); } @@ -1270,14 +1270,14 @@ end struct b_pelem * Alternate(struct b_pelem * L,struct b_pelem * R) { tended struct b_pelem *lpe = L; - tended struct b_pelem *rpe = R; + tended struct b_pelem *rpe = R; tended struct descrip param; param.dword = D_Pelem; param.vword.bptr = (union block *)rpe; EVVal(PC_Alt, E_PatCode); if (lpe == &EOP) { return (struct b_pelem *)pelem_make(&EOP, (word)PC_Alt, - (word)rpe->index + 1, param); + (word)rpe->index + 1, param); } /* * If the left pattern is non-null, then build a reference vector @@ -1296,9 +1296,9 @@ struct b_pelem * Alternate(struct b_pelem * L,struct b_pelem * R) Refs = (struct b_pelem **)alloc(RefLen * sizeof(struct b_pelem *)); Record_PE(lpe, Refs); for (J = 1; J < RefLen;J++){ - P = Refs[J]; - P->index += rpe->index; - } + P = Refs[J]; + P->index += rpe->index; + } return (struct b_pelem *)pelem_make(lpe, PC_Alt, lpe->index + 1, param); } } @@ -1318,15 +1318,15 @@ function{1} pattern_alternate (LPAT, RPAT ) union block *bp; if (!cnv_pattern(&LPAT, &LPAT)) - runerr(127, LPAT); + runerr(127, LPAT); if (!cnv_pattern(&RPAT, &RPAT)) - runerr(127, RPAT); + runerr(127, RPAT); lpattern = (struct b_pattern *)BlkLoc(LPAT); rpattern = (struct b_pattern *)BlkLoc(RPAT); pe = Alternate(Copy((struct b_pelem *)lpattern->pe), - Copy((struct b_pelem *)rpattern->pe) - ); + Copy((struct b_pelem *)rpattern->pe) + ); bp =pattern_make_pelem(MAX(lpattern->stck_size, rpattern->stck_size),pe); return pattern(bp); } @@ -1542,14 +1542,14 @@ emacs * Stack_Base := Stack (Stack_Base).Cursor; #define StackNode(i) (Stack->next->Lelem.lslots[i].vword.bptr) #begdef Pop_Region() -if (Stack_Ptr == Stack_Base) { +if (Stack_Ptr == Stack_Base) { EVVal(0, E_PatPop); Stack_Ptr = Stack_Base - 2; Stack_Base = StackCursor(Stack_Ptr + 2); Stack->next->Lelem.nused -= 2; } else { - EVVal(1, E_PatPop); + EVVal(1, E_PatPop); Stack_Ptr++; StackCursor(Stack_Ptr) = Stack_Base; StackNode(Stack_Ptr) = (union block *)&CP_R_Restore; @@ -1569,7 +1569,7 @@ else { */ #begdef Push(Node) -EVVal(0, E_PatPush); +EVVal(0, E_PatPush); Stack_Ptr++; StackCursor(Stack_Ptr) = k_pos - 1; StackNode(Stack_Ptr) = (union block *)Node; @@ -1589,7 +1589,7 @@ Stack->next->Lelem.nused++; * end Push_Region; */ #begdef Push_Region() -EVVal(1, E_PatPush); +EVVal(1, E_PatPush); Stack_Ptr = Stack_Ptr + 2; StackCursor(Stack_Ptr) = Stack_Base; StackNode(Stack_Ptr) = (union block *)&CP_R_Remove; @@ -1637,9 +1637,9 @@ if (is:list(Node->parameter)) { nfields = bptr->Proc.nfields; for (i=0;iProc.lnames[i])) && - !strncmp(StrLoc(fieldptr), - StrLoc(bptr->Proc.lnames[i]),StrLen(fieldptr))) - break; + !strncmp(StrLoc(fieldptr), + StrLoc(bptr->Proc.lnames[i]),StrLen(fieldptr))) + break; } if (iparameter)) { cnv:C_string(Node->parameter, varnam); if (getvar(varnam, &varref) == Failed) { - fatalerr(160, &(Node->parameter)); - } + fatalerr(160, &(Node->parameter)); + } deref(&varref, &var); pvar = VarLoc(varref); EVValD(&var, E_PatVal); @@ -1695,10 +1695,10 @@ int isMethod(struct b_lelem *ep){ else fatalerr(107, &(ep->lslots[0])); for( i = 0; i < bptr->Proc.nfields;i++) { if ((StrLoc(bptr->Proc.lnames[i]) != NULL) && - !strcmp(StrLoc(bptr->Proc.lnames[i]), "__m")) { - found__m = i; - break; - } + !strcmp(StrLoc(bptr->Proc.lnames[i]), "__m")) { + found__m = i; + break; + } }/* for ... nfields */ return found__m; } @@ -1724,32 +1724,32 @@ dptr processFuncCallList(struct b_list *lp) DEBUGF(25,(stdout, "nargs %d\n", nargs)); for (i = 1; i < ep->nused; i++) { if(i == 1 && is:list(ep->lslots[i])) { - /*check for method call else function call*/ - DEBUGF(25,(stdout, "is a list\n")); - if(isMethod(ep) >= 0) { - rv = processMethodCallList(BlkD(ep->lslots[i], List)); - } - else { - rv = processFuncCallList(BlkD(ep->lslots[i], List)); - } - if (rv == 0) { free(procargs); return 0; } - procargs[i - 1] = *rv; - } + /*check for method call else function call*/ + DEBUGF(25,(stdout, "is a list\n")); + if(isMethod(ep) >= 0) { + rv = processMethodCallList(BlkD(ep->lslots[i], List)); + } + else { + rv = processFuncCallList(BlkD(ep->lslots[i], List)); + } + if (rv == 0) { free(procargs); return 0; } + procargs[i - 1] = *rv; + } else if (is:variable(ep->lslots[i])) { - DEBUGF(25,(stdout, "replacing var %16lx : %16lx\n", - ep->lslots[i].dword, - (long)ep->lslots[i].vword.bptr)); - procargs[i - 1] = *(ep->lslots[i].vword.descptr); - } - else { - procargs[i - 1] = ep->lslots[i]; - DEBUGF(25,(stdout, "nargs %d arg %d val %16lx : %16lx\n", - nargs, i-1, procargs[i-1].dword, (long)procargs - [i-1].vword.bptr)); + DEBUGF(25,(stdout, "replacing var %16lx : %16lx\n", + ep->lslots[i].dword, + (long)ep->lslots[i].vword.bptr)); + procargs[i - 1] = *(ep->lslots[i].vword.descptr); + } + else { + procargs[i - 1] = ep->lslots[i]; + DEBUGF(25,(stdout, "nargs %d arg %d val %16lx : %16lx\n", + nargs, i-1, procargs[i-1].dword, (long)procargs + [i-1].vword.bptr)); } } DEBUGF(25,(stdout, "proc %16lx : %16lx\n", proc.dword, - (unsigned long int)proc.vword.bptr)); + (unsigned long int)proc.vword.bptr)); DEBUGF(25,(stdout, "nargs %d\n", nargs)); call_result = (dptr)calliconproc(proc,procargs,nargs); free(procargs); @@ -1816,9 +1816,9 @@ dptr processMethodCallList(struct b_list *lp) nfields = bptr->Proc.nfields; for (i=0; iProc.lnames[i])) && - !strncmp(StrLoc(methodptr), - StrLoc(bptr->Proc.lnames[i]),StrLen(methodptr))) - break; + !strncmp(StrLoc(methodptr), + StrLoc(bptr->Proc.lnames[i]),StrLen(methodptr))) + break; } if (inused; i++) { if(is:list(ep->lslots[i])) { - /* check for method call else function call*/ - if(isMethod((struct b_lelem *)(BlkD(ep->lslots[i],List)->listhead)) >= 0) { - /* slot is a method */ - rv = processMethodCallList(BlkD(ep->lslots[i], List)); - } - else { - /* slot is a procedure */ - rv = processFuncCallList(BlkD(ep->lslots[i], List)); - } - if (rv == 0) { - return 0; - } - procargs[i - 1] = *rv; - } + /* check for method call else function call*/ + if(isMethod((struct b_lelem *)(BlkD(ep->lslots[i],List)->listhead)) >= 0) { + /* slot is a method */ + rv = processMethodCallList(BlkD(ep->lslots[i], List)); + } + else { + /* slot is a procedure */ + rv = processFuncCallList(BlkD(ep->lslots[i], List)); + } + if (rv == 0) { + return 0; + } + procargs[i - 1] = *rv; + } else if (is:variable(ep->lslots[i])) { - procargs[i - 1] = *(ep->lslots[i].vword.descptr); - } + procargs[i - 1] = *(ep->lslots[i].vword.descptr); + } else if (cnv:integer(ep->lslots[i], argmnt)) { - procargs[i - 1] = argmnt; - } + procargs[i - 1] = argmnt; + } else if (is:string(ep->lslots[i])) { /* "string" needs interpreting */ if ((StrLen(ep->lslots[i])>0) && StrLoc(ep->lslots[i])[0]=='\"') { - procargs[i - 1] = ep->lslots[i]; - StrLoc(procargs[i-1])++; - StrLen(procargs[i-1]) -= 2; - } + procargs[i - 1] = ep->lslots[i]; + StrLoc(procargs[i-1])++; + StrLen(procargs[i-1]) -= 2; + } else if ((StrLen(ep->lslots[i])>0) && StrLoc(ep->lslots[i])[0]=='\''){ - procargs[i - 1] = ep->lslots[i]; - StrLoc(procargs[i-1])++; - StrLen(procargs[i-1]) -= 2; - cnv:cset(procargs[i-1], procargs[i-1]); - } + procargs[i - 1] = ep->lslots[i]; + StrLoc(procargs[i-1])++; + StrLen(procargs[i-1]) -= 2; + cnv:cset(procargs[i-1], procargs[i-1]); + } else { tended char * varname; - tended char * varstring; - tended struct descrip parm; + tended char * varstring; + tended struct descrip parm; cnv:C_string(ep->lslots[i], varname); - /* - * We are evaluating a parameter in a variable name. - * Probably needs more thought than getvar(). - */ - if (getvar(varname, &parm) == Failed) { - AsgnCStr(parm, varname); - ReturnErrVal(160, parm, NULL); - } - deref(&parm,&(procargs[i-1])); - } - } + /* + * We are evaluating a parameter in a variable name. + * Probably needs more thought than getvar(). + */ + if (getvar(varname, &parm) == Failed) { + AsgnCStr(parm, varname); + ReturnErrVal(160, parm, NULL); + } + deref(&parm,&(procargs[i-1])); + } + } } call_result = (dptr)calliconproc(proc,procargs,nargs-1); return call_result; @@ -1931,11 +1931,11 @@ else { /* * internal_match() - primary pattern match engine. */ -int f(char * pat_sub, int Length, int Pat_S, struct descrip op, - struct b_pelem * pat, int *Start, int *Stop, - int initial_cursor, - int Anchored_Mode - ) +int f(char * pat_sub, int Length, int Pat_S, struct descrip op, + struct b_pelem * pat, int *Start, int *Stop, + int initial_cursor, + int Anchored_Mode + ) { int i, Stack_Ptr, Stack_Base; int Assign_OnM = 0, Region_Level = 0; @@ -1945,9 +1945,9 @@ int f(char * pat_sub, int Length, int Pat_S, struct descrip op, tended struct b_pelem * Node; #if COMPILER tended struct b_pelem * PE_Unanchored; -#else /* COMPILER */ +#else /* COMPILER */ tended struct b_pelem * PE_Unanchored; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * And now for something weird. A pattern stack, allocated on the stack, @@ -1973,16 +1973,16 @@ int f(char * pat_sub, int Length, int Pat_S, struct descrip op, struct descrip lslots[Stack_Size]; } bsle; struct b_cons bcons; - + EVValD(&op, E_PatAttempt); - + tpattern = pat; Node = NULL; #if COMPILER PE_Unanchored = alcpelem(PC_Unanchored); -#else /* COMPILER */ +#else /* COMPILER */ PE_Unanchored = alcpelem(PC_Unanchored, ipc.opnd); -#endif /* COMPILER */ +#endif /* COMPILER */ PE_Unanchored->pthen = (union block *)tpattern; PE_Unanchored->parameter = nulldesc; @@ -2004,10 +2004,10 @@ int f(char * pat_sub, int Length, int Pat_S, struct descrip op, bcons.next = (union block *)&bsle; Stack = &bcons; - + DEBUGF(2, (stdout, - "Initiating pattern match\nsubject = \"%*s\", len = %d, pos = %ld\n", - Length,pat_sub,Length, k_pos)); + "Initiating pattern match\nsubject = \"%*s\", len = %d, pos = %ld\n", + Length,pat_sub,Length, k_pos)); if (tpattern == NULL) { fatalerr(162, NULL); @@ -2069,39 +2069,39 @@ Match_Succeed: StrLen(evalue) = *Stop - *Start; StrLoc(evalue) = pat_sub + *Start; EVValD(&evalue, e_patmatch); -#endif /* e_patmatch */ +#endif /* e_patmatch */ DEBUGF(2,(stdout, "first matched character index =%d\n", *Start)); DEBUGF(2,(stdout, "last matched character index =%d\n" ,*Stop)); if (Assign_OnM) { int S; for ( S = Stack_Init; S <= Stack_Ptr; S++) { - if (StackNode(S) == (union block *)&CP_Assign){ - int Inner_Base = StackCursor(S + 1); - int Special_Entry = Inner_Base - 1; - tended struct b_pelem * Node_OnM = StackNode(Special_Entry); - int Start = StackCursor(Special_Entry); - int Stop = StackCursor(S); - GetVarFromNodeParameter(Node_OnM); - if (Node_OnM->pcode == PC_Assign_OnM){ - if (var.dword == D_File) { - struct b_file *f; - f = (struct b_file *)BlkLoc(var); - fwrite(pat_sub + Start, 1, Stop - Start, f->fd.fp); - fputc('\n', f->fd.fp); - fflush(f->fd.fp); - } - else { - EVVar(&varref, e_assign); + if (StackNode(S) == (union block *)&CP_Assign){ + int Inner_Base = StackCursor(S + 1); + int Special_Entry = Inner_Base - 1; + tended struct b_pelem * Node_OnM = StackNode(Special_Entry); + int Start = StackCursor(Special_Entry); + int Stop = StackCursor(S); + GetVarFromNodeParameter(Node_OnM); + if (Node_OnM->pcode == PC_Assign_OnM){ + if (var.dword == D_File) { + struct b_file *f; + f = (struct b_file *)BlkLoc(var); + fwrite(pat_sub + Start, 1, Stop - Start, f->fd.fp); + fputc('\n', f->fd.fp); + fflush(f->fd.fp); + } + else { + EVVar(&varref, e_assign); StrLen(*pvar) = Stop - Start; StrLoc(*pvar) = pat_sub + Start; - EVValD(pvar, e_value); - } - } - else { - syserr("logic error in internal_match"); - } - } - } + EVValD(pvar, e_value); + } + } + else { + syserr("logic error in internal_match"); + } + } + } } return 1; Node_Fail: @@ -2192,7 +2192,7 @@ Node_Succeed: case PC_String_VF: EVValDEx(&nulldesc,e_patarg,/*noop*/,arg_image(Node->parameter,PC_String_VF,PT_VF,&(mycurpstate->parent->eventval)),/*noop*/); break; - case PC_String_MF: + case PC_String_MF: EVValDEx(&nulldesc,e_patarg,/*noop*/,arg_image(Node->parameter,PC_String_MF,PT_VF,&(mycurpstate->parent->eventval)),/*noop*/); break; case PC_Pred_MF: case PC_Any_MF: case PC_Break_MF: case PC_BreakX_MF: @@ -2202,7 +2202,7 @@ Node_Succeed: EVValDEx(&nulldesc,e_patarg,/*noop*/,arg_image(Node->parameter,-1,PT_MF,&(mycurpstate->parent->eventval)),/*noop*/); break; } -#endif /* e_patarg */ +#endif /* e_patarg */ #if !COMPILER k_patindex = Node->index; @@ -2221,59 +2221,59 @@ Node_Succeed: case PC_Any_CS:{ DEBUGF(20,(stdout,"Matching Any\n")); if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)){ - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } break; } case PC_Any_VP:{ GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Any unevaluated variable\n")); if (!cnv_cset(&var,&var)) { - fatalerr(104, &var); - } + fatalerr(104, &var); + } if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), var)) { - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } break; } case PC_Any_VF: { GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Any unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } break; } case PC_Any_MF: { GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Any unevaluated method call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } break; } @@ -2293,14 +2293,14 @@ Node_Succeed: case PC_Arb_Y : { DEBUGF(20,(stdout, "extending Arb")); if (k_pos <= Length){ - k_pos++; - Push (Node); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + Push (Node); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } break; } /* @@ -2333,7 +2333,7 @@ Node_Succeed: case PC_Arbno_Y : { int Null_Match = 0; if ((k_pos - 1) == StackCursor(Stack_Base - 1)) - Null_Match = 1; + Null_Match = 1; DEBUGF(20,(stdout,"extending Arbno")); Pop_Region(); @@ -2341,9 +2341,9 @@ Node_Succeed: * If arbno extension matched null, then immediately fail */ if (Null_Match){ - DEBUGF(20,(stdout,"Arbno extension matched null, so fails")); - goto Node_Fail; - } + DEBUGF(20,(stdout,"Arbno extension matched null, so fails")); + goto Node_Fail; + } /* * Here we must do a stack check to make sure enough stack * is left. This check will happen once for each instance of @@ -2352,8 +2352,8 @@ Node_Succeed: * for the Arbno with one instance and the successor pattern */ if (Stack_Ptr + IntVal(Node->parameter) >= Stack_Size){ - fatalerr(309, NULL); - } + fatalerr(309, NULL); + } goto Node_Succeed; } /* @@ -2371,19 +2371,19 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout, "executing immediate assignment\n")); if (var.dword == D_File) { - struct b_file *f; - f = (struct b_file *)BlkLoc(var); - fwrite(pat_sub + StackCursor(Stack_Base - 1), 1, - (k_pos - 1) - StackCursor(Stack_Base - 1), f->fd.fp); - fputc('\n', f->fd.fp); - fflush(f->fd.fp); - } + struct b_file *f; + f = (struct b_file *)BlkLoc(var); + fwrite(pat_sub + StackCursor(Stack_Base - 1), 1, + (k_pos - 1) - StackCursor(Stack_Base - 1), f->fd.fp); + fputc('\n', f->fd.fp); + fflush(f->fd.fp); + } else { - EVVar(&varref, E_Assign); + EVVar(&varref, E_Assign); StrLen(*pvar) = (k_pos - 1) - StackCursor(Stack_Base - 1); StrLoc(*pvar) = pat_sub + StackCursor(Stack_Base - 1); - EVValD(pvar, E_Value); - } + EVValD(pvar, E_Value); + } Pop_Region(); goto Node_Succeed; } @@ -2410,43 +2410,43 @@ Node_Succeed: case PC_Bal : { DEBUGF(2,(stdout,"matching or extending Bal\n")); if (((k_pos - 1) >= Length) || pat_sub[k_pos - 1] == ')') - goto Node_Fail; + goto Node_Fail; else if (pat_sub[k_pos - 1] == '('){ - int Paren_Count = 1; - DEBUGF(2,(stdout, - "Paren_Count = %d Pos = %ld\n", Paren_Count, k_pos)); - while(1) { - k_pos++; - if ((k_pos - 1) >= Length) { - goto Node_Fail; - } - else if (pat_sub[k_pos - 1] == '(' ){ - Paren_Count++; - DEBUGF(2,(stdout, - " Found ( Paren_Count = %d Pos = %ld\n", - Paren_Count,k_pos)); - } - else if (pat_sub[k_pos - 1] == ')'){ - Paren_Count--; - DEBUGF(2,(stdout, - "Found ) Paren_Count = %d Pos = %ld\n", - Paren_Count,k_pos)); - } - if (Paren_Count == 0) { - DEBUGF(2,(stdout, - "Paren_Count = %d Pos = %ld\n", - Paren_Count,k_pos)); - break; - } - } - } - k_pos++; - Push (Node); - DEBUGF(2,(stdout, - "matching or extending Bal succeeded, Pos = %ld\n", - k_pos)); + int Paren_Count = 1; + DEBUGF(2,(stdout, + "Paren_Count = %d Pos = %ld\n", Paren_Count, k_pos)); + while(1) { + k_pos++; + if ((k_pos - 1) >= Length) { + goto Node_Fail; + } + else if (pat_sub[k_pos - 1] == '(' ){ + Paren_Count++; + DEBUGF(2,(stdout, + " Found ( Paren_Count = %d Pos = %ld\n", + Paren_Count,k_pos)); + } + else if (pat_sub[k_pos - 1] == ')'){ + Paren_Count--; + DEBUGF(2,(stdout, + "Found ) Paren_Count = %d Pos = %ld\n", + Paren_Count,k_pos)); + } + if (Paren_Count == 0) { + DEBUGF(2,(stdout, + "Paren_Count = %d Pos = %ld\n", + Paren_Count,k_pos)); + break; + } + } + } + k_pos++; + Push (Node); + DEBUGF(2,(stdout, + "matching or extending Bal succeeded, Pos = %ld\n", + k_pos)); EVVal(k_pos, e_spos); - goto Node_Succeed; + goto Node_Succeed; } /* @@ -2455,19 +2455,19 @@ Node_Succeed: case PC_Break_CS : { int start_kpos = k_pos; DEBUGF(20,(stdout, "matching Break\n")); - while( k_pos <= Length ){ - if (Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { - if (k_pos != start_kpos) - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + while( k_pos <= Length ){ + if (Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { + if (k_pos != start_kpos) + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } /* probably discarded, but if Break() failed, k_pos didn't change. */ if (k_pos != start_kpos) - k_pos = start_kpos; + k_pos = start_kpos; goto Node_Fail; break; } @@ -2476,20 +2476,20 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Break unevaluated variable\n")); if (!cnv_cset(&var,&var)){ - fatalerr(104, &var); - } + fatalerr(104, &var); + } while( k_pos <= Length ){ - if (Testb(ToAscii(pat_sub[k_pos - 1]), var)) { - if (k_pos != start_kpos) - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), var)) { + if (k_pos != start_kpos) + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } if (k_pos != start_kpos) - k_pos = start_kpos; + k_pos = start_kpos; goto Node_Fail; break; } @@ -2498,19 +2498,19 @@ Node_Succeed: GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Break unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while (k_pos <= Length ){ - if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - if (k_pos != start_kpos) - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { + if (k_pos != start_kpos) + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } if (k_pos != start_kpos) - k_pos = start_kpos; + k_pos = start_kpos; goto Node_Fail; break; } @@ -2520,20 +2520,20 @@ Node_Succeed: GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Break unevaluated method call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while( k_pos <= Length ){ - if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - if (k_pos != start_kpos) - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { + if (k_pos != start_kpos) + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } /* if a Break has failed, should &pos have changed at all? */ if (k_pos != start_kpos) - k_pos = start_kpos; + k_pos = start_kpos; goto Node_Fail; break; } @@ -2546,14 +2546,14 @@ Node_Succeed: case PC_BreakX_CS: { DEBUGF(20,(stdout, "matching Breakx\n")); while( k_pos <= Length ){ - if (Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } EVVal(k_pos, e_spos); goto Node_Fail; break; @@ -2562,18 +2562,18 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Breakx unevaluated variable\n")); if (!cnv_cset(&var,&var)) { - fatalerr(104, &var); - } + fatalerr(104, &var); + } while (k_pos <= Length) { - if (Testb(ToAscii(pat_sub[k_pos - 1]), var)) { - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), var)) { + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } EVVal(k_pos, e_spos); goto Node_Fail; break; @@ -2582,16 +2582,16 @@ Node_Succeed: GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Breakx unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while (k_pos <= Length) { - if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } EVVal(k_pos, e_spos); goto Node_Fail; break; @@ -2600,16 +2600,16 @@ Node_Succeed: GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Breakx unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while (k_pos <= Length) { - if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - k_pos++; - } - } + if (Testb(ToAscii(pat_sub[k_pos - 1]), cresult)) { + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + k_pos++; + } + } EVVal(k_pos, e_spos); goto Node_Fail; break; @@ -2688,36 +2688,36 @@ Node_Succeed: goto Node_Fail; else { if(is:string(cresult)) { - int LV_Len = StrLen(cresult); - DEBUGF(20,(stdout, "Matching unevaluated String variable \n")); - if ((Length - (k_pos - 1) >= LV_Len ) - && !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)){ - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - goto Node_Fail; - } - } - goto Node_Succeed; - } - break; - } - + int LV_Len = StrLen(cresult); + DEBUGF(20,(stdout, "Matching unevaluated String variable \n")); + if ((Length - (k_pos - 1) >= LV_Len ) + && !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)){ + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + goto Node_Fail; + } + } + goto Node_Succeed; + } + break; + } + case PC_Len_Nat: { DEBUGF(20,(stdout, "matching Len Nat\n")); - /* + /* * k_pos is 1-based. k_pos + Len should be allowed, as a legal value, * to go up to Length+1. Greater than Length+1 it is out of range. */ if (k_pos + IntVal(Node->parameter) > Length+1) { - goto Node_Fail; - } + goto Node_Fail; + } else { - k_pos += IntVal(Node->parameter); - EVVal(k_pos, e_spos); - } + k_pos += IntVal(Node->parameter); + EVVal(k_pos, e_spos); + } goto Node_Succeed; break; } @@ -2725,16 +2725,16 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Len unevaluated variable\n")); if (!cnv_int(&var,&var)) { - fatalerr(101, &var); - } + fatalerr(101, &var); + } DEBUGF(20,(stdout, "matching Len\n")); if (k_pos + IntVal(var) > Length+1) { - goto Node_Fail; - } + goto Node_Fail; + } else { - k_pos += IntVal(var); - EVVal(k_pos, e_spos); - } + k_pos += IntVal(var); + EVVal(k_pos, e_spos); + } goto Node_Succeed; break; } @@ -2743,11 +2743,11 @@ Node_Succeed: GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Len unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if (k_pos + IntVal(cresult) > Length+1) { - goto Node_Fail; - } + goto Node_Fail; + } k_pos += IntVal(cresult); EVVal(k_pos, e_spos); goto Node_Succeed; @@ -2758,11 +2758,11 @@ Node_Succeed: GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Len unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if (k_pos + IntVal(cresult) > Length+1) { - goto Node_Fail; - } + goto Node_Fail; + } k_pos += IntVal(cresult); EVVal(k_pos, e_spos); goto Node_Succeed; @@ -2772,66 +2772,66 @@ Node_Succeed: case PC_NotAny_CS : { DEBUGF(20,(stdout, "matching NotAny\n")); if ((k_pos <= Length) && - !Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !Testb(ToAscii(pat_sub[k_pos - 1]), Node->parameter)) { + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_NotAny_VP : { GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching NotAny unevaluated variable\n")); if (!cnv_cset(&var,&var)) { - fatalerr(104, &var); - } + fatalerr(104, &var); + } DEBUGF(20,(stdout, "matching NotAny_VP\n")); if ((k_pos <= Length) && - !Testb(ToAscii(pat_sub[k_pos - 1]), var)){ - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !Testb(ToAscii(pat_sub[k_pos - 1]), var)){ + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_NotAny_VF: { GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching NotAny unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); DEBUGF(20,(stdout, "matching NotAny\n")); if ((k_pos <= Length) && - !Testb(ToAscii(pat_sub[k_pos - 1]), cresult)){ - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !Testb(ToAscii(pat_sub[k_pos - 1]), cresult)){ + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } - + case PC_NotAny_MF : { GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching NotAny unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); DEBUGF(20,(stdout, "matching NotAny\n")); if ((k_pos <= Length) && - !Testb(ToAscii(pat_sub[k_pos - 1]), cresult)){ - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !Testb(ToAscii(pat_sub[k_pos - 1]), cresult)){ + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -2841,50 +2841,50 @@ Node_Succeed: GetVarFromNodeParameter(Node); type_case var of { string: { - int LV_Len = StrLen(var); - DEBUGF(20,(stdout, "Matching unevaluated String variable \n")); - if ((Length - (k_pos - 1) >= LV_Len ) - && !strncmp(pat_sub + (k_pos - 1), StrLoc(var), LV_Len)){ - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - goto Node_Fail; - } - break; - } + int LV_Len = StrLen(var); + DEBUGF(20,(stdout, "Matching unevaluated String variable \n")); + if ((Length - (k_pos - 1) >= LV_Len ) + && !strncmp(pat_sub + (k_pos - 1), StrLoc(var), LV_Len)){ + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + goto Node_Fail; + } + break; + } cset: { - DEBUGF(20,(stdout,"Matching unevaluated cset variable\n")); - if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), var)) { - k_pos++; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - goto Node_Fail; - } - break; - } + DEBUGF(20,(stdout,"Matching unevaluated cset variable\n")); + if ((k_pos <= Length) && Testb(ToAscii(pat_sub[k_pos - 1]), var)) { + k_pos++; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + goto Node_Fail; + } + break; + } pattern: { - DEBUGF(20,(stdout, "Matching unevaluated pattern variable\n")); - StackNode(Stack_Ptr + 1) = Node->pthen; - Push_Region(); - if (Stack_Ptr + - ((struct b_pattern *)BlkLoc(var))->stck_size >= Stack_Size) { - fatalerr(309, NULL); - } - else { - Node = (struct b_pelem *) ((struct b_pattern *)BlkLoc(var))->pe; - goto Match; - } - break; - } + DEBUGF(20,(stdout, "Matching unevaluated pattern variable\n")); + StackNode(Stack_Ptr + 1) = Node->pthen; + Push_Region(); + if (Stack_Ptr + + ((struct b_pattern *)BlkLoc(var))->stck_size >= Stack_Size) { + fatalerr(309, NULL); + } + else { + Node = (struct b_pelem *) ((struct b_pattern *)BlkLoc(var))->pe; + goto Match; + } + break; + } default: { - fatalerr(161, NULL); - } - } + fatalerr(161, NULL); + } + } } /* @@ -2892,50 +2892,50 @@ Node_Succeed: */ case PC_Pos_Nat: { if (k_pos == IntVal(Node->parameter)) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Pos_NP:{ GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Pos unevaluated variable\n")); if (!cnv_int(&var,&var)) { - fatalerr(101, &var); - } + fatalerr(101, &var); + } DEBUGF(20,(stdout, "matching Len\n")); if (k_pos == IntVal(var)) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Pos_NF: { GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Len unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if (k_pos == IntVal(cresult)) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Pos_NMF: { GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Len unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if (k_pos == IntVal(cresult)) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -2943,63 +2943,63 @@ Node_Succeed: */ case PC_Tab_Nat: { if (IntVal(Node->parameter) - 1 <= Length){ - k_pos = IntVal(Node->parameter); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = IntVal(Node->parameter); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Tab_NP: { GetVarFromNodeParameter(Node); if (!cnv_int(&var,&var)) { - fatalerr(101, &var); - } + fatalerr(101, &var); + } if (IntVal(var) - 1 <= Length) { - k_pos = IntVal(var); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = IntVal(var); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Tab_NF: { GetResultFromFuncCall(); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if (IntVal(cresult) - 1 <= Length) { - k_pos = IntVal(cresult); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = IntVal(cresult); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } - + case PC_Tab_NMF: { GetResultFromMethodCall(); if (call_result == 0) { - goto Node_Fail; - } + goto Node_Fail; + } else { - if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); - cresult.dword = D_Integer; - } + if (!cnv_c_int(&cresult, &(cresult.vword.integr))) + fatalerr(101, &cresult); + cresult.dword = D_Integer; + } if (IntVal(cresult) - 1 <= Length) { - k_pos = IntVal(cresult); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = IntVal(cresult); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -3016,50 +3016,50 @@ Node_Succeed: */ case PC_RPos_Nat: { if ((k_pos - 1) == (Length - IntVal(Node->parameter))) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_RPos_NP: { GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Rpos unevaluated variable\n")); if (!cnv_int(&var,&var)){ - fatalerr(101, &var); - } + fatalerr(101, &var); + } DEBUGF(20,(stdout, "matching Len\n")); if ((k_pos - 1) == (Length - IntVal(var))) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_RPos_NF: { GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching RPos unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if ((k_pos - 1) == (Length - IntVal(cresult))) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_RPos_NMF: { GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching RPos unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if ((k_pos - 1) == (Length - IntVal(cresult))) - goto Node_Succeed; + goto Node_Succeed; else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -3067,62 +3067,62 @@ Node_Succeed: */ case PC_RTab_Nat: { if ((0<=IntVal(Node->parameter)) & (IntVal(Node->parameter) <= Length)) { - k_pos = Length - IntVal(Node->parameter) + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = Length - IntVal(Node->parameter) + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_RTab_NP: { GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching RTab unevaluated variable\n")); if (!cnv_int(&var,&var)){ - fatalerr(101, &var); - } + fatalerr(101, &var); + } DEBUGF(20,(stdout, "matching Len\n")); if ((0<=IntVal(var)) & (IntVal(var) <= Length)) { - k_pos = Length - IntVal(var) + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = Length - IntVal(var) + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_RTab_NF: { GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching RTab unevaluated function call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if ((0<=IntVal(cresult)) & (IntVal(cresult) <= Length)) { - k_pos = Length - IntVal(cresult) + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = Length - IntVal(cresult) + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } - + case PC_RTab_NMF: { GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching RTab unevaluated method call\n")); if (!cnv_c_int(&cresult, &(cresult.vword.integr))) - fatalerr(101, &cresult); + fatalerr(101, &cresult); cresult.dword = D_Integer; if ((0<=IntVal(cresult)) & (IntVal(cresult) <= Length)) { - k_pos = Length - IntVal(cresult) + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = Length - IntVal(cresult) + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -3162,7 +3162,7 @@ Node_Succeed: */ case PC_R_Restore : { DEBUGF(20,(stdout, - "failure, search for alternatives in nested pattern\n")); + "failure, search for alternatives in nested pattern\n")); Region_Level = Region_Level + 1; Stack_Base = k_pos - 1; goto Node_Fail; @@ -3182,15 +3182,15 @@ Node_Succeed: int P = k_pos - 1; DEBUGF(20,(stdout,"Matching Span_CS\n")); while ((P < Length) && Testb(ToAscii(pat_sub[P]),Node->parameter)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Span_VP : { @@ -3198,19 +3198,19 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching Span unevaluated variable\n")); if (!cnv_cset(&var,&var)) { - fatalerr(104, &var); - } + fatalerr(104, &var); + } DEBUGF(20,(stdout,"Matching Span_VP\n")); while ((P < Length) && Testb(ToAscii(pat_sub[P]),var)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_Span_VF: { @@ -3218,46 +3218,46 @@ Node_Succeed: GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching Span_VF unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while ((P < Length) && Testb(ToAscii(pat_sub[P]),cresult)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } - + case PC_Span_MF: { int P = k_pos - 1; GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching Span_MF unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while ((P < Length) && Testb(ToAscii(pat_sub[P]),cresult)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_NSpan_CS : { int P = k_pos - 1; DEBUGF(20,(stdout,"Matching NSpan_CS\n")); while ((P < Length) && Testb(ToAscii(pat_sub[P]),Node->parameter)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + } goto Node_Succeed; } @@ -3266,15 +3266,15 @@ Node_Succeed: GetVarFromNodeParameter(Node); DEBUGF(20,(stdout,"Matching NSpan unevaluated variable\n")); if (!cnv_cset(&var,&var)) { - fatalerr(104, &var); - } + fatalerr(104, &var); + } DEBUGF(20,(stdout,"Matching NSpan_VP\n")); while ((P < Length) && Testb(ToAscii(pat_sub[P]),var)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + } goto Node_Succeed; } @@ -3283,28 +3283,28 @@ Node_Succeed: GetResultFromFuncCall(); DEBUGF(20,(stdout,"Matching NSpan_VF unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while ((P < Length) && Testb(ToAscii(pat_sub[P]),cresult)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + } goto Node_Succeed; } - + case PC_NSpan_MF: { int P = k_pos - 1; GetResultFromMethodCall(); DEBUGF(20,(stdout,"Matching NSpan_MF unevaluated function call\n")); if (!cnv_cset(&cresult,&cresult)) - fatalerr(104, &cresult); + fatalerr(104, &cresult); while ((P < Length) && Testb(ToAscii(pat_sub[P]),cresult)) - P++; + P++; if (P != (k_pos - 1)) { - k_pos = P + 1; - EVVal(k_pos, e_spos); - } + k_pos = P + 1; + EVVal(k_pos, e_spos); + } goto Node_Succeed; } @@ -3312,14 +3312,14 @@ Node_Succeed: int LV_Len = StrLen(Node->parameter); DEBUGF(20,(stdout,"Matching String \"%*s\" against %s, Length %d Pos %ld Len %d\n", LV_Len, StrLoc(Node->parameter), pat_sub, Length, k_pos, LV_Len)); if ((Length - (k_pos - 1) >= LV_Len) && - !strncmp(pat_sub + (k_pos - 1), StrLoc(Node->parameter), LV_Len)) { - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !strncmp(pat_sub + (k_pos - 1), StrLoc(Node->parameter), LV_Len)) { + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } case PC_String_VP : { @@ -3328,14 +3328,14 @@ Node_Succeed: LV_Len = StrLen(var); DEBUGF(20,(stdout,"Matching String\n")); if ((Length -(k_pos - 1) >= LV_Len) && - !strncmp(pat_sub + (k_pos - 1), StrLoc(var), LV_Len)) { - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + !strncmp(pat_sub + (k_pos - 1), StrLoc(var), LV_Len)) { + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } else { - goto Node_Fail; - } + goto Node_Fail; + } } /* @@ -3343,18 +3343,18 @@ Node_Succeed: case PC_String_VF: { GetResultFromFuncCall(); if (cnv_str(&cresult,&cresult)) { - int LV_Len = StrLen(cresult); - DEBUGF(20,(stdout,"Matching String\n")); - if ((Length - (k_pos - 1) >= LV_Len) && - !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)) { - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - goto Node_Fail; - } - } + int LV_Len = StrLen(cresult); + DEBUGF(20,(stdout,"Matching String\n")); + if ((Length - (k_pos - 1) >= LV_Len) && + !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)) { + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + goto Node_Fail; + } + } /* should instead probably be a runtime error */ goto Node_Succeed; } @@ -3362,18 +3362,18 @@ Node_Succeed: case PC_String_MF: { GetResultFromMethodCall(); if (cnv_str(&cresult,&cresult)) { - int LV_Len = StrLen(cresult); - DEBUGF(20,(stdout,"Matching String\n")); - if ((Length - (k_pos - 1) >= LV_Len) && - !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)) { - k_pos += LV_Len; - EVVal(k_pos, e_spos); - goto Node_Succeed; - } - else { - goto Node_Fail; - } - } + int LV_Len = StrLen(cresult); + DEBUGF(20,(stdout,"Matching String\n")); + if ((Length - (k_pos - 1) >= LV_Len) && + !strncmp(pat_sub + (k_pos - 1), StrLoc(cresult), LV_Len)) { + k_pos += LV_Len; + EVVal(k_pos, e_spos); + goto Node_Succeed; + } + else { + goto Node_Fail; + } + } /* should instead probably be a runtime error */ goto Node_Succeed; } @@ -3390,14 +3390,14 @@ Node_Succeed: case PC_Unanchored : { /* -- All done if we tried every position */ if (k_pos >= Length ) - goto Match_Fail; + goto Match_Fail; /* -- Otherwise extend the anchor point, and restack ourself */ else{ - k_pos++; - Push (Node); - EVVal(k_pos, e_spos); - goto Node_Succeed; - } + k_pos++; + Push (Node); + EVVal(k_pos, e_spos); + goto Node_Succeed; + } } /* @@ -3405,17 +3405,17 @@ Node_Succeed: */ case PC_EOP: { if (Stack_Base == Stack_Init) { - goto Match_Succeed; - } + goto Match_Succeed; + } /* * End of recursive inner match. See separate section on * handing of recursive pattern matches for details. */ else { - Node = (struct b_pelem *)StackNode(Stack_Base - 1); - Pop_Region(); - goto Match; - } + Node = (struct b_pelem *)StackNode(Stack_Base - 1); + Pop_Region(); + goto Match; + } } } { @@ -3429,9 +3429,9 @@ Node_Succeed: #ifdef MultiProgram internal_match_macro(internal_match_0,0,0,0,0,0,0,0,0,0) internal_match_macro(internal_match_1,E_PatFail,E_PatMatch,E_PatArg,E_PelemAttempt,E_PelemMatch,E_PelemFail,E_Assign,E_Value,E_Spos) -#else /* MultiProgram */ +#else /* MultiProgram */ internal_match_macro(internal_match,0,0,0,0,0,0,0,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* keep this at the end so the #undef Fail affects no-one else */ #undef Fail @@ -3446,4 +3446,4 @@ function {1} Fail() } end -#endif /* PatternType */ +#endif /* PatternType */ diff --git a/src/runtime/fxposix.ri b/src/runtime/fxposix.ri index 80270fe20..2dba07a8a 100644 --- a/src/runtime/fxposix.ri +++ b/src/runtime/fxposix.ri @@ -13,7 +13,7 @@ #ifndef MultiProgram struct descrip amperErrno = {D_Integer}; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef PosixFns #if NT @@ -21,12 +21,12 @@ struct descrip amperErrno = {D_Integer}; #if !defined(NTGCC) #define pclose _pclose -#endif /* NTGCC */ +#endif /* NTGCC */ #define dup2 _dup2 #define execvp _execvp #define fstat _fstat -#endif /* NT */ +#endif /* NT */ extern int errno; @@ -63,31 +63,31 @@ char *alc_strerror(int n) while ((s=strerror_r(n, s, size)) != NULL && errno == ERANGE) { #else while ((rv=strerror_r(n, s, size)) != 0 && errno == ERANGE) { -#endif - size *= 2; - if ((s = alcstr(NULL, size)) == NULL) break; - } +#endif + size *= 2; + if ((s = alcstr(NULL, size)) == NULL) break; + } if (rv != 0) { - k_errornumber = errno; /* EINVAL, don't call recursively to get text */ - StrLoc(k_errortext) = "invalid error number"; - StrLen(k_errortext) = strlen(StrLoc(k_errortext)); - return NULL; - } + k_errornumber = errno; /* EINVAL, don't call recursively to get text */ + StrLoc(k_errortext) = "invalid error number"; + StrLen(k_errortext) = strlen(StrLoc(k_errortext)); + return NULL; + } } -#else /* HAVE_STRERROR_R */ +#else /* HAVE_STRERROR_R */ #ifdef HAVE_STRERROR s = strerror(n); s = alcstr(s, strlen(s)+1); -#else /* HAVE_STRERROR */ +#else /* HAVE_STRERROR */ #if defined(HAVE_SYS_NERR) && defined(HAVE_SYS_ERRLIST) if (n <= 0 || n > sys_nerr) - return NULL; + return NULL; s = (char *)sys_errlist[n]; -#endif /* HAVE_SYS_NERR && HAVE_SYS_ERRLIST */ +#endif /* HAVE_SYS_NERR && HAVE_SYS_ERRLIST */ -#endif /* HAVE_STRERROR */ -#endif /* HAVE_STRERROR_R */ +#endif /* HAVE_STRERROR */ +#endif /* HAVE_STRERROR_R */ if (s == NULL) k_errornumber = 306; @@ -104,17 +104,17 @@ function{0,1} sys_errstr(e) C_integer ern; #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ if (!def:C_integer(e, IntVal(amperErrno), ern)) - runerr(101, e); + runerr(101, e); if ((StrLoc(result) = alc_strerror(ern)) != 0) - StrLen(result) = strlen(StrLoc(result)); + StrLen(result) = strlen(StrLoc(result)); else { - if (errno == EINVAL) fail; - runerr(0); - } + if (errno == EINVAL) fail; + runerr(0); + } return result; } end @@ -123,22 +123,22 @@ end #if NT function{0} getppid() -#else /* NT */ +#else /* NT */ function{0,1} getppid() -#endif /* NT */ +#endif /* NT */ abstract { return integer } body { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ return C_integer (getppid()); -#endif /* NT */ +#endif /* NT */ } end @@ -162,9 +162,9 @@ end #if NT function{0} hardlink(s1, s2) -#else /* NT */ +#else /* NT */ function{0,1} hardlink(s1, s2) -#endif /* NT */ +#endif /* NT */ if !cnv:C_string(s1) then runerr(103, s1) if !cnv:C_string(s2) then @@ -175,17 +175,17 @@ function{0,1} hardlink(s1, s2) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (link(s1, s2) != 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -193,9 +193,9 @@ end #if NT function{0} symlink(s1, s2) -#else /* NT */ +#else /* NT */ function{0,1} symlink(s1, s2) -#endif /* NT */ +#endif /* NT */ if !cnv:C_string(s1) then runerr(103, s1) if !cnv:C_string(s2) then @@ -206,17 +206,17 @@ function{0,1} symlink(s1, s2) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (symlink(s1, s2) != 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -224,9 +224,9 @@ end #if NT function{0} readlink(s) -#else /* NT */ +#else /* NT */ function{0,1} readlink(s) -#endif /* NT */ +#endif /* NT */ if !cnv:C_string(s) then runerr(103, s) abstract { @@ -241,18 +241,18 @@ function{0,1} readlink(s) IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ reserve(Strings, NAME_MAX); Protect(StrLoc(result) = alcstr(NULL, NAME_MAX), runerr(0)); if ((len = readlink(s, StrLoc(result), NAME_MAX)) < 0) { - /* Give back the string */ - n = DiffPtrs(StrLoc(result),strfree); /* note the deallocation */ - EVStrAlc(n); + /* Give back the string */ + n = DiffPtrs(StrLoc(result),strfree); /* note the deallocation */ + EVStrAlc(n); strtotal += n; strfree = StrLoc(result); /* reset free pointer */ - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } /* Return the extra characters at the end */ @@ -264,7 +264,7 @@ function{0,1} readlink(s) strfree = out; /* give back unused space */ return result; -#endif /* NT */ +#endif /* NT */ } end @@ -272,9 +272,9 @@ end #if NT function{0} kill(pid, signal) -#else /* NT */ +#else /* NT */ function{0,1} kill(pid, signal) -#endif /* NT */ +#endif /* NT */ if !is:string(signal) then if !is:integer(signal) then runerr(170, signal) @@ -287,34 +287,34 @@ function{0,1} kill(pid, signal) body { C_integer sig; tended char *signalname; - + if (is:string(signal)) { - /* Parse signal name */ + /* Parse signal name */ cnv:C_string(signal, signalname); - sig = si_s2i((siptr)signalnames, signalname); - if (sig == -1) - runerr(1043, signal); + sig = si_s2i((siptr)signalnames, signalname); + if (sig == -1) + runerr(1043, signal); } else { if (!cnv:C_integer(signal, sig)) runerr(101, signal); - if (sig < 0 || sig > 50) - runerr(1043, signal); - } - if (sig == 0) { - IntVal(amperErrno) = EINVAL; - fail; - } + if (sig < 0 || sig > 50) + runerr(1043, signal); + } + if (sig == 0) { + IntVal(amperErrno) = EINVAL; + fail; + } IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (kill(pid, sig) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -327,32 +327,32 @@ function{0,1} trap(nsignal, handler) abstract { return proc } - body { + body { C_integer sig; tended char *signalname; if (is:string(nsignal)) { cnv:C_string(nsignal, signalname); - sig = si_s2i((siptr)signalnames, signalname); - if (sig == -1) - runerr(1043, nsignal); + sig = si_s2i((siptr)signalnames, signalname); + if (sig == -1) + runerr(1043, nsignal); } else { if (!cnv:C_integer(nsignal, sig)) runerr(101, nsignal); - if (sig < 0 || sig > 50) - runerr(1043, nsignal); + if (sig < 0 || sig > 50) + runerr(1043, nsignal); } - if (sig == 0) { - IntVal(amperErrno) = EINVAL; - fail; - } + if (sig == 0) { + IntVal(amperErrno) = EINVAL; + fail; + } if (is:null(handler)) signal(sig, SIG_DFL); else if (is:proc(handler)) { - struct b_proc *pp = BlkD(handler, Proc); - if (pp->nparam != 1 && pp->nparam != -1) - runerr(172, handler); + struct b_proc *pp = BlkD(handler, Proc); + if (pp->nparam != 1 && pp->nparam != -1) + runerr(172, handler); signal(sig, signal_dispatcher); } else @@ -365,101 +365,101 @@ end #if NT function{0} chown(s, u, g) -#else /* NT */ +#else /* NT */ function{0,1} chown(s, u, g) -#endif /* NT */ +#endif /* NT */ declare { C_integer i_u, i_g; } type_case u of { string: { - body { - tended char* fname; - cnv:C_string(u, fname); - i_u = get_uid(fname); - } + body { + tended char* fname; + cnv:C_string(u, fname); + i_u = get_uid(fname); + } } integer: { - body { - if (!cnv:C_integer(u, i_u)) runerr(101, u); - } + body { + if (!cnv:C_integer(u, i_u)) runerr(101, u); + } } null: { - body { - i_u = -1; - } + body { + i_u = -1; + } } default: { - runerr(170, g); + runerr(170, g); } } type_case g of { string: { - body { - tended char* gname; - cnv:C_string(g, gname); - i_g = get_gid(gname); - } + body { + tended char* gname; + cnv:C_string(g, gname); + i_g = get_gid(gname); + } } integer: { - body { - if (!cnv:C_integer(g, i_g)) runerr(101, g); - } + body { + if (!cnv:C_integer(g, i_g)) runerr(101, g); + } } null: { - body { - i_g = -1; - } + body { + i_g = -1; + } } default: { - runerr(170, u); + runerr(170, u); } } type_case s of { string: { abstract { - return null + return null } - body { - tended char *fname; + body { + tended char *fname; - IntVal(amperErrno) = 0; + IntVal(amperErrno) = 0; cnv:C_string(s, fname); #if NT - fail; -#else /* NT */ - if (chown(fname, i_u, i_g) != 0) { - IntVal(amperErrno) = errno; - fail; - } - return nulldesc; -#endif /* NT */ - } + fail; +#else /* NT */ + if (chown(fname, i_u, i_g) != 0) { + IntVal(amperErrno) = errno; + fail; + } + return nulldesc; +#endif /* NT */ + } } file: { abstract { - return null - } - body { - int fd; - IntVal(amperErrno) = 0; - if ((fd = get_fd(s, 0)) < 0) - runerr(174, s); -#if NT - fail; -#else /* NT */ - if (fchown(fd, i_u, i_g) != 0) { - IntVal(amperErrno) = errno; - fail; - } - return nulldesc; -#endif /* NT */ - } + return null + } + body { + int fd; + IntVal(amperErrno) = 0; + if ((fd = get_fd(s, 0)) < 0) + runerr(174, s); +#if NT + fail; +#else /* NT */ + if (fchown(fd, i_u, i_g) != 0) { + IntVal(amperErrno) = errno; + fail; + } + return nulldesc; +#endif /* NT */ + } } default: - runerr(109, s) + runerr(109, s) } end @@ -472,73 +472,73 @@ function{0,1} chmod(s, m) type_case s of { string: { - abstract { - return null - } - body { - C_integer i; - tended char *fname, *cmode; - IntVal(amperErrno) = 0; + abstract { + return null + } + body { + C_integer i; + tended char *fname, *cmode; + IntVal(amperErrno) = 0; cnv:C_string(s, fname); - if (is:string(m)) { - cnv:C_string(m, cmode); - i = getmodenam(fname, cmode); - if (i == -1) { - IntVal(amperErrno) = errno; - fail; - } - if (i == -2) - runerr(1045, m); - } - else { - if (!cnv:C_integer(m, i)) runerr(101, m); - } + if (is:string(m)) { + cnv:C_string(m, cmode); + i = getmodenam(fname, cmode); + if (i == -1) { + IntVal(amperErrno) = errno; + fail; + } + if (i == -2) + runerr(1045, m); + } + else { + if (!cnv:C_integer(m, i)) runerr(101, m); + } #if NT #define chmod _chmod #endif - if (chmod(fname, i) != 0) { - IntVal(amperErrno) = errno; - fail; - } - return nulldesc; - } + if (chmod(fname, i) != 0) { + IntVal(amperErrno) = errno; + fail; + } + return nulldesc; + } } file: { - abstract { - return null - } - body { - tended char *cmode; - C_integer i, fd; - IntVal(amperErrno) = 0; - if ((fd = get_fd(s, 0)) < 0) - runerr(174, s); - - if (is:string(m)) { - cnv:C_string(m, cmode); - i = getmodefd(fd, cmode); - if (i == -1) { - IntVal(amperErrno) = errno; - fail; - } - if (i == -2) - runerr(1045, m); - } - else - if (!cnv:C_integer(m, i)) runerr(101, m); -#if NT - fail; -#else /* NT */ - if (fchmod(fd, i) != 0) { - IntVal(amperErrno) = errno; - fail; - } - return nulldesc; -#endif /* NT */ - } + abstract { + return null + } + body { + tended char *cmode; + C_integer i, fd; + IntVal(amperErrno) = 0; + if ((fd = get_fd(s, 0)) < 0) + runerr(174, s); + + if (is:string(m)) { + cnv:C_string(m, cmode); + i = getmodefd(fd, cmode); + if (i == -1) { + IntVal(amperErrno) = errno; + fail; + } + if (i == -2) + runerr(1045, m); + } + else + if (!cnv:C_integer(m, i)) runerr(101, m); +#if NT + fail; +#else /* NT */ + if (fchmod(fd, i) != 0) { + IntVal(amperErrno) = errno; + fail; + } + return nulldesc; +#endif /* NT */ + } } default: - runerr(109, s) + runerr(109, s) } end @@ -546,9 +546,9 @@ end #if NT function{0} chroot(d) -#else /* NT */ +#else /* NT */ function{0,1} chroot(d) -#endif /* NT */ +#endif /* NT */ if !cnv:C_string(d) then runerr(103, d) abstract { @@ -557,17 +557,17 @@ function{0,1} chroot(d) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (chroot(d) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -582,14 +582,14 @@ function{0,1} rmdir(s) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT && !defined(MSWIN64) #define rmdir _rmdir #endif if (rmdir(s) != 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } return nulldesc; } @@ -602,7 +602,7 @@ function{0,1} mkdir(s, m) runerr(103, s) if !is:string(m) then if !is:integer(m) then - if !is:null(m) then + if !is:null(m) then runerr(170, m) abstract { @@ -610,17 +610,17 @@ function{0,1} mkdir(s, m) } body { tended char *cmode; - C_integer mode = 0777; /* default; will be modified by umask */ - + C_integer mode = 0777; /* default; will be modified by umask */ + if (is:string(m)) { cnv:C_string(m, cmode); - mode = getmodenam(0, cmode); - if (mode == -1) { - IntVal(amperErrno) = errno; - fail; - } - if (mode == -2) - runerr(1045, m); + mode = getmodenam(0, cmode); + if (mode == -1) { + IntVal(amperErrno) = errno; + fail; + } + if (mode == -2) + runerr(1045, m); } else if (!is:null(m)) { if (!cnv:C_integer(m, mode)) runerr(101, m); @@ -629,14 +629,14 @@ function{0,1} mkdir(s, m) IntVal(amperErrno) = 0; #if NT #ifdef MSWIN64 -#define mkdir(s,mode) mkdir(s) /* in NT, mkdir don't have mode*/ +#define mkdir(s,mode) mkdir(s) /* in NT, mkdir don't have mode*/ #else -#define mkdir(s,mode) _mkdir(s) /* in NT, _mkdir don't have mode*/ +#define mkdir(s,mode) _mkdir(s) /* in NT, _mkdir don't have mode*/ #endif #endif if (mkdir(s, mode) != 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } return nulldesc; } @@ -649,58 +649,58 @@ function{0,1} truncate(f, l) runerr(101, l) type_case f of { string: { - abstract { - return null - } - body { - tended char *s; - IntVal(amperErrno) = 0; + abstract { + return null + } + body { + tended char *s; + IntVal(amperErrno) = 0; cnv:C_string(f, s); #if NT { - int fd; - if (((fd = _open(s, _O_RDWR | _O_CREAT, _S_IWRITE)) == -1) || - (_chsize(fd, l) != 0)) { - IntVal(amperErrno) = errno; - fail; - } - _close(fd); - } -#else /* NT */ - if (truncate(s, l) != 0) { - IntVal(amperErrno) = errno; - fail; - } -#endif /* NT */ - return nulldesc; - } + int fd; + if (((fd = _open(s, _O_RDWR | _O_CREAT, _S_IWRITE)) == -1) || + (_chsize(fd, l) != 0)) { + IntVal(amperErrno) = errno; + fail; + } + _close(fd); + } +#else /* NT */ + if (truncate(s, l) != 0) { + IntVal(amperErrno) = errno; + fail; + } +#endif /* NT */ + return nulldesc; + } } file: { - abstract { - return null - } - body { - int fd; - IntVal(amperErrno) = 0; - -#if HAVE_LIBZ + abstract { + return null + } + body { + int fd; + IntVal(amperErrno) = 0; + +#if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { fail; } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ - if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); - if (ftruncate(fd, l) != 0) { - IntVal(amperErrno) = errno; - fail; - } - return nulldesc; - } + if ((fd = get_fd(f, 0)) < 0) + runerr(174, f); + if (ftruncate(fd, l) != 0) { + IntVal(amperErrno) = errno; + fail; + } + return nulldesc; + } } default: - runerr(109, f) + runerr(109, f) } end @@ -722,18 +722,18 @@ int flock(int fd, int operation) #define LOCK_NB LK_NBLCK #if defined(OLD_NTGCC) && (__GNUC__ < 3) #define LOCK_UN LK_UNLOCK -#else /* NTGCC < 3 */ +#else /* NTGCC < 3 */ #define LOCK_UN LK_UNLCK -#endif /* NTGCC < 3 */ -#endif /* NT */ +#endif /* NTGCC < 3 */ +#endif /* NT */ "flock() - apply or remove a lock on a file." #ifdef HAVE_FLOCK function{0,1} flock(f, cmd) -#else /* HAVE_FLOCK */ +#else /* HAVE_FLOCK */ function{0} flock(f, cmd) -#endif /* HAVE_FLOCK */ +#endif /* HAVE_FLOCK */ declare { tended char *c; } @@ -750,38 +750,38 @@ function{0} flock(f, cmd) int fd, i=0; #ifdef HAVE_FLOCK -#if HAVE_LIBZ +#if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { fail; } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ while (c[i]) - switch (c[i++]) { - case 'x': option |= LOCK_EX; break; + switch (c[i++]) { + case 'x': option |= LOCK_EX; break; #if NT - case 's': fail; + case 's': fail; #else - case 's': option |= LOCK_SH; break; + case 's': option |= LOCK_SH; break; #endif - case 'b': option |= LOCK_NB; break; - case 'u': option |= LOCK_UN; break; - default: runerr(1044, cmd); + case 'b': option |= LOCK_NB; break; + case 'u': option |= LOCK_UN; break; + default: runerr(1044, cmd); } IntVal(amperErrno) = 0; - + if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); + runerr(174, f); if (flock(fd, option) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#else /* HAVE_FLOCK */ +#else /* HAVE_FLOCK */ fail; -#endif /* HAVE_FLOCK */ +#endif /* HAVE_FLOCK */ } end @@ -790,9 +790,9 @@ end #if NT function{0} fcntl(f, action, options) -#else /* NT */ +#else /* NT */ function{0,1} fcntl(f, action, options) -#endif /* NT */ +#endif /* NT */ if !is:string(action) then runerr(103, action) @@ -809,161 +809,161 @@ function{0,1} fcntl(f, action, options) tended char *c; static dptr constr; -#if HAVE_LIBZ +#if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { fail; } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #if NT fail; -#else /* NT */ +#else /* NT */ if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); + runerr(174, f); cnv:C_string(action, c); switch (*c) { - case 'F': cmd = F_SETFL; break; - case 'f': cmd = F_GETFL; break; - case 'X': cmd = F_SETFD; break; - case 'x': cmd = F_GETFD; break; - case 'L': cmd = F_SETLK; break; - case 'l': cmd = F_GETLK; break; - case 'W': cmd = F_SETLKW; break; + case 'F': cmd = F_SETFL; break; + case 'f': cmd = F_GETFL; break; + case 'X': cmd = F_SETFD; break; + case 'x': cmd = F_GETFD; break; + case 'L': cmd = F_SETLK; break; + case 'l': cmd = F_GETLK; break; + case 'W': cmd = F_SETLKW; break; #ifdef HP - /* Owners not defined on HP */ -#else /* HP */ - case 'O': cmd = F_SETOWN; break; - case 'o': cmd = F_GETOWN; break; -#endif /* HP */ - default: runerr(1044, action); + /* Owners not defined on HP */ +#else /* HP */ + case 'O': cmd = F_SETOWN; break; + case 'o': cmd = F_GETOWN; break; +#endif /* HP */ + default: runerr(1044, action); } /* Figure out options to use */ if (cmd == F_SETLK || cmd == F_GETLK || cmd == F_SETLKW) { - struct flock fl; - tended struct b_record *rp; - tended char *lock; - char *start, *len, *p; - char buf[32]; + struct flock fl; + tended struct b_record *rp; + tended char *lock; + char *start, *len, *p; + char buf[32]; cnv:C_string(options, lock); - if ((start = strchr(lock, ',')) == NULL) - runerr(1044, options); - /* found a comma, skipping over it */ - start++; - if ((len = strchr(start, ',')) == NULL) - runerr(1044, options); - len++; - - switch (lock[0]) { - case 'r': fl.l_type = F_RDLCK; break; - case 'w': fl.l_type = F_WRLCK; break; - case 'u': fl.l_type = F_UNLCK; break; - default: runerr(1044, options); - } - if (lock[1] != ',') - runerr(1044, options); - - switch(start[0]) { - case '+': - fl.l_whence = SEEK_CUR; - fl.l_start = strtol(start+1, &p, 10); - break; - case '-': - fl.l_whence = SEEK_END; - fl.l_start = strtol(start+1, &p, 10); - break; - default : - fl.l_whence = SEEK_SET; - fl.l_start = strtol(start, &p, 10); - break; - } - if (*p != ',') - runerr(1044, options); - - fl.l_len = strtol(len, &p, 10); - if (*p != '\0') - runerr(1044, options); - - IntVal(amperErrno) = 0; - if (fcntl(fd, cmd, &fl) < 0) { - IntVal(amperErrno) = errno; - fail; - } - - p = buf; - switch (fl.l_type) { - case F_RDLCK: *p++ = 'r'; break; - case F_WRLCK: *p++ = 'w'; break; - case F_UNLCK: *p++ = 'u'; break; - } - *p++ = ','; - switch (fl.l_whence) { - case SEEK_CUR: *p++ = '+'; break; - case SEEK_END: *p++ = '-'; break; - } - - sprintf(p, "%ld,%ld", (long)fl.l_start, (long)fl.l_len); - - if (!constr) - if (!(constr = rec_structor("posix_lock"))) - syserr("failed to create posix record constructor"); - - nfields = (int) BlkD(*constr, Proc)->nfields; - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - result.dword = D_Record; - result.vword.bptr = (union block*)rp; - IntVal(rp->fields[1]) = fl.l_pid; - buflen = strlen(buf); - Protect(StrLoc(rp->fields[0]) = alcstr(buf, buflen), runerr(0)); - StrLen(rp->fields[0]) = buflen; - - return result; + if ((start = strchr(lock, ',')) == NULL) + runerr(1044, options); + /* found a comma, skipping over it */ + start++; + if ((len = strchr(start, ',')) == NULL) + runerr(1044, options); + len++; + + switch (lock[0]) { + case 'r': fl.l_type = F_RDLCK; break; + case 'w': fl.l_type = F_WRLCK; break; + case 'u': fl.l_type = F_UNLCK; break; + default: runerr(1044, options); + } + if (lock[1] != ',') + runerr(1044, options); + + switch(start[0]) { + case '+': + fl.l_whence = SEEK_CUR; + fl.l_start = strtol(start+1, &p, 10); + break; + case '-': + fl.l_whence = SEEK_END; + fl.l_start = strtol(start+1, &p, 10); + break; + default : + fl.l_whence = SEEK_SET; + fl.l_start = strtol(start, &p, 10); + break; + } + if (*p != ',') + runerr(1044, options); + + fl.l_len = strtol(len, &p, 10); + if (*p != '\0') + runerr(1044, options); + + IntVal(amperErrno) = 0; + if (fcntl(fd, cmd, &fl) < 0) { + IntVal(amperErrno) = errno; + fail; + } + + p = buf; + switch (fl.l_type) { + case F_RDLCK: *p++ = 'r'; break; + case F_WRLCK: *p++ = 'w'; break; + case F_UNLCK: *p++ = 'u'; break; + } + *p++ = ','; + switch (fl.l_whence) { + case SEEK_CUR: *p++ = '+'; break; + case SEEK_END: *p++ = '-'; break; + } + + sprintf(p, "%ld,%ld", (long)fl.l_start, (long)fl.l_len); + + if (!constr) + if (!(constr = rec_structor("posix_lock"))) + syserr("failed to create posix record constructor"); + + nfields = (int) BlkD(*constr, Proc)->nfields; + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + result.dword = D_Record; + result.vword.bptr = (union block*)rp; + IntVal(rp->fields[1]) = fl.l_pid; + buflen = strlen(buf); + Protect(StrLoc(rp->fields[0]) = alcstr(buf, buflen), runerr(0)); + StrLen(rp->fields[0]) = buflen; + + return result; } else { - /* options should be an int */ - C_integer o = 0, retval; - - if (cmd == F_SETFL) { - tended char *opt; - cnv:C_string(options, opt); - while (*opt) - switch(*opt++) { - case 'd': o |= O_NDELAY; break; - case 'a': o |= O_APPEND; break; + /* options should be an int */ + C_integer o = 0, retval; + + if (cmd == F_SETFL) { + tended char *opt; + cnv:C_string(options, opt); + while (*opt) + switch(*opt++) { + case 'd': o |= O_NDELAY; break; + case 'a': o |= O_APPEND; break; #if defined(HP) || defined(SUN) - case 's': o |= FASYNC; break; + case 's': o |= FASYNC; break; #endif - default: runerr(1044, options); - } - } else - if (!cnv:C_integer(options, o)) runerr(101, options); - - IntVal(amperErrno) = 0; - if ((retval = fcntl(fd, cmd, o)) < 0) { - IntVal(amperErrno) = errno; - fail; - } - - if (cmd == F_GETFL) { - char buf[10], *p = buf; - int buflen; - if (retval & O_APPEND) *p++ = 'a'; - if (retval & O_NDELAY) *p++ = 'd'; + default: runerr(1044, options); + } + } else + if (!cnv:C_integer(options, o)) runerr(101, options); + + IntVal(amperErrno) = 0; + if ((retval = fcntl(fd, cmd, o)) < 0) { + IntVal(amperErrno) = errno; + fail; + } + + if (cmd == F_GETFL) { + char buf[10], *p = buf; + int buflen; + if (retval & O_APPEND) *p++ = 'a'; + if (retval & O_NDELAY) *p++ = 'd'; #if defined(HP) || defined(SUN) - if (retval & FASYNC) *p++ = 's'; + if (retval & FASYNC) *p++ = 's'; #endif - *p = 0; - buflen = strlen(buf); - Protect(StrLoc(result) = alcstr(buf, buflen), runerr(0)); - StrLen(result) = buflen; - return result; + *p = 0; + buflen = strlen(buf); + Protect(StrLoc(result) = alcstr(buf, buflen), runerr(0)); + StrLen(result) = buflen; + return result; - } else - return C_integer retval; + } else + return C_integer retval; } -#endif /* NT */ +#endif /* NT */ } end @@ -990,9 +990,9 @@ function{0,1} utime(f, atime, mtime) t.modtime = mtime; IntVal(amperErrno) = 0; if (utime(f, &t) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; } end @@ -1016,33 +1016,33 @@ function{0,1} ioctl(f, action, options) int fd; #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); + runerr(174, f); -#if HAVE_LIBZ +#if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) { fail; } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #if NT fail; -#else /* NT */ +#else /* NT */ #ifdef UNICON_IOCTL { int retval; if ((retval = ioctl(fd, action, options)) < 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } } return C_integer retval; -#else /* UNICON_IOCTL */ +#else /* UNICON_IOCTL */ runerr(121, f); -#endif /* UNICON_IOCTL */ -#endif /* NT */ +#endif /* UNICON_IOCTL */ +#endif /* NT */ } end @@ -1050,9 +1050,9 @@ end #if NT function{0} filepair() -#else /* NT */ +#else /* NT */ function{0,1} filepair() -#endif /* NT */ +#endif /* NT */ abstract { return new list(file) } @@ -1064,12 +1064,12 @@ function{0,1} filepair() tended union block *ep; #if NT fail; -#else /* NT */ +#else /* NT */ IntVal(amperErrno) = 0; if (socketpair(AF_UNIX, SOCK_STREAM, 0, fds) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } /* create a list to put them in */ Protect(lp = alclist(2, 2), runerr(0)); ep = lp->listhead; @@ -1078,15 +1078,15 @@ function{0,1} filepair() StrLoc(fname) = "filepair"; StrLen(fname) = 8; for(i = 0; i < 2; i++) { - Protect(fl = alcfile(0, Fs_Write|Fs_Read|Fs_Socket, &fname), - runerr(0)); - fl->fd.fd = fds[i]; - Blk(ep,Lelem)->lslots[i].dword = D_File; - ep->Lelem.lslots[i].vword.bptr = (union block*)fl; - } + Protect(fl = alcfile(0, Fs_Write|Fs_Read|Fs_Socket, &fname), + runerr(0)); + fl->fd.fd = fds[i]; + Blk(ep,Lelem)->lslots[i].dword = D_File; + ep->Lelem.lslots[i].vword.bptr = (union block*)fl; + } return list(lp); -#endif /* NT */ +#endif /* NT */ } end @@ -1109,9 +1109,9 @@ function{0,1} pipe() #define pipe(x) _pipe(x, 4096, O_BINARY|O_NOINHERIT) #endif if (pipe(fds) != 0) { - set_syserrortext(errno); - fail; - } + set_syserrortext(errno); + fail; + } /* create a list to put them in */ Protect(lp = alclist(2, 2), runerr(0)); ep = lp->listhead; @@ -1120,12 +1120,12 @@ function{0,1} pipe() StrLoc(fname) = "pipe"; StrLen(fname) = 4; for(i = 0; i < 2; i++) { - fps[i] = fdopen(fds[i], i? "w":"r"); - Protect(fl = alcfile(fps[i], ((i? Fs_Write:Fs_Read))|Fs_BPipe, &fname), - runerr(0)); - Blk(ep,Lelem)->lslots[i].dword = D_File; - ep->Lelem.lslots[i].vword.bptr = (union block*)fl; - } + fps[i] = fdopen(fds[i], i? "w":"r"); + Protect(fl = alcfile(fps[i], ((i? Fs_Write:Fs_Read))|Fs_BPipe, &fname), + runerr(0)); + Blk(ep,Lelem)->lslots[i].dword = D_File; + ep->Lelem.lslots[i].vword.bptr = (union block*)fl; + } return list(lp); } end @@ -1134,9 +1134,9 @@ end #if NT function{0} fork() -#else /* NT */ +#else /* NT */ function{0,1} fork() -#endif /* NT */ +#endif /* NT */ abstract { return integer } @@ -1144,17 +1144,17 @@ function{0,1} fork() int pid; #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if ((pid = fork()) < 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return C_integer pid; -#endif /* NT */ +#endif /* NT */ } end @@ -1175,32 +1175,32 @@ function{0,1} fdup(src, dest) CURTSTATE(); if (BlkD(src,File)->status == 0) - runerr(1042, src); + runerr(1042, src); #ifdef Graphics if (BlkLoc(src)->File.status & Fs_Window) - runerr(105, src); + runerr(105, src); if (BlkD(dest,File)->status & Fs_Window) - runerr(105, dest); -#endif /* Graphics */ + runerr(105, dest); +#endif /* Graphics */ if ((fd_src = get_fd(src, 0)) < 0) - runerr(174, src); + runerr(174, src); if ((fd_dest = get_fd(dest, 0)) < 0) - runerr(174, dest); + runerr(174, dest); if (BlkLoc(dest)->File.status != 0) { - if (BlkLoc(dest)->File.status & Fs_Pipe) - pclose(BlkLoc(dest)->File.fd.fp); - else - fclose(BlkLoc(dest)->File.fd.fp); - } - + if (BlkLoc(dest)->File.status & Fs_Pipe) + pclose(BlkLoc(dest)->File.fd.fp); + else + fclose(BlkLoc(dest)->File.fd.fp); + } + IntVal(amperErrno) = 0; if (dup2(fd_src, fd_dest) < 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } BlkLoc(dest)->File.status = status = BlkD(src,File)->status; switch (status & (Fs_Read|Fs_Write)) { case Fs_Read & ~Fs_Write : fmode = "r"; break; @@ -1230,15 +1230,15 @@ function{0,1} exec(f, argv[argc]) */ tended char *p; /* fixme: remove static limit on margv */ - char *margv[200]; /* We need a different array so we can put - a nil pointer at the end of the list */ + char *margv[200]; /* We need a different array so we can put + a nil pointer at the end of the list */ if (argc > 200) - runerr(0); + runerr(0); IntVal(amperErrno) = 0; for(i = 0; i < argc; i++) { if (!cnv:C_string(argv[i], p)) - runerr(103, argv[i]); - margv[i] = p; + runerr(103, argv[i]); + margv[i] = p; } margv[i] = 0; #if NT @@ -1246,9 +1246,9 @@ function{0,1} exec(f, argv[argc]) #else if (execvp(f, margv) != 0) { #endif - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; } end @@ -1258,29 +1258,29 @@ end #if NT function{0} getuid() -#else /* NT */ +#else /* NT */ function{0,1} getuid() -#endif /* NT */ +#endif /* NT */ abstract { return string } body { #if NT fail; -#else /* NT */ +#else /* NT */ struct passwd *pw; char name[12], *user; int u; pw = getpwuid(u = getuid()); if (!pw) { - sprintf(name, "%d", u); - user = name; - } + sprintf(name, "%d", u); + user = name; + } else - user = pw->pw_name; + user = pw->pw_name; String(result, user); return result; -#endif /* NT */ +#endif /* NT */ } end @@ -1288,29 +1288,29 @@ end #if NT function{0} geteuid() -#else /* NT */ +#else /* NT */ function{0,1} geteuid() -#endif /* NT */ +#endif /* NT */ abstract { return string } body { #if NT fail; -#else /* NT */ +#else /* NT */ struct passwd *pw; char name[12], *user; int u; pw = getpwuid(u = geteuid()); if (!pw) { - sprintf(name, "%d", u); - user = name; - } + sprintf(name, "%d", u); + user = name; + } else - user = pw->pw_name; + user = pw->pw_name; String(result, user); return result; -#endif /* NT */ +#endif /* NT */ } end @@ -1318,29 +1318,29 @@ end #if NT function{0} getgid() -#else /* NT */ +#else /* NT */ function{0,1} getgid() -#endif /* NT */ +#endif /* NT */ abstract { return string } body { #if NT fail; -#else /* NT */ +#else /* NT */ struct group *gr; char name[12], *user; int g; gr = getgrgid(g = getgid()); if (!gr) { - sprintf(name, "%d", g); - user = name; - } + sprintf(name, "%d", g); + user = name; + } else - user = gr->gr_name; + user = gr->gr_name; String(result, user); return result; -#endif /* NT */ +#endif /* NT */ } end @@ -1348,29 +1348,29 @@ end #if NT function{0} getegid() -#else /* NT */ +#else /* NT */ function{0,1} getegid() -#endif /* NT */ +#endif /* NT */ abstract { return string } body { #if NT fail; -#else /* NT */ +#else /* NT */ struct group *gr; char name[12], *user; int g; gr = getgrgid(g = getegid()); if (!gr) { - sprintf(name, "%d", g); - user = name; - } + sprintf(name, "%d", g); + user = name; + } else - user = gr->gr_name; + user = gr->gr_name; String(result, user); return result; -#endif /* NT */ +#endif /* NT */ } end @@ -1378,9 +1378,9 @@ end #if NT function{0} setuid(u) -#else /* NT */ +#else /* NT */ function{0,1} setuid(u) -#endif /* NT */ +#endif /* NT */ if !cnv:C_integer(u) then runerr(101, u) abstract { @@ -1389,17 +1389,17 @@ function{0,1} setuid(u) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (setuid(u) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -1407,9 +1407,9 @@ end #if NT function{0} setgid(g) -#else /* NT */ +#else /* NT */ function{0,1} setgid(g) -#endif /* NT */ +#endif /* NT */ if !cnv:C_integer(g) then runerr(101, g) abstract { @@ -1418,17 +1418,17 @@ function{0,1} setgid(g) inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (setgid(g) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -1436,18 +1436,18 @@ end #if NT function{0} getpgrp() -#else /* NT */ +#else /* NT */ function{0,1} getpgrp() -#endif /* NT */ +#endif /* NT */ abstract { return integer } inline { #if NT fail; -#else /* NT */ +#else /* NT */ return C_integer getpgrp(); -#endif /* NT */ +#endif /* NT */ } end @@ -1455,35 +1455,35 @@ end #if NT function{0} setpgrp() -#else /* NT */ +#else /* NT */ function{0,1} setpgrp() -#endif /* NT */ +#endif /* NT */ abstract { return null } inline { #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ IntVal(amperErrno) = 0; #if NT fail; -#else /* NT */ +#else /* NT */ if (Setpgrp() != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; -#endif /* NT */ +#endif /* NT */ } end "crypt() - the password encryption function." #if defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) function{0, 1} crypt(key, salt) -#else /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ +#else /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ function{0} crypt(key, salt) -#endif /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ +#endif /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ if !cnv:C_string(key) then runerr(103, key) if !cnv:C_string(salt) then @@ -1501,23 +1501,23 @@ function{0} crypt(key, salt) localdata.initialized = 0; IntVal(amperErrno) = 0; s = crypt_r(key, salt, &localdata); -#else /* HAVE_CRYPT_R */ +#else /* HAVE_CRYPT_R */ #ifdef HAVE_CRYPT char *crypt(const char *key, const char *salt); CURTSTATE(); IntVal(amperErrno) = 0; s = crypt(key, salt); -#endif /* HAVE_CRYPT_R */ -#endif /* HAVE_CRYPT */ +#endif /* HAVE_CRYPT_R */ +#endif /* HAVE_CRYPT */ if (s == NULL) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } String(result, alcstr(s, strlen(s))); return result; -#else /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ +#else /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ fail; -#endif /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ +#endif /* defined(HAVE_CRYPT_R) || defined(HAVE_CRYPT) */ } end @@ -1526,7 +1526,7 @@ end function{0,1} umask(mask) declare { C_integer m; - tended char *perm; + tended char *perm; } if cnv:C_integer(mask, m) then { abstract { return integer } @@ -1581,7 +1581,7 @@ function{0,1} umask(mask) } } else { - runerr(170, mask); + runerr(170, mask); } end @@ -1594,35 +1594,35 @@ function{0,1} wait(pid, options) if is:coexpr(pid) then { abstract { return coexpr } body { - struct b_coexpr *cp; - if (IS_TS_THREAD(BlkLoc(pid)->Coexpr.status)) { - cp = &BlkLoc(pid)->Coexpr; + struct b_coexpr *cp; + if (IS_TS_THREAD(BlkLoc(pid)->Coexpr.status)) { + cp = &BlkLoc(pid)->Coexpr; - if ( cp->alive == 0 || cp->alive == -2) fail; + if ( cp->alive == 0 || cp->alive == -2) fail; - DEC_NARTHREADS; - THREAD_JOIN(cp->thread, NULL); - cp->alive = -2; /* mark it as joined*/ - INC_NARTHREADS_CONTROLLED; + DEC_NARTHREADS; + THREAD_JOIN(cp->thread, NULL); + cp->alive = -2; /* mark it as joined*/ + INC_NARTHREADS_CONTROLLED; - return pid; - } - else fail; - } + return pid; + } + else fail; + } } else { -#endif /* Concurrent */ +#endif /* Concurrent */ if !def:C_integer(pid, -1) then runerr(101, pid) - if !def:C_string(options, "") then + if !def:C_string(options, "") then runerr(103, options) #ifdef Concurrent abstract { return integer ++ string } -#else /* Concurrent */ +#else /* Concurrent */ abstract { return string } -#endif /* Concurrent */ +#endif /* Concurrent */ body { char retval[64]; @@ -1633,103 +1633,103 @@ function{0,1} wait(pid, options) CURTSTATE(); #ifdef Concurrent - /* + /* * If pid>=-1 then it is a process, otherwise it is a condition variable. */ if (pid < -1) { - int x = -pid-2; - if (x<0 || x>=ncondvars) - irunerr(181, pid); + int x = -pid-2; + if (x<0 || x>=ncondvars) + irunerr(181, pid); - DEC_NARTHREADS; - CV_WAIT(condvars[x], condvarsmtxs[x]); - INC_NARTHREADS_CONTROLLED; + DEC_NARTHREADS; + CV_WAIT(condvars[x], condvarsmtxs[x]); + INC_NARTHREADS_CONTROLLED; - return C_integer 1; - } -#endif /* Concurrent */ + return C_integer 1; + } +#endif /* Concurrent */ #if !NT #if defined(BSD) || defined(BSD_4_4_LITE) while(options[i]) - switch(options[i++]) { - case 'n' : option |= WNOHANG; break; - case 'u' : option |= WUNTRACED; break; - } + switch(options[i++]) { + case 'n' : option |= WNOHANG; break; + case 'u' : option |= WUNTRACED; break; + } IntVal(amperErrno) = 0; if ((wpid = wait4(pid, &status, option, &rusage)) < 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } -#else /* BSD */ +#else /* BSD */ if (pid == -1) { - IntVal(amperErrno) = 0; - if ((wpid = wait(&status)) < 0) { - IntVal(amperErrno) = errno; - fail; - } - } + IntVal(amperErrno) = 0; + if ((wpid = wait(&status)) < 0) { + IntVal(amperErrno) = errno; + fail; + } + } else { - while(options[i]) - switch(options[i++]) { - case 'n' : option |= WNOHANG; break; - case 'u' : option |= WUNTRACED; break; - } + while(options[i]) + switch(options[i++]) { + case 'n' : option |= WNOHANG; break; + case 'u' : option |= WUNTRACED; break; + } - IntVal(amperErrno) = 0; - if ((wpid = waitpid(pid, &status, option)) < 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = 0; + if ((wpid = waitpid(pid, &status, option)) < 0) { + IntVal(amperErrno) = errno; + fail; + } } -#endif /* BSD */ +#endif /* BSD */ /* Unpack all the fields */ if (WIFSTOPPED(status)) - sprintf(retval, "%d stopped:%s", wpid, - si_i2s((siptr)signalnames, WSTOPSIG(status))); + sprintf(retval, "%d stopped:%s", wpid, + si_i2s((siptr)signalnames, WSTOPSIG(status))); else if (WIFSIGNALED(status)) - sprintf(retval, "%d terminated:%s", wpid, - si_i2s((siptr)signalnames, WTERMSIG(status))); + sprintf(retval, "%d terminated:%s", wpid, + si_i2s((siptr)signalnames, WTERMSIG(status))); else if (WIFEXITED(status)) - sprintf(retval, "%d exited:%d", wpid, WEXITSTATUS(status)); + sprintf(retval, "%d exited:%d", wpid, WEXITSTATUS(status)); else - sprintf(retval, "???"); + sprintf(retval, "???"); #if defined(BSD) && defined(SUN) if (WIFSIGNALED(status) && ((union __wait*)&status)->w_T.w_Coredump) #else if (WIFSIGNALED(status) && WCOREDUMP(status)) #endif - strcat(retval, ":core"); -#else /* NT */ + strcat(retval, ":core"); +#else /* NT */ { int termstat; while(options[i]) - switch(options[i++]) { - case 'n' : option |= _WAIT_CHILD; break; - case 'u' : option |= _WAIT_GRANDCHILD; break; - } + switch(options[i++]) { + case 'n' : option |= _WAIT_CHILD; break; + case 'u' : option |= _WAIT_GRANDCHILD; break; + } IntVal(amperErrno) = 0; if ((wpid = _cwait(&termstat, pid, option)) < 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } sprintf(retval, "%d terminated:%d", wpid, termstat); } -#endif /* NT */ +#endif /* NT */ String(result, retval); return result; } #ifdef Concurrent } -#endif /* Concurrent */ +#endif /* Concurrent */ end #begdef GenTime(name, conv_type, i) @@ -1748,10 +1748,10 @@ function{0,1} name(t) #if i #if HAVE_CTIME_R if ((p = ctime_r((time_t *)&t, buf)) == NULL) runerr(0); -#else /* HAVE_CTIME_R */ +#else /* HAVE_CTIME_R */ /* need to add mutex here for thread-safe version if Concurrent */ if ((p = ctime((time_t *)&t)) == NULL) runerr(0); -#endif /* HAVE_CTIME_R */ +#endif /* HAVE_CTIME_R */ #else #if HAVE_GMTIME_R && HAVE_ASCTIME_R { @@ -1760,10 +1760,10 @@ function{0,1} name(t) if (gmtime_r((time_t *)&t, &gmt) == NULL) runerr(0); if ((p = asctime_r(&gmt, buf)) == NULL) runerr(0); } -#else /* HAVE_GMTIME_R && HAVE_ASCTIME_R */ +#else /* HAVE_GMTIME_R && HAVE_ASCTIME_R */ /* need to add mutex here for thread-safe version if Concurrent */ p = asctime(gmtime((time_t *)&t)); -#endif /* HAVE_GMTIME_R && HAVE_ASCTIME_R */ +#endif /* HAVE_GMTIME_R && HAVE_ASCTIME_R */ #endif l = strlen(p) - 1; Protect(StrLoc(result) = alcstr(p, l), runerr(0)); @@ -1788,7 +1788,7 @@ function{0,1} gettimeofday() struct timeval tp; #if NT struct _timeb wtp; -#endif /* NT */ +#endif /* NT */ struct b_record *rp; /* does not need to be tended */ int nfields; CURTSTATE(); @@ -1796,15 +1796,15 @@ function{0,1} gettimeofday() IntVal(amperErrno) = 0; #if NT _ftime( &wtp ); -#else /* NT */ +#else /* NT */ if (gettimeofday(&tp, 0) < 0) { - IntVal(amperErrno) = errno; - fail; - } -#endif /* NT */ + IntVal(amperErrno) = errno; + fail; + } +#endif /* NT */ if (!timeval_constr) - if (!(timeval_constr = rec_structor("posix_timeval"))) - syserr("failed to create posix record constructor"); + if (!(timeval_constr = rec_structor("posix_timeval"))) + syserr("failed to create posix record constructor"); nfields = (int) BlkD(*timeval_constr, Proc)->nfields; Protect(rp = alcrecd(nfields, BlkLoc(*timeval_constr)), runerr(0)); @@ -1813,10 +1813,10 @@ function{0,1} gettimeofday() #if NT MakeInt(wtp.time, &(rp->fields[0])); MakeInt(wtp.millitm * 1000, &(rp->fields[1])); -#else /* NT */ +#else /* NT */ MakeInt(tp.tv_sec, &(rp->fields[0])); MakeInt(tp.tv_usec, &(rp->fields[1])); -#endif /* NT */ +#endif /* NT */ return result; } @@ -1826,9 +1826,9 @@ end #if NT function{0} getrusage(who) -#else /* NT */ +#else /* NT */ function{0,1} getrusage(who) -#endif /* NT */ +#endif /* NT */ if !def:C_string(who, "self") then runerr(103, who) abstract { return record @@ -1840,7 +1840,7 @@ function{0,1} getrusage(who) #if NT fail; /* for now */ -#else /* NT */ +#else /* NT */ struct rusage usage; IntVal(amperErrno) = 0; if ((*who == '\0') || (!strcmp(who, "self"))) iwho = RUSAGE_SELF; @@ -1851,22 +1851,22 @@ function{0,1} getrusage(who) else fail; if (getrusage(iwho, &usage) != 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } if (!constr) - if (!(constr = rec_structor("posix_rusage"))) - syserr("failed to create posix record constructor"); + if (!(constr = rec_structor("posix_rusage"))) + syserr("failed to create posix record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; if (!timeval_constr) - if (!(timeval_constr = rec_structor("posix_timeval"))) - syserr("failed to create posix record constructor"); + if (!(timeval_constr = rec_structor("posix_timeval"))) + syserr("failed to create posix record constructor"); Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); rusage2rec(&usage, &result, &rp); return result; -#endif /* NT */ +#endif /* NT */ } end @@ -1882,24 +1882,24 @@ function{0,1} lstat(f) tended struct b_record *rp; #if NT struct _stat sbuf; -#else /* NT */ +#else /* NT */ struct stat sbuf; -#endif /* NT */ +#endif /* NT */ static dptr constr; int nfields; IntVal(amperErrno) = 0; #if NT #define lstat _stat -#endif /* NT */ +#endif /* NT */ if (lstat(f, &sbuf) != 0) { - IntVal(amperErrno) = errno; - fail; + IntVal(amperErrno) = errno; + fail; } if (!constr) - if (!(constr = rec_structor("posix_stat"))) - syserr("failed to create posix record constructor"); + if (!(constr = rec_structor("posix_stat"))) + syserr("failed to create posix record constructor"); nfields = (int) BlkD(*constr, Proc)->nfields; Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); @@ -1913,129 +1913,129 @@ end function{0,1} stat(f) type_case f of { string: { - abstract { - return record - } - body { - tended struct b_record *rp; -#if NT - struct _stat sbuf; -#else /* NT */ - struct stat sbuf; -#endif /* NT */ - tended char *fname; - static dptr constr; - int nfields; - - /* - * remove a layer of double quoting on filenames - * such as "C:\Program Files\Unicon\bin\wicont.exe" - */ - if ((StrLen(f)>1) && (StrLoc(f)[0] == '\"') && - (StrLoc(f)[StrLen(f)-1] == '\"')) { - StrLoc(f)++; - StrLen(f)-=2; - } + abstract { + return record + } + body { + tended struct b_record *rp; +#if NT + struct _stat sbuf; +#else /* NT */ + struct stat sbuf; +#endif /* NT */ + tended char *fname; + static dptr constr; + int nfields; + + /* + * remove a layer of double quoting on filenames + * such as "C:\Program Files\Unicon\bin\wicont.exe" + */ + if ((StrLen(f)>1) && (StrLoc(f)[0] == '\"') && + (StrLoc(f)[StrLen(f)-1] == '\"')) { + StrLoc(f)++; + StrLen(f)-=2; + } cnv:C_string(f, fname); /* can't fail, type_case says so */ - - IntVal(amperErrno) = 0; - if (lstat(fname, &sbuf) != 0) { - set_syserrortext(errno); - fail; - } - if (!constr) - if (!(constr = rec_structor("posix_stat"))) - syserr("failed to create posix record constructor"); - - nfields = (int) BlkD(*constr, Proc)->nfields; - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - stat2rec(&sbuf, &result, &rp); + + IntVal(amperErrno) = 0; + if (lstat(fname, &sbuf) != 0) { + set_syserrortext(errno); + fail; + } + if (!constr) + if (!(constr = rec_structor("posix_stat"))) + syserr("failed to create posix record constructor"); + + nfields = (int) BlkD(*constr, Proc)->nfields; + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + stat2rec(&sbuf, &result, &rp); #if !NT - if (S_ISLNK(sbuf.st_mode)) { - /* readlink */ - int len; - char *out; - long n; - - IntVal(amperErrno) = 0; - - reserve(Strings, NAME_MAX); - Protect(StrLoc(rp->fields[13]) = - alcstr(NULL, NAME_MAX), runerr(0)); - if ((len = readlink(fname, StrLoc(rp->fields[13]), NAME_MAX)) < 0) { - /* Give back the string */ - n = DiffPtrs(StrLoc(rp->fields[13]),strfree); - EVStrAlc(n); - strtotal += DiffPtrs(StrLoc(rp->fields[13]),strfree); - /* reset free pointer */ - strfree = StrLoc(rp->fields[13]); - - set_syserrortext(errno); - fail; - } - - /* Return the extra characters at the end */ - out = StrLoc(rp->fields[13]) + len; - StrLen(rp->fields[13]) = DiffPtrs(out,StrLoc(rp->fields[13])); - n = DiffPtrs(out,strfree); - EVStrAlc(n); - strtotal += n; - strfree = out; - } -#endif /* !NT */ - return result; - } + if (S_ISLNK(sbuf.st_mode)) { + /* readlink */ + int len; + char *out; + long n; + + IntVal(amperErrno) = 0; + + reserve(Strings, NAME_MAX); + Protect(StrLoc(rp->fields[13]) = + alcstr(NULL, NAME_MAX), runerr(0)); + if ((len = readlink(fname, StrLoc(rp->fields[13]), NAME_MAX)) < 0) { + /* Give back the string */ + n = DiffPtrs(StrLoc(rp->fields[13]),strfree); + EVStrAlc(n); + strtotal += DiffPtrs(StrLoc(rp->fields[13]),strfree); + /* reset free pointer */ + strfree = StrLoc(rp->fields[13]); + + set_syserrortext(errno); + fail; + } + + /* Return the extra characters at the end */ + out = StrLoc(rp->fields[13]) + len; + StrLen(rp->fields[13]) = DiffPtrs(out,StrLoc(rp->fields[13])); + n = DiffPtrs(out,strfree); + EVStrAlc(n); + strtotal += n; + strfree = out; + } +#endif /* !NT */ + return result; + } } file: { - abstract { - return record - } - body { - tended struct b_record *rp; -#if NT - struct _stat sbuf; -#else /* NT */ - struct stat sbuf; -#endif /* NT */ - static dptr constr; - int nfields, fd; - -#if HAVE_LIBZ + abstract { + return record + } + body { + tended struct b_record *rp; +#if NT + struct _stat sbuf; +#else /* NT */ + struct stat sbuf; +#endif /* NT */ + static dptr constr; + int nfields, fd; + +#if HAVE_LIBZ if (BlkD(f,File)->status & Fs_Compress) fail; -#endif /* HAVE_LIBZ */ - - IntVal(amperErrno) = 0; - if (BlkD(f,File)->status & Fs_Directory) { - tended char *fname; - cnv:C_string((BlkD(f,File)->fname), fname); - if (lstat(fname, &sbuf) != 0) { - set_syserrortext(errno); - fail; - } - } - else { - if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); - if (fstat(fd, &sbuf) != 0) { - set_syserrortext(errno); - fail; - } - } - if (!constr) - if (!(constr = rec_structor("posix_stat"))) - syserr("failed to create posix record constructor"); - - nfields = (int) BlkD(*constr, Proc)->nfields; - Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); - stat2rec(&sbuf, &result, &rp); - return result; - } +#endif /* HAVE_LIBZ */ + + IntVal(amperErrno) = 0; + if (BlkD(f,File)->status & Fs_Directory) { + tended char *fname; + cnv:C_string((BlkD(f,File)->fname), fname); + if (lstat(fname, &sbuf) != 0) { + set_syserrortext(errno); + fail; + } + } + else { + if ((fd = get_fd(f, 0)) < 0) + runerr(174, f); + if (fstat(fd, &sbuf) != 0) { + set_syserrortext(errno); + fail; + } + } + if (!constr) + if (!(constr = rec_structor("posix_stat"))) + syserr("failed to create posix record constructor"); + + nfields = (int) BlkD(*constr, Proc)->nfields; + Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); + stat2rec(&sbuf, &result, &rp); + return result; + } } default: - runerr(109, f) + runerr(109, f) } end @@ -2050,22 +2050,22 @@ end abstract { return integer } body { CURTSTATE(); - if (msg_send(&k_current, &addr, &msg, timeout) == A_Continue) - return msg; - fail; - } + if (msg_send(&k_current, &addr, &msg, timeout) == A_Continue) + return msg; + fail; + } } else if is:null(addr) then { abstract { return integer } body { - CURTSTATE(); - if (msg_send(&k_current, NULL, &msg, timeout) == A_Continue) - return msg; - fail; - } + CURTSTATE(); + if (msg_send(&k_current, NULL, &msg, timeout) == A_Continue) + return msg; + fail; + } } else { -#endif /* Concurrent */ +#endif /* Concurrent */ if !cnv:C_string(addr) then runerr(103, addr) if !cnv:string(msg) then @@ -2076,39 +2076,39 @@ end int af_fam; #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ if (is:null(fam)){ - af_fam = AF_INET; + af_fam = AF_INET; } else { - if (!cnv:C_string(fam, fstr)) - runerr(103, fam); - if (strcmp(fstr, "ipv4")==0) - af_fam = AF_INET; - if (strcmp(fstr, "ipv6")==0) - af_fam = AF_INET6; - else if (strcmp(fstr, "ip")==0) - af_fam = AF_UNSPEC; - else // FIXME: maybe we should make this an error - af_fam = AF_INET; + if (!cnv:C_string(fam, fstr)) + runerr(103, fam); + if (strcmp(fstr, "ipv4")==0) + af_fam = AF_INET; + if (strcmp(fstr, "ipv6")==0) + af_fam = AF_INET6; + else if (strcmp(fstr, "ip")==0) + af_fam = AF_UNSPEC; + else // FIXME: maybe we should make this an error + af_fam = AF_INET; } IntVal(amperErrno) = 0; if (!sock_send(addr, StrLoc(msg), StrLen(msg), af_fam)) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } return nulldesc; } #ifdef Concurrent } -#endif /* Concurrent */ +#endif /* Concurrent */ end "receive() - receive a UDP datagram." #ifdef Concurrent function{0,1} receive(f, timeout) -#else /* Concurrent */ +#else /* Concurrent */ function{0,1} receive(f) -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef Concurrent if !def:C_integer(timeout, 0) then @@ -2116,25 +2116,25 @@ function{0,1} receive(f) if is:null(f) then { abstract { return any_value } body { - tended struct descrip d; + tended struct descrip d; - if (msg_receive(&k_current, NULL, &d, 0) == A_Continue) - return d; - fail; - } + if (msg_receive(&k_current, NULL, &d, 0) == A_Continue) + return d; + fail; + } } else if is:coexpr(f) then { abstract { return any_value } body { - tended struct descrip d; + tended struct descrip d; - if (msg_receive(&k_current, &f, &d, 0) == A_Continue) - return d; - fail; - } + if (msg_receive(&k_current, &f, &d, 0) == A_Continue) + return d; + fail; + } } else { -#endif /* Concurrent */ +#endif /* Concurrent */ if !is:file(f) then runerr(105, f) abstract { @@ -2144,33 +2144,33 @@ function{0,1} receive(f) tended struct b_record *rp; static dptr constr; int nfields, status, ret; - + status = BlkD(f,File)->status; if (!(status & Fs_Socket)) - runerr(175, f); + runerr(175, f); if (!constr) - if (!(constr = rec_structor("posix_message"))) - syserr("failed to create posix record constructor"); + if (!(constr = rec_structor("posix_message"))) + syserr("failed to create posix record constructor"); nfields = (int) BlkD(*constr,Proc)->nfields; Protect(rp = alcrecd(nfields, BlkLoc(*constr)), runerr(0)); IntVal(amperErrno) = 0; if ((ret = sock_recv(BlkD(f,File)->fd.fd, &rp)) == 0) { - IntVal(amperErrno) = errno; - fail; - } + IntVal(amperErrno) = errno; + fail; + } if (ret == -1) - runerr(171, f); - + runerr(171, f); + result.dword = D_Record; result.vword.bptr = (union block *)rp; return result; } #ifdef Concurrent } -#endif /* Concurrent */ +#endif /* Concurrent */ end #if defined(Dbm) || defined(ISQL) @@ -2187,76 +2187,76 @@ function{0,1} fetch(d, k) tended struct descrip dkey; #ifdef Dbm if (BlkD(d,File)->status & Fs_Dbm) { - DBM *db; - datum key, content; - - if (!cnv:string(k, dkey)) - runerr(103, k); - db = BlkLoc(d)->File.fd.dbm; - key.dsize = StrLen(dkey); key.dptr = StrLoc(dkey); - content = dbm_fetch(db, key); - if (content.dptr == NULL) - fail; - Protect(StrLoc(result)=alcstr(content.dptr, content.dsize),runerr(0)); - StrLen(result) = content.dsize; - return result; - } + DBM *db; + datum key, content; + + if (!cnv:string(k, dkey)) + runerr(103, k); + db = BlkLoc(d)->File.fd.dbm; + key.dsize = StrLen(dkey); key.dptr = StrLoc(dkey); + content = dbm_fetch(db, key); + if (content.dptr == NULL) + fail; + Protect(StrLoc(result)=alcstr(content.dptr, content.dsize),runerr(0)); + StrLen(result) = content.dsize; + return result; + } else -#endif /* Dbm */ +#endif /* Dbm */ #ifdef ISQL if (BlkD(d,File)->status & Fs_ODBC) { - int rv; - if (!is:null(k) && (!cnv:string(k, dkey))) - runerr(103, k); - rv = dbfetch(BlkLoc(d)->File.fd.sqlf, &result); - if (rv == Succeeded) { - if (is:null(k)) - return result; - else { /* pick out element k from result record */ - register union block *bp2; /* doesn't need to be tended */ - register word i; - register int len; - char *loc; - int nf; - bp2 = BlkD(result,Record)->recdesc; - nf = Blk(bp2,Proc)->nfields; - loc = StrLoc(dkey); - len = StrLen(dkey); - for(i=0; ilnames[i]) && - !strncmp(loc, StrLoc(Blk(bp2,Proc)->lnames[i]), len)){ - EVValD(&result, E_Rref); - EVVal(i+1, E_Rsub); + int rv; + if (!is:null(k) && (!cnv:string(k, dkey))) + runerr(103, k); + rv = dbfetch(BlkLoc(d)->File.fd.sqlf, &result); + if (rv == Succeeded) { + if (is:null(k)) + return result; + else { /* pick out element k from result record */ + register union block *bp2; /* doesn't need to be tended */ + register word i; + register int len; + char *loc; + int nf; + bp2 = BlkD(result,Record)->recdesc; + nf = Blk(bp2,Proc)->nfields; + loc = StrLoc(dkey); + len = StrLen(dkey); + for(i=0; ilnames[i]) && + !strncmp(loc, StrLoc(Blk(bp2,Proc)->lnames[i]), len)){ + EVValD(&result, E_Rref); + EVVal(i+1, E_Rsub); #if COMPILER - syserr("dynamic records not supported in compiler yet"); -#else /* COMPILER */ - /* - * Found the field, return a pointer to it. - */ - { - register union block *bp; /* doesn't need to be tended */ - bp = BlkLoc(result); - return struct_var(&(Blk(bp,Record)->fields[i]), bp); - } -#endif /* COMPILER */ - } - } - } - } - else if (rv == Failed) fail; - else runerr(0); - } + syserr("dynamic records not supported in compiler yet"); +#else /* COMPILER */ + /* + * Found the field, return a pointer to it. + */ + { + register union block *bp; /* doesn't need to be tended */ + bp = BlkLoc(result); + return struct_var(&(Blk(bp,Record)->fields[i]), bp); + } +#endif /* COMPILER */ + } + } + } + } + else if (rv == Failed) fail; + else runerr(0); + } else -#endif /* ISQL */ - runerr(190, d); +#endif /* ISQL */ + runerr(190, d); fail; /* avoid (gcc) compiler warning */ } end -#endif /* DBM */ +#endif /* DBM */ -/* +/* * Select */ int set_if_selectable(struct descrip *f, fd_set *fdsp, int *n) @@ -2267,31 +2267,31 @@ int set_if_selectable(struct descrip *f, fd_set *fdsp, int *n) #if UNIX if (status & Fs_Buff) return 1048; BlkLoc(*f)->File.status |= Fs_Unbuf; -#endif /* UNIX */ +#endif /* UNIX */ #ifdef Graphics /* * windows are handled separately from sockets in select() */ if (status & Fs_Window) { - return 0; - } - else -#endif /* Graphics */ + return 0; + } + else +#endif /* Graphics */ #if defined(PseudoPty) && defined(MSWindows) /* * windows pty's are handled separately from sockets in select() */ if (status & Fs_Pty) { - return 0; - } - else -#endif /* PseudoPty && MSWindows */ + return 0; + } + else +#endif /* PseudoPty && MSWindows */ if ((fd = get_fd(*f, Fs_Read|Fs_Socket|Fs_Messaging)) < 0) { - if (fd == -2) - return 212; - else - return 174; + if (fd == -2) + return 212; + else + return 174; } } else @@ -2312,8 +2312,8 @@ void post_if_ready(dptr ldp, dptr f, fd_set *fdsp) if ((status & (Fs_Read | Fs_Socket | Fs_Messaging | Fs_BPipe #if UNIX && defined(PseudoPty) | Fs_Pty -#endif /* UNIX && PseudoPty */ - )) == 0) +#endif /* UNIX && PseudoPty */ + )) == 0) return; #if FIXME_HAVE_LIBSSL @@ -2321,7 +2321,7 @@ void post_if_ready(dptr ldp, dptr f, fd_set *fdsp) if (SSL_has_pending(BlkD(*f, File)->fd.ssl) == 0 ) return; } -#endif /* LIBSSL */ +#endif /* LIBSSL */ fd = get_fd(*f, Fs_Read|Fs_Socket|Fs_Messaging); if ((fd != -1) && FD_ISSET(fd, fdsp)) { @@ -2329,15 +2329,15 @@ void post_if_ready(dptr ldp, dptr f, fd_set *fdsp) * If its a listener socket, convert it to the new connection. */ if (status & Fs_Listen) { - fromlen = sizeof(from); - DEC_NARTHREADS; - fd = accept(fd, (struct sockaddr *)&from, &fromlen); - INC_NARTHREADS_CONTROLLED; - if (fd < 0) - return; - BlkD(*f,File)->fd.fd = fd; - BlkLoc(*f)->File.status = Fs_Socket | Fs_Read | Fs_Write; - } + fromlen = sizeof(from); + DEC_NARTHREADS; + fd = accept(fd, (struct sockaddr *)&from, &fromlen); + INC_NARTHREADS_CONTROLLED; + if (fd < 0) + return; + BlkD(*f,File)->fd.fd = fd; + BlkLoc(*f)->File.status = Fs_Socket | Fs_Read | Fs_Write; + } c_put(ldp, f); } } @@ -2356,9 +2356,9 @@ function{0,1} select(files[nargs]) #if UNIX struct tms t; int base_time = times(&t), ctps = sysconf(_SC_CLK_TCK); -#else /* UNIX */ +#else /* UNIX */ int base_time = clock(), ctps = CLOCKS_PER_SEC; -#endif /* UNIX */ +#endif /* UNIX */ fd_set fds; struct timeval tv, *ptv = &tv; tended struct b_list *lp = NULL; @@ -2382,45 +2382,45 @@ function{0,1} select(files[nargs]) if ((lps = alclist(0, MinListSlots)) == NULL) runerr(307); d3.dword = D_List; BlkLoc(d3) = (union block *)lps; -#endif /* PseudoPty */ +#endif /* PseudoPty */ for (k=0; kstatus & Fs_Window)) - c_put(&d2, files+k); + if (is:file(files[k]) && (BlkD(files[k],File)->status & Fs_Window)) + c_put(&d2, files+k); #if defined(PseudoPty) && defined(MSWindows) - else if (is:file(files[k]) && (BlkD(files[k],File)->status & Fs_Pty)) - c_put(&d3, files+k); -#endif /* PseudoPty */ - else if (is:list(files[k])) { - for (ep = BlkD(files[k],List)->listhead; - BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext) { - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = Blk(ep,Lelem)->first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - f = ep->Lelem.lslots[j]; - if (is:file(f) && BlkD(f,File)->status & Fs_Window) - c_put(&d2, &f); + else if (is:file(files[k]) && (BlkD(files[k],File)->status & Fs_Pty)) + c_put(&d3, files+k); +#endif /* PseudoPty */ + else if (is:list(files[k])) { + for (ep = BlkD(files[k],List)->listhead; + BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext) { + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = Blk(ep,Lelem)->first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + f = ep->Lelem.lslots[j]; + if (is:file(f) && BlkD(f,File)->status & Fs_Window) + c_put(&d2, &f); #if defined(PseudoPty) && defined(MSWindows) - else if (is:file(f) && BlkD(f,File)->status & Fs_Pty) - c_put(&d3, &f); -#endif /* PseudoPty */ - } - } - } - else if (is:set(files[k])) { - for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; - ep = hgnext(BlkLoc(files[k]), &state, ep)) { - f = ep->Selem.setmem; - if (is:file(f) && BlkD(f,File)->status & Fs_Window) - c_put(&d2, &f); + else if (is:file(f) && BlkD(f,File)->status & Fs_Pty) + c_put(&d3, &f); +#endif /* PseudoPty */ + } + } + } + else if (is:set(files[k])) { + for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; + ep = hgnext(BlkLoc(files[k]), &state, ep)) { + f = ep->Selem.setmem; + if (is:file(f) && BlkD(f,File)->status & Fs_Window) + c_put(&d2, &f); #if defined(PseudoPty) && defined(MSWindows) - else if (is:file(f) && BlkD(f,File)->status & Fs_Pty) - c_put(&d3, &f); -#endif /* PseudoPty */ - } - } - } -#endif /* Graphics */ + else if (is:file(f) && BlkD(f,File)->status & Fs_Pty) + c_put(&d3, &f); +#endif /* PseudoPty */ + } + } + } +#endif /* Graphics */ /* * Unicon select() repeats until a timeout or real result. @@ -2431,92 +2431,92 @@ function{0,1} select(files[nargs]) */ do { - n = 0; - FD_ZERO(&fds); /* Set the fd's in the set */ - - for(k=0;klisthead; - BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext) { - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = Blk(ep,Lelem)->first + i; - if (j >= ep->Lelem.nslots) - j -= Blk(ep,Lelem)->nslots; - f = Blk(ep,Lelem)->lslots[j]; - if ((rv = set_if_selectable(&f, &fds, &n))) - runerr(rv, f); - } - } - } - else if (is:set(files[k])) { - for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; - ep = hgnext(BlkLoc(files[k]), &state, ep)) { - f = ep->Selem.setmem; - if ((rv = set_if_selectable(&f, &fds, &n))) - runerr(rv, f); - } - } - else { - if ((k+1 == nargs) && is:integer(files[k])) { - if (!cnv:C_integer(files[k], timeout)) runerr(101, files[k]); - } - else - if ((rv = set_if_selectable(files+k, &fds, &n))) - runerr(rv, files[k]); - } - } - - + n = 0; + FD_ZERO(&fds); /* Set the fd's in the set */ + + for(k=0;klisthead; + BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext) { + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = Blk(ep,Lelem)->first + i; + if (j >= ep->Lelem.nslots) + j -= Blk(ep,Lelem)->nslots; + f = Blk(ep,Lelem)->lslots[j]; + if ((rv = set_if_selectable(&f, &fds, &n))) + runerr(rv, f); + } + } + } + else if (is:set(files[k])) { + for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; + ep = hgnext(BlkLoc(files[k]), &state, ep)) { + f = ep->Selem.setmem; + if ((rv = set_if_selectable(&f, &fds, &n))) + runerr(rv, f); + } + } + else { + if ((k+1 == nargs) && is:integer(files[k])) { + if (!cnv:C_integer(files[k], timeout)) runerr(101, files[k]); + } + else + if ((rv = set_if_selectable(files+k, &fds, &n))) + runerr(rv, files[k]); + } + } + + /* Set the tv struct */ if (timeout < 0) { #ifdef Graphics - /* - * if there are any windows, then even if we said to go forever - * timeout periodically to check for window events. - */ - if (lws->size > 0) { - tv.tv_sec = 0; - tv.tv_usec = 50000; - } - else -#endif /* Graphics */ + /* + * if there are any windows, then even if we said to go forever + * timeout periodically to check for window events. + */ + if (lws->size > 0) { + tv.tv_sec = 0; + tv.tv_usec = 50000; + } + else +#endif /* Graphics */ #if defined(PseudoPty) && defined(MSWindows) - /* - * if there are any ptys, then even if we said to go forever - * timeout periodically to check for window events. - */ - if (lps->size > 0) { - tv.tv_sec = 0; - tv.tv_usec = 50000; - } - else -#endif /* PseudoPty && MSWindows */ - ptv = 0; + /* + * if there are any ptys, then even if we said to go forever + * timeout periodically to check for window events. + */ + if (lps->size > 0) { + tv.tv_sec = 0; + tv.tv_usec = 50000; + } + else +#endif /* PseudoPty && MSWindows */ + ptv = 0; } else { - tv.tv_sec = timeout/1000; - tv.tv_usec = (timeout%1000)*1000; - } + tv.tv_sec = timeout/1000; + tv.tv_usec = (timeout%1000)*1000; + } errno = 0; IntVal(amperErrno) = 0; #ifdef Graphics if ((lws->size > 0) && ((lp = findactivewindow(lws)) != NULL)) { - d.dword = D_List; - BlkLoc(d) = (union block *) lp; + d.dword = D_List; + BlkLoc(d) = (union block *) lp; tv.tv_sec = tv.tv_usec = 0; - } -#endif /* Graphics */ + } +#endif /* Graphics */ #if defined(PseudoPty) && defined(MSWindows) else if ((lps->size > 0) && ((lp = findactivepty(lps)) != NULL)) { - d.dword = D_List; - BlkLoc(d) = (union block *) lp; + d.dword = D_List; + BlkLoc(d) = (union block *) lp; tv.tv_sec = tv.tv_usec = 0; - } -#endif /* PseudoPty && MSWindows */ + } +#endif /* PseudoPty && MSWindows */ if (n) { DEC_NARTHREADS; @@ -2534,107 +2534,107 @@ function{0,1} select(files[nargs]) } #ifdef Graphics - pollevent(); - - /* - * if our select() could have taken any time, try windows again - */ - if ((lp == NULL) && ((lp = findactivewindow(lws)) != NULL)) { - d.dword = D_List; - BlkLoc(d) = (union block *) lp; - } -#endif /* Graphics */ + pollevent(); + + /* + * if our select() could have taken any time, try windows again + */ + if ((lp == NULL) && ((lp = findactivewindow(lws)) != NULL)) { + d.dword = D_List; + BlkLoc(d) = (union block *) lp; + } +#endif /* Graphics */ #if defined(PseudoPty) && defined(MSWindows) - /* - * if our select() could have taken any time, try ptys again - */ - if ((lp == NULL) && ((lp = findactivepty(lps)) != NULL)) { - d.dword = D_List; - BlkLoc(d) = (union block *) lp; - } -#endif /* PseudoPty */ - } + /* + * if our select() could have taken any time, try ptys again + */ + if ((lp == NULL) && ((lp = findactivepty(lps)) != NULL)) { + d.dword = D_List; + BlkLoc(d) = (union block *) lp; + } +#endif /* PseudoPty */ + } else if (ptv && (ptv->tv_sec || ptv->tv_usec)) { - idelay(ptv->tv_sec * 1000 + ptv->tv_usec / 1000); - } + idelay(ptv->tv_sec * 1000 + ptv->tv_usec / 1000); + } if (lp == NULL) { - if ((lp = alclist(0, MinListSlots)) == NULL) runerr(307); + if ((lp = alclist(0, MinListSlots)) == NULL) runerr(307); } d.dword = D_List; BlkLoc(d) = (union block *)lp; for(k=0;kstatus & Fs_Compress) { - runerr(214); + if (BlkD(files[k],File)->status & Fs_Compress) { + runerr(214); } -#endif /* HAVE_LIBZ */ - post_if_ready(&d, files+k, &fds); - } +#endif /* HAVE_LIBZ */ + post_if_ready(&d, files+k, &fds); + } else if (is:integer(files[k])) { - /* timeout */ - } - else if (is:list(files[k])) { + /* timeout */ + } + else if (is:list(files[k])) { for (ep = BlkD(files[k],List)->listhead; - BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext) { - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = Blk(ep,Lelem)->first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - f = Blk(ep,Lelem)->lslots[j]; - if (is:file(f)) { + BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext) { + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = Blk(ep,Lelem)->first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + f = Blk(ep,Lelem)->lslots[j]; + if (is:file(f)) { #if HAVE_LIBZ - if (BlkD(f,File)->status & Fs_Compress) { - runerr(214); - } -#endif /* HAVE_LIBZ */ - post_if_ready(&d, &f, &fds); - } - } - } - } - else if (is:set(files[k])) { - for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; - ep = hgnext(BlkLoc(files[k]), &state, ep)) { - f = ep->Selem.setmem; - if (is:file(f)) { + if (BlkD(f,File)->status & Fs_Compress) { + runerr(214); + } +#endif /* HAVE_LIBZ */ + post_if_ready(&d, &f, &fds); + } + } + } + } + else if (is:set(files[k])) { + for (ep = hgfirst(BlkLoc(files[k]), &state); ep != 0; + ep = hgnext(BlkLoc(files[k]), &state, ep)) { + f = ep->Selem.setmem; + if (is:file(f)) { #if HAVE_LIBZ - if (BlkD(f,File)->status & Fs_Compress) { - runerr(214); - } -#endif /* HAVE_LIBZ */ - post_if_ready(&d, &f, &fds); - } - } - } - } - /* - * This little gem tries to check if the timeout has elapsed. - * On some buggy versions of linux, at least, the struct members - * that t points at don't get updated, although times()'s return - * value does show forward progress. Use that return value, - * try to handle overflow. More ifdef's will be needed here - * if times() return value doesn't work on some systems. - */ + if (BlkD(f,File)->status & Fs_Compress) { + runerr(214); + } +#endif /* HAVE_LIBZ */ + post_if_ready(&d, &f, &fds); + } + } + } + } + /* + * This little gem tries to check if the timeout has elapsed. + * On some buggy versions of linux, at least, the struct members + * that t points at don't get updated, although times()'s return + * value does show forward progress. Use that return value, + * try to handle overflow. More ifdef's will be needed here + * if times() return value doesn't work on some systems. + */ #if UNIX - clocks = times(&t); -#else /* UNIX */ - clocks = clock(); -#endif /* UNIX */ - if (clocks > base_time) { - acc_time = clocks - base_time; - check_time = acc_time; - } - else { - check_time = clocks + acc_time; - } + clocks = times(&t); +#else /* UNIX */ + clocks = clock(); +#endif /* UNIX */ + if (clocks > base_time) { + acc_time = clocks - base_time; + check_time = acc_time; + } + else { + check_time = clocks + acc_time; + } } while ((BlkD(d,List)->size == 0) && - ((timeout < 0)||(check_time*1000/ctpsstatus & Fs_Socket) { - char buf[100], *s; - int len = sock_me(BlkD(h,File)->fd.fd, buf, sizeof(buf)); - if (!len) fail; - Protect(s=alcstr(buf,len), runerr(0)); - MakeStr(s, len, &result); - return result; - } - else { - runerr(103, h); - } + body { + /* if it is not a socket, then fail */ + if (BlkD(h,File)->status & Fs_Socket) { + char buf[100], *s; + int len = sock_me(BlkD(h,File)->fd.fd, buf, sizeof(buf)); + if (!len) fail; + Protect(s=alcstr(buf,len), runerr(0)); + MakeStr(s, len, &result); + return result; + } + else { + runerr(103, h); + } } } default: { @@ -2921,73 +2921,73 @@ function{0,1} getserv(s, proto) } type_case s of { string: { - body { - struct servent *serv; - tended char *p; - tended char* name; - p = 0; - cnv:C_string(s, name); + body { + struct servent *serv; + tended char *p; + tended char* name; + p = 0; + cnv:C_string(s, name); if (!is:null(proto)) - if (!cnv:C_string(proto, p)) - runerr(103, proto); - - if (p && !getprotobyname(p)) - runerr(1047, proto); - if ((serv = getservbyname(name, p)) == NULL) { + if (!cnv:C_string(proto, p)) + runerr(103, proto); + + if (p && !getprotobyname(p)) + runerr(1047, proto); + if ((serv = getservbyname(name, p)) == NULL) { #if NT /* TODO: call WSAGetLastError to find out what went wrong and set errortext */ #endif - set_errortext(1049); - fail; - } + set_errortext(1049); + fail; + } - if (make_serv(serv, &result) == 0) - syserr("failed to create posix record constructor"); - return result; - } + if (make_serv(serv, &result) == 0) + syserr("failed to create posix record constructor"); + return result; + } } integer: { - body { - tended char *p; - C_integer port; - unsigned short real_port; - p = 0; - if (!cnv:C_integer(s, port)) runerr(101, s); + body { + tended char *p; + C_integer port; + unsigned short real_port; + p = 0; + if (!cnv:C_integer(s, port)) runerr(101, s); if (!is:null(proto)) - if (!cnv:C_string(proto, p)) - runerr(103, proto); + if (!cnv:C_string(proto, p)) + runerr(103, proto); - if (p && !getprotobyname(p)) - runerr(1047, proto); + if (p && !getprotobyname(p)) + runerr(1047, proto); real_port = htons((unsigned short)port); - if ((serv = getservbyport((int)real_port, p)) == NULL) { + if ((serv = getservbyport((int)real_port, p)) == NULL) { #if NT /* TODO: call WSAGetLastError to find out what went wrong and set errortext */ #endif - set_errortext(1049); - fail; - } + set_errortext(1049); + fail; + } - if (make_serv(serv, &result) == 0) - syserr("failed to create posix record constructor"); - return result; - } + if (make_serv(serv, &result) == 0) + syserr("failed to create posix record constructor"); + return result; + } } null: { - body { + body { #if NT - fail; -#else /* NT */ - if ((serv = getservent()) == NULL) { - set_errortext(1049); - fail; - } + fail; +#else /* NT */ + if ((serv = getservent()) == NULL) { + set_errortext(1049); + fail; + } - if (make_serv(serv, &result) == 0) - syserr("failed to create posix record constructor"); - return result; -#endif /* NT */ - } + if (make_serv(serv, &result) == 0) + syserr("failed to create posix record constructor"); + return result; +#endif /* NT */ + } } default: { runerr(170, s) @@ -2999,19 +2999,19 @@ end #if NT function{0} setpwent() -#else /* NT */ +#else /* NT */ function{0,1} setpwent() -#endif /* NT */ +#endif /* NT */ abstract { return null } body { #if NT fail; -#else /* NT */ +#else /* NT */ setpwent(); return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -3019,19 +3019,19 @@ end #if NT function{0} setgrent() -#else /* NT */ +#else /* NT */ function{0,1} setgrent() -#endif /* NT */ +#endif /* NT */ abstract { return null } body { #if NT fail; -#else /* NT */ +#else /* NT */ setgrent(); return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -3039,9 +3039,9 @@ end #if NT function{0} sethostent(so) -#else /* NT */ +#else /* NT */ function{0,1} sethostent(so) -#endif /* NT */ +#endif /* NT */ if !def:C_integer(so, 1) then runerr(101, so) abstract { @@ -3050,10 +3050,10 @@ function{0,1} sethostent(so) body { #if NT fail; -#else /* NT */ +#else /* NT */ sethostent(so); return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -3061,9 +3061,9 @@ end #if NT function{0} setservent(so) -#else /* NT */ +#else /* NT */ function{0,1} setservent(so) -#endif /* NT */ +#endif /* NT */ if !def:C_integer(so, 1) then runerr(101, so) abstract { @@ -3072,10 +3072,10 @@ function{0,1} setservent(so) body { #if NT fail; -#else /* NT */ +#else /* NT */ setservent(so); return nulldesc; -#endif /* NT */ +#endif /* NT */ } end @@ -3087,9 +3087,9 @@ function{0, 1} ready(f, i) if is:null(f) then inline { - f.dword = D_File; - BlkLoc(f) = (union block *)&k_input; - } + f.dword = D_File; + BlkLoc(f) = (union block *)&k_input; + } else if !is:file(f) then runerr(105, f) @@ -3102,14 +3102,14 @@ function{0, 1} ready(f, i) status = BlkD(f,File)->status; if (!(status & Fs_Read)) - runerr(212, f); + runerr(212, f); #ifdef Graphics if (status & Fs_Window) { - /* implement ready() on window */ + /* implement ready() on window */ fail; } -#endif /* Graphics */ +#endif /* Graphics */ #if defined(PseudoPty) if (status & Fs_Pty) { @@ -3117,42 +3117,42 @@ function{0, 1} ready(f, i) struct ptstruct *pt = BlkD(f,File)->fd.pt; #if NT DWORD tb; - if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) - && (tb>0)) { + if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) + && (tb>0)) { #else - int tb; - fd_set readset; - struct timeval tv; - FD_ZERO(&readset); - FD_SET(pt->master_fd, &readset); - tv.tv_sec = tv.tv_usec = 0; - if (select(pt->master_fd+1, &readset, NULL, NULL, &tv) > 0) { - /* performance bug: how many bytes are really available? */ - tb = 1; + int tb; + fd_set readset; + struct timeval tv; + FD_ZERO(&readset); + FD_SET(pt->master_fd, &readset); + tv.tv_sec = tv.tv_usec = 0; + if (select(pt->master_fd+1, &readset, NULL, NULL, &tv) > 0) { + /* performance bug: how many bytes are really available? */ + tb = 1; #endif - if (i == 0) i = tb; + if (i == 0) i = tb; else if (tb < i) i = tb; Protect(sbuf = alcstr(NULL, i), runerr(0)); #if NT status = ReadFile(pt->master_read, sbuf, i, &tb, NULL); #else - tb = read(pt->master_fd, sbuf, i); - status = (tb != -1); + tb = read(pt->master_fd, sbuf, i); + status = (tb != -1); #endif - if (!status) fail; + if (!status) fail; StrLoc(desc) = sbuf; StrLen(desc) = tb; return desc; - } - else fail; - } -#endif /* PseudoPty */ + } + else fail; + } +#endif /* PseudoPty */ if (status & Fs_Buff) - runerr(1048, f); + runerr(1048, f); if (u_read(&f, i, status, &desc) == 0) - fail; + fail; return desc; } end @@ -3165,9 +3165,9 @@ function{0, 1} syswrite(f, s) if is:null(f) then inline { - f.dword = D_File; - BlkLoc(f) = (union block *)&k_output; - } + f.dword = D_File; + BlkLoc(f) = (union block *)&k_output; + } else if !is:file(f) then runerr(105, f) @@ -3179,20 +3179,20 @@ function{0, 1} syswrite(f, s) tended struct descrip desc; status = BlkD(f,File)->status; - if (!status || !(status & Fs_Write) + if (!status || !(status & Fs_Write) #ifdef Graphics || (status & Fs_Window) -#endif /* Graphics */ +#endif /* Graphics */ ) - runerr(213, f); + runerr(213, f); if ((fd = get_fd(f, 0)) < 0) - runerr(174, f); - + runerr(174, f); + if (status & Fs_Buff) - runerr(1048, f); + runerr(1048, f); BlkLoc(f)->File.status = status; - + IntVal(amperErrno) = 0; rc = write(fd, StrLoc(s), StrLen(s)); if (rc < 0) { @@ -3256,16 +3256,16 @@ function{0, 1} setenv(name, value) fail; if (q) free(q); -#else /* SUN || HP */ +#else /* SUN || HP */ /* Tested on OpenBSD 3.1, FreeBSD-4.6, Linux 2.4.18 */ if (setenv(name, value, 1) < 0) fail; -#endif /* SUN || HP */ -#endif /* NT */ +#endif /* SUN || HP */ +#endif /* NT */ return nulldesc; } end -#else /* POSIX_FUNCS */ -/* static char junk; /* avoid empty module */ -#endif /* POSIX_FUNCS */ +#else /* POSIX_FUNCS */ +/* static char junk; /* avoid empty module */ +#endif /* POSIX_FUNCS */ diff --git a/src/runtime/fxprmnt.ri b/src/runtime/fxprmnt.ri index 393edbcab..09e5c16b5 100644 --- a/src/runtime/fxprmnt.ri +++ b/src/runtime/fxprmnt.ri @@ -32,9 +32,9 @@ function {1} XAnimateFrame(argv[argc]) * 1 or more pixmaps must be included */ while(warg < argc && is:file(argv[warg]) && - (BlkLoc(argv[warg])->file.status & Fs_Window)) { + (BlkLoc(argv[warg])->file.status & Fs_Window)) { npixmaps++; - warg++; + warg++; } if (!npixmaps) runerr(140); @@ -50,21 +50,21 @@ function {1} XAnimateFrame(argv[argc]) closed = 1; /* duplicate the next to last point */ x[0] = IntVal(argv[argc-4]); y[0] = IntVal(argv[argc-3]); - x[0] += _w_->dx; - y[0] += _w_->dy; + x[0] += _w_->dx; + y[0] += _w_->dy; } else if (argc > 1) { /* duplicate the first point */ x[0] = IntVal(argv[warg]); y[0] = IntVal(argv[warg+1]); - x[0] += _w_->dx; - y[0] += _w_->dy; + x[0] += _w_->dx; + y[0] += _w_->dy; } for (i = 0, j = 1; i < n; i++, j++) { - int base = warg + i * 2; - + int base = warg + i * 2; + if (j == MAXXOBJS) { animate(_w_, &(argv[warg-npixmaps]), npixmaps, - x, y, MAXXOBJS, delay); + x, y, MAXXOBJS, delay); x[0] = x[j-3]; y[0] = y[j-3]; /* duplicate the last three points */ x[1] = x[j-2]; /* for the next call, to insure */ @@ -75,8 +75,8 @@ function {1} XAnimateFrame(argv[argc]) } CnvCInteger(argv[base], x[j]); CnvCInteger(argv[base + 1], y[j]); - x[j] += _w_->dx; - y[j] += _w_->dy; + x[j] += _w_->dx; + y[j] += _w_->dy; } if (closed) { /* duplicate the second point */ x[j] = x[2]; diff --git a/src/runtime/fxtra.r b/src/runtime/fxtra.r index 682d796c5..c76f11ddf 100644 --- a/src/runtime/fxtra.r +++ b/src/runtime/fxtra.r @@ -13,19 +13,19 @@ #ifdef DosFncs #include "fxmsdos.ri" -#endif /* DosFncs */ +#endif /* DosFncs */ #ifdef PosixFns #include "fxposix.ri" -#endif /* POSIX interface functions */ +#endif /* POSIX interface functions */ /* * Always include - defines dummy functions if audio is not supported. */ #include "fxaudio.ri" - + #ifdef PatternType #include "fxpattrn.ri" -#endif /* (Snobol-style) Pattern data type */ +#endif /* (Snobol-style) Pattern data type */ -/* static char junk; /* avoid empty module */ +/* static char junk; /* avoid empty module */ diff --git a/src/runtime/imain.r b/src/runtime/imain.r index 6d6f7d96e..735d0247c 100644 --- a/src/runtime/imain.r +++ b/src/runtime/imain.r @@ -14,13 +14,13 @@ pointer stkadr; word stkint; } stkword; -#endif /* MSDOS */ +#endif /* MSDOS */ /* * Prototypes. */ -void icon_setup (int argc, char **argv, int *ip); +void icon_setup (int argc, char **argv, int *ip); #ifdef MacGraph void MacMain (int argc, char **argv); @@ -28,7 +28,7 @@ void ToolBoxInit (void); void MenuBarInit (void); void MouseInfoInit (void); int GetArgs (char **argv); -#endif /* MacGraph */ +#endif /* MacGraph */ /* * The following code is operating-system dependent [@imain.01]. Declarations @@ -38,11 +38,11 @@ int GetArgs (char **argv); #if PORT /* probably needs something more */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || MVS || VM || UNIX || VMS /* nothing needed */ -#endif /* MSDOS || ... */ +#endif /* MSDOS || ... */ /* * End of operating-system specific code. @@ -55,9 +55,9 @@ extern int set_up; */ #ifndef MultiProgram -int n_globals = 0; /* number of globals */ -int n_statics = 0; /* number of statics */ -#endif /* MultiProgram */ +int n_globals = 0; /* number of globals */ +int n_statics = 0; /* number of statics */ +#endif /* MultiProgram */ /* * Initial icode sequence. This is used to invoke the main procedure with one @@ -66,7 +66,7 @@ int n_statics = 0; /* number of statics */ word istart[4]; int mterm = Op_Quit; - + #if NT @@ -80,7 +80,7 @@ int mterm = Op_Quit; #endif -#if NT /* MSWindows */ +#if NT /* MSWindows */ #if WildCards void ExpandArgv(int *argcp, char ***avp) { @@ -94,7 +94,7 @@ void ExpandArgv(int *argcp, char ***avp) if (strchr(argv[j], '*') || strchr(argv[j], '?')) { if (FINDFIRST(argv[j], &fd)) { while (FINDNEXT(&fd)) newargc++; - FINDCLOSE(&fd); + FINDCLOSE(&fd); } } } @@ -131,8 +131,8 @@ void ExpandArgv(int *argcp, char ***avp) *avp = newargv; *argcp = newargc; } -#endif /* WildCards */ -#endif /* NT */ +#endif /* WildCards */ +#endif /* NT */ #ifdef MacGraph MouseInfoType gMouseInfo; @@ -143,17 +143,17 @@ char *cmlArgs; StringHandle textHandle; void MacMain (int argc, char **argv) -#else /* MacGraph */ +#else /* MacGraph */ #ifdef DLLICONX #passthru void __declspec(dllexport) iconx_entry(int argc, char **argv) -#else /* DLLICONX */ +#else /* DLLICONX */ #ifdef INTMAIN int main(int argc, char **argv) #else void main(int argc, char **argv) -#endif /* INTMAIN */ -#endif /* DLLICONX */ -#endif /* MacGraph */ +#endif /* INTMAIN */ +#endif /* DLLICONX */ +#endif /* MacGraph */ { int i, slen; @@ -162,15 +162,15 @@ void main(int argc, char **argv) #ifndef HAVE_KEYWORD__THREAD struct threadstate *curtstate; pthread_key_create(&tstate_key, NULL); -#endif /* HAVE_KEYWORD__THREAD */ +#endif /* HAVE_KEYWORD__THREAD */ rt_status = RTSTATUS_NORMAL; init_threads(); global_curtstate = &roottstate; -#endif /* Concurrent */ +#endif /* Concurrent */ #if WildCards && NT ExpandArgv(&argc, &argv); -#endif /* WildCards && NT */ +#endif /* WildCards && NT */ #ifdef MultiProgram /* @@ -183,28 +183,28 @@ void main(int argc, char **argv) int i=0, j = 1, k = 1; if ((p = getenv("MTENV")) != NULL) { for(i=0;p[i];i++) - if (p[i] == ' ') - j++; + if (p[i] == ' ') + j++; new_argv = (char **)malloc((argc + j) * sizeof(char *)); new_argv[0] = argv[0]; for (i=0; p[i]; ) { - new_argv[k++] = p+i; - while (p[i] && (p[i] != ' ')) - i++; - if (p[i] == ' ') - p[i++] = '\0'; - } + new_argv[k++] = p+i; + while (p[i] && (p[i] != ' ')) + i++; + if (p[i] == ' ') + p[i++] = '\0'; + } for(i=1;ic; -#endif /* Concurrent */ -#endif /* MultiProgram */ +#endif /* Concurrent */ +#endif /* MultiProgram */ #ifdef Messaging errno = 0; -#endif /* Messaging */ +#endif /* Messaging */ #ifdef NativeObjects @@ -290,9 +290,9 @@ void main(int argc, char **argv) { #ifdef StackCheck unsigned *temp_stackend=BlkD(k_current,Coexpr)->es_stackend, *temp_sp=sp; -#else /* StackCheck */ +#else /* StackCheck */ unsigned *temp_stackend=stackend, *temp_sp=sp; -#endif /* StackCheck */ +#endif /* StackCheck */ inst temp_ipc=ipc; struct gf_marker *temp_gfp=gfp; struct ef_marker *temp_efp=efp; @@ -328,10 +328,10 @@ void main(int argc, char **argv) #ifdef StackCheck BlkD(k_current,Coexpr)->es_stackend = BlkD(k_current,Coexpr)->es_stack + mstksize/WordSize; sp = BlkD(k_current,Coexpr)->es_stack + Wsizeof(struct b_coexpr); -#else /* StackCheck */ - stackend = stack + mstksize/WordSize; - sp = stack + Wsizeof(struct b_coexpr); -#endif /* StackCheck */ +#else /* StackCheck */ + stackend = stack + mstksize/WordSize; + sp = stack + Wsizeof(struct b_coexpr); +#endif /* StackCheck */ ipc.opnd = istart; *ipc.op++ = Op_Noop; @@ -358,39 +358,39 @@ void main(int argc, char **argv) PushDesc(globals[i]); #ifdef TSTATARG interp(0,(dptr)NULL, CURTSTATARG); /* [[I?]] */ -#else /* TSTATARG */ +#else /* TSTATARG */ interp(0,(dptr)NULL); /* [[I?]] */ -#endif /* TSTATARG */ - /* - * Now we have __oprec pointing at method vector. - * Copy it in __m field of record constructor block - */ - - strcat(classname,"__state"); - for(j=0; j < numberof_globals; ++j) { - union block *bptr=globals[j].vword.bptr; - if((globals[j].dword == D_Proc) && (-3 == bptr->proc.ndynam) && - (0==strcmp(classname,bptr->proc.pname.vword.sptr))) { - *strstr(classname,"__state")=0; - strcat(classname,"__oprec"); - - for(k=0;k < numberof_globals;++k) { - if(strcmp(classname,gnames[k].vword.sptr)==0) { - bptr->proc.lnames[bptr->proc.nparam]=globals[k]; - j = numberof_globals; /* exit outer for-loop */ - break; - } - } - } +#endif /* TSTATARG */ + /* + * Now we have __oprec pointing at method vector. + * Copy it in __m field of record constructor block + */ + + strcat(classname,"__state"); + for(j=0; j < numberof_globals; ++j) { + union block *bptr=globals[j].vword.bptr; + if((globals[j].dword == D_Proc) && (-3 == bptr->proc.ndynam) && + (0==strcmp(classname,bptr->proc.pname.vword.sptr))) { + *strstr(classname,"__state")=0; + strcat(classname,"__oprec"); + + for(k=0;k < numberof_globals;++k) { + if(strcmp(classname,gnames[k].vword.sptr)==0) { + bptr->proc.lnames[bptr->proc.nparam]=globals[k]; + j = numberof_globals; /* exit outer for-loop */ + break; + } + } + } } - } + } } #ifdef StackCheck BlkD(k_current,Coexpr)->es_stackend=temp_stackend; -#else /* StackCheck */ +#else /* StackCheck */ stackend=temp_stackend; -#endif /* StackCheck */ +#endif /* StackCheck */ sp=temp_sp; ipc=temp_ipc; gfp=temp_gfp; @@ -400,24 +400,24 @@ void main(int argc, char **argv) glbl_argp = temp_glbl_argp; set_up=temp_set_up; } -#endif /* NativeObjects */ +#endif /* NativeObjects */ /* * Point sp at word after b_coexpr block for &main, point ipc at initial - * icode segment, and clear the gfp. + * icode segment, and clear the gfp. */ #ifdef StackCheck BlkD(k_current,Coexpr)->es_stackend = BlkD(k_current,Coexpr)->es_stack + mstksize/WordSize; sp = BlkD(k_current,Coexpr)->es_stack + Wsizeof(struct b_coexpr); -#else /* StackCheck */ +#else /* StackCheck */ stackend = stack + mstksize/WordSize; sp = stack + Wsizeof(struct b_coexpr); -#endif /* StackCheck */ +#endif /* StackCheck */ ipc.opnd = istart; - *ipc.op++ = Op_Noop; /* aligns Invoke's operand */ /* [[I?]] */ - *ipc.op++ = Op_Invoke; /* [[I?]] */ + *ipc.op++ = Op_Noop; /* aligns Invoke's operand */ /* [[I?]] */ + *ipc.op++ = Op_Invoke; /* [[I?]] */ *ipc.opnd++ = 1; *ipc.op = Op_Quit; ipc.opnd = istart; @@ -480,25 +480,25 @@ void main(int argc, char **argv) sp = (word *)glbl_argp + 1; glbl_argp = 0; - set_up = 1; /* post fact that iconx is initialized */ + set_up = 1; /* post fact that iconx is initialized */ /* * Start things rolling by calling interp. This call to interp - * returns only if an Op_Quit is executed. If this happens, + * returns only if an Op_Quit is executed. If this happens, * c_exit() is called to wrap things up. */ #ifdef TSTATARG interp(0,(dptr)NULL, CURTSTATARG); /* [[I?]] */ -#else /* TSTATARG */ +#else /* TSTATARG */ interp(0,(dptr)NULL); /* [[I?]] */ -#endif /* TSTATARG */ +#endif /* TSTATARG */ c_exit(EXIT_SUCCESS); #ifdef INTMAIN return 0; #endif } - + /* * icon_setup - handle interpreter command line options. */ @@ -510,9 +510,9 @@ int *ip; #ifdef TallyOpt extern int tallyopt; -#endif /* TallyOpt */ +#endif /* TallyOpt */ - *ip = 0; /* number of arguments processed */ + *ip = 0; /* number of arguments processed */ #ifdef ExecImages if (dumped) { @@ -530,7 +530,7 @@ int *ip; argc++; (*ip)--; } -#endif /* ExecImages */ +#endif /* ExecImages */ /* * if we didn't start with *iconx[.exe], backup one @@ -567,7 +567,7 @@ int *ip; maxilevel = 0; maxplevel = 0; maxsp = 0; -#endif /* MaxLevel */ +#endif /* MaxLevel */ /* * Handle command line options. @@ -577,72 +577,72 @@ int *ip; switch ( optletter ) { #ifdef TallyOpt - /* - * Set tallying flag if -T option given - */ - case 'T': - tallyopt = 1; - break; -#endif /* TallyOpt */ - - /* - * Perform version check and exit if -V option given - */ - case 'V': { - extern int versioncheck_only; - versioncheck_only = 1; - } - break; - - /* -l: IDE whole-console-session logfile */ - /* -L: runtime error messaging logfile */ - case 'l': case 'L': { - extern char *logopt; - char *p; - if ( *(argv[1]+2) != '\0' ) - p = argv[1]+2; - else { - argv++; - argc--; + /* + * Set tallying flag if -T option given + */ + case 'T': + tallyopt = 1; + break; +#endif /* TallyOpt */ + + /* + * Perform version check and exit if -V option given + */ + case 'V': { + extern int versioncheck_only; + versioncheck_only = 1; + } + break; + + /* -l: IDE whole-console-session logfile */ + /* -L: runtime error messaging logfile */ + case 'l': case 'L': { + extern char *logopt; + char *p; + if ( *(argv[1]+2) != '\0' ) + p = argv[1]+2; + else { + argv++; + argc--; (*ip)++; - p = argv[1]; - if ( !p ) - error(NULL, "no file name given for logfile"); - } - if(optletter == 'l') { - openlog(p); - if (!flog) - syserr("Unable to open logfile\n"); - } - else { /* -L */ - logopt = p; - } - break; - } - + p = argv[1]; + if ( !p ) + error(NULL, "no file name given for logfile"); + } + if(optletter == 'l') { + openlog(p); + if (!flog) + syserr("Unable to open logfile\n"); + } + else { /* -L */ + logopt = p; + } + break; + } + /* * Set stderr to new file if -e option is given. */ - case 'e': { - char *p; - if ( *(argv[1]+2) != '\0' ) - p = argv[1]+2; - else { - argv++; - argc--; + case 'e': { + char *p; + if ( *(argv[1]+2) != '\0' ) + p = argv[1]+2; + else { + argv++; + argc--; (*ip)++; - p = argv[1]; - if ( !p ) - error(NULL, "no file name given for redirection of &errout"); - } + p = argv[1]; + if ( !p ) + error(NULL, "no file name given for redirection of &errout"); + } if (!redirerr(p)) syserr("Unable to redirect &errout\n"); - break; - } + break; + } } - argc--; + argc--; (*ip)++; - argv++; + argv++; } } @@ -653,9 +653,9 @@ int *ip; #ifdef MultiProgram void resolve(pstate) struct progstate *pstate; -#else /* MultiProgram */ +#else /* MultiProgram */ void resolve() -#endif /* MultiProgram */ +#endif /* MultiProgram */ { register word i, j; @@ -664,11 +664,11 @@ int *ip; #ifdef MultiProgram register struct progstate *savedstate = curpstate; CURTSTATE(); - if (pstate){ - curpstate = pstate; - curtstate = pstate->tstate; + if (pstate){ + curpstate = pstate; + curtstate = pstate->tstate; } - #endif /* MultiProgram */ + #endif /* MultiProgram */ /* * Relocate the names of the global variables. @@ -695,11 +695,11 @@ int *ip; if (i < 0) { /* * globals[j] points to a built-in function; call (bi_)strprc - * to look it up by name in the interpreter's table of built-in - * functions. + * to look it up by name in the interpreter's table of built-in + * functions. */ - if((BlkLoc(globals[j])= (union block *)bi_strprc(gnames+j,0)) == NULL) - globals[j] = nulldesc; /* undefined, set to &null */ + if((BlkLoc(globals[j])= (union block *)bi_strprc(gnames+j,0)) == NULL) + globals[j] = nulldesc; /* undefined, set to &null */ } else { @@ -718,22 +718,22 @@ int *ip; if ((pp->ndynam == -2) || (pp->ndynam == -3)) { /* - * This procedure is a record constructor. Make its entry point - * be the entry point of Omkrec(). + * This procedure is a record constructor. Make its entry point + * be the entry point of Omkrec(). */ pp->entryp.ccode = Omkrec; - /* - * Initialize field names - */ + /* + * Initialize field names + */ for (i = 0; i < pp->nfields; i++) StrLoc(pp->lnames[i]) = strcons + (uword)StrLoc(pp->lnames[i]); - } + } else { /* * This is an Icon procedure. Relocate the entry point and - * the names of the parameters, locals, and static variables. + * the names of the parameters, locals, and static variables. */ pp->entryp.icode = code + pp->entryp.ioff; for (i = 0; i < abs((int)pp->nparam)+pp->ndynam+pp->nstatic; i++) @@ -753,7 +753,7 @@ int *ip; curpstate = savedstate; curtstate = curpstate->tstate; (void) curtstate; /* silence "not used" compiler warning */ -#endif /* MultiProgram */ +#endif /* MultiProgram */ } /* @@ -768,40 +768,40 @@ void xmfree() register struct astkblk *abp, *xabp; CURTSTATE(); - if (mainhead == NULL) return; /* already xmfreed */ - free((pointer)mainhead->es_actstk); /* activation block for &main */ + if (mainhead == NULL) return; /* already xmfreed */ + free((pointer)mainhead->es_actstk); /* activation block for &main */ mainhead->es_actstk = NULL; #ifdef StackCheck - free((pointer)mainhead->es_stack); /* interpreter stack */ + free((pointer)mainhead->es_stack); /* interpreter stack */ mainhead->es_stack = NULL; -#else /* StackCheck */ - free((pointer)stack); /* interpreter stack */ +#else /* StackCheck */ + free((pointer)stack); /* interpreter stack */ stack = NULL; -#endif /* StackCheck */ +#endif /* StackCheck */ mainhead = NULL; - free((pointer)code); /* icode */ + free((pointer)code); /* icode */ code = NULL; /* * more is needed to free chains of heaps, also a multithread version * of this function may be needed someday. */ if (strbase) - free((pointer)strbase); /* allocated string region */ + free((pointer)strbase); /* allocated string region */ strbase = NULL; if (blkbase) - free((pointer)blkbase); /* allocated block region */ + free((pointer)blkbase); /* allocated block region */ blkbase = NULL; #ifndef MultiProgram if (curstring != &rootstring) - free((pointer)curstring); /* string region */ + free((pointer)curstring); /* string region */ curstring = NULL; if (curblock != &rootblock) - free((pointer)curblock); /* allocated block region */ + free((pointer)curblock); /* allocated block region */ curblock = NULL; -#endif /* MultiProgram */ +#endif /* MultiProgram */ if (quallist) - free((pointer)quallist); /* qualifier list */ + free((pointer)quallist); /* qualifier list */ quallist = NULL; /* @@ -820,23 +820,23 @@ void xmfree() * code provides for more than one. */ for (abp = xep->es_actstk; abp; ) { - xabp = abp; - abp = abp->astk_nxt; - free((pointer)xabp); - } + xabp = abp; + abp = abp->astk_nxt; + free((pointer)xabp); + } #ifdef Concurrent - /* - * do we need to kill a thread before we free its pointer here - */ -#endif /* Concurrent */ + /* + * do we need to kill a thread before we free its pointer here + */ +#endif /* Concurrent */ free((pointer)xep); stklist = NULL; } MUTEX_UNLOCKID(MTX_STKLIST); } -#endif /* !COMPILER */ +#endif /* !COMPILER */ #if NT @@ -864,12 +864,12 @@ char *ArgvToCmdline(char **argv) char *qq = mytmp; while (qq=strchr(qq, '/')) *qq='\\'; if (strchr(mytmp, ' ')) { - int j = strlen(mytmp); - mytmp[j+2] = '\0'; - mytmp[j+1] = '"'; - for( ; j > 0 ; j--) mytmp[j] = mytmp[j-1]; - mytmp[0] = '"'; - } + int j = strlen(mytmp); + mytmp[j+2] = '\0'; + mytmp[j+1] = '"'; + for( ; j > 0 ; j--) mytmp[j] = mytmp[j-1]; + mytmp[0] = '"'; + } } len += strlen(mytmp); if (len > 1023) mytmp = realloc(mytmp, len+1); @@ -881,7 +881,7 @@ char *ArgvToCmdline(char **argv) } return mytmp; } -#endif /* NT */ +#endif /* NT */ #ifdef MacGraph @@ -940,4 +940,4 @@ void main () EventLoop (); } -#endif /* MacGraph */ +#endif /* MacGraph */ diff --git a/src/runtime/imisc.r b/src/runtime/imisc.r index 85dd6cffc..4b508eabd 100644 --- a/src/runtime/imisc.r +++ b/src/runtime/imisc.r @@ -18,16 +18,16 @@ LibDcl(field,2,".") #ifdef MultiProgram struct progstate *thisprog = curpstate, *progtouse = NULL; -#else /* MultiProgram */ +#else /* MultiProgram */ extern int *ftabp; #ifdef FieldTableCompression extern int *fo; extern unsigned char *focp; extern unsigned short *fosp; extern char *bm; - #endif /* FieldTableCompression */ + #endif /* FieldTableCompression */ extern word *records; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * We may need to modify the argp, if we have to insert a "self" parameter. @@ -73,16 +73,16 @@ LibDcl(field,2,".") linearsearch: nfields = Blk(bptr, Proc)->nfields; for (i=0;iProc.lnames[i])) && - !strncmp(StrLoc(Arg0), StrLoc(bptr->Proc.lnames[i]),StrLen(Arg0))) - break; + if ((StrLen(Arg0) == StrLen(bptr->Proc.lnames[i])) && + !strncmp(StrLoc(Arg0), StrLoc(bptr->Proc.lnames[i]),StrLen(Arg0))) + break; } if (iProc.recnum == -1) { - Arg0 = fnames[IntVal(Arg2)]; - goto linearsearch; + Arg0 = fnames[IntVal(Arg2)]; + goto linearsearch; } else { @@ -93,19 +93,19 @@ linearsearch: * the current program, we may need to translate it, eh? */ if (!InRange(records, bptr, ftabp)) { - /* foreign */ - if ((progtouse = findprogramforblock(bptr)) == curpstate) { - /* "foreign" is actually a built-in, no field table at all */ - Arg0 = fnames[IntVal(Arg2)]; - goto linearsearch; - } - } + /* foreign */ + if ((progtouse = findprogramforblock(bptr)) == curpstate) { + /* "foreign" is actually a built-in, no field table at all */ + Arg0 = fnames[IntVal(Arg2)]; + goto linearsearch; + } + } else /* domestic */ - progtouse = curpstate; + progtouse = curpstate; /* use the correct field table */ ENTERPSTATE(progtouse); -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef FieldTableCompression #define FO(i) ((foffwidth==1)?(focp[i]&255L):((foffwidth==2)?(fosp[i]&65535L):fo[i])) @@ -123,25 +123,25 @@ linearsearch: bytes = *records >> 3; if ((*records & 07) != 0) - bytes++; + bytes++; index = IntVal(Arg2) * bytes + (rp->recdesc->Proc.recnum - 1) / 8; this_bit = this_bit >> (rp->recdesc->Proc.recnum - 1) % 8; if ((bm[index] | this_bit) != bm[index]) { - fnum = -1; - } + fnum = -1; + } } if (ftabwidth == 1 && fnum == 255) { - RunErr(207, &Arg1); - } + RunErr(207, &Arg1); + } -#else /* FieldTableCompression */ +#else /* FieldTableCompression */ fnum = ftabp[IntVal(Arg2) * *records + Blk(rp->recdesc,Proc)->recnum - 1]; -#endif /* FieldTableCompression */ +#endif /* FieldTableCompression */ #ifdef MultiProgram ENTERPSTATE(thisprog); -#endif /* MultiProgram */ +#endif /* MultiProgram */ } @@ -154,121 +154,121 @@ linearsearch: */ union block *rd = rp->recdesc; if (Blk(rd,Proc)->ndynam == -3) { - struct b_record *rp2; - union block *rd2; - tended struct descrip md; + struct b_record *rp2; + union block *rd2; + tended struct descrip md; #ifdef NativeObjects - if (rd->Proc.ndynam == -3) { - md = rp->fields[rd->Proc.nparam]; /* methods in procedure block */ - } -#else /* NativeObjects */ - if (rd->Proc.ndynam == -3) { - md = rp->fields[1]; /* fields[0] is __s, fields[1] is __m */ - } -#endif /* NativeObjects */ - - if (!is:record(md)) - RunErr(107, &Arg1); - rp2 = BlkD(md, Record); - rd2 = rp2->recdesc; - if (IntVal(Arg2) < 0) { - int nfields = Blk(rd2,Proc)->nfields; - int i; + if (rd->Proc.ndynam == -3) { + md = rp->fields[rd->Proc.nparam]; /* methods in procedure block */ + } +#else /* NativeObjects */ + if (rd->Proc.ndynam == -3) { + md = rp->fields[1]; /* fields[0] is __s, fields[1] is __m */ + } +#endif /* NativeObjects */ + + if (!is:record(md)) + RunErr(107, &Arg1); + rp2 = BlkD(md, Record); + rd2 = rp2->recdesc; + if (IntVal(Arg2) < 0) { + int nfields = Blk(rd2,Proc)->nfields; + int i; #ifdef MultiProgram - if (progtouse) - Arg0 = progtouse->Efnames[IntVal(Arg2)]; - else - RunErr(207, &Arg1); -#else /* MultiProgram */ - Arg0 = efnames[IntVal(Arg2)]; -#endif /* MultiProgram */ - for (i=0;iProc.lnames[i])) && - !strncmp(StrLoc(Arg0), - StrLoc(rd2->Proc.lnames[i]), StrLen(Arg0))) - break; - } - if (iEfnames[IntVal(Arg2)]; + else + RunErr(207, &Arg1); +#else /* MultiProgram */ + Arg0 = efnames[IntVal(Arg2)]; +#endif /* MultiProgram */ + for (i=0;iProc.lnames[i])) && + !strncmp(StrLoc(Arg0), + StrLoc(rd2->Proc.lnames[i]), StrLen(Arg0))) + break; + } + if (iProc.recnum - 1)); - - /* - * Check the bitmap for this entry. If it fails, it converts our - * nice field offset number into -1 (empty/invalid for our row). - */ - { - int bytes, index; - unsigned char this_bit = 0200; - - bytes = *records >> 3; - if ((*records & 07) != 0) - bytes++; - index = IntVal(Arg2) * bytes + (rd2->Proc.recnum - 1) / 8; - this_bit = this_bit >> (rd2->Proc.recnum - 1) % 8; - if ((bm[index] | this_bit) != bm[index]) { - fnum = -1; - } - else { /* bitmap passes test on __m.field */ - } - } -#else /* FieldTableCompression */ - fnum = ftabp[IntVal(Arg2) * *records + rd2->Proc.recnum - 1]; -#endif /* FieldTableCompression */ + fnum = FTAB(FO(IntVal(Arg2)) + (rd2->Proc.recnum - 1)); + + /* + * Check the bitmap for this entry. If it fails, it converts our + * nice field offset number into -1 (empty/invalid for our row). + */ + { + int bytes, index; + unsigned char this_bit = 0200; + + bytes = *records >> 3; + if ((*records & 07) != 0) + bytes++; + index = IntVal(Arg2) * bytes + (rd2->Proc.recnum - 1) / 8; + this_bit = this_bit >> (rd2->Proc.recnum - 1) % 8; + if ((bm[index] | this_bit) != bm[index]) { + fnum = -1; + } + else { /* bitmap passes test on __m.field */ + } + } +#else /* FieldTableCompression */ + fnum = ftabp[IntVal(Arg2) * *records + rd2->Proc.recnum - 1]; +#endif /* FieldTableCompression */ #ifdef MultiProgram - ENTERPSTATE(thisprog); + ENTERPSTATE(thisprog); #endif - } - if (fnum < 0) { - RunErr(207, &Arg1); - } - md = rp2->fields[fnum]; - if (is:record(md)) { - /* - * Make an indirect reference to the current instance, - * overloaded with the superclass' methods vector. - */ - - /* - * Note, these pointers don't need to be tended, because they are - * not used until after allocation is complete. - */ - struct b_record *new_rec; - - Protect(new_rec = alcrecd(2, (union block *)stubrec), RunErr(0,0)); - - /* - * overwrite the __s to point at the original, the __m to point at - * the superclass methods. - */ - new_rec->fields[0] = Arg1; - new_rec->fields[1] = md; - - Arg0 = Arg1; - BlkLoc(Arg0) = (union block *) new_rec; - Return; - } - else { - Arg0 = md; - if (!strcmp(StrLoc(rp->recdesc->Proc.lnames[0]), "__s")) - *((&(Arg0))+1) = rp->fields[0]; - else - *((&(Arg0))+1) = Arg1; - sp++; sp++; - /* - * Bump up the argp; we inserted a "self" object. - */ - field_argp = cargp+1; - Return; - } - } + } + if (fnum < 0) { + RunErr(207, &Arg1); + } + md = rp2->fields[fnum]; + if (is:record(md)) { + /* + * Make an indirect reference to the current instance, + * overloaded with the superclass' methods vector. + */ + + /* + * Note, these pointers don't need to be tended, because they are + * not used until after allocation is complete. + */ + struct b_record *new_rec; + + Protect(new_rec = alcrecd(2, (union block *)stubrec), RunErr(0,0)); + + /* + * overwrite the __s to point at the original, the __m to point at + * the superclass methods. + */ + new_rec->fields[0] = Arg1; + new_rec->fields[1] = md; + + Arg0 = Arg1; + BlkLoc(Arg0) = (union block *) new_rec; + Return; + } + else { + Arg0 = md; + if (!strcmp(StrLoc(rp->recdesc->Proc.lnames[0]), "__s")) + *((&(Arg0))+1) = rp->fields[0]; + else + *((&(Arg0))+1) = Arg1; + sp++; sp++; + /* + * Bump up the argp; we inserted a "self" object. + */ + field_argp = cargp+1; + Return; + } + } RunErr(207, &Arg1); } @@ -284,7 +284,7 @@ linearsearch: Return; } - + /* * mkrec - create a record. */ @@ -292,7 +292,7 @@ linearsearch: LibDcl(mkrec,-1,"mkrec") { register int i, nfld; - struct b_proc *bp; /* not tended, used only prior to alc */ + struct b_proc *bp; /* not tended, used only prior to alc */ tended struct b_record *rp; /* @@ -326,7 +326,7 @@ LibDcl(mkrec,-1,"mkrec") EVValD(&Arg0, E_Rcreate); Return; } - + /* * limit - explicit limitation initialization. */ @@ -350,20 +350,20 @@ LibDcl(limit,2,BackSlash) RunErr(101, &Arg0); MakeInt(tmp,&Arg0); - if (IntVal(Arg0) < 0) + if (IntVal(Arg0) < 0) RunErr(205, &Arg0); if (IntVal(Arg0) == 0) Fail; Return; } - + /* * bscan - set &subject and &pos upon entry to a scanning expression. * * Arguments are: - * Arg0 - new value for &subject - * Arg1 - saved value of &subject - * Arg2 - saved value of &pos + * Arg0 - new value for &subject + * Arg1 - saved value of &subject + * Arg2 - saved value of &pos * * A variable pointing to the saved &subject and &pos is returned to be * used by escan. @@ -403,18 +403,18 @@ LibDcl(bscan,2,"?") */ ArgType(0) = D_Var; VarLoc(Arg0) = &Arg1; -#ifdef TSTATARG +#ifdef TSTATARG rc = interp(G_Csusp,cargp, CURTSTATARG); -#else /* TSTATARG */ +#else /* TSTATARG */ rc = interp(G_Csusp,cargp ); -#endif /* TSTATARG */ +#endif /* TSTATARG */ #if E_Srem || E_Sfail if (rc != A_Resume) EVValD(&Arg1, E_Srem); else EVValD(&Arg1, E_Sfail); -#endif /* E_Srem || E_Sfail */ +#endif /* E_Srem || E_Sfail */ if (pfp != cur_pfp) return rc; @@ -431,7 +431,7 @@ LibDcl(bscan,2,"?") return rc; } - + /* * escan - restore &subject and &pos at the end of a scanning expression. * @@ -487,7 +487,7 @@ LibDcl(escan,1,"escan") k_pos = IntVal(tmp); /* - * If we are returning to the scanning environment of the current + * If we are returning to the scanning environment of the current * procedure call, indicate that it is no longed in a saved state. */ if (pfp->pf_scan == VarLoc(Arg1)) @@ -500,11 +500,11 @@ LibDcl(escan,1,"escan") EVValD(&k_subject, E_Ssusp); -#ifdef TSTATARG +#ifdef TSTATARG rc = interp(G_Csusp,cargp, CURTSTATARG); -#else /* TSTATARG */ +#else /* TSTATARG */ rc = interp(G_Csusp,cargp ); -#endif /* TSTATARG */ +#endif /* TSTATARG */ if (pfp != cur_pfp) return rc; @@ -520,7 +520,7 @@ LibDcl(escan,1,"escan") #if E_Sresum if (rc == A_Resume) EVValD(&k_subject, E_Sresum); -#endif /* E_Sresum */ +#endif /* E_Sresum */ tmp = *(VarLoc(Arg1) + 1); IntVal(*(VarLoc(Arg1) + 1)) = k_pos; @@ -531,4 +531,4 @@ LibDcl(escan,1,"escan") return rc; } -#endif /* !COMPILER */ +#endif /* !COMPILER */ diff --git a/src/runtime/init.r b/src/runtime/init.r index 945bd9267..a9374512a 100644 --- a/src/runtime/init.r +++ b/src/runtime/init.r @@ -9,15 +9,15 @@ #if !COMPILER #include "../h/header.h" -static FILE * readhdr (char *name, struct header *hdr); -#endif /* !COMPILER */ +static FILE * readhdr (char *name, struct header *hdr); +#endif /* !COMPILER */ /* * Prototypes. */ -static void env_err (char *msg, char *name, char *val); -FILE *pathOpen (char *fname, char *mode); +static void env_err (char *msg, char *name, char *val); +FILE *pathOpen (char *fname, char *mode); /* * The following code is operating-system dependent [@init.01]. Declarations @@ -27,17 +27,17 @@ FILE *pathOpen (char *fname, char *mode); #if PORT /* probably needs something more */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MVS || VM || UNIX || VMS /* nothing needed */ -#endif /* MVS ... VMS */ +#endif /* MVS ... VMS */ /* * End of operating-system specific code. */ -char *prog_name; /* name of icode file */ +char *prog_name; /* name of icode file */ TRuntime_Status rt_status; #if !COMPILER @@ -50,100 +50,100 @@ TRuntime_Status rt_status; */ #passthru #define OpDef(f,nargs,sname,underef)\ - {\ - T_Proc,\ - Vsizeof(struct b_proc),\ - Cat(O,f),\ - nargs,\ - -1,\ - underef,\ - 0,\ - {{sizeof(sname)-1,sname}}}, + {\ + T_Proc,\ + Vsizeof(struct b_proc),\ + Cat(O,f),\ + nargs,\ + -1,\ + underef,\ + 0,\ + {{sizeof(sname)-1,sname}}}, #passthru static B_IProc(2) init_op_tbl[] = { #passthru #include "../h/odefs.h" #passthru }; #undef OpDef -#endif /* !COMPILER */ +#endif /* !COMPILER */ /* * A number of important variables follow. */ -int line_info; /* flag: line information is available */ -int versioncheck_only; /* flag: check version and exit */ -char *file_name = NULL; /* source file for current execution point */ +int line_info; /* flag: line information is available */ +int versioncheck_only; /* flag: check version and exit */ +char *file_name = NULL; /* source file for current execution point */ #ifndef MultiProgram -int line_num = 0; /* line number for current execution point */ -#endif /* MultiProgram */ -struct b_proc *op_tbl; /* operators available for string invocation */ +int line_num = 0; /* line number for current execution point */ +#endif /* MultiProgram */ +struct b_proc *op_tbl; /* operators available for string invocation */ -extern struct errtab errtab[]; /* error numbers and messages */ +extern struct errtab errtab[]; /* error numbers and messages */ -word mstksize = MStackSize; /* initial size of main stack */ -word stksize = StackSize; /* co-expression stack size */ +word mstksize = MStackSize; /* initial size of main stack */ +word stksize = StackSize; /* co-expression stack size */ int runtime_status; #ifndef MultiProgram #if !ConcurrentCOMPILER -int k_level = 0; /* &level */ +int k_level = 0; /* &level */ #ifdef PatternType int k_patindex = 0; -#endif /* PatternType */ +#endif /* PatternType */ #endif /* ConcurrentCOMPILER */ -struct descrip k_main; /* &main */ -#endif /* MultiProgram */ +struct descrip k_main; /* &main */ +#endif /* MultiProgram */ -int set_up = 0; /* set-up switch */ -char *currend = NULL; /* current end of memory region */ -word qualsize = QualLstSize; /* size of quallist for fixed regions */ +int set_up = 0; /* set-up switch */ +char *currend = NULL; /* current end of memory region */ +word qualsize = QualLstSize; /* size of quallist for fixed regions */ -word memcushion = RegionCushion; /* memory region cushion factor */ -word memgrowth = RegionGrowth; /* memory region growth factor */ +word memcushion = RegionCushion; /* memory region cushion factor */ +word memgrowth = RegionGrowth; /* memory region growth factor */ -uword stattotal = 0; /* cumulative total static allocatn. */ +uword stattotal = 0; /* cumulative total static allocatn. */ #if !(defined(MultiProgram) || ConcurrentCOMPILER) -uword strtotal = 0; /* cumulative total string allocatn. */ -uword blktotal = 0; /* cumulative total block allocation */ -#endif /* !(MultiProgram|ConcurrentCOMPILER) */ +uword strtotal = 0; /* cumulative total string allocatn. */ +uword blktotal = 0; /* cumulative total block allocation */ +#endif /* !(MultiProgram|ConcurrentCOMPILER) */ -int dodump; /* if nonzero, core dump on error */ -int noerrbuf; /* if nonzero, do not buffer stderr */ +int dodump; /* if nonzero, core dump on error */ +int noerrbuf; /* if nonzero, do not buffer stderr */ #ifndef Concurrent -struct descrip maps2; /* second cached argument of map */ -struct descrip maps3; /* third cached argument of map */ +struct descrip maps2; /* second cached argument of map */ +struct descrip maps3; /* third cached argument of map */ #endif /* Concurrent */ #if !(defined(MultiProgram) || ConcurrentCOMPILER) -struct descrip k_current; /* current expression stack pointer */ -int k_errornumber = 0; /* &errornumber */ -struct descrip k_errortext = {0,(word)""}; /* &errortext */ -struct descrip k_errorvalue; /* &errorvalue */ -int have_errval = 0; /* &errorvalue has legal value */ -int t_errornumber = 0; /* tentative k_errornumber value */ -int t_have_val = 0; /* tentative have_errval flag */ -struct descrip t_errorvalue; /* tentative k_errorvalue value */ -#endif /* !(MultiProgram|ConcurrentCOMPILER) */ - -struct b_coexpr *stklist; /* base of co-expression block list */ +struct descrip k_current; /* current expression stack pointer */ +int k_errornumber = 0; /* &errornumber */ +struct descrip k_errortext = {0,(word)""}; /* &errortext */ +struct descrip k_errorvalue; /* &errorvalue */ +int have_errval = 0; /* &errorvalue has legal value */ +int t_errornumber = 0; /* tentative k_errornumber value */ +int t_have_val = 0; /* tentative have_errval flag */ +struct descrip t_errorvalue; /* tentative k_errorvalue value */ +#endif /* !(MultiProgram|ConcurrentCOMPILER) */ + +struct b_coexpr *stklist; /* base of co-expression block list */ #ifndef Concurrent /* or never? */ struct tend_desc *tend = NULL; /* chain of tended descriptors */ -#endif /* Concurrent */ +#endif /* Concurrent */ struct region rootstring, rootblock; #ifndef MultiProgram #if !ConcurrentCOMPILER -dptr glbl_argp = NULL; /* argument pointer */ +dptr glbl_argp = NULL; /* argument pointer */ #endif /* ConcurrentCOMPILER */ -dptr globals, eglobals; /* pointer to global variables */ -dptr gnames, egnames; /* pointer to global variable names */ -dptr estatics; /* pointer to end of static variables */ +dptr globals, eglobals; /* pointer to global variables */ +dptr gnames, egnames; /* pointer to global variable names */ +dptr estatics; /* pointer to end of static variables */ struct region *curstring, *curblock; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if defined(MultiProgram) || ConcurrentCOMPILER @@ -152,41 +152,41 @@ struct region *curstring, *curblock; struct threadstate *global_curtstate; #ifdef HAVE_KEYWORD__THREAD - #passthru __thread struct threadstate roottstate; + #passthru __thread struct threadstate roottstate; #passthru __thread struct threadstate *curtstate; -#else /* HAVE_KEYWORD__THREAD */ +#else /* HAVE_KEYWORD__THREAD */ + struct threadstate roottstate; +#endif /* HAVE_KEYWORD__THREAD */ +#else /* Concurrent */ struct threadstate roottstate; -#endif /* HAVE_KEYWORD__THREAD */ -#else /* Concurrent */ - struct threadstate roottstate; struct threadstate *curtstate; -#endif /* Concurrent */ -#endif /* MultiProgram || ConcurrentCOMPILER */ +#endif /* Concurrent */ +#endif /* MultiProgram || ConcurrentCOMPILER */ #if COMPILER #if !ConcurrentCOMPILER -struct p_frame *pfp = NULL; /* procedure frame pointer */ +struct p_frame *pfp = NULL; /* procedure frame pointer */ #endif /* ConcurrentCOMPILER */ -int debug_info; /* flag: is debugging info available */ -int err_conv; /* flag: is error conversion supported */ -int largeints; /* flag: large integers are supported */ +int debug_info; /* flag: is debugging info available */ +int err_conv; /* flag: is error conversion supported */ +int largeints; /* flag: large integers are supported */ -struct b_coexpr *mainhead; /* &main */ +struct b_coexpr *mainhead; /* &main */ -#else /* COMPILER */ +#else /* COMPILER */ -int debug_info=1; /* flag: debugging information IS available */ -int err_conv=1; /* flag: error conversion IS supported */ +int debug_info=1; /* flag: debugging information IS available */ +int err_conv=1; /* flag: error conversion IS supported */ int op_tbl_sz = (sizeof(init_op_tbl) / sizeof(struct b_proc)); #ifndef MaxHeader #define MaxHeader MaxHdr -#endif /* MaxHeader */ +#endif /* MaxHeader */ #ifdef OVLD - int *OpTab; /* pointer to op2fieldnum table */ + int *OpTab; /* pointer to op2fieldnum table */ #endif #endif /* COMPILER */ @@ -201,49 +201,49 @@ struct region *Public_blockregion; word mutexid_stringtotal; word mutexid_blocktotal; word mutexid_coll; -#else /* ConcurrentCOMPILER */ +#else /* ConcurrentCOMPILER */ struct progstate *curpstate; struct progstate rootpstate; -#endif /* ConcurrentCOMPILER */ -#endif /* MultiProgram */ +#endif /* ConcurrentCOMPILER */ +#endif /* MultiProgram */ #ifndef MultiProgram -struct b_coexpr *mainhead; /* &main */ +struct b_coexpr *mainhead; /* &main */ -char *code; /* interpreter code buffer */ -char *endcode; /* end of interpreter code buffer */ -word *records; /* pointer to record procedure blocks */ +char *code; /* interpreter code buffer */ +char *endcode; /* end of interpreter code buffer */ +word *records; /* pointer to record procedure blocks */ -int *ftabp; /* pointer to record/field table */ +int *ftabp; /* pointer to record/field table */ #ifdef FieldTableCompression -word ftabwidth; /* field table entry width */ -word foffwidth; /* field offset entry width */ -unsigned char *ftabcp, *focp; /* pointers to record/field table */ -unsigned short *ftabsp, *fosp; /* pointers to record/field table */ +word ftabwidth; /* field table entry width */ +word foffwidth; /* field offset entry width */ +unsigned char *ftabcp, *focp; /* pointers to record/field table */ +unsigned short *ftabsp, *fosp; /* pointers to record/field table */ -int *fo; /* field offset (row in field table) */ -char *bm; /* bitmap array of valid field bits */ -#endif /* FieldTableCompression */ +int *fo; /* field offset (row in field table) */ +char *bm; /* bitmap array of valid field bits */ +#endif /* FieldTableCompression */ -dptr fnames, efnames; /* pointer to field names */ +dptr fnames, efnames; /* pointer to field names */ #if !COMPILER /* in generated code */ -dptr statics; /* pointer to static variables */ -#endif /* !COMPILER */ -char *strcons; /* pointer to string constant table */ -struct ipc_fname *filenms, *efilenms; /* pointer to ipc/file name table */ -struct ipc_line *ilines, *elines; /* pointer to ipc/line number table */ -#endif /* MultiProgram */ +dptr statics; /* pointer to static variables */ +#endif /* !COMPILER */ +char *strcons; /* pointer to string constant table */ +struct ipc_fname *filenms, *efilenms; /* pointer to ipc/file name table */ +struct ipc_line *ilines, *elines; /* pointer to ipc/line number table */ +#endif /* MultiProgram */ #ifdef TallyOpt -word tallybin[16]; /* counters for tallying */ -int tallyopt = 0; /* want tally results output? */ -#endif /* TallyOpt */ +word tallybin[16]; /* counters for tallying */ +int tallyopt = 0; /* want tally results output? */ +#endif /* TallyOpt */ #ifdef ExecImages -int dumped = 0; /* non-zero if reloaded from dump */ -#endif /* ExecImages */ +int dumped = 0; /* non-zero if reloaded from dump */ +#endif /* ExecImages */ #ifdef MultipleRuns extern word coexp_ser; @@ -252,7 +252,7 @@ extern word intern_list_ser; extern word set_ser; extern word table_ser; extern int first_time; -#endif /* MultipleRuns */ +#endif /* MultipleRuns */ #if NT WSADATA wsaData; @@ -298,21 +298,21 @@ int get_num_cpu_cores() { #if !COMPILER -int fdgets(int fd, char *buf, size_t count) +int fdgets(int fd, char *buf, size_t count) { int i, rrv; char *temp=buf; for (i=0;i sizeof(tname)) @@ -410,42 +410,42 @@ struct header *hdr; strcat(tname,IcodeSuffix); #if MSDOS - fdname = pathOpenHandle(tname,ReadBinary); /* try to find path */ -#else /* MSDOS */ + fdname = pathOpenHandle(tname,ReadBinary); /* try to find path */ +#else /* MSDOS */ fdname = open(tname,O_RDONLY); -#endif /* MSDOS */ +#endif /* MSDOS */ #if NT /* * tried appending .exe, now try .bat or .cmd */ if (fdname == -1) { - strcpy(tname,name); - if (strcmp(".bat", name + n - 4)) - strcat(tname,".bat"); - fdname = pathOpenHandle(tname, ReadBinary); - if (fdname == -1) { - strcpy(tname,name); - if (strcmp(".cmd", name + n - 4)) - strcat(tname,".cmd"); - fdname = pathOpenHandle(tname, ReadBinary); + strcpy(tname,name); + if (strcmp(".bat", name + n - 4)) + strcat(tname,".bat"); + fdname = pathOpenHandle(tname, ReadBinary); + if (fdname == -1) { + strcpy(tname,name); + if (strcmp(".cmd", name + n - 4)) + strcat(tname,".cmd"); + fdname = pathOpenHandle(tname, ReadBinary); } - } -#endif /* NT */ + } +#endif /* NT */ } - if (fdname == -1) /* try the name as given */ + if (fdname == -1) /* try the name as given */ #if MSDOS fdname = pathOpenHandle(name, ReadBinary); -#else /* MSDOS */ +#else /* MSDOS */ fdname = open(name, O_RDONLY); -#endif /* MSDOS */ +#endif /* MSDOS */ #if MSDOS } /* end if (n >= 4 && !stricmp(".exe", name + n - 4)) */ -#endif /* MSDOS */ +#endif /* MSDOS */ if (fdname == -1) return NULL; @@ -499,10 +499,10 @@ struct header *hdr; #endif if (lseek(fdname, offset, SEEK_SET) == (off_t)-1) error(name, errmsg); - while ((n = dgetc(fdname)) != EOF && n != '\f') { /* read thru \f\n\0 */ + while ((n = dgetc(fdname)) != EOF && n != '\f') { /* read thru \f\n\0 */ if ((n != ' ') && (n != '\n') && (n != '\015')) { - error(name, "bad file format (unexpected chars) after sentinel string"); - } + error(name, "bad file format (unexpected chars) after sentinel string"); + } offset++; } if ((n=dgetc(fdname)) != '\n') { @@ -514,14 +514,14 @@ struct header *hdr; offset += 3; /* \f\n\0 */ precode = filebuffer + offset + sizeof(*hdr); -#else /* ShellHeader */ +#else /* ShellHeader */ #if HAVE_LIBZ deliberate syntax errror -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ if (fseek(fname, (long)MaxHeader, 0) == -1) error(name, errmsg); -#endif /* ShellHeader */ -#endif /* Header */ +#endif /* ShellHeader */ +#endif /* Header */ if (read(fdname,(char *)hdr, sizeof(*hdr)) != sizeof(*hdr)) error(name, errmsg); @@ -533,7 +533,7 @@ deliberate syntax errror */ if (strncmp((char *)hdr->config, IVersion, strlen(IVersion)) || ((((char *)hdr->config)[strlen(IVersion)]) && - strcmp(((char *)hdr->config) + strlen(IVersion), "Z")) ) { + strcmp(((char *)hdr->config) + strlen(IVersion), "Z")) ) { fprintf(stderr,"icode version mismatch in %s\n", name); fprintf(stderr,"\ticode version: %s\n",(char *)hdr->config); fprintf(stderr,"\texpected version: %s\n",IVersion); @@ -558,18 +558,18 @@ deliberate syntax errror return (FILE *)gzdopen(fdname,"rb"); } else -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ return fdopen(fdname,"rb"); } -#endif /* !COMPILER */ - +#endif /* !COMPILER */ + /* * init/icon_init - initialize memory and prepare for Icon execution. */ #if !COMPILER struct header hdr; -#endif /* !COMPILER */ +#endif /* !COMPILER */ #ifdef HELPER_THREAD pthread_t helper_thread; @@ -588,11 +588,11 @@ void * helper_thread_work(void * data){ void init_helper_thread(){ int i; - if (pthread_create(&helper_thread, NULL, helper_thread_work, (void *)&i) != 0) + if (pthread_create(&helper_thread, NULL, helper_thread_work, (void *)&i) != 0) syserr("cannot create helper thread"); } -#endif /* HELPER_THREAD */ +#endif /* HELPER_THREAD */ @@ -601,7 +601,7 @@ void init_threadstate( struct threadstate *ts) #ifdef Concurrent ts->tid = pthread_self(); ts->Pollctr=0; - + /* used in fmath.r, log() */ ts->Lastbase=0.0; @@ -611,18 +611,18 @@ void init_threadstate( struct threadstate *ts) #ifdef PosixFns ts->Nsaved=0; -#endif /* PosixFns */ +#endif /* PosixFns */ #else #if !COMPILER ts->Lastop = 0; -#endif /* !COMPILER */ -#endif /* Concurrent */ +#endif /* !COMPILER */ +#endif /* Concurrent */ ts->Glbl_argp = NULL; ts->Eret_tmp = nulldesc; #if !COMPILER ts->Value_tmp = nulldesc; -#endif /* !COMPILER */ +#endif /* !COMPILER */ MakeInt(1, &(ts->Kywd_pos)); StrLen(ts->ksub) = 0; @@ -640,7 +640,7 @@ void init_threadstate( struct threadstate *ts) ts->T_errorvalue = nulldesc; #ifdef PosixFns ts->AmperErrno = zerodesc; -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef PatternType ts->K_patindex = 0; @@ -652,20 +652,20 @@ void init_threadstate( struct threadstate *ts) #if 0 ts->c->es_ipc.opnd = NULL; - ts->c->es_efp=NULL; /* Expression frame pointer */ - ts->c->es_gfp=NULL; /* Generator frame pointer */ - ts->c->es_pfp=NULL; /* procedure frame pointer */ - ts->c->es_sp = NULL; /* Stack pointer */ - ts->c->es_ilevel=0; /* Depth of recursion in interp() */ + ts->c->es_efp=NULL; /* Expression frame pointer */ + ts->c->es_gfp=NULL; /* Generator frame pointer */ + ts->c->es_pfp=NULL; /* procedure frame pointer */ + ts->c->es_sp = NULL; /* Stack pointer */ + ts->c->es_ilevel=0; /* Depth of recursion in interp() */ #endif #ifndef StackCheck - ts->Stack=NULL; /* Interpreter stack */ - ts->Stackend=NULL; /* End of interpreter stack */ -#endif /* StackCheck */ + ts->Stack=NULL; /* Interpreter stack */ + ts->Stackend=NULL; /* End of interpreter stack */ +#endif /* StackCheck */ -#endif /* !COMPILER */ +#endif /* !COMPILER */ ts->Line_num = ts->Column = ts->Lastline = ts->Lastcol = 0; @@ -676,20 +676,20 @@ void init_threadstate( struct threadstate *ts) ts->Curblock = NULL; ts->stringtotal=0; ts->blocktotal=0; - + #ifdef SoftThreads ts->sthrd_size = 0; - ts->sthrd_tick = 0; + ts->sthrd_tick = 0; ts->sthrd_cur = 0; ts->owner = ts->c ; /* the co-expression where the thread spawned */ -#endif /* LW_Threads */ +#endif /* LW_Threads */ -#endif /* Concurrent */ +#endif /* Concurrent */ } #ifdef MultiProgram void init_progstate(struct progstate *pstate); -#endif /* MutliThread */ +#endif /* MutliThread */ #if COMPILER void init(name, argcp, argv, trc_init) @@ -697,54 +697,54 @@ char *name; int *argcp; char *argv[]; int trc_init; -#else /* COMPILER */ +#else /* COMPILER */ void icon_init(name, argcp, argv) char *name; int *argcp; char *argv[]; -#endif /* COMPILER */ +#endif /* COMPILER */ { #if !COMPILER FILE *fname = 0; -#endif /* COMPILER */ +#endif /* COMPILER */ #if defined(Concurrent) && !defined(HAVE_KEYWORD__THREAD) struct threadstate *curtstate; -#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ +#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ - prog_name = name; /* Set icode file name */ + prog_name = name; /* Set icode file name */ #if defined(HAVE_LIBPTHREAD) && (defined(Concurrent) || defined(PthreadCoswitch)) && !defined(SUN) pthread_rwlock_init(&__environ_lock, NULL); -#endif /*HAVE_LIBPTHREAD && !SUN */ +#endif /*HAVE_LIBPTHREAD && !SUN */ num_cpu_cores = get_num_cpu_cores(); #if COMPILER && !defined(Concurrent) curstring = &rootstring; curblock = &rootblock; -#else /* COMPILER && !Concurrent */ +#else /* COMPILER && !Concurrent */ #ifdef MultiProgram - + /* * initialize root pstate */ curpstate = &rootpstate; rootpstate.next = NULL; init_progstate(curpstate); -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if defined(MultiProgram) || ConcurrentCOMPILER curtstate = &roottstate; #ifdef MultiProgram rootpstate.tstate = curtstate; -#endif /* MultiProgram */ +#endif /* MultiProgram */ init_threadstate(curtstate); #if defined(Concurrent) && !defined(HAVE_KEYWORD__THREAD) pthread_setspecific(tstate_key, (void *) curtstate); -#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ +#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ #ifdef MultiProgram StrLen(rootpstate.Kywd_prog) = strlen(prog_name); @@ -755,16 +755,16 @@ char *argv[]; rootpstate.stringregion = &rootstring; rootpstate.blockregion = &rootblock; #endif /* MultiProgram */ -#endif /* COMPILER && !Concurrent */ +#endif /* COMPILER && !Concurrent */ #ifdef Concurrent global_curtstate = curtstate; - /* - * The heaps for root are handled differently (allocated already). - * This replaces a call to init_threadheap(curtstate, , ,) - */ + /* + * The heaps for root are handled differently (allocated already). + * This replaces a call to init_threadheap(curtstate, , ,) + */ curtstate->Curstring = &rootstring; curtstate->Curblock = &rootblock; @@ -784,23 +784,23 @@ MUTEX_LOCKID(MTX_PUBLICBLKHEAP); Public_blockregion = NULL; MUTEX_UNLOCKID(MTX_PUBLICSTRHEAP); MUTEX_UNLOCKID(MTX_PUBLICBLKHEAP); -#else /* ConcurrentCOMPILER */ +#else /* ConcurrentCOMPILER */ rootpstate.Public_stringregion = NULL; rootpstate.Public_blockregion = NULL; -#endif /* ConcurrentCOMPILER */ -#endif /* Concurrent */ +#endif /* ConcurrentCOMPILER */ +#endif /* Concurrent */ #ifndef MultiProgram curstring = &rootstring; curblock = &rootblock; init_sighandlers(); -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if !COMPILER op_tbl = (struct b_proc*)init_op_tbl; -#endif /* !COMPILER */ +#endif /* !COMPILER */ -#endif /* COMPILER && !Concurrent */ +#endif /* COMPILER && !Concurrent */ rootstring.size = MaxStrSpace; rootblock.size = MaxAbrSize; @@ -811,22 +811,22 @@ MUTEX_UNLOCKID(MTX_PUBLICBLKHEAP); */ { unsigned long l, twopercent; if ((l = memorysize(1))) { - twopercent = l * 2 / 100; - if (rootstring.size < twopercent) rootstring.size = twopercent; - if (rootblock.size < twopercent) rootblock.size = twopercent; - if (mstksize < (twopercent / 4) / WordSize) { - mstksize = (twopercent / 4) / WordSize; - } - if (stksize < (twopercent / 100) / WordSize) { - stksize = (twopercent / 100) / WordSize; - } - } + twopercent = l * 2 / 100; + if (rootstring.size < twopercent) rootstring.size = twopercent; + if (rootblock.size < twopercent) rootblock.size = twopercent; + if (mstksize < (twopercent / 4) / WordSize) { + mstksize = (twopercent / 4) / WordSize; + } + if (stksize < (twopercent / 100) / WordSize) { + stksize = (twopercent / 100) / WordSize; + } + } } #ifdef Double if (sizeof(struct size_dbl) != sizeof(double)) syserr("Icon configuration does not handle double alignment"); -#endif /* Double */ +#endif /* Double */ /* * Catch floating-point traps and memory faults. @@ -839,18 +839,18 @@ MUTEX_UNLOCKID(MTX_PUBLICBLKHEAP); #if PORT /* probably needs something */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS #if MICROSOFT || TURBO signal(SIGFPE, SigFncCast fpetrap); -#endif /* MICROSOFT || TURBO */ -#endif /* MSDOS */ +#endif /* MICROSOFT || TURBO */ +#endif /* MSDOS */ #if UNIX || VMS signal(SIGSEGV, SigFncCast segvtrap); signal(SIGFPE, SigFncCast fpetrap); -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ /* * End of operating-system specific code. @@ -864,8 +864,8 @@ Deliberate Syntax Error */ if (dumped) goto btinit; -#endif /* ExecImages */ -#endif /* COMPILER */ +#endif /* ExecImages */ +#endif /* COMPILER */ /* * Initialize data that can't be initialized statically. @@ -875,7 +875,7 @@ Deliberate Syntax Error #if COMPILER IntVal(kywd_trc) = trc_init; -#endif /* COMPILER */ +#endif /* COMPILER */ #if !COMPILER fname = readhdr(name,&hdr); @@ -885,7 +885,7 @@ Deliberate Syntax Error MakeInt(hdr.trace, &(kywd_trc)); -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Examine the environment and make appropriate settings. [[I?]] @@ -904,17 +904,17 @@ Deliberate Syntax Error */ #if COMPILER initalloc(); -#else /* COMPILER */ +#else /* COMPILER */ #ifdef MultiProgram initalloc(hdr.hsize,&rootpstate); -#else /* MultiProgram */ +#else /* MultiProgram */ initalloc(hdr.hsize); -#endif /* MultiProgram */ -#endif /* COMPILER */ +#endif /* MultiProgram */ +#endif /* COMPILER */ #if !COMPILER /* - * Establish pointers to icode data regions. [[I?]] + * Establish pointers to icode data regions. [[I?]] */ endcode = code + hdr.Records; #ifdef OVLD @@ -939,7 +939,7 @@ Deliberate Syntax Error foffwidth = hdr.FoffWidth; ftabcp = (unsigned char *)(code + hdr.Ftab); ftabsp = (unsigned short *)(code + hdr.Ftab); -#endif /* FieldTableCompression */ +#endif /* FieldTableCompression */ fnames = (dptr)(code + hdr.Fnames); globals = efnames = (dptr)(code + hdr.Globals); gnames = eglobals = (dptr)(code + hdr.Gnames); @@ -952,7 +952,7 @@ Deliberate Syntax Error strcons = (char *)elines; n_globals = eglobals - globals; n_statics = estatics - statics; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Allocate stack and initialize &main. @@ -960,54 +960,54 @@ Deliberate Syntax Error #if COMPILER mainhead = (struct b_coexpr *)malloc((msize)sizeof(struct b_coexpr)); -#else /* COMPILER */ +#else /* COMPILER */ #ifdef StackCheck mainhead = (struct b_coexpr *)malloc((msize)mstksize); -#else /* StackCheck */ +#else /* StackCheck */ stack = (word *)malloc((msize)mstksize); mainhead = (struct b_coexpr *)stack; -#endif /* StackCheck */ -#endif /* COMPILER */ +#endif /* StackCheck */ +#endif /* COMPILER */ if (mainhead == NULL) #if COMPILER err_msg(305, NULL); -#else /* COMPILER */ +#else /* COMPILER */ fatalerr(303, NULL); -#endif /* COMPILER */ +#endif /* COMPILER */ mainhead->title = T_Coexpr; - mainhead->size = 1; /* pretend main() does an activation */ + mainhead->size = 1; /* pretend main() does an activation */ mainhead->id = 1; mainhead->nextstk = NULL; mainhead->es_tend = NULL; mainhead->tvalloc = NULL; - mainhead->freshblk = nulldesc; /* &main has no refresh block. */ + mainhead->freshblk = nulldesc; /* &main has no refresh block. */ mainhead->tvalloc = NULL; #ifdef StackCheck mainhead->es_stack = (word *)(mainhead+1); -#endif /* StackCheck */ - /* This really is a bug. */ +#endif /* StackCheck */ + /* This really is a bug. */ #ifdef MultiProgram mainhead->program = &rootpstate; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if defined(MultiProgram) || ConcurrentCOMPILER curtstate->c=mainhead; #ifdef SoftThreads curtstate->owner=mainhead; curtstate->c->sthrd_tick = SOFT_THREADS_TSLICE; -#endif /* SoftThreads */ -#endif /* MultiProgram || ConcurrentCOMPILER */ +#endif /* SoftThreads */ +#endif /* MultiProgram || ConcurrentCOMPILER */ #if COMPILER mainhead->es_pfp = NULL; mainhead->file_name = ""; mainhead->line_num = 0; -#endif /* COMPILER */ +#endif /* COMPILER */ #ifdef CoExpr Protect(mainhead->es_actstk = alcactiv(), fatalerr(0,NULL)); pushact(mainhead, mainhead); -#endif /* CoExpr */ +#endif /* CoExpr */ /* * Point &main at the co-expression block for the main procedure and set @@ -1019,13 +1019,13 @@ Deliberate Syntax Error mainhead->status = Ts_Main | Ts_Attached | Ts_Async; #ifdef Concurrent - thread_call=0; /* The thread who requested a GC */ - NARthreads=1; /* Number of Async Running threads*/ + thread_call=0; /* The thread who requested a GC */ + NARthreads=1; /* Number of Async Running threads*/ if (alcce_queues(mainhead) == Failed) fatalerr(307, NULL); -#endif /* Concurrent */ - +#endif /* Concurrent */ + #ifdef PthreadCoswitch /* @@ -1036,20 +1036,20 @@ Deliberate Syntax Error mainhead->thread = pthread_self(); mainhead->alive = 1; #ifdef Concurrent - /* + /* * This is the first node in the chain. It will be always the first. * New nodes will be added to the end of the chain, setting roottstate.prev - * to point to the last node will make it easy to add at the end. The chain + * to point to the last node will make it easy to add at the end. The chain * is circular in one direction, backward, but not forward. * No need to lock TLS chain since only main is running. */ - roottstate.prev = &roottstate; + roottstate.prev = &roottstate; roottstate.next = NULL; mainhead->isProghead = 1; mainhead->tstate = &roottstate; -#endif /* Concurrent */ +#endif /* Concurrent */ } -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ #if !COMPILER /* @@ -1059,15 +1059,15 @@ Deliberate Syntax Error #if HAVE_LIBZ word cbread; if ((cbread = gzlongread(code, sizeof(char), (long)hdr.hsize, fname)) != - hdr.hsize) { - fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n", - (long)hdr.hsize,(long)cbread); - error(name, "bad icode file"); - } + hdr.hsize) { + fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n", + (long)hdr.hsize,(long)cbread); + error(name, "bad icode file"); + } gzclose(fname); -#else /* HAVE_LIBZ */ +#else /* HAVE_LIBZ */ error(name, "this VM can't read compressed icode"); -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ } /* Don't need to decompress */ else { @@ -1075,7 +1075,7 @@ Deliberate Syntax Error free(filebuffer); fclose(fname); } -#endif /* !COMPILER */ +#endif /* !COMPILER */ /* * Initialize the event monitoring system, if configured. @@ -1083,7 +1083,7 @@ Deliberate Syntax Error #ifdef MultiProgram EVInit(); -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* this is the end of yonggang's compressed icode else-branch ! */ @@ -1096,8 +1096,8 @@ Deliberate Syntax Error redirect(argcp, argv, 0); #ifdef KeyboardFncs assign_channel_to_terminal(); -#endif /* KeyboardFncs */ -#endif /* VMS */ +#endif /* KeyboardFncs */ +#endif /* VMS */ #if !COMPILER /* @@ -1105,15 +1105,15 @@ Deliberate Syntax Error */ #ifdef MultiProgram resolve(NULL); -#else /* MultiProgram */ +#else /* MultiProgram */ resolve(); -#endif /* MultiProgram */ -#endif /* COMPILER */ +#endif /* MultiProgram */ +#endif /* COMPILER */ #if !COMPILER #ifdef ExecImages btinit: -#endif /* ExecImages */ +#endif /* ExecImages */ { #define LONGEST_DR_NUM 16 @@ -1130,7 +1130,7 @@ btinit: stubrec->ndynam = -3; /* oh, let's pretend we're an object */ } -#endif /* COMPILER */ +#endif /* COMPILER */ /* * The following code is operating-system dependent [@init.03]. Allocate and @@ -1140,7 +1140,7 @@ btinit: #if PORT /* probably nothing */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if UNIX || VMS if (noerrbuf) @@ -1150,10 +1150,10 @@ Deliberate Syntax Error buf = (char *)malloc((msize)BUFSIZ); if (buf == NULL) - fatalerr(305, NULL); + fatalerr(305, NULL); setbuf(stderr, buf); } -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ #if MSDOS if (noerrbuf) @@ -1162,11 +1162,11 @@ Deliberate Syntax Error #ifndef MSWindows char *buf = (char *)malloc((msize)BUFSIZ); if (buf == NULL) - fatalerr(305, NULL); + fatalerr(305, NULL); setbuf(stderr, buf); -#endif /* MSWindows */ +#endif /* MSWindows */ } -#endif /* MSDOS */ +#endif /* MSDOS */ /* * End of operating-system specific code. @@ -1174,7 +1174,7 @@ Deliberate Syntax Error #ifdef HELPER_THREAD init_helper_thread(); -#endif /* HELPER_THREAD */ +#endif /* HELPER_THREAD */ #if NT && (WINVER>=0x0501) { @@ -1191,7 +1191,7 @@ Deliberate Syntax Error fprintf(stderr, "WSAStartup failed with error: %d\n", err); } - /* + /* * Confirm that the WinSock DLL supports 2.2. * Note that if the DLL supports versions greater * than 2.2 in addition to 2.2, it will still return @@ -1208,7 +1208,7 @@ Deliberate Syntax Error /* The Winsock DLL is acceptable. Proceed to use it. */ } -#endif /* NT && WINVER<=0x0501 */ +#endif /* NT && WINVER<=0x0501 */ /* * Start timing execution. @@ -1238,12 +1238,12 @@ void envset() env_int(HEAPSIZE, &abrsize, 1, (uword)MaxBlock); #ifndef BSD_4_4_LITE env_int(BLOCKSIZE, &abrsize, 1, (uword)MaxBlock); /* synonym */ -#endif /* BSD_4_4_LITE */ +#endif /* BSD_4_4_LITE */ env_int(BLKSIZE, &abrsize, 1, (uword)MaxBlock); /* synonym */ env_int(MSTKSIZE, &mstksize, 1, (uword)MaxUnsigned); env_int(QLSIZE, &qualsize, 1, (uword)MaxBlock); - env_int("IXCUSHION", &memcushion, 1, (uword)100); /* max 100 % */ - env_int("IXGROWTH", &memgrowth, 1, (uword)10000); /* max 100x growth */ + env_int("IXCUSHION", &memcushion, 1, (uword)100); /* max 100 % */ + env_int("IXGROWTH", &memgrowth, 1, (uword)10000); /* max 100x growth */ #ifdef VerifyHeap env_int("VRFY", &vrfy, 0, (uword)0); /* Bit significant verify flags */ @@ -1258,11 +1258,11 @@ void envset() #if PORT /* nothing to do */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || MVS || UNIX || VM || VMS /* nothing to do */ -#endif /* MSDOS || ... */ +#endif /* MSDOS || ... */ /* * End of operating-system specific code. @@ -1278,21 +1278,21 @@ Deliberate Syntax Error #if PORT /* can't handle */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS #if TURBO signal(SIGFPE, SIG_DFL); -#endif /* TURBO */ -#endif /* MSDOS */ +#endif /* TURBO */ +#endif /* MSDOS */ #if MVS || VM /* Really nothing to do. */ -#endif /* MVS || VM */ +#endif /* MVS || VM */ #if UNIX || VMS signal(SIGSEGV, SIG_DFL); -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ /* * End of operating-system specific code. @@ -1340,7 +1340,7 @@ uword limit; value = s = sbuf; if (*s == '-') { if (non_neg) - env_err("environment variable out of range", name, value); + env_err("environment variable out of range", name, value); sign = -1; ++s; } @@ -1352,14 +1352,14 @@ uword limit; * See if 10 * n + d > limit, but do it so there can be no overflow. */ if ((d > (uword)(limit / 10 - n) * 10 + limit % 10) && (limit > 0)) - env_err("environment variable out of range", name, value); + env_err("environment variable out of range", name, value); n = n * 10 + d; } if (*s != '\0') env_err("environment variable not numeric", name, value); *variable = sign * n; } - + /* * Termination routines. */ @@ -1381,7 +1381,7 @@ void inttrap() { fatalerr(320, NULL); } - + /* * Produce run-time error 302 on segmentation faults. */ @@ -1390,7 +1390,7 @@ void segvtrap() static int n = 0; MUTEX_LOCKID_CONTROLLED(MTX_SEGVTRAP_N); - if (n != 0) { /* only try traceback once */ + if (n != 0) { /* only try traceback once */ fprintf(stderr, "[Traceback failed]\n"); MUTEX_UNLOCKID(MTX_SEGVTRAP_N); exit(1); @@ -1403,7 +1403,7 @@ void segvtrap() #ifdef Concurrent int is_startup_error; -#endif /* Concurrent */ +#endif /* Concurrent */ /* * error - print error message from s1 and s2; used only in startup code. @@ -1421,7 +1421,7 @@ char *s1, *s2; #ifdef Concurrent is_startup_error = 1; -#endif /* Concurrent */ +#endif /* Concurrent */ if (dodump) abort(); c_exit(EXIT_FAILURE); @@ -1451,11 +1451,11 @@ char *s; else { #if COMPILER if (line_info) - fprintf(stderr, " at line %d in %s", line_num, file_name); -#else /* COMPILER */ + fprintf(stderr, " at line %d in %s", line_num, file_name); +#else /* COMPILER */ fprintf(stderr, " at line %ld in %s", (long)findline(ipc.opnd), - findfile(ipc.opnd)); -#endif /* COMPILER */ + findfile(ipc.opnd)); +#endif /* COMPILER */ } fprintf(stderr, "\n%s\n", s); @@ -1479,17 +1479,17 @@ int i; #ifdef ConsoleWindow #ifdef ScrollingConsoleWin char *msg = "Click the \"x\" to close console..."; -#else /* ScrollingConsoleWin */ +#else /* ScrollingConsoleWin */ char *msg = "Strike any key to close console..."; -#endif /* ScrollingConsoleWin */ -#endif /* ConsoleWindow */ +#endif /* ScrollingConsoleWin */ +#endif /* ConsoleWindow */ CURTSTATE_AND_CE(); #if E_Exit if (curpstate != NULL) EVVal((word)i, E_Exit); -#endif /* E_Exit */ +#endif /* E_Exit */ #ifdef MultiProgram /* * A loaded program is calling c_exit. Usually this will be due to a @@ -1504,17 +1504,17 @@ int i; */ co_chng(curpstate->parent->Mainhead, NULL, &dummy, A_Cofail, 1); } -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef Concurrent - /* - * make sure no other thread is running, we are about to do - * some cleanup and free memory so it wont be safe to leave - * any other thread running after this point. - */ - if (!is_startup_error) + /* + * make sure no other thread is running, we are about to do + * some cleanup and free memory so it wont be safe to leave + * any other thread running after this point. + */ + if (!is_startup_error) thread_control(TC_KILLALLTHREADS); -#endif /* Concurrent */ +#endif /* Concurrent */ #if UNIX && defined(HAVE_WORKING_VFORK) clear_all_filepids(); @@ -1523,7 +1523,7 @@ int i; #if defined(Audio) && defined(HAVE_LIBOPENAL) if (isPlaying != -1) audio_exit(); -#endif /* Audio && HAVE_LIBOPENAL */ +#endif /* Audio && HAVE_LIBOPENAL */ #ifdef TallyOpt { @@ -1532,18 +1532,18 @@ int i; if (tallyopt) { fprintf(stderr,"tallies: "); for (j=0; j<16; j++) - fprintf(stderr," %ld", (long)tallybin[j]); - fprintf(stderr,"\n"); - } + fprintf(stderr," %ld", (long)tallybin[j]); + fprintf(stderr,"\n"); + } } -#endif /* TallyOpt */ +#endif /* TallyOpt */ if (k_dump && set_up) { fprintf(stderr,"\nTermination dump:\n\n"); fflush(stderr); fprintf(stderr,"co-expression #%ld(%ld)\n", - (long)BlkD(k_current,Coexpr)->id, - (long)BlkD(k_current,Coexpr)->size); + (long)BlkD(k_current,Coexpr)->id, + (long)BlkD(k_current,Coexpr)->size); fflush(stderr); xdisp(pfp,glbl_argp,k_level,stderr); } @@ -1556,7 +1556,7 @@ int i; if (ConsoleBinding) { char label[256], tossanswer[256]; struct descrip answer; - + wputstr((wbp)ConsoleBinding, msg, strlen(msg)); strcpy(tossanswer, "label="); @@ -1571,14 +1571,14 @@ int i; #undef exit #passthru #undef exit -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #if defined(MultipleRuns) /* * Free allocated memory so application can continue. */ xmfree(); -#endif /* MultipleRuns */ +#endif /* MultipleRuns */ #if MSDOS /* add others who need to free their resources here */ #ifdef ISQL @@ -1591,27 +1591,27 @@ int i; if (ISQLEnv!=NULL) { SQLFreeEnv(ISQLEnv); /* release ODBC environment */ } -#endif /* ISQL */ +#endif /* ISQL */ /* * free dynamic record types */ #ifdef MultiProgram if (curpstate && dr_arrays) { -#else /* MultiProgram */ +#else /* MultiProgram */ if (dr_arrays) { -#endif /* MultiProgram */ +#endif /* MultiProgram */ int i, j; struct b_proc_list *bpelem, *to_free; for(i=0;ithis->recname)); - for(j=0;jthis->nparam;j++) - free(StrLoc(bpelem->this->lnames[j])); - free(bpelem->this); - to_free = bpelem; - bpelem = bpelem->next; - free(to_free); + for(bpelem = dr_arrays[i]; bpelem; ) { + free(StrLoc(bpelem->this->recname)); + for(j=0;jthis->nparam;j++) + free(StrLoc(bpelem->this->lnames[j])); + free(bpelem->this); + to_free = bpelem; + bpelem = bpelem->next; + free(to_free); } } } @@ -1622,7 +1622,7 @@ int i; #ifdef MSWindows PostQuitMessage(0); while (wstates != NULL) pollevent(); -#endif /* MSWindows */ +#endif /* MSWindows */ #if NT if (LstTmpFiles) closetmpfiles(); @@ -1633,17 +1633,17 @@ int i; #if TURBO flushall(); _exit(i); -#else /* TURBO */ +#else /* TURBO */ #ifdef Concurrent clean_threads(); /*pthread_exit(EXIT_SUCCESS);*/ #endif exit(i); -#endif /* TURBO */ +#endif /* TURBO */ } - + /* * err() is called if an erroneous situation occurs in the virtual * machine code. It is typed as int to avoid declaration problems @@ -1652,9 +1652,9 @@ int i; int err() { syserr("call to 'err'\n"); - return 1; /* unreachable; make compilers happy */ + return 1; /* unreachable; make compilers happy */ } - + /* * fatalerr - disable error conversion and call run-time error routine. */ @@ -1664,9 +1664,9 @@ dptr v; { IntVal(kywd_err) = 0; err_msg(n, v); - c_exit(0); /* unreachable; but makes clang happy */ + c_exit(0); /* unreachable; but makes clang happy */ } - + /* * pstrnmcmp - compare names in two pstrnm structs; used for qsort. */ @@ -1675,7 +1675,7 @@ struct pstrnm *a, *b; { return strcmp(a->pstrep, b->pstrep); } - + word getrandom() { #ifndef NoRandomize @@ -1691,7 +1691,7 @@ word getrandom() struct tm *ct; #if defined(Concurrent) && !NT struct tm ctstruct; -#endif /* Concurrent */ +#endif /* Concurrent */ time(&t); @@ -1702,9 +1702,9 @@ word getrandom() */ #if defined(Concurrent) && !NT ct = localtime_r(&t, &ctstruct); -#else /* Concurrent */ +#else /* Concurrent */ ct = localtime(&t); -#endif /* Concurrent */ +#endif /* Concurrent */ if (ct == NULL) return 0; /* map &clock */ @@ -1727,9 +1727,9 @@ word getrandom() krandom += millisec() + 1009 * (int) curtstate; #endif return krandom; -#else /* NoRandomize */ +#else /* NoRandomize */ return 0; -#endif /* NoRandomize */ +#endif /* NoRandomize */ } /* @@ -1739,12 +1739,12 @@ void datainit() { #ifdef MSWindows extern FILE *finredir, *fouredir, *ferredir; -#endif /* MSWindows */ +#endif /* MSWindows */ CURTSTATE(); /* * Initializations that cannot be performed statically (at least for - * some compilers). [[I?]] + * some compilers). [[I?]] */ #ifdef MultiProgram @@ -1756,15 +1756,15 @@ void datainit() k_errout.mutexid = get_mutex(&rmtx_attr); k_input.mutexid = get_mutex(&rmtx_attr); k_output.mutexid = get_mutex(&rmtx_attr); -#endif /* Concurrent */ +#endif /* Concurrent */ -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef MSWindows if (ferredir != NULL) k_errout.fd.fp = ferredir; else -#endif /* MSWindows */ +#endif /* MSWindows */ k_errout.fd.fp = stderr; StrLen(k_errout.fname) = 7; StrLoc(k_errout.fname) = "&errout"; @@ -1772,14 +1772,14 @@ void datainit() if (!(ConsoleFlags & StdErrRedirect)) k_errout.status = Fs_Write | Fs_Window; else -#endif /* Console Window */ +#endif /* Console Window */ k_errout.status = Fs_Write; #ifdef MSWindows if (finredir != NULL) k_input.fd.fp = finredir; else -#endif /* MSWindows */ +#endif /* MSWindows */ if (k_input.fd.fp == NULL) k_input.fd.fp = stdin; StrLen(k_input.fname) = 6; @@ -1788,14 +1788,14 @@ void datainit() if (!(ConsoleFlags & StdInRedirect)) k_input.status = Fs_Read | Fs_Window; else -#endif /* Console Window */ +#endif /* Console Window */ k_input.status = Fs_Read; #ifdef MSWindows if (fouredir != NULL) k_output.fd.fp = fouredir; else -#endif /* MSWindows */ +#endif /* MSWindows */ if (k_output.fd.fp == NULL) k_output.fd.fp = stdout; StrLen(k_output.fname) = 7; @@ -1804,7 +1804,7 @@ void datainit() if (!(ConsoleFlags & StdOutRedirect)) k_output.status = Fs_Write | Fs_Window; else -#endif /* Console Window */ +#endif /* Console Window */ k_output.status = Fs_Write; IntVal(kywd_pos) = 1; @@ -1838,10 +1838,10 @@ void datainit() Kcset(&csetdesc); #ifdef DescriptorDouble rzerodesc.vword.realval = 0.0; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ BlkLoc(rzerodesc) = (union block *)&realzero; -#endif /* DescriptorDouble */ -#endif /* MultiProgram */ +#endif /* DescriptorDouble */ +#endif /* MultiProgram */ #ifndef Concurrent maps2 = nulldesc; @@ -1850,36 +1850,36 @@ void datainit() #if !COMPILER qsort((char *)pntab, pnsize, sizeof(struct pstrnm), - (QSortFncCast)pstrnmcmp); + (QSortFncCast)pstrnmcmp); #ifdef MultipleRuns /* * Initializations required for repeated program runs */ - /* In this module: */ - k_level = 0; /* &level */ - k_patindex = 0; - k_errornumber = 0; /* &errornumber */ - k_errortext = emptystr; /* &errortext */ - currend = NULL; /* current end of memory region */ - mstksize = MStackSize; /* initial size of main stack */ - stksize = StackSize; /* co-expression stack size */ - ssize = MaxStrSpace; /* initial string space size (bytes) */ - abrsize = MaxAbrSize; /* initial size of allocated block - region (bytes) */ - qualsize = QualLstSize; /* size of quallist for fixed regions */ - - dodump = 0; /* produce dump on error */ + /* In this module: */ + k_level = 0; /* &level */ + k_patindex = 0; + k_errornumber = 0; /* &errornumber */ + k_errortext = emptystr; /* &errortext */ + currend = NULL; /* current end of memory region */ + mstksize = MStackSize; /* initial size of main stack */ + stksize = StackSize; /* co-expression stack size */ + ssize = MaxStrSpace; /* initial string space size (bytes) */ + abrsize = MaxAbrSize; /* initial size of allocated block + region (bytes) */ + qualsize = QualLstSize; /* size of quallist for fixed regions */ + + dodump = 0; /* produce dump on error */ #ifdef ExecImages - dumped = 0; /* This is a dumped image. */ -#endif /* ExecImages */ + dumped = 0; /* This is a dumped image. */ +#endif /* ExecImages */ - /* In module interp.r: */ - pfp = 0; /* Procedure frame pointer */ - sp = NULL; /* Stack pointer */ + /* In module interp.r: */ + pfp = 0; /* Procedure frame pointer */ + sp = NULL; /* Stack pointer */ - /* In module rmemmgt.r: */ + /* In module rmemmgt.r: */ coexp_ser = 2; list_ser = 1; intern_list_ser = -1; @@ -1891,11 +1891,11 @@ void datainit() coll_blk = 0; coll_tot = 0; - /* In module time.c: */ + /* In module time.c: */ first_time = 1; -#endif /* MultipleRuns */ -#endif /* COMPILER */ +#endif /* MultipleRuns */ +#endif /* COMPILER */ } @@ -1904,7 +1904,7 @@ void datainit() void init_progstate(struct progstate *pstate){ init_sighandlers(pstate); - + pstate->parent= NULL; pstate->parentdesc= nulldesc; @@ -1925,7 +1925,7 @@ void init_progstate(struct progstate *pstate){ pstate->AmperInterval = zerodesc; pstate->LastEventWin = nulldesc; pstate->Kywd_xwin[XKey_Window] = nulldesc; -#endif /* Graphics */ +#endif /* Graphics */ pstate->Coexp_ser = 2; pstate->List_ser = 1; @@ -1946,12 +1946,12 @@ void init_progstate(struct progstate *pstate){ pstate->Alcpelem = alcpelem_0; pstate->Cnvpattern = cnv_pattern_0; pstate->Internalmatch = internal_match_0; -#endif /* PatternType */ +#endif /* PatternType */ -#ifdef Arrays +#ifdef Arrays pstate->Cprealarray = cprealarray_0; pstate->Cpintarray = cpintarray_0; -#endif /* Arrays */ +#endif /* Arrays */ pstate->Cplist = cplist_0; pstate->Cpset = cpset_0; @@ -1967,7 +1967,7 @@ void init_progstate(struct progstate *pstate){ pstate->Deref = deref_0; #ifdef LargeInts pstate->Alcbignum = alcbignum_0; -#endif /* LargeInts */ +#endif /* LargeInts */ pstate->Alccset = alccset_0; pstate->Alcfile = alcfile; pstate->Alchash = alchash_0; @@ -1977,7 +1977,7 @@ void init_progstate(struct progstate *pstate){ pstate->Alclstb = alclstb_0; #ifndef DescriptorDouble pstate->Alcreal = alcreal; -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ pstate->Alcrecd = alcrecd_0; pstate->Alcrefresh = alcrefresh_0; pstate->Alcselem = alcselem_0; @@ -1995,7 +1995,7 @@ void init_progstate(struct progstate *pstate){ * icodesize (nonzero, perhaps good if longword-aligned) to alccoexp. */ struct b_coexpr *initprogram(word icodesize, word stacksize, - word stringsiz, word blocksiz) + word stringsiz, word blocksiz) { struct b_coexpr *coexp = alccoexp(icodesize, stacksize); struct progstate *pstate = NULL; @@ -2011,7 +2011,7 @@ struct b_coexpr *initprogram(word icodesize, word stacksize, #ifdef StackCheck coexp->es_stack = tstate->Stack; coexp->es_stackend = tstate->Stackend; -#endif /* StackCheck */ +#endif /* StackCheck */ /* * Initialize values. @@ -2019,7 +2019,7 @@ struct b_coexpr *initprogram(word icodesize, word stacksize, pstate->hsize = icodesize; init_progstate(pstate); - + init_threadstate(tstate); pstate->Kywd_time_elsewhere = millisec(); pstate->Kywd_time_out = 0; @@ -2044,8 +2044,8 @@ struct b_coexpr *initprogram(word icodesize, word stacksize, #ifdef Concurrent init_threadheap(tstate, stringsiz, blocksiz, pstate); pstate->stringregion = tstate->Curstring; - pstate->blockregion = tstate->Curblock; -#else + pstate->blockregion = tstate->Curblock; +#else pstate->stringregion = (struct region *)malloc(sizeof(struct region)); pstate->blockregion = (struct region *)malloc(sizeof(struct region)); pstate->stringregion->size = stringsiz; @@ -2073,7 +2073,7 @@ struct b_coexpr *initprogram(word icodesize, word stacksize, curpstate->blockregion->Gnext->Gprev = pstate->blockregion; curpstate->blockregion->Gnext = pstate->blockregion; -#endif /* Concurrent */ +#endif /* Concurrent */ initalloc(0, pstate); @@ -2092,8 +2092,8 @@ struct progstate * findicode(word *opnd) for (p = &rootpstate; p != NULL; p = p->next) { if (InRange(p->Code, opnd, p->Ecode)) { - return p; - } + return p; + } } syserr("unidentified inter-program icode\n"); return p; /* avoid spurious warning message */ @@ -2150,7 +2150,7 @@ C_integer bs, ss, stk; */ /* - * Establish pointers to icode data regions. [[I?]] + * Establish pointers to icode data regions. [[I?]] */ pstate->Code = ((char *)(pstate + 1)); pstate->Ecode = (char *)(pstate->Code + hdr.Records); @@ -2173,7 +2173,7 @@ C_integer bs, ss, stk; pstate->Foffwidth = hdr.FoffWidth; pstate->Ftabcp = (unsigned char *)(pstate->Code + hdr.Ftab); pstate->Ftabsp = (unsigned short *)(pstate->Code + hdr.Ftab); -#endif /* FieldTableCompression */ +#endif /* FieldTableCompression */ pstate->Fnames = (dptr)(pstate->Code + hdr.Fnames); pstate->Globals = pstate->Efnames = (dptr)(pstate->Code + hdr.Globals); pstate->Gnames = pstate->Eglobals = (dptr)(pstate->Code + hdr.Gnames); @@ -2199,15 +2199,15 @@ C_integer bs, ss, stk; #if HAVE_LIBZ word cbread; if ((cbread = gzlongread(pstate->Code, sizeof(char), (long)hdr.hsize, fname)) - != hdr.hsize) { - fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n", - (long)hdr.hsize,(long)cbread); - error(name, "can't read interpreter code"); - } + != hdr.hsize) { + fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n", + (long)hdr.hsize,(long)cbread); + error(name, "can't read interpreter code"); + } gzclose(fname); -#else /* HAVE_LIBZ */ - error(name, "this VM can't read compressed icode"); -#endif /* HAVE_LIBZ */ +#else /* HAVE_LIBZ */ + error(name, "this VM can't read compressed icode"); +#endif /* HAVE_LIBZ */ } /* Don't need to decompress */ else { @@ -2244,13 +2244,13 @@ struct progstate *findprogramforblock(union block *p) while (ce != NULL) { tmpp = ce->program; if (InRange(tmpp->Code, p, tmpp->Elines)) { - MUTEX_UNLOCKID(MTX_STKLIST); - return tmpp; - } + MUTEX_UNLOCKID(MTX_STKLIST); + return tmpp; + } ce = ce->nextstk; } MUTEX_UNLOCKID(MTX_STKLIST); return NULL; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ diff --git a/src/runtime/interp.r b/src/runtime/interp.r index 5d34c6379..7312028ac 100644 --- a/src/runtime/interp.r +++ b/src/runtime/interp.r @@ -14,8 +14,8 @@ extern word istart[4]; extern int mterm; pointer stkadr; word stkint; } stkword; -#endif /* MSDOS */ - +#endif /* MSDOS */ + #ifdef OVLD extern int *OpTab; #endif @@ -33,62 +33,62 @@ static void vanq_proc (struct ef_marker *efp_v, struct gf_marker *gfp_v); #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || MVS || UNIX || VM || VMS /* nothing needed */ -#endif /* MSDOS|| ... */ +#endif /* MSDOS|| ... */ /* * End of operating-system specific code. */ #ifndef MultiProgram -word lastop; /* Last operator evaluated */ -#endif /* MultiProgram */ +word lastop; /* Last operator evaluated */ +#endif /* MultiProgram */ /* * Istate variables. */ #ifndef Concurrent -struct pf_marker *pfp = NULL; /* Procedure frame pointer */ -struct ef_marker *efp; /* Expression frame pointer */ -struct gf_marker *gfp; /* Generator frame pointer */ -inst ipc; /* Interpreter program counter */ +struct pf_marker *pfp = NULL; /* Procedure frame pointer */ +struct ef_marker *efp; /* Expression frame pointer */ +struct gf_marker *gfp; /* Generator frame pointer */ +inst ipc; /* Interpreter program counter */ inst oldipc; /* the previous ipc, fix returned line zero */ -word *sp = NULL; /* Stack pointer */ -int ilevel; +word *sp = NULL; /* Stack pointer */ +int ilevel; #ifndef StackCheck -word *stack; /* Interpreter stack */ -word *stackend; /* End of interpreter stack */ -#endif /* StackCheck */ -#else /* Concurrent */ +word *stack; /* Interpreter stack */ +word *stackend; /* End of interpreter stack */ +#endif /* StackCheck */ +#else /* Concurrent */ int lock_count_mtx_init; -#endif /* Concurrent */ +#endif /* Concurrent */ #if HAVE_PROFIL && E_Tick -extern union { /* clock ticker -- keep in sync w/ fmonitor.r */ - unsigned short s[16]; /* 16 counters */ - unsigned long l[8]; /* 8 longs are easier to check */ +extern union { /* clock ticker -- keep in sync w/ fmonitor.r */ + unsigned short s[16]; /* 16 counters */ + unsigned long l[8]; /* 8 longs are easier to check */ } ticker; -extern unsigned long oldtick; /* previous sum of the two longs */ -#endif /* HAVE_PROFIL && E_Tick */ +extern unsigned long oldtick; /* previous sum of the two longs */ +#endif /* HAVE_PROFIL && E_Tick */ #ifndef MultiProgram -struct descrip value_tmp; /* list argument to Op_Apply */ -#endif /* MultiProgram */ +struct descrip value_tmp; /* list argument to Op_Apply */ +#endif /* MultiProgram */ #ifndef Concurrent -struct descrip eret_tmp; /* eret value during unwinding */ -#endif /* Concurrent */ +struct descrip eret_tmp; /* eret value during unwinding */ +#endif /* Concurrent */ #ifndef MultiProgram dptr xargp; word xnargs; -dptr field_argp; /* see comment in imisc.r/Ofield() */ -#endif /* MultiProgram */ +dptr field_argp; /* see comment in imisc.r/Ofield() */ +#endif /* MultiProgram */ /* * Macros for use inside the main loop of the interpreter. @@ -112,11 +112,11 @@ dptr field_argp; /* see comment in imisc.r/Ofield() */ EVValDEx(&value_tmp, e, word mylastop, mylastop=lastop, lastop=mylastop); */ value_tmp = nulldesc; -#endif /* MultiProgram */ +#endif /* MultiProgram */ rargp = (dptr)(rsp - 1) - nargs; xargp = rargp; ExInterp_sp; -#enddef /* Setup_Op */ +#enddef /* Setup_Op */ /* * Setup_Arg sets things up for a call to the C function. @@ -126,11 +126,11 @@ dptr field_argp; /* see comment in imisc.r/Ofield() */ #begdef Setup_Arg(nargs) #ifdef MultiProgram lastev = E_Misc; -#endif /* MultiProgram */ +#endif /* MultiProgram */ rargp = (dptr)(rsp - 1) - nargs; xargp = rargp; ExInterp_sp; -#enddef /* Setup_Arg */ +#enddef /* Setup_Arg */ #begdef Call_Cond(e) if ((*(optab[lastop]))(rargp) == A_Resume) { @@ -140,53 +140,53 @@ dptr field_argp; /* see comment in imisc.r/Ofield() */ rsp = (word *) rargp + 1; #ifdef MultiProgram goto return_term; -#else /* MultiProgram */ +#else /* MultiProgram */ break; -#endif /* MultiProgram */ -#enddef /* Call_Cond */ +#endif /* MultiProgram */ +#enddef /* Call_Cond */ #begdef HandleOVLD(numargs) #ifdef OVLD - fieldnum = OpTab[lastop]; + fieldnum = OpTab[lastop]; #ifdef OVLD_DEBUG - fprintf(stdout,"LastOp = %d\tFieldNum=%d\n",lastop, fieldnum); + fprintf(stdout,"LastOp = %d\tFieldNum=%d\n",lastop, fieldnum); #endif - if ( fieldnum != -1) { - deref(&rargp[1],&x); + if ( fieldnum != -1) { + deref(&rargp[1],&x); #ifdef OVLD_DEBUG - fprintf(stdout, "Try overload\n"); + fprintf(stdout, "Try overload\n"); #endif - if (is:record(x)) { - register word fnum; - tended struct b_record *rp; - register dptr dp; - register union block *bptr; - int nfields, i; - struct b_record *rp2; - tended struct descrip md; - int found = 0; - char *funcname = NULL; - rp = (struct b_record *) BlkLoc(x); - bptr = rp->recdesc; - nfields = bptr->Proc.nfields; + if (is:record(x)) { + register word fnum; + tended struct b_record *rp; + register dptr dp; + register union block *bptr; + int nfields, i; + struct b_record *rp2; + tended struct descrip md; + int found = 0; + char *funcname = NULL; + rp = (struct b_record *) BlkLoc(x); + bptr = rp->recdesc; + nfields = bptr->Proc.nfields; #ifdef OVLD_DEBUG - fprintf(stdout, "x is a record\n"); + fprintf(stdout, "x is a record\n"); #endif /* Check if our record is a class ( has a method vector) */ - for( i = 0; i < nfields;i++) { - if (!strcmp(StrLoc(bptr->Proc.lnames[i]), "__m")) { - found = 1; - break; - } - }/* for ... nfields */ - if (found) { - md = rp->fields[i]; - if (is:record(md)) { - rp2 = (struct b_record *)BlkLoc(md); + for( i = 0; i < nfields;i++) { + if (!strcmp(StrLoc(bptr->Proc.lnames[i]), "__m")) { + found = 1; + break; + } + }/* for ... nfields */ + if (found) { + md = rp->fields[i]; + if (is:record(md)) { + rp2 = (struct b_record *)BlkLoc(md); #ifdef OVLD_DEBUG - fprintf(stdout, " x has method vector\n"); + fprintf(stdout, " x has method vector\n"); #endif /* Now that we have a method vector we check if it contains the specified field @@ -196,53 +196,53 @@ Now that we have a method vector we check if it contains the specified field #define FO(i) ((foffwidth==1)?(focp[i]&255L):((foffwidth==2)?(fosp[i]&65535L):fo[i])) #define FTAB(i) ((ftabwidth==1)?(ftabcp[i]&255L):((ftabwidth==2)?(ftabsp[i]&65535L):ftabp[i])) - if (rp2->recdesc->Proc.recnum == -1) - syserr("dynamic classes not supported yet\n"); - - fnum = FTAB(FO(fieldnum) + (rp2->recdesc->Proc.recnum - 1)); - - /* - * Check the bitmap for this entry. If it fails, it converts our - * nice field offset number into -1 (empty/invalid for our row). - */ - { - int bytes, index; - unsigned char this_bit = 0200; - - bytes = *records >> 3; - if ((*records & 07) != 0) - bytes++; - index = IntVal(Arg2) * bytes + (rp2->recdesc->Proc.recnum - 1) / 8; - this_bit = this_bit >> (rp2->recdesc->Proc.recnum - 1) % 8; - if ((bm[index] | this_bit) != bm[index]) { - fnum = -1; - } - else { /* bitmap passes test on __m.field */ - } - } -#else /* FieldTableCompression */ + if (rp2->recdesc->Proc.recnum == -1) + syserr("dynamic classes not supported yet\n"); + + fnum = FTAB(FO(fieldnum) + (rp2->recdesc->Proc.recnum - 1)); + + /* + * Check the bitmap for this entry. If it fails, it converts our + * nice field offset number into -1 (empty/invalid for our row). + */ + { + int bytes, index; + unsigned char this_bit = 0200; + + bytes = *records >> 3; + if ((*records & 07) != 0) + bytes++; + index = IntVal(Arg2) * bytes + (rp2->recdesc->Proc.recnum - 1) / 8; + this_bit = this_bit >> (rp2->recdesc->Proc.recnum - 1) % 8; + if ((bm[index] | this_bit) != bm[index]) { + fnum = -1; + } + else { /* bitmap passes test on __m.field */ + } + } +#else /* FieldTableCompression */ #ifdef OVLD_DEBUG printf("interp, fieldnum is still %d, recnum %d\n", - fieldnum, rp2->recdesc->Proc.recnum); fflush(stdout); + fieldnum, rp2->recdesc->Proc.recnum); fflush(stdout); #endif - fnum = ftabp[fieldnum * *records + rp2->recdesc->Proc.recnum - 1]; + fnum = ftabp[fieldnum * *records + rp2->recdesc->Proc.recnum - 1]; #ifdef OVLD_DEBUG fprintf(stdout,"Resolving method fnum = %d\n" , fnum); #endif -#endif /* FieldTableCompression */ - if ( fnum >= 0) - { -#ifdef OVLD_DEBUG - fprintf(stdout, "x has the overloaded method\n"); +#endif /* FieldTableCompression */ + if ( fnum >= 0) + { +#ifdef OVLD_DEBUG + fprintf(stdout, "x has the overloaded method\n"); #endif - rargp[0] = (rp2->fields[fnum]); - args = numargs; - goto invokej; - - } - }/*if is:record(md)*/ - }/*if found == 1*/ - }/*if is record x*/ + rargp[0] = (rp2->fields[fnum]); + args = numargs; + goto invokej; + + } + }/*if is:record(md)*/ + }/*if found == 1*/ + }/*if is record x*/ }/*if fieldnum != -1*/ #ifdef OVLD_DEBUG fprintf(stdout, "%s\n", "No overloading occured"); @@ -260,7 +260,7 @@ printf("interp, fieldnum is still %d, recnum %d\n", #begdef Call_Gen signal = (*(optab[lastop]))(rargp); goto C_rtn_term; -#enddef /* Call_Gen */ +#enddef /* Call_Gen */ /* * GetWord fetches the next icode word. PutWord(x) stores x at the current @@ -323,14 +323,14 @@ deliberate syntax error * handle all register variables that need to be saved/restored. */ -#define ExInterp_sp sp = rsp; -#define EntInterp_sp rsp = sp; +#define ExInterp_sp sp = rsp; +#define EntInterp_sp rsp = sp; -/*#define ExInterp_ipc ipc = ripc; -#define EntInterp_ipc ripc = ipc; +/*#define ExInterp_ipc ipc = ripc; +#define EntInterp_ipc ripc = ipc; -#define ExInterp_lastop rlastop = lastop; -#define EntInterp_lastop lastop = rlastop; +#define ExInterp_lastop rlastop = lastop; +#define EntInterp_lastop lastop = rlastop; */ /* * Inside the interpreter loop, PushDesc, PushNull, PushAVal, and @@ -353,18 +353,18 @@ deliberate syntax error #if PORT #define PushAVal(x) PushVal(x) Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MVS || UNIX || VM || VMS #define PushAVal(x) PushVal(x) -#endif /* MSDOS || ... */ +#endif /* MSDOS || ... */ #if MSDOS #define PushAVal(x) {rsp++; \ - stkword.stkadr = (char *)(x); \ - *rsp = stkword.stkint; \ - } -#endif /* MSDOS */ + stkword.stkadr = (char *)(x); \ + *rsp = stkword.stkint; \ + } +#endif /* MSDOS */ /* * End of operating-system specific code. @@ -377,9 +377,9 @@ Deliberate Syntax Error */ #ifdef TSTATARG int interp_x(int fsig,dptr cargp, struct threadstate *curtstate) -#else /* TSTATARG */ +#else /* TSTATARG */ int interp_x(int fsig,dptr cargp) -#endif /* TSTATARG */ +#endif /* TSTATARG */ { register word opnd; register word *rsp; @@ -396,11 +396,11 @@ int interp_x(int fsig,dptr cargp) #ifdef MultiProgram int lastev = E_Misc; struct descrip lastdesc = nulldesc; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef TallyOpt extern word tallybin[]; -#endif /* TallyOpt */ +#endif /* TallyOpt */ #ifdef Concurrent /* @@ -410,19 +410,19 @@ int interp_x(int fsig,dptr cargp) */ #if !(defined(TSTATARG) || defined(OVLD)) CURTSTATE_AND_CE(); -#endif /* TSTATARG */ -#endif /* Concurrent */ +#endif /* TSTATARG */ +#endif /* Concurrent */ #if e_intcall EVVal(fsig, e_intcall); -#endif /* e_intcall */ +#endif /* e_intcall */ #if e_cstack #ifdef StackCheck EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ +#else /* StackCheck */ EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ -#endif /* e_cstack */ +#endif /* StackCheck */ +#endif /* e_cstack */ #ifdef StackCheck /* @@ -431,25 +431,25 @@ int interp_x(int fsig,dptr cargp) */ if (((char *)sp + PerilDelta) > (char *)(BlkD(k_current,Coexpr)->es_stackend)){ fatalerr(301, NULL); - } -#else /* StackCheck */ + } +#else /* StackCheck */ #ifndef MultiProgram /* * Make a stab at catching interpreter stack overflow. This does * nothing for invocation in a co-expression other than &main. */ if (BlkLoc(k_current) == BlkLoc(k_main) && - ((char *)sp + PerilDelta) > (char *)stackend) + ((char *)sp + PerilDelta) > (char *)stackend) fatalerr(301, NULL); -#endif /* MultiProgram */ -#endif /* StackCheck */ +#endif /* MultiProgram */ +#endif /* StackCheck */ #ifdef Polling if (!pollctr--) { pollctr = pollevent(); if (pollctr == -1) fatalerr(141, NULL); } -#endif /* Polling */ +#endif /* Polling */ ilevel++; @@ -458,24 +458,24 @@ int interp_x(int fsig,dptr cargp) switch (fsig) { case G_Csusp: case G_Fsusp: case G_Osusp: #if 0 - value_tmp = *(dptr)(rsp - 1); /* argument? */ + value_tmp = *(dptr)(rsp - 1); /* argument? */ #else value_tmp = cargp[0]; #endif #ifdef MultiProgram Deref0(value_tmp); -#else /* MultiProgram */ +#else /* MultiProgram */ Deref(value_tmp); -#endif /* MultiProgram */ +#endif /* MultiProgram */ if (fsig == G_Fsusp) { - InterpEVValD(&value_tmp, e_fsusp); - } + InterpEVValD(&value_tmp, e_fsusp); + } else if (fsig == G_Osusp) { - InterpEVValD(&value_tmp, e_osusp); - } + InterpEVValD(&value_tmp, e_osusp); + } else { - InterpEVValD(&value_tmp, e_bsusp); - } + InterpEVValD(&value_tmp, e_bsusp); + } oldsp = rsp; value_tmp = nulldesc; @@ -496,13 +496,13 @@ int interp_x(int fsig,dptr cargp) * routine to the first argument of the routine. */ if (gfp != 0) { - if (gfp->gf_gentype == G_Psusp) - firstwd = (word *)gfp + Wsizeof(*gfp); - else - firstwd = (word *)gfp + Wsizeof(struct gf_smallmarker); - } + if (gfp->gf_gentype == G_Psusp) + firstwd = (word *)gfp + Wsizeof(*gfp); + else + firstwd = (word *)gfp + Wsizeof(struct gf_smallmarker); + } else - firstwd = (word *)efp + Wsizeof(*efp); + firstwd = (word *)efp + Wsizeof(*efp); lastwd = (word *)cargp + 1; /* @@ -510,7 +510,7 @@ int interp_x(int fsig,dptr cargp) * (inclusive) to the top of the stack. */ for (wd = firstwd; wd <= lastwd; wd++) - *++rsp = *wd; + *++rsp = *wd; gfp = newgfp; } /* @@ -523,28 +523,28 @@ int interp_x(int fsig,dptr cargp) if (curtstate->sthrd_size>0){ if (curtstate->c->sthrd_tick-- <= 10){ struct b_coexpr *ncp; - ncp = curtstate->sthrds[curtstate->sthrd_cur]; + ncp = curtstate->sthrds[curtstate->sthrd_cur]; ncp->sthrd_tick = SOFT_THREADS_TSLICE; /* give the new thread a "slice" */ - curtstate->sthrds[curtstate->sthrd_cur] = curtstate->c; - curtstate->sthrd_cur = (curtstate->sthrd_cur + 1) % curtstate->sthrd_size; - ExInterp_sp; - if (ncp->es_actstk == NULL){ /* this shouldn't be the case */ - Protect(ncp->es_actstk = alcactiv(), err_msg(0,NULL)); - if (pushact(ncp, curtstate->owner) == RunError) - err_msg(183, NULL); - co_chng(ncp, NULL, NULL, A_Coschedule, 0); - } - else + curtstate->sthrds[curtstate->sthrd_cur] = curtstate->c; + curtstate->sthrd_cur = (curtstate->sthrd_cur + 1) % curtstate->sthrd_size; + ExInterp_sp; + if (ncp->es_actstk == NULL){ /* this shouldn't be the case */ + Protect(ncp->es_actstk = alcactiv(), err_msg(0,NULL)); + if (pushact(ncp, curtstate->owner) == RunError) + err_msg(183, NULL); + co_chng(ncp, NULL, NULL, A_Coschedule, 0); + } + else co_chng(ncp, NULL, NULL, A_Coschedule, 1); - - SYNC_CURTSTATE_CE(); - EntInterp_sp; - } + + SYNC_CURTSTATE_CE(); + EntInterp_sp; + } } -#endif /* SoftThreads */ +#endif /* SoftThreads */ #ifdef MultiProgram - /* + /* * If the TP (the child program) received a signal that it does * not have a handler for, it reports it back to its parent. * The reported event is E_Signal with a string name of that signal @@ -556,28 +556,28 @@ int interp_x(int fsig,dptr cargp) InterpEVValD(&val,E_Signal); curpstate->signal = 0; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if HAVE_PROFIL && e_tick if (ticker.l[0] + ticker.l[1] + ticker.l[2] + ticker.l[3] + - ticker.l[4] + ticker.l[5] + ticker.l[6] + ticker.l[7] != oldtick) { - /* - * Record a Tick event reflecting a clock advance. - * - * The interpreter main loop has detected a change in the - * profile counters. This means that the system clock has - * ticked. Record an event and update the records. - */ - word sum, nticks; - ExInterp_sp; - oldtick = ticker.l[0] + ticker.l[1]; - sum = ticker.s[0] + ticker.s[1] + ticker.s[2] + ticker.s[3]; - nticks = sum - oldsum; - EVVal(nticks, e_tick); - oldsum = sum; - EntInterp_sp; - } -#endif /* HAVE_PROFIL && e_tick */ + ticker.l[4] + ticker.l[5] + ticker.l[6] + ticker.l[7] != oldtick) { + /* + * Record a Tick event reflecting a clock advance. + * + * The interpreter main loop has detected a change in the + * profile counters. This means that the system clock has + * ticked. Record an event and update the records. + */ + word sum, nticks; + ExInterp_sp; + oldtick = ticker.l[0] + ticker.l[1]; + sum = ticker.s[0] + ticker.s[1] + ticker.s[2] + ticker.s[3]; + nticks = sum - oldsum; + EVVal(nticks, e_tick); + oldsum = sum; + EntInterp_sp; + } +#endif /* HAVE_PROFIL && e_tick */ #if e_line || e_loc /* @@ -591,51 +591,51 @@ int interp_x(int fsig,dptr cargp) #if e_loc Testb((word)ToAscii(E_Loc), curpstate->eventmask) #if e_line - || -#endif /* e_line */ -#endif /* e_loc */ + || +#endif /* e_line */ +#endif /* e_loc */ #if e_line Testb((word)ToAscii(E_Line), curpstate->eventmask) -#endif /* e_line */ +#endif /* e_line */ )) { if (InRange(code, ipc.opnd, endcode)) { - uword ipc_offset = DiffPtrs((char *)ipc.opnd, (char *)code); - uword size; - word temp_no; - if (!current_line_ptr || - current_line_ptr->ipc_saved > ipc_offset || - current_line_ptr[1].ipc_saved <= ipc_offset) { + uword ipc_offset = DiffPtrs((char *)ipc.opnd, (char *)code); + uword size; + word temp_no; + if (!current_line_ptr || + current_line_ptr->ipc_saved > ipc_offset || + current_line_ptr[1].ipc_saved <= ipc_offset) { #if defined(LineCodes) && defined(Polling) if (!pollctr--) { - ExInterp_sp; + ExInterp_sp; pollctr = pollevent(); - EntInterp_sp; - if (pollctr == -1) fatalerr(141, NULL); - } -#endif /* LineCodes && Polling */ - - if(current_line_ptr && - current_line_ptr + 2 < elines && - current_line_ptr[1].ipc_saved < ipc_offset && - ipc_offset < current_line_ptr[2].ipc_saved) { - current_line_ptr ++; - } - else { - current_line_ptr = ilines; - size = DiffPtrs((char *)elines, (char *)ilines) / - sizeof(struct ipc_line *); - while (size > 1) { - if (ipc_offset >= current_line_ptr[size>>1].ipc_saved) { - current_line_ptr = ¤t_line_ptr[size>>1]; - size -= (size >> 1); - } - else { - size >>= 1; - } - } - } - line_num = current_line_ptr->line; + EntInterp_sp; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif /* LineCodes && Polling */ + + if(current_line_ptr && + current_line_ptr + 2 < elines && + current_line_ptr[1].ipc_saved < ipc_offset && + ipc_offset < current_line_ptr[2].ipc_saved) { + current_line_ptr ++; + } + else { + current_line_ptr = ilines; + size = DiffPtrs((char *)elines, (char *)ilines) / + sizeof(struct ipc_line *); + while (size > 1) { + if (ipc_offset >= current_line_ptr[size>>1].ipc_saved) { + current_line_ptr = ¤t_line_ptr[size>>1]; + size -= (size >> 1); + } + else { + size >>= 1; + } + } + } + line_num = current_line_ptr->line; temp_no = line_num & 65535; if ((lastline & 65535) != temp_no) { #if e_line @@ -643,43 +643,43 @@ int interp_x(int fsig,dptr cargp) if (temp_no) InterpEVVal(temp_no, e_line); #endif - } - if (lastline != line_num) { - lastline = line_num; + } + if (lastline != line_num) { + lastline = line_num; #if e_loc - if (Testb((word)ToAscii(E_Loc), curpstate->eventmask) && - current_line_ptr->line >> 16) - InterpEVVal(current_line_ptr->line, e_loc); + if (Testb((word)ToAscii(E_Loc), curpstate->eventmask) && + current_line_ptr->line >> 16) + InterpEVVal(current_line_ptr->line, e_loc); #endif - } - } - } + } + } + } } -#else /* E_Line || E_Loc */ +#else /* E_Line || E_Loc */ #ifdef MultiProgram /* * We are uninstrumented code, but the program should be instrumented. * Switch to the instrumented version of the interpreter. */ if (curpstate->Interp == interp_1) { - ilevel--; - ExInterp_sp; -#ifdef TSTATARG - return interp_1(0, cargp, CURTSTATARG); -#else /* TSTATARG */ + ilevel--; + ExInterp_sp; +#ifdef TSTATARG + return interp_1(0, cargp, CURTSTATARG); +#else /* TSTATARG */ return interp_1(0, cargp); -#endif /* TSTATARG */ - } -#endif /* MultiProgram */ -#endif /* E_Line || E_Loc */ +#endif /* TSTATARG */ + } +#endif /* MultiProgram */ +#endif /* E_Line || E_Loc */ - lastop = GetOp; /* Instruction fetch */ + lastop = GetOp; /* Instruction fetch */ #ifdef StackPic ExInterp_sp; stkdump((int)lastop); EntInterp_sp; -#endif /* StackPic */ +#endif /* StackPic */ /* * The following code is operating-system dependent [@interp.03]. Check @@ -687,11 +687,11 @@ int interp_x(int fsig,dptr cargp) */ #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || MVS || UNIX || VM || VMS /* nothing to do */ -#endif /* MSDOS || ... */ +#endif /* MSDOS || ... */ /* * End of operating-system specific code. @@ -699,525 +699,525 @@ Deliberate Syntax Error #if e_opcode EVValEx(lastop,E_Opcode,word mylastop,mylastop=lastop,lastop=mylastop); -#endif /* E_Opcode */ +#endif /* E_Opcode */ #ifdef Concurrent /* If there is a pending GC request, then block/sleep*/ if (thread_call){ - ExInterp_sp; - thread_control(TC_ANSWERCALL); - /*EntInterp_sp;*/ - } -#endif /* Concurrent */ - - switch ((int)lastop) { /* - * Switch on opcode. The cases are - * organized roughly by functionality - * to make it easier to find things. - * For some C compilers, there may be - * an advantage to arranging them by - * likelihood of selection. - */ - - /* ---Constant construction--- */ + ExInterp_sp; + thread_control(TC_ANSWERCALL); + /*EntInterp_sp;*/ + } +#endif /* Concurrent */ + + switch ((int)lastop) { /* + * Switch on opcode. The cases are + * organized roughly by functionality + * to make it easier to find things. + * For some C compilers, there may be + * an advantage to arranging them by + * likelihood of selection. + */ + + /* ---Constant construction--- */ #ifdef OVLD - tended struct descrip x; - int fieldnum; + tended struct descrip x; + int fieldnum; #endif - case Op_Cset: /* cset */ + case Op_Cset: /* cset */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_ACSET); - if (ipc.op[-1] == Op_Acset) { - MUTEX_UNLOCKID(MTX_OP_ACSET); goto L_acset; } -#else /*Concurrent*/ - PutOp(Op_Acset); -#endif /*Concurrent*/ - PushVal(D_Cset); - opnd = GetWord; - opnd += (word)ipc.opnd; + MUTEX_LOCKID(MTX_OP_ACSET); + if (ipc.op[-1] == Op_Acset) { + MUTEX_UNLOCKID(MTX_OP_ACSET); goto L_acset; } +#else /*Concurrent*/ + PutOp(Op_Acset); +#endif /*Concurrent*/ + PushVal(D_Cset); + opnd = GetWord; + opnd += (word)ipc.opnd; #ifdef Concurrent - PutInstr(Op_Acset, opnd, 1); -#else /*Concurrent*/ - PutWord(opnd); -#endif /*Concurrent*/ - PushAVal(opnd); - InterpEVValD((dptr)(rsp-1), e_literal); + PutInstr(Op_Acset, opnd, 1); +#else /*Concurrent*/ + PutWord(opnd); +#endif /*Concurrent*/ + PushAVal(opnd); + InterpEVValD((dptr)(rsp-1), e_literal); MUTEX_UNLOCKID(MTX_OP_ACSET); - break; + break; - case Op_Acset: /* cset, absolute address */ + case Op_Acset: /* cset, absolute address */ L_acset: - PushVal(D_Cset); - PushAVal(GetWord); - InterpEVValD((dptr)(rsp-1), e_literal); - break; - - case Op_Int: /* integer */ - PushVal(D_Integer); - PushVal(GetWord); - InterpEVValD((dptr)(rsp-1), e_literal); - break; - - case Op_Real: /* real */ + PushVal(D_Cset); + PushAVal(GetWord); + InterpEVValD((dptr)(rsp-1), e_literal); + break; + + case Op_Int: /* integer */ + PushVal(D_Integer); + PushVal(GetWord); + InterpEVValD((dptr)(rsp-1), e_literal); + break; + + case Op_Real: /* real */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_AREAL); - if (ipc.op[-1] == Op_Areal) { - MUTEX_UNLOCKID(MTX_OP_AREAL); goto L_areal; } -#else /*Concurrent*/ - PutOp(Op_Areal); -#endif /*Concurrent*/ - PushVal(D_Real); - opnd = GetWord; - opnd += (word)ipc.opnd; + MUTEX_LOCKID(MTX_OP_AREAL); + if (ipc.op[-1] == Op_Areal) { + MUTEX_UNLOCKID(MTX_OP_AREAL); goto L_areal; } +#else /*Concurrent*/ + PutOp(Op_Areal); +#endif /*Concurrent*/ + PushVal(D_Real); + opnd = GetWord; + opnd += (word)ipc.opnd; #ifdef DescriptorDouble - /* - * Now it is a pointer, but we want it to be the actual double. - * Fetch the bit pattern needed. Beware of fetching as real and - * casting to word (int); it will change the value. - */ - opnd = ((dptr)opnd)->vword.integr; - PushVal( opnd ); + /* + * Now it is a pointer, but we want it to be the actual double. + * Fetch the bit pattern needed. Beware of fetching as real and + * casting to word (int); it will change the value. + */ + opnd = ((dptr)opnd)->vword.integr; + PushVal( opnd ); #else - PushAVal(opnd); -#endif /* DescriptorDouble */ + PushAVal(opnd); +#endif /* DescriptorDouble */ #ifdef Concurrent - PutInstr(Op_Areal, opnd, 1); -#else /*Concurrent*/ - PutWord(opnd); -#endif /*Concurrent*/ - InterpEVValD((dptr)(rsp-1), e_literal); + PutInstr(Op_Areal, opnd, 1); +#else /*Concurrent*/ + PutWord(opnd); +#endif /*Concurrent*/ + InterpEVValD((dptr)(rsp-1), e_literal); MUTEX_UNLOCKID(MTX_OP_AREAL); - break; + break; - case Op_Areal: /* real, absolute address */ + case Op_Areal: /* real, absolute address */ L_areal: - PushVal(D_Real); + PushVal(D_Real); #ifdef DescriptorDouble - PushVal(GetWord); -#else /* DescriptorDouble */ - PushAVal(GetWord); -#endif /* DescriptorDouble */ - InterpEVValD((dptr)(rsp-1), e_literal); - break; - - case Op_Str: /* string */ + PushVal(GetWord); +#else /* DescriptorDouble */ + PushAVal(GetWord); +#endif /* DescriptorDouble */ + InterpEVValD((dptr)(rsp-1), e_literal); + break; + + case Op_Str: /* string */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_ASTR); + MUTEX_LOCKID(MTX_OP_ASTR); if (ipc.op[-1] == Op_Astr) { - MUTEX_UNLOCKID(MTX_OP_ASTR); goto L_astr; } -#else /*Concurrent*/ - PutOp(Op_Astr); -#endif /*Concurrent*/ - PushVal(GetWord) + MUTEX_UNLOCKID(MTX_OP_ASTR); goto L_astr; } +#else /*Concurrent*/ + PutOp(Op_Astr); +#endif /*Concurrent*/ + PushVal(GetWord) #ifdef MultiProgram - /* - * if the current procedure is not within the current program - * state, then lookup the program state of the current procedure, - * and use its globals instead of the current program state. - */ - if (!InRange(code, ipc.opnd, endcode)) { - struct progstate *p = findicode(ipc.opnd); - opnd = (word)(p->Strcons + GetWord); - } - else -#endif /* MultiProgram */ + /* + * if the current procedure is not within the current program + * state, then lookup the program state of the current procedure, + * and use its globals instead of the current program state. + */ + if (!InRange(code, ipc.opnd, endcode)) { + struct progstate *p = findicode(ipc.opnd); + opnd = (word)(p->Strcons + GetWord); + } + else +#endif /* MultiProgram */ opnd = (word)strcons + GetWord; #ifdef Concurrent - PutInstr(Op_Astr, opnd, 2); -#else /*Concurrent*/ - PutWord(opnd); -#endif /*Concurrent*/ - PushAVal(opnd); - InterpEVValD((dptr)(rsp-1), e_literal); + PutInstr(Op_Astr, opnd, 2); +#else /*Concurrent*/ + PutWord(opnd); +#endif /*Concurrent*/ + PushAVal(opnd); + InterpEVValD((dptr)(rsp-1), e_literal); MUTEX_UNLOCKID(MTX_OP_ASTR); - break; + break; - case Op_Astr: /* string, absolute address */ + case Op_Astr: /* string, absolute address */ L_astr: - PushVal(GetWord); - PushAVal(GetWord); - InterpEVValD((dptr)(rsp-1), e_literal); - break; + PushVal(GetWord); + PushAVal(GetWord); + InterpEVValD((dptr)(rsp-1), e_literal); + break; - /* ---Variable construction--- */ + /* ---Variable construction--- */ - case Op_Arg: /* argument */ - PushVal(D_Var); - PushAVal(&glbl_argp[GetWord + 1]); - break; + case Op_Arg: /* argument */ + PushVal(D_Var); + PushAVal(&glbl_argp[GetWord + 1]); + break; - case Op_Global: /* global */ + case Op_Global: /* global */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_AGLOBAL); + MUTEX_LOCKID(MTX_OP_AGLOBAL); if (ipc.op[-1] == Op_Aglobal) { - MUTEX_UNLOCKID(MTX_OP_AGLOBAL); goto L_aglobal; } -#else /*Concurrent*/ - PutOp(Op_Aglobal); -#endif /*Concurrent*/ - PushVal(D_Var); - opnd = GetWord; + MUTEX_UNLOCKID(MTX_OP_AGLOBAL); goto L_aglobal; } +#else /*Concurrent*/ + PutOp(Op_Aglobal); +#endif /*Concurrent*/ + PushVal(D_Var); + opnd = GetWord; #ifdef MultiProgram - /* - * if the current procedure is not within the current program - * state, then lookup the program state of the current procedure, - * and use its globals instead of the current program state. - */ - if (!InRange(code, ipc.opnd, endcode)) { - struct progstate *p = findicode(ipc.opnd); - PushAVal(&(p->Globals[opnd])); - PutWord((word)&(p->Globals[opnd])); - } - else -#endif /* MultiProgram */ - { - PushAVal(&globals[opnd]); + /* + * if the current procedure is not within the current program + * state, then lookup the program state of the current procedure, + * and use its globals instead of the current program state. + */ + if (!InRange(code, ipc.opnd, endcode)) { + struct progstate *p = findicode(ipc.opnd); + PushAVal(&(p->Globals[opnd])); + PutWord((word)&(p->Globals[opnd])); + } + else +#endif /* MultiProgram */ + { + PushAVal(&globals[opnd]); #ifdef Concurrent - PutInstr(Op_Aglobal, (word)&globals[opnd], 1); -#else /*Concurrent*/ - PutWord((word)&globals[opnd]); -#endif /*Concurrent*/ - } + PutInstr(Op_Aglobal, (word)&globals[opnd], 1); +#else /*Concurrent*/ + PutWord((word)&globals[opnd]); +#endif /*Concurrent*/ + } MUTEX_UNLOCKID(MTX_OP_AGLOBAL); - break; + break; - case Op_Aglobal: /* global, absolute address */ + case Op_Aglobal: /* global, absolute address */ L_aglobal: - PushVal(D_Var); - PushAVal(GetWord); - break; + PushVal(D_Var); + PushAVal(GetWord); + break; - case Op_Local: /* local */ - PushVal(D_Var); - PushAVal(&pfp->pf_locals[GetWord]); - break; + case Op_Local: /* local */ + PushVal(D_Var); + PushAVal(&pfp->pf_locals[GetWord]); + break; - case Op_Static: /* static */ + case Op_Static: /* static */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_ASTATIC); + MUTEX_LOCKID(MTX_OP_ASTATIC); if (ipc.op[-1] == Op_Astatic) { - MUTEX_UNLOCKID(MTX_OP_ASTATIC); goto L_astatic; } -#else /*Concurrent*/ - PutOp(Op_Astatic); -#endif /*Concurrent*/ - PushVal(D_Var); - opnd = GetWord; + MUTEX_UNLOCKID(MTX_OP_ASTATIC); goto L_astatic; } +#else /*Concurrent*/ + PutOp(Op_Astatic); +#endif /*Concurrent*/ + PushVal(D_Var); + opnd = GetWord; #ifdef MultiProgram - /* - * if the current procedure is not within the current program - * state, then lookup the program state of the current procedure, - * and use its statics instead of the current program state. - */ - if (!InRange(code, ipc.opnd, endcode)) { - struct progstate *p = findicode(ipc.opnd); - PushAVal(&(p->Statics[opnd])); - PutWord((word)&(p->Statics[opnd])); - } - else -#endif /* MultiProgram */ - { - PushAVal(&statics[opnd]); + /* + * if the current procedure is not within the current program + * state, then lookup the program state of the current procedure, + * and use its statics instead of the current program state. + */ + if (!InRange(code, ipc.opnd, endcode)) { + struct progstate *p = findicode(ipc.opnd); + PushAVal(&(p->Statics[opnd])); + PutWord((word)&(p->Statics[opnd])); + } + else +#endif /* MultiProgram */ + { + PushAVal(&statics[opnd]); #ifdef Concurrent - PutInstr(Op_Astatic, (word)&statics[opnd], 1); -#else /*Concurrent*/ - PutWord((word)&statics[opnd]); -#endif /*Concurrent*/ - } + PutInstr(Op_Astatic, (word)&statics[opnd], 1); +#else /*Concurrent*/ + PutWord((word)&statics[opnd]); +#endif /*Concurrent*/ + } MUTEX_UNLOCKID(MTX_OP_ASTATIC); - break; + break; - case Op_Astatic: /* static, absolute address */ + case Op_Astatic: /* static, absolute address */ L_astatic: - PushVal(D_Var); - PushAVal(GetWord); - break; + PushVal(D_Var); + PushAVal(GetWord); + break; - /* ---Operators--- */ + /* ---Operators--- */ - /* Unary operators */ + /* Unary operators */ - case Op_Compl: /* ~e */ - case Op_Neg: /* -e */ - case Op_Number: /* +e */ - case Op_Refresh: /* ^e */ - case Op_Size: /* *e */ - Setup_Op(1, e_ocall); - HandleOVLD(1); - DerefArg(1); - Call_Cond(e_ofail); + case Op_Compl: /* ~e */ + case Op_Neg: /* -e */ + case Op_Number: /* +e */ + case Op_Refresh: /* ^e */ + case Op_Size: /* *e */ + Setup_Op(1, e_ocall); + HandleOVLD(1); + DerefArg(1); + Call_Cond(e_ofail); - case Op_Value: /* .e */ + case Op_Value: /* .e */ Setup_Op(1, e_ocall); DerefArg(1); Call_Cond(e_ofail); - case Op_Nonnull: /* \e */ - case Op_Null: /* /e */ - Setup_Op(1, e_ocall); - Call_Cond(e_ofail); - - case Op_Random: /* ?e */ - PushNull; - Setup_Op(2, e_ocall) - HandleOVLD(1); - Call_Cond(e_ofail) - - /* Generative unary operators */ - - case Op_Tabmat: /* =e */ - Setup_Op(1, e_ocall); - HandleOVLD(1); - DerefArg(1); - Call_Gen; - - case Op_Bang: /* !e */ - PushNull; - Setup_Op(2, e_ocall); - HandleOVLD(1); - Call_Gen; - - /* Binary operators */ - - case Op_Cat: /* e1 || e2 */ - case Op_Diff: /* e1 -- e2 */ - case Op_Div: /* e1 / e2 */ - case Op_Inter: /* e1 ** e2 */ - case Op_Lconcat: /* e1 ||| e2 */ - case Op_Minus: /* e1 - e2 */ - case Op_Mod: /* e1 % e2 */ - case Op_Mult: /* e1 * e2 */ - case Op_Power: /* e1 ^ e2 */ - case Op_Unions: /* e1 ++ e2 */ - case Op_Plus: /* e1 + e2 */ - case Op_Eqv: /* e1 === e2 */ - case Op_Lexeq: /* e1 == e2 */ - case Op_Lexge: /* e1 >>= e2 */ - case Op_Lexgt: /* e1 >> e2 */ - case Op_Lexle: /* e1 <<= e2 */ - case Op_Lexlt: /* e1 << e2 */ - case Op_Lexne: /* e1 ~== e2 */ - case Op_Neqv: /* e1 ~=== e2 */ - case Op_Numeq: /* e1 = e2 */ - case Op_Numge: /* e1 >= e2 */ - case Op_Numgt: /* e1 > e2 */ - case Op_Numle: /* e1 <= e2 */ - case Op_Numne: /* e1 ~= e2 */ - case Op_Numlt: /* e1 < e2 */ - Setup_Op(2, e_ocall); - HandleOVLD(2); - DerefArg(1); - DerefArg(2); - Call_Cond(e_ofail); - - case Op_Rcv: /* e1 @< e2 */ - case Op_RcvBk: /* e1 @<< e2 */ - case Op_Snd: /* e1 @> e2 */ - case Op_SndBk: /* e1 @>> e2 */ - Setup_Op(2, e_ocall); - DerefArg(1); - DerefArg(2); - Call_Cond(e_ofail); - - case Op_Asgn: /* e1 := e2 */ - Setup_Op(2, e_ocall); - Call_Cond(e_ofail); - - case Op_Swap: /* e1 :=: e2 */ - PushNull; - Setup_Op(3, e_ocall); - Call_Cond(e_ofail); - - case Op_Subsc: /* e1[e2] */ - PushNull; - Setup_Op(3, e_ocall); - HandleOVLD(2); - Call_Cond(e_ofail); - /* Generative binary operators */ - - case Op_Rasgn: /* e1 <- e2 */ - Setup_Op(2, e_ocall); - Call_Gen; - - case Op_Rswap: /* e1 <-> e2 */ - PushNull; - Setup_Op(3, e_ocall); - Call_Gen; - - /* Conditional ternary operators */ - - case Op_Sect: /* e1[e2:e3] */ - PushNull; - Setup_Op(4, e_ocall); - HandleOVLD(4); - Call_Cond(e_ofail); - /* Generative ternary operators */ - - case Op_Toby: /* e1 to e2 by e3 */ - Setup_Op(3, e_ocall); - HandleOVLD(3); - DerefArg(1); - DerefArg(2); - DerefArg(3); - Call_Gen; - - case Op_Noop: /* no-op */ - + case Op_Nonnull: /* \e */ + case Op_Null: /* /e */ + Setup_Op(1, e_ocall); + Call_Cond(e_ofail); + + case Op_Random: /* ?e */ + PushNull; + Setup_Op(2, e_ocall) + HandleOVLD(1); + Call_Cond(e_ofail) + + /* Generative unary operators */ + + case Op_Tabmat: /* =e */ + Setup_Op(1, e_ocall); + HandleOVLD(1); + DerefArg(1); + Call_Gen; + + case Op_Bang: /* !e */ + PushNull; + Setup_Op(2, e_ocall); + HandleOVLD(1); + Call_Gen; + + /* Binary operators */ + + case Op_Cat: /* e1 || e2 */ + case Op_Diff: /* e1 -- e2 */ + case Op_Div: /* e1 / e2 */ + case Op_Inter: /* e1 ** e2 */ + case Op_Lconcat: /* e1 ||| e2 */ + case Op_Minus: /* e1 - e2 */ + case Op_Mod: /* e1 % e2 */ + case Op_Mult: /* e1 * e2 */ + case Op_Power: /* e1 ^ e2 */ + case Op_Unions: /* e1 ++ e2 */ + case Op_Plus: /* e1 + e2 */ + case Op_Eqv: /* e1 === e2 */ + case Op_Lexeq: /* e1 == e2 */ + case Op_Lexge: /* e1 >>= e2 */ + case Op_Lexgt: /* e1 >> e2 */ + case Op_Lexle: /* e1 <<= e2 */ + case Op_Lexlt: /* e1 << e2 */ + case Op_Lexne: /* e1 ~== e2 */ + case Op_Neqv: /* e1 ~=== e2 */ + case Op_Numeq: /* e1 = e2 */ + case Op_Numge: /* e1 >= e2 */ + case Op_Numgt: /* e1 > e2 */ + case Op_Numle: /* e1 <= e2 */ + case Op_Numne: /* e1 ~= e2 */ + case Op_Numlt: /* e1 < e2 */ + Setup_Op(2, e_ocall); + HandleOVLD(2); + DerefArg(1); + DerefArg(2); + Call_Cond(e_ofail); + + case Op_Rcv: /* e1 @< e2 */ + case Op_RcvBk: /* e1 @<< e2 */ + case Op_Snd: /* e1 @> e2 */ + case Op_SndBk: /* e1 @>> e2 */ + Setup_Op(2, e_ocall); + DerefArg(1); + DerefArg(2); + Call_Cond(e_ofail); + + case Op_Asgn: /* e1 := e2 */ + Setup_Op(2, e_ocall); + Call_Cond(e_ofail); + + case Op_Swap: /* e1 :=: e2 */ + PushNull; + Setup_Op(3, e_ocall); + Call_Cond(e_ofail); + + case Op_Subsc: /* e1[e2] */ + PushNull; + Setup_Op(3, e_ocall); + HandleOVLD(2); + Call_Cond(e_ofail); + /* Generative binary operators */ + + case Op_Rasgn: /* e1 <- e2 */ + Setup_Op(2, e_ocall); + Call_Gen; + + case Op_Rswap: /* e1 <-> e2 */ + PushNull; + Setup_Op(3, e_ocall); + Call_Gen; + + /* Conditional ternary operators */ + + case Op_Sect: /* e1[e2:e3] */ + PushNull; + Setup_Op(4, e_ocall); + HandleOVLD(4); + Call_Cond(e_ofail); + /* Generative ternary operators */ + + case Op_Toby: /* e1 to e2 by e3 */ + Setup_Op(3, e_ocall); + HandleOVLD(3); + DerefArg(1); + DerefArg(2); + DerefArg(3); + Call_Gen; + + case Op_Noop: /* no-op */ + #ifdef LineCodes #ifdef Polling if (!pollctr--) { - ExInterp_sp; + ExInterp_sp; pollctr = pollevent(); - EntInterp_sp; - if (pollctr == -1) fatalerr(141, NULL); - } -#endif /* Polling */ + EntInterp_sp; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif /* Polling */ -#endif /* LineCodes */ +#endif /* LineCodes */ break; - case Op_Colm: /* source column number */ + case Op_Colm: /* source column number */ { #if e_loc word loc; column = GetWord; loc = column; - loc <<= (WordBits >> 1); /* column in high-order part */ + loc <<= (WordBits >> 1); /* column in high-order part */ loc += line_num; InterpEVVal(loc, E_Loc); -#endif /* E_Loc */ +#endif /* E_Loc */ break; } - case Op_Line: /* source line number */ + case Op_Line: /* source line number */ #if defined(LineCodes) && defined(Polling) if (!pollctr--) { - ExInterp_sp; + ExInterp_sp; pollctr = pollevent(); - EntInterp_sp; - if (pollctr == -1) fatalerr(141, NULL); - } -#endif /* LineCodes && Polling */ + EntInterp_sp; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif /* LineCodes && Polling */ line_num = GetWord; #ifdef MultiProgram lastline = line_num; -#endif /* MultiProgram */ +#endif /* MultiProgram */ break; - /* ---String Scanning--- */ + /* ---String Scanning--- */ - case Op_Bscan: /* prepare for scanning */ - PushDesc(k_subject); - PushVal(D_Integer); - PushVal(k_pos); - Setup_Arg(2); + case Op_Bscan: /* prepare for scanning */ + PushDesc(k_subject); + PushVal(D_Integer); + PushVal(k_pos); + Setup_Arg(2); - signal = Obscan(2,rargp); + signal = Obscan(2,rargp); - goto C_rtn_term; + goto C_rtn_term; - case Op_Escan: /* exit from scanning */ - Setup_Arg(1); + case Op_Escan: /* exit from scanning */ + Setup_Arg(1); - signal = Oescan(1,rargp); + signal = Oescan(1,rargp); - goto C_rtn_term; + goto C_rtn_term; - /* ---Other Language Operations--- */ + /* ---Other Language Operations--- */ - case Op_Apply: { /* apply, a.k.a. binary bang */ + case Op_Apply: { /* apply, a.k.a. binary bang */ union block *bp; int i, j; - value_tmp = *(dptr)(rsp - 1); /* argument */ + value_tmp = *(dptr)(rsp - 1); /* argument */ Deref(value_tmp); switch (Type(value_tmp)) { case T_List: { - rsp -= 2; /* pop it off */ + rsp -= 2; /* pop it off */ bp = BlkLoc(value_tmp); args = (int)Blk(bp,List)->size; #ifdef StackCheck - /* - * Make a stab at catching interpreter stack overflow. - * This does not detect C stack overflow. - */ - if ((char *)sp + args * sizeof(struct descrip) + PerilDelta > + /* + * Make a stab at catching interpreter stack overflow. + * This does not detect C stack overflow. + */ + if ((char *)sp + args * sizeof(struct descrip) + PerilDelta > (char *)(BlkD(k_current,Coexpr)->es_stackend)) { - fatalerr(301, NULL); - } -#else /* StackCheck */ + fatalerr(301, NULL); + } +#else /* StackCheck */ #ifndef MultiProgram - /* - * Make a stab at catching interpreter stack overflow. - * This does nothing for invocation in a co-expression other - * than &main. - */ - if (BlkLoc(k_current) == BlkLoc(k_main) && - ((char *)sp + args * sizeof(struct descrip) > + /* + * Make a stab at catching interpreter stack overflow. + * This does nothing for invocation in a co-expression other + * than &main. + */ + if (BlkLoc(k_current) == BlkLoc(k_main) && + ((char *)sp + args * sizeof(struct descrip) > (char *)stackend)) - fatalerr(301, NULL); -#endif /* MultiProgram */ -#endif /* StackCheck */ + fatalerr(301, NULL); +#endif /* MultiProgram */ +#endif /* StackCheck */ #ifdef Arrays - if(Blk(bp,List)->listtail) { -#endif /* Arrays */ + if(Blk(bp,List)->listtail) { +#endif /* Arrays */ for (bp = Blk(bp,List)->listhead; BlkType(bp) == T_Lelem; - bp = Blk(bp,Lelem)->listnext) { - for (i = 0; i < Blk(bp,Lelem)->nused; i++) { - j = bp->Lelem.first + i; - if (j >= bp->Lelem.nslots) - j -= bp->Lelem.nslots; - PushDesc(bp->Lelem.lslots[j]); - } - } + bp = Blk(bp,Lelem)->listnext) { + for (i = 0; i < Blk(bp,Lelem)->nused; i++) { + j = bp->Lelem.first + i; + if (j >= bp->Lelem.nslots) + j -= bp->Lelem.nslots; + PushDesc(bp->Lelem.lslots[j]); + } + } #ifdef Arrays - } - else { - bp = Blk(bp,List)->listhead; - if (bp->Intarray.title==T_Intarray) { - for (i = 0; i < args; i++) { - PushVal(D_Integer); - PushVal(bp->Intarray.a[i]); - } - } - else { /* not list or an intarray, must be a realarray */ + } + else { + bp = Blk(bp,List)->listhead; + if (bp->Intarray.title==T_Intarray) { + for (i = 0; i < args; i++) { + PushVal(D_Integer); + PushVal(bp->Intarray.a[i]); + } + } + else { /* not list or an intarray, must be a realarray */ #ifndef DescriptorDouble - reserve(Blocks, args * sizeof(struct b_real)); - bp = BlkLoc(value_tmp)->List.listhead; + reserve(Blocks, args * sizeof(struct b_real)); + bp = BlkLoc(value_tmp)->List.listhead; #endif - for (i = 0; i < args; i++) { - PushVal(D_Real); + for (i = 0; i < args; i++) { + PushVal(D_Real); #ifdef DescriptorDouble - PushVal(*(word *)(bp->Realarray.a+i)); + PushVal(*(word *)(bp->Realarray.a+i)); #else - PushAVal(alcreal(bp->Realarray.a[i])); + PushAVal(alcreal(bp->Realarray.a[i])); #endif - } - } - } -#endif /* Arrays */ + } + } + } +#endif /* Arrays */ - goto invokej; - } + goto invokej; + } case T_Record: { - rsp -= 2; /* pop it off */ + rsp -= 2; /* pop it off */ bp = (union block *)BlkD(value_tmp, Record); args = Blk(bp->Record.recdesc,Proc)->nfields; for (i = 0; i < args; i++) { @@ -1226,95 +1226,95 @@ L_astatic: goto invokej; } - default: { /* illegal type for invocation */ + default: { /* illegal type for invocation */ xargp = (dptr)(rsp - 3); err_msg(126, &value_tmp); goto efail; } } - } + } - case Op_Invoke: { /* invoke */ + case Op_Invoke: { /* invoke */ args = (int)GetWord; invokej: - { + { int nargs; - dptr carg; + dptr carg; - ExInterp_sp; + ExInterp_sp; #if e_stack - EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_stack); + EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_stack); #endif #ifdef StackCheck - /* - * Make a stab at catching interpreter stack overflow. This does - * not detect C stack overflow. - */ - if (((char *)sp + PerilDelta) > - (char *)(BlkD(k_current,Coexpr)->es_stackend)) - fatalerr(301, NULL); -#endif /* StackCheck */ - - type = invoke(args, &carg, &nargs); - EntInterp_sp; - - if (type == I_Fail) - goto efail_noev; - if (type == I_Continue) - break; - else { - - rargp = carg; /* valid only for Vararg or Builtin */ + /* + * Make a stab at catching interpreter stack overflow. This does + * not detect C stack overflow. + */ + if (((char *)sp + PerilDelta) > + (char *)(BlkD(k_current,Coexpr)->es_stackend)) + fatalerr(301, NULL); +#endif /* StackCheck */ + + type = invoke(args, &carg, &nargs); + EntInterp_sp; + + if (type == I_Fail) + goto efail_noev; + if (type == I_Continue) + break; + else { + + rargp = carg; /* valid only for Vararg or Builtin */ #ifdef Polling - /* - * Do polling here - */ - pollctr >>= 1; + /* + * Do polling here + */ + pollctr >>= 1; if (!pollctr) { - ExInterp_sp; + ExInterp_sp; pollctr = pollevent(); - EntInterp_sp; - if (pollctr == -1) fatalerr(141, NULL); - } -#endif /* Polling */ + EntInterp_sp; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif /* Polling */ #ifdef MultiProgram - lastev = E_Function; - lastdesc = *rargp; - InterpEVValD(rargp, e_fcall); -#endif /* MultiProgram */ + lastev = E_Function; + lastdesc = *rargp; + InterpEVValD(rargp, e_fcall); +#endif /* MultiProgram */ - bproc = BlkD(*rargp, Proc); + bproc = BlkD(*rargp, Proc); #ifdef FncTrace typedef int (*bfunc2)(dptr, struct descrip *); -#endif /* FncTrace */ +#endif /* FncTrace */ - /* ExInterp not needed since no change since last EntInterp */ - if (type == I_Vararg) { - int (*bfunc)(); + /* ExInterp not needed since no change since last EntInterp */ + if (type == I_Vararg) { + int (*bfunc)(); bfunc = bproc->entryp.ccode; #ifdef FncTrace signal = (*bfunc)(nargs, rargp, &(procs->pname)); -#else /* FncTrace */ - signal = (*bfunc)(nargs,rargp); -#endif /* FncTrace */ +#else /* FncTrace */ + signal = (*bfunc)(nargs,rargp); +#endif /* FncTrace */ } - else + else { int (*bfunc)(); bfunc = bproc->entryp.ccode; #ifdef FncTrace signal = (*(bfunc2)bfunc)(rargp, &(bproc->pname)); -#else /* FncTrace */ - signal = (*bfunc)(rargp); -#endif /* FncTrace */ +#else /* FncTrace */ + signal = (*bfunc)(rargp); +#endif /* FncTrace */ } #ifdef FncTrace @@ -1325,823 +1325,823 @@ invokej: else rtrace(&(bproc->pname),rargp); } -#endif /* FncTrace */ +#endif /* FncTrace */ - goto C_rtn_term; - } - } - break; - } + goto C_rtn_term; + } + } + break; + } - case Op_Keywd: /* keyword */ + case Op_Keywd: /* keyword */ PushNull; opnd = GetWord; Setup_Arg(0); - signal = (*(keytab[(int)opnd]))(rargp); - goto C_rtn_term; + signal = (*(keytab[(int)opnd]))(rargp); + goto C_rtn_term; - case Op_Llist: /* construct list */ - opnd = GetWord; + case Op_Llist: /* construct list */ + opnd = GetWord; #ifdef MultiProgram value_tmp.dword = D_Proc; value_tmp.vword.bptr = (union block *)&mt_llist; lastev = E_Operator; - lastdesc = value_tmp; + lastdesc = value_tmp; InterpEVValD(&value_tmp, e_ocall); rargp = (dptr)(rsp - 1) - opnd; xargp = rargp; ExInterp_sp; -#else /* MultiProgram */ - Setup_Arg(opnd); -#endif /* MultiProgram */ +#else /* MultiProgram */ + Setup_Arg(opnd); +#endif /* MultiProgram */ - { - int i; - for (i=1;i<=opnd;i++) + { + int i; + for (i=1;i<=opnd;i++) DerefArg(i); - } + } - signal = Ollist((int)opnd,rargp); + signal = Ollist((int)opnd,rargp); - value_tmp = nulldesc; + value_tmp = nulldesc; - goto C_rtn_term; + goto C_rtn_term; - /* ---Marking and Unmarking--- */ + /* ---Marking and Unmarking--- */ - case Op_Mark: /* create expression frame marker */ + case Op_Mark: /* create expression frame marker */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_AMARK); + MUTEX_LOCKID(MTX_OP_AMARK); if (ipc.op[-1] == Op_Amark) { - MUTEX_UNLOCKID(MTX_OP_AMARK); goto L_amark; } -#else /*Concurrent*/ - PutOp(Op_Amark); -#endif /*Concurrent*/ - opnd = GetWord; - opnd += (word)ipc.opnd; + MUTEX_UNLOCKID(MTX_OP_AMARK); goto L_amark; } +#else /*Concurrent*/ + PutOp(Op_Amark); +#endif /*Concurrent*/ + opnd = GetWord; + opnd += (word)ipc.opnd; #ifdef Concurrent - PutInstr(Op_Amark, opnd, 1); -#else /*Concurrent*/ - PutWord(opnd); -#endif /*Concurrent*/ - newefp = (struct ef_marker *)(rsp + 1); - newefp->ef_failure.opnd = (word *)opnd; + PutInstr(Op_Amark, opnd, 1); +#else /*Concurrent*/ + PutWord(opnd); +#endif /*Concurrent*/ + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)opnd; MUTEX_UNLOCKID(MTX_OP_AMARK); - goto mark; + goto mark; - case Op_Amark: /* mark with absolute fipc */ + case Op_Amark: /* mark with absolute fipc */ L_amark: - newefp = (struct ef_marker *)(rsp + 1); - newefp->ef_failure.opnd = (word *)GetWord; + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)GetWord; mark: - newefp->ef_gfp = gfp; - newefp->ef_efp = efp; - newefp->ef_ilevel = ilevel; - InterpEVValS((word *) ipc.opnd, E_Syntax);/* -new- */ - rsp += Wsizeof(*efp); - efp = newefp; - gfp = 0; + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; + InterpEVValS((word *) ipc.opnd, E_Syntax);/* -new- */ + rsp += Wsizeof(*efp); + efp = newefp; + gfp = 0; InterpEVVal(newefp->ef_failure.opnd, E_Operand); - break; + break; - case Op_Mark0: /* create expression frame with 0 ipl */ + case Op_Mark0: /* create expression frame with 0 ipl */ mark0: - newefp = (struct ef_marker *)(rsp + 1); - newefp->ef_failure.opnd = 0; - newefp->ef_gfp = gfp; - newefp->ef_efp = efp; - newefp->ef_ilevel = ilevel; + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = 0; + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; InterpEVValS((word *) ipc.opnd, E_Syntax);/* -new- */ - rsp += Wsizeof(*efp); - efp = newefp; - gfp = 0; + rsp += Wsizeof(*efp); + efp = newefp; + gfp = 0; InterpEVVal(newefp->ef_failure.opnd, E_Operand); - break; + break; - case Op_Unmark: /* remove expression frame */ + case Op_Unmark: /* remove expression frame */ #if e_prem || e_erem - ExInterp_sp; + ExInterp_sp; vanq_bound(efp, gfp); - EntInterp_sp; -#endif /* E_Prem || E_Erem */ + EntInterp_sp; +#endif /* E_Prem || E_Erem */ - gfp = efp->ef_gfp; - rsp = (word *)efp - 1; + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; - /* - * Remove any suspended C generators. - */ + /* + * Remove any suspended C generators. + */ Unmark_uw: InterpEVValS((word *) ipc.opnd - 1, E_Syntax); /* -new- */ - if (efp->ef_ilevel < ilevel) { - --ilevel; - ExInterp_sp; - EVVal(A_Unmark_uw, e_intret); + if (efp->ef_ilevel < ilevel) { + --ilevel; + ExInterp_sp; + EVVal(A_Unmark_uw, e_intret); #ifdef StackCheck - EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ - EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Unmark_uw; - } - - efp = efp->ef_efp; - break; - - /* ---Suspensions--- */ - - case Op_Esusp: { /* suspend from expression */ - - /* - * Create the generator frame. - */ - oldsp = rsp; - newgfp = (struct gf_marker *)(rsp + 1); - newgfp->gf_gentype = G_Esusp; - newgfp->gf_gfp = gfp; - newgfp->gf_efp = efp; - newgfp->gf_ipc = ipc; - gfp = newgfp; - rsp += Wsizeof(struct gf_smallmarker); - - /* - * Region extends from first word after enclosing generator or - * expression frame marker to marker for current expression frame. - */ - if (efp->ef_gfp != 0) { - newgfp = (struct gf_marker *)(efp->ef_gfp); - if (newgfp->gf_gentype == G_Psusp) - firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); - else - firstwd = (word *)efp->ef_gfp + - Wsizeof(struct gf_smallmarker); - } - else - firstwd = (word *)efp->ef_efp + Wsizeof(*efp); - lastwd = (word *)efp - 1; - efp = efp->ef_efp; - - /* - * Copy the portion of the stack with endpoints firstwd and lastwd - * (inclusive) to the top of the stack. - */ - for (wd = firstwd; wd <= lastwd; wd++) - *++rsp = *wd; - PushVal(oldsp[-1]); - PushVal(oldsp[0]); - break; - } - - case Op_Lsusp: { /* suspend from limitation */ - struct descrip sval; - - /* - * The limit counter is contained in the descriptor immediately - * prior to the current expression frame. lval is established - * as a pointer to this descriptor. - */ - dptr lval = (dptr)((word *)efp - 2); - - /* - * Decrement the limit counter and check it. - */ - if (--IntVal(*lval) > 0) { - /* - * The limit has not been reached, set up stack. - */ - - sval = *(dptr)(rsp - 1); /* save result */ - - /* - * Region extends from first word after enclosing generator or - * expression frame marker to the limit counter just prior to - * to the current expression frame marker. - */ - if (efp->ef_gfp != 0) { - newgfp = (struct gf_marker *)(efp->ef_gfp); - if (newgfp->gf_gentype == G_Psusp) - firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); - else - firstwd = (word *)efp->ef_gfp + - Wsizeof(struct gf_smallmarker); - } - else - firstwd = (word *)efp->ef_efp + Wsizeof(*efp); - lastwd = (word *)efp - 3; - if (gfp == 0) - gfp = efp->ef_gfp; - efp = efp->ef_efp; - - /* - * Copy the portion of the stack with endpoints firstwd and lastwd - * (inclusive) to the top of the stack. - */ - rsp -= 2; /* overwrite result */ - for (wd = firstwd; wd <= lastwd; wd++) - *++rsp = *wd; - PushDesc(sval); /* push saved result */ - } - else { - /* - * Otherwise, the limit has been reached. Instead of - * suspending, remove the current expression frame and - * replace the limit counter with the value on top of - * the stack (which would have been suspended had the - * limit not been reached). - */ - *lval = *(dptr)(rsp - 1); + EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); +#else /* StackCheck */ + EVVal(DiffPtrs(sp, stack), e_cstack); +#endif /* StackCheck */ + return A_Unmark_uw; + } + + efp = efp->ef_efp; + break; + + /* ---Suspensions--- */ + + case Op_Esusp: { /* suspend from expression */ + + /* + * Create the generator frame. + */ + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Esusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + gfp = newgfp; + rsp += Wsizeof(struct gf_smallmarker); + + /* + * Region extends from first word after enclosing generator or + * expression frame marker to marker for current expression frame. + */ + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); + else + firstwd = (word *)efp->ef_gfp + + Wsizeof(struct gf_smallmarker); + } + else + firstwd = (word *)efp->ef_efp + Wsizeof(*efp); + lastwd = (word *)efp - 1; + efp = efp->ef_efp; + + /* + * Copy the portion of the stack with endpoints firstwd and lastwd + * (inclusive) to the top of the stack. + */ + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushVal(oldsp[-1]); + PushVal(oldsp[0]); + break; + } + + case Op_Lsusp: { /* suspend from limitation */ + struct descrip sval; + + /* + * The limit counter is contained in the descriptor immediately + * prior to the current expression frame. lval is established + * as a pointer to this descriptor. + */ + dptr lval = (dptr)((word *)efp - 2); + + /* + * Decrement the limit counter and check it. + */ + if (--IntVal(*lval) > 0) { + /* + * The limit has not been reached, set up stack. + */ + + sval = *(dptr)(rsp - 1); /* save result */ + + /* + * Region extends from first word after enclosing generator or + * expression frame marker to the limit counter just prior to + * to the current expression frame marker. + */ + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); + else + firstwd = (word *)efp->ef_gfp + + Wsizeof(struct gf_smallmarker); + } + else + firstwd = (word *)efp->ef_efp + Wsizeof(*efp); + lastwd = (word *)efp - 3; + if (gfp == 0) + gfp = efp->ef_gfp; + efp = efp->ef_efp; + + /* + * Copy the portion of the stack with endpoints firstwd and lastwd + * (inclusive) to the top of the stack. + */ + rsp -= 2; /* overwrite result */ + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushDesc(sval); /* push saved result */ + } + else { + /* + * Otherwise, the limit has been reached. Instead of + * suspending, remove the current expression frame and + * replace the limit counter with the value on top of + * the stack (which would have been suspended had the + * limit not been reached). + */ + *lval = *(dptr)(rsp - 1); #if e_prem || e_erem - ExInterp_sp; + ExInterp_sp; vanq_bound(efp, gfp); - EntInterp_sp; -#endif /* E_Prem || E_Erem */ + EntInterp_sp; +#endif /* E_Prem || E_Erem */ - gfp = efp->ef_gfp; + gfp = efp->ef_gfp; - /* - * Since an expression frame is being removed, inactive - * C generators contained therein are deactivated. - */ + /* + * Since an expression frame is being removed, inactive + * C generators contained therein are deactivated. + */ Lsusp_uw: - if (efp->ef_ilevel < ilevel) { - --ilevel; - ExInterp_sp; + if (efp->ef_ilevel < ilevel) { + --ilevel; + ExInterp_sp; EVVal(A_Lsusp_uw, e_intret); #ifdef StackCheck - EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ - EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Lsusp_uw; - } - rsp = (word *)efp - 1; - efp = efp->ef_efp; - } - break; - } - - case Op_Psusp: { /* suspend from procedure */ - - /* - * An Icon procedure is suspending a value. Determine if the - * value being suspended should be dereferenced and if so, - * dereference it. If tracing is on, strace is called - * to generate a message. Appropriate values are - * restored from the procedure frame of the suspending procedure. - */ - - struct descrip tmp; + EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); +#else /* StackCheck */ + EVVal(DiffPtrs(sp, stack), e_cstack); +#endif /* StackCheck */ + return A_Lsusp_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + } + break; + } + + case Op_Psusp: { /* suspend from procedure */ + + /* + * An Icon procedure is suspending a value. Determine if the + * value being suspended should be dereferenced and if so, + * dereference it. If tracing is on, strace is called + * to generate a message. Appropriate values are + * restored from the procedure frame of the suspending procedure. + */ + + struct descrip tmp; dptr svalp; - struct b_proc *sproc; + struct b_proc *sproc; #if e_psusp - value_tmp = *(dptr)(rsp - 1); /* argument */ + value_tmp = *(dptr)(rsp - 1); /* argument */ Deref0(value_tmp); InterpEVValD(&value_tmp, E_Psusp); -#endif /* E_Psusp */ +#endif /* E_Psusp */ - svalp = (dptr)(rsp - 1); - if (Var(*svalp)) { + svalp = (dptr)(rsp - 1); + if (Var(*svalp)) { ExInterp_sp; retderef(svalp, (word *)glbl_argp, sp); EntInterp_sp; } - /* - * Create the generator frame. - */ - oldsp = rsp; - newgfp = (struct gf_marker *)(rsp + 1); - newgfp->gf_gentype = G_Psusp; - newgfp->gf_gfp = gfp; - newgfp->gf_efp = efp; - newgfp->gf_ipc = ipc; - newgfp->gf_argp = glbl_argp; - newgfp->gf_pfp = pfp; - gfp = newgfp; - rsp += Wsizeof(*gfp); - - /* - * Region extends from first word after the marker for the - * generator or expression frame enclosing the call to the - * now-suspending procedure to Arg0 of the procedure. - */ - if (pfp->pf_gfp != 0) { - newgfp = (struct gf_marker *)(pfp->pf_gfp); - if (newgfp->gf_gentype == G_Psusp) - firstwd = (word *)pfp->pf_gfp + Wsizeof(*gfp); - else - firstwd = (word *)pfp->pf_gfp + - Wsizeof(struct gf_smallmarker); - } - else - firstwd = (word *)pfp->pf_efp + Wsizeof(*efp); - lastwd = (word *)glbl_argp - 1; - efp = efp->ef_efp; - - /* - * Copy the portion of the stack with endpoints firstwd and lastwd - * (inclusive) to the top of the stack. - */ - for (wd = firstwd; wd <= lastwd; wd++) - *++rsp = *wd; - PushVal(oldsp[-1]); - PushVal(oldsp[0]); - --k_level; - if (k_trace) { + /* + * Create the generator frame. + */ + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Psusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + newgfp->gf_argp = glbl_argp; + newgfp->gf_pfp = pfp; + gfp = newgfp; + rsp += Wsizeof(*gfp); + + /* + * Region extends from first word after the marker for the + * generator or expression frame enclosing the call to the + * now-suspending procedure to Arg0 of the procedure. + */ + if (pfp->pf_gfp != 0) { + newgfp = (struct gf_marker *)(pfp->pf_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)pfp->pf_gfp + Wsizeof(*gfp); + else + firstwd = (word *)pfp->pf_gfp + + Wsizeof(struct gf_smallmarker); + } + else + firstwd = (word *)pfp->pf_efp + Wsizeof(*efp); + lastwd = (word *)glbl_argp - 1; + efp = efp->ef_efp; + + /* + * Copy the portion of the stack with endpoints firstwd and lastwd + * (inclusive) to the top of the stack. + */ + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushVal(oldsp[-1]); + PushVal(oldsp[0]); + --k_level; + if (k_trace) { k_trace--; - sproc = BlkD(*glbl_argp, Proc); - strace(&(sproc->pname), svalp); - } - - /* - * If the scanning environment for this procedure call is in - * a saved state, switch environments. - */ - if (pfp->pf_scan != NULL) { - InterpEVValD(&k_subject, e_ssusp); - tmp = k_subject; - k_subject = *pfp->pf_scan; - *pfp->pf_scan = tmp; - - tmp = *(pfp->pf_scan + 1); - IntVal(*(pfp->pf_scan + 1)) = k_pos; - k_pos = IntVal(tmp); - } - - efp = pfp->pf_efp; - ipc = pfp->pf_ipc; - glbl_argp = pfp->pf_argp; - pfp = pfp->pf_pfp; - value_tmp = nulldesc; - break; - } - - /* ---Returns--- */ - - case Op_Eret: { /* return from expression */ - /* - * Op_Eret removes the current expression frame, leaving the - * original top of stack value on top. - */ - /* - * Save current top of stack value in global temporary (no - * danger of reentry). - */ - eret_tmp = *(dptr)&rsp[-1]; - gfp = efp->ef_gfp; + sproc = BlkD(*glbl_argp, Proc); + strace(&(sproc->pname), svalp); + } + + /* + * If the scanning environment for this procedure call is in + * a saved state, switch environments. + */ + if (pfp->pf_scan != NULL) { + InterpEVValD(&k_subject, e_ssusp); + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + } + + efp = pfp->pf_efp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + value_tmp = nulldesc; + break; + } + + /* ---Returns--- */ + + case Op_Eret: { /* return from expression */ + /* + * Op_Eret removes the current expression frame, leaving the + * original top of stack value on top. + */ + /* + * Save current top of stack value in global temporary (no + * danger of reentry). + */ + eret_tmp = *(dptr)&rsp[-1]; + gfp = efp->ef_gfp; Eret_uw: - /* - * Since an expression frame is being removed, inactive - * C generators contained therein are deactivated. - */ - if (efp->ef_ilevel < ilevel) { - --ilevel; - ExInterp_sp; + /* + * Since an expression frame is being removed, inactive + * C generators contained therein are deactivated. + */ + if (efp->ef_ilevel < ilevel) { + --ilevel; + ExInterp_sp; EVVal(A_Eret_uw, e_intret); #ifdef StackCheck - EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ - EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Eret_uw; - } - rsp = (word *)efp - 1; - efp = efp->ef_efp; - PushDesc(eret_tmp); - eret_tmp = nulldesc; - break; - } - - - case Op_Pret: { /* return from procedure */ - /* - * An Icon procedure is returning a value. Determine if the - * value being returned should be dereferenced and if so, - * dereference it. If tracing is on, rtrace is called to - * generate a message. Inactive generators created after - * the activation of the procedure are deactivated. Appropriate - * values are restored from the procedure frame. - */ - struct b_proc *rproc; - rproc = BlkD(*glbl_argp, Proc); + EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); +#else /* StackCheck */ + EVVal(DiffPtrs(sp, stack), e_cstack); +#endif /* StackCheck */ + return A_Eret_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + PushDesc(eret_tmp); + eret_tmp = nulldesc; + break; + } + + + case Op_Pret: { /* return from procedure */ + /* + * An Icon procedure is returning a value. Determine if the + * value being returned should be dereferenced and if so, + * dereference it. If tracing is on, rtrace is called to + * generate a message. Inactive generators created after + * the activation of the procedure are deactivated. Appropriate + * values are restored from the procedure frame. + */ + struct b_proc *rproc; + rproc = BlkD(*glbl_argp, Proc); #if e_prem || e_erem - ExInterp_sp; + ExInterp_sp; vanq_proc(efp, gfp); - EntInterp_sp; -#endif /* E_Prem || E_Erem */ + EntInterp_sp; +#endif /* E_Prem || E_Erem */ #if e_pret - /* - * originally was InterpEVValD(argp,E_Pret) here. - * InterpEVValD(glbl_argp,E_Pret) would give the - * procedure as the event value; want actual return value. - * - * We do the E_Pret, using the return value in value_tmp, - * prior to replacing the procedure ref (in glbl_argp) - * with the return value. - */ - value_tmp = *(dptr)(rsp - 1); /* argument */ - Deref0(value_tmp); - InterpEVValD(&value_tmp, E_Pret); + /* + * originally was InterpEVValD(argp,E_Pret) here. + * InterpEVValD(glbl_argp,E_Pret) would give the + * procedure as the event value; want actual return value. + * + * We do the E_Pret, using the return value in value_tmp, + * prior to replacing the procedure ref (in glbl_argp) + * with the return value. + */ + value_tmp = *(dptr)(rsp - 1); /* argument */ + Deref0(value_tmp); + InterpEVValD(&value_tmp, E_Pret); #endif #ifdef MultiProgram - /* - * Store the procedure we are returning from, it may - * be useful in the E_Deref event in the retderef(). - */ - value_tmp = *glbl_argp; -#endif /* MultiProgram */ - *glbl_argp = *(dptr)(rsp - 1); - - if (Var(*glbl_argp)) { + /* + * Store the procedure we are returning from, it may + * be useful in the E_Deref event in the retderef(). + */ + value_tmp = *glbl_argp; +#endif /* MultiProgram */ + *glbl_argp = *(dptr)(rsp - 1); + + if (Var(*glbl_argp)) { ExInterp_sp; retderef(glbl_argp, (word *)glbl_argp, sp); EntInterp_sp; } - --k_level; - if (k_trace) { + --k_level; + if (k_trace) { k_trace--; - rtrace(&(rproc->pname), glbl_argp); + rtrace(&(rproc->pname), glbl_argp); } Pret_uw: - if (pfp->pf_ilevel < ilevel) { - --ilevel; - ExInterp_sp; + if (pfp->pf_ilevel < ilevel) { + --ilevel; + ExInterp_sp; EVVal(A_Pret_uw, e_intret); #ifdef StackCheck - EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ - EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Pret_uw; - } - - rsp = (word *)glbl_argp + 1; - efp = pfp->pf_efp; - gfp = pfp->pf_gfp; - ipc = pfp->pf_ipc; - glbl_argp = pfp->pf_argp; - pfp = pfp->pf_pfp; - value_tmp = nulldesc; - - /* - * Had moved E_Pret (via value_tmp) here for awhile, - * but don't we get duplicate E_Pret's due to unwinding here? - */ - - break; - } - - /* ---Failures--- */ - - case Op_Efail: + EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); +#else /* StackCheck */ + EVVal(DiffPtrs(sp, stack), e_cstack); +#endif /* StackCheck */ + return A_Pret_uw; + } + + rsp = (word *)glbl_argp + 1; + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + value_tmp = nulldesc; + + /* + * Had moved E_Pret (via value_tmp) here for awhile, + * but don't we get duplicate E_Pret's due to unwinding here? + */ + + break; + } + + /* ---Failures--- */ + + case Op_Efail: efail: InterpEVVal((word)-1, e_efail); efail_noev: - /* - * Failure has occurred in the current expression frame. - */ - if (gfp == 0) { - /* - * There are no suspended generators to resume. - * Remove the current expression frame, restoring - * values. - * - * If the failure ipc is 0, propagate failure to the - * enclosing frame by branching back to efail. - * This happens, for example, in looping control - * structures that fail when complete. - */ - - if (efp == 0) { - break; - } + /* + * Failure has occurred in the current expression frame. + */ + if (gfp == 0) { + /* + * There are no suspended generators to resume. + * Remove the current expression frame, restoring + * values. + * + * If the failure ipc is 0, propagate failure to the + * enclosing frame by branching back to efail. + * This happens, for example, in looping control + * structures that fail when complete. + */ + + if (efp == 0) { + break; + } oldipc = ipc; /* fixing the line zero return */ - ipc = efp->ef_failure; - gfp = efp->ef_gfp; - rsp = (word *)efp - 1; - efp = efp->ef_efp; + ipc = efp->ef_failure; + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; + efp = efp->ef_efp; - if (ipc.op == 0) - goto efail; + if (ipc.op == 0) + goto efail; if (pfp != NULL && sp != rsp) InterpEVValS((word *) ipc.opnd - 1, E_Syntax); /* -new- */ - break; - } + break; + } - else { - /* - * There is a generator that can be resumed. Make - * the stack adjustments and then switch on the - * type of the generator frame marker. - */ - struct descrip tmp; - register struct gf_marker *resgfp = gfp; + else { + /* + * There is a generator that can be resumed. Make + * the stack adjustments and then switch on the + * type of the generator frame marker. + */ + struct descrip tmp; + register struct gf_marker *resgfp = gfp; - type = (int)resgfp->gf_gentype; + type = (int)resgfp->gf_gentype; - if (type == G_Psusp) { - glbl_argp = resgfp->gf_argp; - if (k_trace) { /* procedure tracing */ + if (type == G_Psusp) { + glbl_argp = resgfp->gf_argp; + if (k_trace) { /* procedure tracing */ k_trace--; - ExInterp_sp; - atrace(&(BlkD(*glbl_argp, Proc)->pname)); - EntInterp_sp; - } - } - ipc = resgfp->gf_ipc; - efp = resgfp->gf_efp; - gfp = resgfp->gf_gfp; - rsp = (word *)resgfp - 1; - if (type == G_Psusp) { - pfp = resgfp->gf_pfp; - - /* - * If the scanning environment for this procedure call is - * supposed to be in a saved state, switch environments. - */ - if (pfp->pf_scan != NULL) { - tmp = k_subject; - k_subject = *pfp->pf_scan; - *pfp->pf_scan = tmp; - - tmp = *(pfp->pf_scan + 1); - IntVal(*(pfp->pf_scan + 1)) = k_pos; - k_pos = IntVal(tmp); - InterpEVValD(&k_subject, e_sresum); - } - - ++k_level; /* adjust procedure level */ - } - - switch (type) { - case G_Fsusp: - ExInterp_sp; + ExInterp_sp; + atrace(&(BlkD(*glbl_argp, Proc)->pname)); + EntInterp_sp; + } + } + ipc = resgfp->gf_ipc; + efp = resgfp->gf_efp; + gfp = resgfp->gf_gfp; + rsp = (word *)resgfp - 1; + if (type == G_Psusp) { + pfp = resgfp->gf_pfp; + + /* + * If the scanning environment for this procedure call is + * supposed to be in a saved state, switch environments. + */ + if (pfp->pf_scan != NULL) { + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + InterpEVValD(&k_subject, e_sresum); + } + + ++k_level; /* adjust procedure level */ + } + + switch (type) { + case G_Fsusp: + ExInterp_sp; EVVal((word)0, e_fresum); - --ilevel; + --ilevel; EVVal(A_Resume, e_intret); #ifdef StackCheck EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ +#else /* StackCheck */ EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Resume; +#endif /* StackCheck */ + return A_Resume; - case G_Osusp: - ExInterp_sp; + case G_Osusp: + ExInterp_sp; EVVal((word)0, e_oresum); - --ilevel; + --ilevel; EVVal(A_Resume, e_intret); #ifdef StackCheck EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ +#else /* StackCheck */ EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Resume; +#endif /* StackCheck */ + return A_Resume; - case G_Csusp: - ExInterp_sp; + case G_Csusp: + ExInterp_sp; EVVal((word)0, e_eresum); - --ilevel; + --ilevel; EVVal(A_Resume, e_intret); #ifdef StackCheck EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ +#else /* StackCheck */ EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Resume; +#endif /* StackCheck */ + return A_Resume; - case G_Esusp: + case G_Esusp: InterpEVVal((word)0, e_eresum); - goto efail_noev; + goto efail_noev; - case G_Psusp: /* resuming a procedure */ + case G_Psusp: /* resuming a procedure */ InterpEVValD(glbl_argp, e_presum); - break; - } + break; + } - break; - } + break; + } - case Op_Pfail: { /* fail from procedure */ + case Op_Pfail: { /* fail from procedure */ #if e_pfail || e_prem || e_erem - ExInterp_sp; + ExInterp_sp; #if e_prem || e_erem vanq_proc(efp, gfp); -#endif /* E_Prem || E_Erem */ +#endif /* E_Prem || E_Erem */ EVValD(glbl_argp, e_pfail); - EntInterp_sp; -#endif /* E_Pfail || E_Prem || E_Erem */ - - /* - * An Icon procedure is failing. Generate tracing message if - * tracing is on. Deactivate inactive C generators created - * after activation of the procedure. Appropriate values - * are restored from the procedure frame. - */ - - --k_level; - if (k_trace) { + EntInterp_sp; +#endif /* E_Pfail || E_Prem || E_Erem */ + + /* + * An Icon procedure is failing. Generate tracing message if + * tracing is on. Deactivate inactive C generators created + * after activation of the procedure. Appropriate values + * are restored from the procedure frame. + */ + + --k_level; + if (k_trace) { k_trace--; - failtrace(&(BlkD(*glbl_argp, Proc)->pname)); + failtrace(&(BlkD(*glbl_argp, Proc)->pname)); } Pfail_uw: - if (pfp->pf_ilevel < ilevel) { - --ilevel; - ExInterp_sp; + if (pfp->pf_ilevel < ilevel) { + --ilevel; + ExInterp_sp; EVVal(A_Pfail_uw, e_intret); #ifdef StackCheck EVVal(DiffPtrs(sp, BlkD(k_current,Coexpr)->es_stack), e_cstack); -#else /* StackCheck */ +#else /* StackCheck */ EVVal(DiffPtrs(sp, stack), e_cstack); -#endif /* StackCheck */ - return A_Pfail_uw; - } - efp = pfp->pf_efp; - gfp = pfp->pf_gfp; - ipc = pfp->pf_ipc; - glbl_argp = pfp->pf_argp; - pfp = pfp->pf_pfp; - - goto efail_noev; - } - /* ---Odds and Ends--- */ - - case Op_Ccase: /* case clause */ - PushNull; - PushVal(((word *)efp)[-2]); - PushVal(((word *)efp)[-1]); - break; - - case Op_Chfail: /* change failure ipc */ - opnd = GetWord; - opnd += (word)ipc.opnd; - efp->ef_failure.opnd = (word *)opnd; - break; - - case Op_Dup: /* duplicate descriptor */ - PushNull; - rsp[1] = rsp[-3]; - rsp[2] = rsp[-2]; - rsp += 2; - break; - - case Op_Field: /* e1.e2 */ - PushVal(D_Integer); - PushVal(GetWord); - Setup_Arg(2); +#endif /* StackCheck */ + return A_Pfail_uw; + } + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + + goto efail_noev; + } + /* ---Odds and Ends--- */ + + case Op_Ccase: /* case clause */ + PushNull; + PushVal(((word *)efp)[-2]); + PushVal(((word *)efp)[-1]); + break; + + case Op_Chfail: /* change failure ipc */ + opnd = GetWord; + opnd += (word)ipc.opnd; + efp->ef_failure.opnd = (word *)opnd; + break; + + case Op_Dup: /* duplicate descriptor */ + PushNull; + rsp[1] = rsp[-3]; + rsp[2] = rsp[-2]; + rsp += 2; + break; + + case Op_Field: /* e1.e2 */ + PushVal(D_Integer); + PushVal(GetWord); + Setup_Arg(2); ExInterp_sp; - signal = Ofield(2,rargp); - rargp = field_argp; + signal = Ofield(2,rargp); + rargp = field_argp; EntInterp_sp; - goto C_rtn_term; + goto C_rtn_term; - case Op_Goto: /* goto */ + case Op_Goto: /* goto */ #ifdef Concurrent - MUTEX_LOCKID(MTX_OP_AGOTO); + MUTEX_LOCKID(MTX_OP_AGOTO); if (ipc.op[-1] == Op_Agoto) { - MUTEX_UNLOCKID(MTX_OP_AGOTO); goto L_agoto; } -#else /*Concurrent*/ - PutOp(Op_Agoto); -#endif /*Concurrent*/ - opnd = GetWord; - opnd += (word)ipc.opnd; + MUTEX_UNLOCKID(MTX_OP_AGOTO); goto L_agoto; } +#else /*Concurrent*/ + PutOp(Op_Agoto); +#endif /*Concurrent*/ + opnd = GetWord; + opnd += (word)ipc.opnd; #ifdef Concurrent - PutInstr(Op_Agoto, opnd, 1); -#else /*Concurrent*/ - PutWord(opnd); -#endif /*Concurrent*/ - ipc.opnd = (word *)opnd; + PutInstr(Op_Agoto, opnd, 1); +#else /*Concurrent*/ + PutWord(opnd); +#endif /*Concurrent*/ + ipc.opnd = (word *)opnd; MUTEX_UNLOCKID(MTX_OP_AGOTO); - break; + break; - case Op_Agoto: /* goto absolute address */ + case Op_Agoto: /* goto absolute address */ L_agoto: - opnd = GetWord; - ipc.opnd = (word *)opnd; - break; + opnd = GetWord; + ipc.opnd = (word *)opnd; + break; - case Op_Init: /* initial */ + case Op_Init: /* initial */ #ifdef Concurrent - MUTEX_LOCKID_CONTROLLED_ALWAYS(MTX_INITIAL); + MUTEX_LOCKID_CONTROLLED_ALWAYS(MTX_INITIAL); if (ipc.op[-1] == Op_Agoto) { - MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); - goto L_agoto; - } -#else /*Concurrent*/ - *--ipc.op = Op_Goto; -#endif /*Concurrent*/ + MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); + goto L_agoto; + } +#else /*Concurrent*/ + *--ipc.op = Op_Goto; +#endif /*Concurrent*/ #ifdef Concurrent - /* no-op on concurrent VM's, but still have to skip operand */ - lock_count_mtx_init++; - if (*ipc.opnd ==-1){ - while(lock_count_mtx_init--) - MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); - - err_msg(182, NULL); - } - *ipc.opnd = -1; - ipc.opnd++; + /* no-op on concurrent VM's, but still have to skip operand */ + lock_count_mtx_init++; + if (*ipc.opnd ==-1){ + while(lock_count_mtx_init--) + MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); + + err_msg(182, NULL); + } + *ipc.opnd = -1; + ipc.opnd++; #else - opnd = sizeof(*ipc.op) + sizeof(*rsp); - opnd += (word)ipc.opnd; - ipc.opnd = (word *)opnd; + opnd = sizeof(*ipc.op) + sizeof(*rsp); + opnd += (word)ipc.opnd; + ipc.opnd = (word *)opnd; #endif - break; + break; - case Op_EInit: - /* no-op on non-concurrent VM's, but still have to skip operand */ - opnd = GetWord; + case Op_EInit: + /* no-op on non-concurrent VM's, but still have to skip operand */ + opnd = GetWord; #ifdef Concurrent - /* - * Really interesting variant of PutInstr pokes instruction - * back at corresponding Op_Init instruction to be a Goto - * that jumps to the next instruction...which is our ipc.opnd - */ - - PutInstrAt(Op_Agoto, ipc.opnd, (ipc.op + ((opnd<<3)/IntBits+1))); - - MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); - lock_count_mtx_init--; -#endif /* Concurrent */ - break; - - case Op_Limit: /* limit */ - Setup_Arg(0); - - if (Olimit(0,rargp) == A_Resume) { - - /* - * limit has failed here; could generate an event for it, - * but not an Ofail since limit is not an operator and - * no Ocall was ever generated for it. - */ - goto efail_noev; - } - else { - /* - * limit has returned here; could generate an event for it, - * but not an Oret since limit is not an operator and - * no Ocall was ever generated for it. - */ - rsp = (word *) rargp + 1; - } - goto mark0; + /* + * Really interesting variant of PutInstr pokes instruction + * back at corresponding Op_Init instruction to be a Goto + * that jumps to the next instruction...which is our ipc.opnd + */ + + PutInstrAt(Op_Agoto, ipc.opnd, (ipc.op + ((opnd<<3)/IntBits+1))); + + MUTEX_UNLOCKID_ALWAYS(MTX_INITIAL); + lock_count_mtx_init--; +#endif /* Concurrent */ + break; + + case Op_Limit: /* limit */ + Setup_Arg(0); + + if (Olimit(0,rargp) == A_Resume) { + + /* + * limit has failed here; could generate an event for it, + * but not an Ofail since limit is not an operator and + * no Ocall was ever generated for it. + */ + goto efail_noev; + } + else { + /* + * limit has returned here; could generate an event for it, + * but not an Oret since limit is not an operator and + * no Ocall was ever generated for it. + */ + rsp = (word *) rargp + 1; + } + goto mark0; #ifdef TallyOpt - case Op_Tally: /* tally */ - tallybin[GetWord]++; - break; -#endif /* TallyOpt */ - - case Op_Pnull: /* push null descriptor */ - PushNull; - break; - - case Op_Pop: /* pop descriptor */ - rsp -= 2; - break; - - case Op_Push1: /* push integer 1 */ - PushVal(D_Integer); - PushVal(1); - break; - - case Op_Pushn1: /* push integer -1 */ - PushVal(D_Integer); - PushVal(-1); - break; - - case Op_Sdup: /* duplicate descriptor */ - rsp += 2; - rsp[-1] = rsp[-3]; - rsp[0] = rsp[-2]; - break; - - /* --- calling Icon from C --- */ + case Op_Tally: /* tally */ + tallybin[GetWord]++; + break; +#endif /* TallyOpt */ + + case Op_Pnull: /* push null descriptor */ + PushNull; + break; + + case Op_Pop: /* pop descriptor */ + rsp -= 2; + break; + + case Op_Push1: /* push integer 1 */ + PushVal(D_Integer); + PushVal(1); + break; + + case Op_Pushn1: /* push integer -1 */ + PushVal(D_Integer); + PushVal(-1); + break; + + case Op_Sdup: /* duplicate descriptor */ + rsp += 2; + rsp[-1] = rsp[-3]; + rsp[0] = rsp[-2]; + break; + + /* --- calling Icon from C --- */ #ifdef PosixFns case Op_Copyd: /* Copy a descriptor from off efp */ opnd = GetWord; @@ -2150,37 +2150,37 @@ L_agoto: rsp[-1] = *((word *)efp + opnd); rsp[0] = *((word *)efp + opnd + 1); break; - + case Op_Trapret: ilevel--; ExInterp_sp; return A_Trapret; - + case Op_Trapfail: ilevel--; ExInterp_sp; return A_Trapfail; -#endif /* PosixFns */ +#endif /* PosixFns */ - /* ---Co-expressions--- */ + /* ---Co-expressions--- */ - case Op_Create: /* create */ + case Op_Create: /* create */ #ifdef CoExpr - PushNull; - Setup_Arg(0); - opnd = GetWord; - opnd += (word)ipc.opnd; + PushNull; + Setup_Arg(0); + opnd = GetWord; + opnd += (word)ipc.opnd; - signal = Ocreate((word *)opnd, rargp); + signal = Ocreate((word *)opnd, rargp); - goto C_rtn_term; -#else /* CoExpr */ - err_msg(401, NULL); - goto efail; -#endif /* CoExpr */ + goto C_rtn_term; +#else /* CoExpr */ + err_msg(401, NULL); + goto efail; +#endif /* CoExpr */ - case Op_Coact: { /* @e */ + case Op_Coact: { /* @e */ #ifndef CoExpr @@ -2198,17 +2198,17 @@ L_agoto: #ifdef Concurrent if (is:null(*dp)){ - signal = activate((dptr)(sp - 3), NULL, (dptr)(sp - 3)); - SYNC_CURTSTATE_CE(); - } - else -#endif /* Concurrent */ + signal = activate((dptr)(sp - 3), NULL, (dptr)(sp - 3)); + SYNC_CURTSTATE_CE(); + } + else +#endif /* Concurrent */ if (is:coexpr(*dp)) { ncp = BlkD(*dp, Coexpr); signal = activate((dptr)(sp - 3), ncp, (dptr)(sp - 3)); - SYNC_CURTSTATE_CE(); - } - else{ + SYNC_CURTSTATE_CE(); + } + else{ err_msg(118, dp); goto efail; } @@ -2219,11 +2219,11 @@ L_agoto: goto efail_noev; else rsp -= 2; -#endif /* CoExpr */ +#endif /* CoExpr */ break; - } + } - case Op_Coret: { /* return from co-expression */ + case Op_Coret: { /* return from co-expression */ #ifndef CoExpr syserr("co-expression return, but co-expressions not implemented"); @@ -2235,14 +2235,14 @@ L_agoto: ++BlkLoc(k_current)->Coexpr.size; co_chng(ncp, (dptr)&sp[-1], NULL, A_Coret, 1); - SYNC_CURTSTATE_CE(); + SYNC_CURTSTATE_CE(); EntInterp_sp; -#endif /* CoExpr */ +#endif /* CoExpr */ break; - } + } - case Op_Cofail: { /* fail from co-expression */ + case Op_Cofail: { /* fail from co-expression */ #ifndef CoExpr syserr("co-expression failure, but co-expressions not implemented"); @@ -2252,153 +2252,153 @@ L_agoto: ExInterp_sp; ncp = popact(BlkD(k_current, Coexpr)); - /* - * if this is a main co-expression failing to its parent - * (monitoring) program, generate an E_Exit event. - */ + /* + * if this is a main co-expression failing to its parent + * (monitoring) program, generate an E_Exit event. + */ #ifdef MultiProgram if (curpstate->parent == ncp->program) { - EVVal(0, E_Exit); - } -#endif /* MultiProgram */ + EVVal(0, E_Exit); + } +#endif /* MultiProgram */ co_chng(ncp, NULL, NULL, A_Cofail, 1); - SYNC_CURTSTATE_CE(); + SYNC_CURTSTATE_CE(); EntInterp_sp; -#endif /* CoExpr */ +#endif /* CoExpr */ break; - } - case Op_Quit: /* quit */ + } + case Op_Quit: /* quit */ - goto interp_quit; + goto interp_quit; - default: { - char buf[50]; + default: { + char buf[50]; - sprintf(buf, "unimplemented opcode: %ld (0x%08x)\n", + sprintf(buf, "unimplemented opcode: %ld (0x%08x)\n", (long)lastop, (unsigned int)lastop); - syserr(buf); - } - } - continue; + syserr(buf); + } + } + continue; C_rtn_term: - EntInterp_sp; + EntInterp_sp; - switch (signal) { + switch (signal) { - case A_Resume: + case A_Resume: #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVValD(&lastdesc, e_ffail); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVValD(&lastdesc, e_ofail); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto efail_noev; - - case A_Unmark_uw: /* unwind for unmark */ + if (lastev == E_Function) { + InterpEVValD(&lastdesc, e_ffail); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVValD(&lastdesc, e_ofail); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto efail_noev; + + case A_Unmark_uw: /* unwind for unmark */ #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVValD(&lastdesc, e_frem); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVValD(&lastdesc, e_orem); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto Unmark_uw; + if (lastev == E_Function) { + InterpEVValD(&lastdesc, e_frem); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVValD(&lastdesc, e_orem); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto Unmark_uw; #ifdef MultiProgram - /* unreachable, but good to silence silence compiler wwarning */ - (void) lastdesc; /* silence "not used" compiler warning */ -#endif /* MultiProgram */ + /* unreachable, but good to silence silence compiler wwarning */ + (void) lastdesc; /* silence "not used" compiler warning */ +#endif /* MultiProgram */ - case A_Lsusp_uw: /* unwind for lsusp */ + case A_Lsusp_uw: /* unwind for lsusp */ #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVValD(&lastdesc, e_frem); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVValD(&lastdesc, e_orem); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto Lsusp_uw; - - case A_Eret_uw: /* unwind for eret */ + if (lastev == E_Function) { + InterpEVValD(&lastdesc, e_frem); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVValD(&lastdesc, e_orem); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto Lsusp_uw; + + case A_Eret_uw: /* unwind for eret */ #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVValD(&lastdesc, e_frem); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVValD(&lastdesc, e_orem); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto Eret_uw; - - case A_Pret_uw: /* unwind for pret */ + if (lastev == E_Function) { + InterpEVValD(&lastdesc, e_frem); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVValD(&lastdesc, e_orem); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto Eret_uw; + + case A_Pret_uw: /* unwind for pret */ #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVVal(&lastdesc, e_frem); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVVal(&lastdesc, e_orem); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto Pret_uw; - - case A_Pfail_uw: /* unwind for pfail */ + if (lastev == E_Function) { + InterpEVVal(&lastdesc, e_frem); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVVal(&lastdesc, e_orem); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto Pret_uw; + + case A_Pfail_uw: /* unwind for pfail */ #ifdef MultiProgram - if (lastev == E_Function) { - InterpEVValD(&lastdesc, e_frem); - lastev = E_Misc; - } - else if (lastev == E_Operator) { - InterpEVValD(&lastdesc, e_orem); - lastev = E_Misc; - } -#endif /* MultiProgram */ - goto Pfail_uw; - } - - rsp = (word *)rargp + 1; /* set rsp to result */ + if (lastev == E_Function) { + InterpEVValD(&lastdesc, e_frem); + lastev = E_Misc; + } + else if (lastev == E_Operator) { + InterpEVValD(&lastdesc, e_orem); + lastev = E_Misc; + } +#endif /* MultiProgram */ + goto Pfail_uw; + } + + rsp = (word *)rargp + 1; /* set rsp to result */ #ifdef MultiProgram return_term: if (lastev == E_Function) { #if e_fret - value_tmp = *(dptr)(rsp - 1); /* argument */ - Deref0(value_tmp); - InterpEVValD(&value_tmp, e_fret); -#endif /* E_Fret */ - lastev = E_Misc; - } + value_tmp = *(dptr)(rsp - 1); /* argument */ + Deref0(value_tmp); + InterpEVValD(&value_tmp, e_fret); +#endif /* E_Fret */ + lastev = E_Misc; + } else if (lastev == E_Operator) { #if e_oret - value_tmp = *(dptr)(rsp - 1); /* argument */ - Deref0(value_tmp); - InterpEVValD(&value_tmp, e_oret); -#endif /* E_Oret */ - lastev = E_Misc; + value_tmp = *(dptr)(rsp - 1); /* argument */ + Deref0(value_tmp); + InterpEVValD(&value_tmp, e_oret); +#endif /* E_Oret */ + lastev = E_Misc; - value_tmp = nulldesc; - } -#endif /* MultiProgram */ + value_tmp = nulldesc; + } +#endif /* MultiProgram */ - continue; - } + continue; + } interp_quit: --ilevel; @@ -2406,13 +2406,13 @@ interp_quit: syserr("interp: termination with inactive generators."); /*NOTREACHED*/ - return 0; /* avoid gcc warning */ + return 0; /* avoid gcc warning */ } #enddef #ifdef MultiProgram /* - * When all event codes are zero, interp_macro sets the value of the + * When all event codes are zero, interp_macro sets the value of the * variable lastdesc but never uses it (because the invocations of * RealEVValD, which do use the variable, are elided by the preprocessor). */ @@ -2421,14 +2421,14 @@ interp_quit: interp_macro(interp_0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) #pragma GCC diagnostic pop interp_macro(interp_1,E_Intcall,E_Stack,E_Fsusp,E_Osusp,E_Bsusp,E_Ocall,E_Ofail,E_Tick, E_Line,E_Loc,E_Opcode,E_Fcall,E_Prem,E_Erem,E_Intret,E_Psusp,E_Ssusp,E_Pret,E_Efail, E_Sresum,E_Fresum,E_Oresum,E_Eresum,E_Presum,E_Pfail,E_Ffail,E_Frem,E_Orem,E_Fret, E_Oret,E_Literal,E_Operand,E_Syntax,E_Cstack) -#else /* MultiProgram */ +#else /* MultiProgram */ #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wunused-but-set-variable" interp_macro(interp,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) #pragma GCC diagnostic pop -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - #ifdef StackPic /* * The following code is operating-system dependent [@interp.04]. @@ -2437,11 +2437,11 @@ interp_macro(interp,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #if PORT Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MVS || VM || VMS /* not included */ -#endif /* MVS || ... */ +#endif /* MVS || ... */ #if DEBUG_INTERP void stkdump(op) @@ -2466,7 +2466,7 @@ void stkdump(op) fprintf(stderr,"> ----------\n"); fflush(stderr); } -#endif /* DEBUG_INTERP */ +#endif /* DEBUG_INTERP */ #if MSDOS #if MICROSOFT || TURBO @@ -2492,8 +2492,8 @@ void stkdump(op) fprintf(stderr,"> ----------\n"); fflush(stderr); } -#endif /* MICROSOFT || TURBO ... */ -#endif /* MSDOS */ +#endif /* MICROSOFT || TURBO ... */ +#endif /* MSDOS */ #if UNIX || VMS void stkdump(op) @@ -2514,13 +2514,13 @@ void stkdump(op) fprintf(stderr,"\001----------\n"); fflush(stderr); } -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ /* * End of operating-system specific code. */ -#endif /* StackPic */ - +#endif /* StackPic */ + #if E_Prem || E_Erem /* * vanq_proc - monitor the removal of suspended operations from within @@ -2556,12 +2556,12 @@ struct gf_marker *gfp_v; if (is:null(curpstate->eventmask)) return efp_v; - while (gfp_v != 0) { /* note removal of suspended operations */ + while (gfp_v != 0) { /* note removal of suspended operations */ switch ((int)gfp_v->gf_gentype) { case G_Psusp: EVValD(gfp_v->gf_argp, E_Prem); break; - /* G_Fsusp and G_Osusp handled in-line during unwinding */ + /* G_Fsusp and G_Osusp handled in-line during unwinding */ case G_Esusp: EVVal((word)0, E_Erem); break; @@ -2580,7 +2580,7 @@ struct gf_marker *gfp_v; return efp_v; } -#endif /* E_Prem || E_Erem */ +#endif /* E_Prem || E_Erem */ #ifdef MultiProgram /* @@ -2616,7 +2616,7 @@ register struct b_coexpr *ncp; if (ccp->tvalloc) { if (InRange(blkbase,ccp->tvalloc,blkfree)) { fprintf(stderr, - "Multiprogram garbage collection disaster in mt_activate()!\n"); + "Multiprogram garbage collection disaster in mt_activate()!\n"); fflush(stderr); exit(1); } @@ -2648,13 +2648,13 @@ register struct b_coexpr *ncp; oldtick = ticker.l[0] + ticker.l[1] + ticker.l[2] + ticker.l[3] + ticker.l[4] + ticker.l[5] + ticker.l[6] + ticker.l[7]; sum = ticker.s[0] + ticker.s[1] + ticker.s[2] + ticker.s[3] + - ticker.s[4] + ticker.s[5] + ticker.s[6] + ticker.s[7] + - ticker.s[8] + ticker.s[9] + ticker.s[10] + ticker.s[11] + - ticker.s[12] + ticker.s[13] + ticker.s[14] + ticker.s[15]; + ticker.s[4] + ticker.s[5] + ticker.s[6] + ticker.s[7] + + ticker.s[8] + ticker.s[9] + ticker.s[10] + ticker.s[11] + + ticker.s[12] + ticker.s[13] + ticker.s[14] + ticker.s[15]; /* nticks = sum - oldsum; */ oldsum = sum; } -#endif /* HAVE_PROFIL && E_Tick */ +#endif /* HAVE_PROFIL && E_Tick */ return rv; } @@ -2672,7 +2672,7 @@ int event; StrLen(parent->eventcode) = 1; StrLoc(parent->eventcode) = (char *)&allchars[FromAscii(event)&0xFF]; mt_activate(&(parent->eventcode), NULL, - (struct b_coexpr *)curpstate->parent->Mainhead); + (struct b_coexpr *)curpstate->parent->Mainhead); } -#endif /* MultiProgram */ -#endif /* !COMPILER */ +#endif /* MultiProgram */ +#endif /* !COMPILER */ diff --git a/src/runtime/invoke.r b/src/runtime/invoke.r index 2bb5e5b73..a39b2a341 100644 --- a/src/runtime/invoke.r +++ b/src/runtime/invoke.r @@ -80,12 +80,12 @@ continuation succ_cont; + (nargs - 1) * sizeof(struct descrip))); if (tnd_args == NULL) RunErr(305, NULL); - + tnd_args->d[0] = *callee; indx = 1; for (ep = BlkD(dstrct, List)->listhead; - BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext) { + BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext) { for (i = 0; i < Blk(ep,Lelem)->nused; i++) { j = ep->Lelem.first + i; if (j >= ep->Lelem.nslots) @@ -111,7 +111,7 @@ continuation succ_cont; + (nargs - 1) * sizeof(struct descrip))); if (tnd_args == NULL) RunErr(305, NULL); - + tnd_args->d[0] = *callee; indx = 1; ep = BlkLoc(dstrct); @@ -131,15 +131,15 @@ continuation succ_cont; } } -#else /* COMPILER */ +#else /* COMPILER */ #if E_Ecall -#include "../h/opdefs.h" /* for Op_Invoke eventvalue */ -#endif /* E_Ecall */ +#include "../h/opdefs.h" /* for Op_Invoke eventvalue */ +#endif /* E_Ecall */ + - /* - * invoke -- Perform setup for invocation. + * invoke -- Perform setup for invocation. */ int invoke(nargs,cargp,n) dptr *cargp; @@ -164,7 +164,7 @@ int nargs, *n; xargp = newargp; Deref(newargp[0]); - + /* * See what course the invocation is to take. */ @@ -177,9 +177,9 @@ int nargs, *n; if (cnv:C_integer(newargp[0], tmp)) { MakeInt(tmp,&newargp[0]); - /* - * Arg0 is an integer, select result. - */ + /* + * Arg0 is an integer, select result. + */ i = cvpos(IntVal(newargp[0]), (word)nargs); if (i == CvtFail || i > nargs) return I_Fail; @@ -194,71 +194,71 @@ int nargs, *n; * Arg0 is a co-expression, start by dereferencing the * parameters. */ - int result; - int lelems; - dptr llargp; - - for (i = 1; i <= nargs; i++) - Deref(newargp[i]); - - /* - * Convert argument list to a List - */ - lelems = nargs; - llargp = &newargp[1]; - arg_sv = llargp[-1]; - Ollist(lelems, &llargp[-1]); - llargp[0] = llargp[-1]; - llargp[-1] = arg_sv; - - /* - * Activate the coexpression. - */ - result = activate(&llargp[0], BlkD(newargp[0], Coexpr), &llargp[-1]); - sp = (word *)newargp+1; - if (result == A_Resume) return I_Fail; - return I_Continue; - } + int result; + int lelems; + dptr llargp; + + for (i = 1; i <= nargs; i++) + Deref(newargp[i]); + + /* + * Convert argument list to a List + */ + lelems = nargs; + llargp = &newargp[1]; + arg_sv = llargp[-1]; + Ollist(lelems, &llargp[-1]); + llargp[0] = llargp[-1]; + llargp[-1] = arg_sv; + + /* + * Activate the coexpression. + */ + result = activate(&llargp[0], BlkD(newargp[0], Coexpr), &llargp[-1]); + sp = (word *)newargp+1; + if (result == A_Resume) return I_Fail; + return I_Continue; + } else { struct b_proc *tmp; - /* - * See if Arg0 can be converted to a string that names a procedure - * or operator. If not, generate run-time error 106. - */ - if (!cnv:tmp_string(newargp[0],newargp[0]) || - ((tmp = strprc(newargp, (C_integer)nargs)) == NULL)) { - - if(is:record(newargp[0])) { - struct b_record *rp = BlkD(newargp[0], Record); - union block *bp = rp->recdesc; - if ((Blk(bp,Proc)->ndynam == -3) || - (!strcmp(StrLoc(Blk(bp,Proc)->lnames[0]), "__s")) || - (!strcmp(StrLoc(Blk(bp,Proc)->lnames[0]), "__m")) || - (!strcmp(StrLoc(Blk(bp,Proc)->lnames[ - Blk(bp,Proc)->nfields-1]), "__m"))) { - /* its an object */ - return invoke(nargs+1, cargp, n); - } - } + /* + * See if Arg0 can be converted to a string that names a procedure + * or operator. If not, generate run-time error 106. + */ + if (!cnv:tmp_string(newargp[0],newargp[0]) || + ((tmp = strprc(newargp, (C_integer)nargs)) == NULL)) { + + if(is:record(newargp[0])) { + struct b_record *rp = BlkD(newargp[0], Record); + union block *bp = rp->recdesc; + if ((Blk(bp,Proc)->ndynam == -3) || + (!strcmp(StrLoc(Blk(bp,Proc)->lnames[0]), "__s")) || + (!strcmp(StrLoc(Blk(bp,Proc)->lnames[0]), "__m")) || + (!strcmp(StrLoc(Blk(bp,Proc)->lnames[ + Blk(bp,Proc)->nfields-1]), "__m"))) { + /* its an object */ + return invoke(nargs+1, cargp, n); + } + } err_msg(106, newargp); return I_Fail; } - BlkLoc(newargp[0]) = (union block *)tmp; - newargp[0].dword = D_Proc; - } + BlkLoc(newargp[0]) = (union block *)tmp; + newargp[0].dword = D_Proc; + } } - + /* * newargp[0] is now a descriptor suitable for invocation. Dereference * the supplied arguments. */ proc = BlkD(newargp[0], Proc); - if (proc->nstatic >= 0) /* if negative, don't reference arguments */ + if (proc->nstatic >= 0) /* if negative, don't reference arguments */ for (i = 1; i <= nargs; i++) Deref(newargp[i]); - + /* * Adjust the argument list to conform to what the routine being invoked * expects (proc->nparam). If nparam is less than 0, the number of @@ -289,7 +289,7 @@ int nargs, *n; else { if (proc->ndynam >= 0) { /* this is a procedure */ int lelems, absnparam = abs(nparam); - dptr llargp; + dptr llargp; if (nargs < absnparam - 1) { i = absnparam - 1 - nargs; @@ -300,21 +300,21 @@ int nargs, *n; nargs = absnparam - 1; } - lelems = nargs - (absnparam - 1); + lelems = nargs - (absnparam - 1); llargp = &newargp[absnparam]; arg_sv = llargp[-1]; - Ollist(lelems, &llargp[-1]); + Ollist(lelems, &llargp[-1]); - llargp[0] = llargp[-1]; - llargp[-1] = arg_sv; + llargp[0] = llargp[-1]; + llargp[-1] = arg_sv; /* * Reload proc pointer in case Ollist triggered a garbage collection. */ proc = BlkD(newargp[0], Proc); - newsp = (word *)llargp + 1; - nargs = absnparam; - } + newsp = (word *)llargp + 1; + nargs = absnparam; + } } if (proc->ndynam < 0) { @@ -351,17 +351,17 @@ int nargs, *n; if (((char *)sp + PerilDelta) > (char *)(BlkD(k_current,Coexpr)->es_stackend)){ fatalerr(301, NULL); } -#else /* StackCheck */ +#else /* StackCheck */ #ifndef MultiProgram /* * Make a stab at catching interpreter stack overflow. This does * nothing for invocation in a co-expression other than &main. */ if (BlkLoc(k_current) == BlkLoc(k_main) && - ((char *)sp + PerilDelta) > (char *)stackend) + ((char *)sp + PerilDelta) > (char *)stackend) fatalerr(301, NULL); -#endif /* MultiProgram */ -#endif /* StackCheck */ +#endif /* MultiProgram */ +#endif /* StackCheck */ /* * Build the procedure frame. @@ -374,7 +374,7 @@ int nargs, *n; newpfp->pf_scan = NULL; #ifdef PatternType newpfp->pattern_cache = NULL; -#endif /* PatternType */ +#endif /* PatternType */ newpfp->pf_ipc = ipc; newpfp->pf_gfp = gfp; @@ -386,12 +386,12 @@ int nargs, *n; /* * If tracing is on, use ctrace to generate a message. - */ + */ if (k_trace) { k_trace--; ctrace(&(proc->pname), nargs, &newargp[1]); } - + /* * Point ipc at the icode entry point of the procedure being invoked. */ @@ -415,4 +415,4 @@ int nargs, *n; return I_Continue; } -#endif /* COMPILER */ +#endif /* COMPILER */ diff --git a/src/runtime/keyword.r b/src/runtime/keyword.r index 63169d0cd..3e0738382 100644 --- a/src/runtime/keyword.r +++ b/src/runtime/keyword.r @@ -24,30 +24,30 @@ keyword{4} allocated uword strtot=0; #if !ConcurrentCOMPILER /* plausible to omit as there is only one program, and maybe globals - in lieu of curpstate. But... + in lieu of curpstate. But... */ CURTSTATVAR(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ MUTEX_LOCKID(MTX_TLS_CHAIN); blktot = curpstate->blocktotal; strtot = curpstate->stringtotal; - tstate = curpstate->tstate; + tstate = curpstate->tstate; do { - blktot += tstate->blocktotal; - strtot += tstate->stringtotal; - tstate = tstate->next; - } while (tstate!=NULL); + blktot += tstate->blocktotal; + strtot += tstate->stringtotal; + tstate = tstate->next; + } while (tstate!=NULL); MUTEX_UNLOCKID(MTX_TLS_CHAIN); suspend C_integer stattotal + strtot + blktot; suspend C_integer stattotal; suspend C_integer strtot; return C_integer blktot; -#else /* Concurrent */ +#else /* Concurrent */ suspend C_integer stattotal + strtotal + blktotal; suspend C_integer stattotal; suspend C_integer strtotal; return C_integer blktotal; -#endif /* Concurrent */ +#endif /* Concurrent */ } end @@ -64,15 +64,15 @@ keyword{2} clock #if !ConcurrentCOMPILER /* why on earth would &clock need a curtstate? */ CURTSTATVAR(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ time(&t); ct = localtime(&t); #if defined(SUN) || NT || defined(HAVE_TIMEZONE) tz_sec = timezone; -#else /* HAVE_TIMEZONE */ +#else /* HAVE_TIMEZONE */ tz_sec = ct->tm_gmtoff; -#endif /* HAVE_TIMEZONE */ +#endif /* HAVE_TIMEZONE */ sprintf(sbuf,"%02d:%02d:%02d", ct->tm_hour, ct->tm_min, ct->tm_sec); Protect(tmp = alcstr(sbuf,(word)8), runerr(0)); @@ -107,7 +107,7 @@ keyword{4} collections #if !ConcurrentCOMPILER /* plausible to omit as there is only one program, and maybe globals */ CURTSTATVAR(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ suspend C_integer coll_tot; suspend C_integer coll_stat; suspend C_integer coll_str; @@ -127,10 +127,10 @@ keyword{1} column return C_integer findcol(ipc.opnd); #else fail; -#endif /* MultiProgram */ +#endif /* MultiProgram */ } end -#endif /* !COMPILER */ +#endif /* !COMPILER */ "¤t - the currently active co-expression" keyword{1} current @@ -141,7 +141,7 @@ keyword{1} current #if !ConcurrentCOMPILER /* should be separate ¤t for each thread */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ return k_current; } end @@ -235,15 +235,15 @@ keyword{2} dateline if (ct->tm_isdst) offset_hrs--; #ifdef _UCRT { - size_t tzNameSize = -1; - _get_tzname(&tzNameSize, NULL, 0, (ct->tm_isdst ? 1 : 0)); - if (tzNameSize > 0) { - char tzNameBuf[tzNameSize]; - _get_tzname(&tzNameSize, &tzNameBuf[0],tzNameSize, (ct->tm_isdst ? 1 : 0)); - sprintf(sbuf, "UTC%+d %s", offset_hrs, &tzNameBuff[0]); - } else { - sprintf(sbuf, "UTC%+d (unknown timezone)", offset_hrs); - } + size_t tzNameSize = -1; + _get_tzname(&tzNameSize, NULL, 0, (ct->tm_isdst ? 1 : 0)); + if (tzNameSize > 0) { + char tzNameBuf[tzNameSize]; + _get_tzname(&tzNameSize, &tzNameBuf[0],tzNameSize, (ct->tm_isdst ? 1 : 0)); + sprintf(sbuf, "UTC%+d %s", offset_hrs, &tzNameBuff[0]); + } else { + sprintf(sbuf, "UTC%+d (unknown timezone)", offset_hrs); + } } #elif defined(SUN) || NT || defined(HAVE_TZNAME) sprintf(sbuf, "UTC%+d %s", offset_hrs, ct->tm_isdst?tzname[1]:tzname[0]); @@ -288,7 +288,7 @@ keyword{0,1} errornumber #if !ConcurrentCOMPILER /* plausible to omit as there is only one program, and maybe globals */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ if (k_errornumber == 0) fail; return C_integer k_errornumber; @@ -304,9 +304,9 @@ keyword{0,1} errortext #if !ConcurrentCOMPILER /* plausible to omit as there is only one program, and maybe globals */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ if (((k_errornumber == 0) && IntVal(amperErrno)==0) || - (StrLoc(k_errortext) == NULL)) + (StrLoc(k_errortext) == NULL)) return nulldesc; // fail or return an empty string? return k_errortext; } @@ -321,10 +321,10 @@ keyword{0,1} errorvalue #if !ConcurrentCOMPILER /* plausible to omit as there is only one program, and maybe globals */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ if (have_errval) { return k_errorvalue; - } + } else fail; } @@ -389,67 +389,67 @@ keyword{1,*} features body { #ifdef RefPath char *refpath = RefPath; -#else /* RefPath */ +#else /* RefPath */ char *refpath = ""; -#endif /* RefPath */ +#endif /* RefPath */ CURTSTATVAR(); if ((int)strlen(patchpath) > 18) refpath = patchpath+18; else if (strlen(refpath)==0) { - struct stat buffer; - char *iconx; - int xnamelen; - - iconx = relfile(StrLoc(kywd_prog), "/../" UNICONX_EXE); - xnamelen = strlen(UNICONX_EXE); /* "iconx.exe" */ - - // check if we have iconx on a path relative to us - if ((stat(iconx,&buffer)) == 0) { - refpath = patchpath+18; - strcpy(refpath, iconx); - patchpath[strlen(patchpath)-xnamelen] = '\0'; - } + struct stat buffer; + char *iconx; + int xnamelen; + + iconx = relfile(StrLoc(kywd_prog), "/../" UNICONX_EXE); + xnamelen = strlen(UNICONX_EXE); /* "iconx.exe" */ + + // check if we have iconx on a path relative to us + if ((stat(iconx,&buffer)) == 0) { + refpath = patchpath+18; + strcpy(refpath, iconx); + patchpath[strlen(patchpath)-xnamelen] = '\0'; + } } else { #if MSDOS - if (pathFind(UNICONX_EXE, patchpath+18, MaxPath)) { - refpath = patchpath+18; - patchpath[strlen(patchpath)-strlen(UNICONX_EXE)] = '\0'; - } -#endif /* MSDOS */ + if (pathFind(UNICONX_EXE, patchpath+18, MaxPath)) { + refpath = patchpath+18; + patchpath[strlen(patchpath)-strlen(UNICONX_EXE)] = '\0'; + } +#endif /* MSDOS */ #if UNIX - if (findonpath(UNICONX, patchpath+18, MaxPath)) { - refpath = patchpath+18; - patchpath[strlen(patchpath)-strlen(UNICONX)] = '\0'; - } - else { - int c; - FILE *f = fopen(StrLoc(kywd_prog), "r"); - if (f != NULL) { - /* - * look for iconx in our icode file (could also try the dir - * containing &progname). Should fix to look rather at argv[0] - * or save iconx path from icode when icode is loaded. - */ - while ((c = getc(f)) && (c != EOF) && (c != '\n')); - refpath = patchpath+18; - if (fscanf(f, "IXBIN=%s\n", refpath) != 1) refpath = ""; - fclose(f); - } - else { - fprintf(stderr,"&features: can't open '%s' to look for iconx\n", - StrLoc(kywd_prog)); - } + if (findonpath(UNICONX, patchpath+18, MaxPath)) { + refpath = patchpath+18; + patchpath[strlen(patchpath)-strlen(UNICONX)] = '\0'; } -#endif /* UNIX */ - } + else { + int c; + FILE *f = fopen(StrLoc(kywd_prog), "r"); + if (f != NULL) { + /* + * look for iconx in our icode file (could also try the dir + * containing &progname). Should fix to look rather at argv[0] + * or save iconx path from icode when icode is loaded. + */ + while ((c = getc(f)) && (c != EOF) && (c != '\n')); + refpath = patchpath+18; + if (fscanf(f, "IXBIN=%s\n", refpath) != 1) refpath = ""; + fclose(f); + } + else { + fprintf(stderr,"&features: can't open '%s' to look for iconx\n", + StrLoc(kywd_prog)); + } + } +#endif /* UNIX */ + } #if COMPILER #define Feature(guard,sym,kwval) if ((guard) && (kwval)) suspend C_string kwval; -#else /* COMPILER */ +#else /* COMPILER */ #define Feature(guard,sym,kwval) if (kwval) suspend C_string kwval; -#endif /* COMPILER */ +#endif /* COMPILER */ #include "../h/feature.h" @@ -460,86 +460,86 @@ keyword{1,*} features } { - char *s = alcstr(NULL, 44); + char *s = alcstr(NULL, 44); #if NT unsigned long long int l = physicalmemorysize(); -#else /* NT */ - unsigned long l = physicalmemorysize(); -#endif /* NT */ +#else /* NT */ + unsigned long l = physicalmemorysize(); +#endif /* NT */ if (l > 0) { -#if NT +#if NT sprintf(s, "Physical memory: %llu bytes", l); -#else /* NT */ +#else /* NT */ sprintf(s, "Physical memory: %lu bytes", l); -#endif /* NT */ - suspend C_string s; +#endif /* NT */ + suspend C_string s; } } #ifdef REPO_REVISION { char *s = alcstr(NULL, strlen(REPO_REVISION) + strlen("Revision ") + 1); - sprintf(s, "Revision %s", REPO_REVISION); - suspend C_string s; + sprintf(s, "Revision %s", REPO_REVISION); + suspend C_string s; } -#endif /* REPO_REVISION */ +#endif /* REPO_REVISION */ { void get_arch(char *); - char *s = alcstr(NULL, 20); - get_arch(s); - suspend C_string s; + char *s = alcstr(NULL, 20); + get_arch(s); + suspend C_string s; } { char *s = alcstr(NULL, 20); - if (num_cpu_cores > 0) { - sprintf(s, "CPU cores %d", num_cpu_cores ); - suspend C_string s; - } + if (num_cpu_cores > 0) { + sprintf(s, "CPU cores %d", num_cpu_cores ); + suspend C_string s; + } } #if defined(MSWindows) && defined(SM_DIGITIZER) { int value = GetSystemMetrics(SM_DIGITIZER); if (value & NID_READY){ /* stack ready */ - if (value & NID_MULTI_INPUT){ /* digitizer is multitouch */ - suspend C_string "Multitouch input"; - } - else if (value & (NID_INTEGRATED_TOUCH|NID_EXTERNAL_TOUCH)){ - suspend C_string "Touch input"; - } - else if (value & (NID_INTEGRATED_PEN|NID_EXTERNAL_PEN)){ - suspend C_string "Pen input"; - } + if (value & NID_MULTI_INPUT){ /* digitizer is multitouch */ + suspend C_string "Multitouch input"; + } + else if (value & (NID_INTEGRATED_TOUCH|NID_EXTERNAL_TOUCH)){ + suspend C_string "Touch input"; + } + else if (value & (NID_INTEGRATED_PEN|NID_EXTERNAL_PEN)){ + suspend C_string "Pen input"; + } } } -#endif /* MSWindows && SM_DIGITIZER */ +#endif /* MSWindows && SM_DIGITIZER */ if (refpath && strlen(refpath) > 0) { - char *s; - if (!strcmp(refpath+strlen(refpath)-strlen(UNICONX_EXE), UNICONX_EXE)) { - refpath[strlen(refpath)-strlen(UNICONX_EXE)] = '\0'; - /* - * Trim prefix letters in front of iconx, if any - */ - while ((strlen(refpath)>0) && isalpha(refpath[strlen(refpath)-1])) - refpath[strlen(refpath)-1] = '\0'; - } - - s = alcstr(NULL, strlen(refpath) + strlen("Binaries at ") + 1); - strcpy(s, "Binaries at "); - strcat(s, refpath); - suspend C_string s; - } + char *s; + if (!strcmp(refpath+strlen(refpath)-strlen(UNICONX_EXE), UNICONX_EXE)) { + refpath[strlen(refpath)-strlen(UNICONX_EXE)] = '\0'; + /* + * Trim prefix letters in front of iconx, if any + */ + while ((strlen(refpath)>0) && isalpha(refpath[strlen(refpath)-1])) + refpath[strlen(refpath)-1] = '\0'; + } + + s = alcstr(NULL, strlen(refpath) + strlen("Binaries at ") + 1); + strcpy(s, "Binaries at "); + strcat(s, refpath); + suspend C_string s; + } if ((int)strlen(uniroot) > 18) { - char *s; - s = alcstr(NULL, strlen(uniroot+18) + strlen("Libraries at ") + 1); - strcpy(s, "Libraries at "); - strcat(s, uniroot+18); + char *s; + s = alcstr(NULL, strlen(uniroot+18) + strlen("Libraries at ") + 1); + strcpy(s, "Libraries at "); + strcat(s, uniroot+18); suspend C_string s; - } + } fail; } @@ -558,17 +558,17 @@ keyword{1} file * reporting location of current thread. */ CURTSTATE_AND_CE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #if COMPILER if (line_info) return C_string file_name; else runerr(402); -#else /* COMPILER */ +#else /* COMPILER */ s = findfile(ipc.opnd); if (!strcmp(s,"?")) fail; return C_string s; -#endif /* COMPILER */ +#endif /* COMPILER */ } end @@ -620,11 +620,11 @@ keyword{1} level */ #if !ConcurrentCOMPILER CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ #if COMPILER if (!debug_info) runerr(402); -#endif /* COMPILER */ +#endif /* COMPILER */ return C_integer k_level; } end @@ -641,15 +641,15 @@ keyword{1} line * reporting location of current thread. */ CURTSTATE_AND_CE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ #if COMPILER if (line_info) return C_integer line_num; else runerr(402); -#else /* COMPILER */ +#else /* COMPILER */ return C_integer findline(ipc.opnd); -#endif /* COMPILER */ +#endif /* COMPILER */ } end @@ -706,7 +706,7 @@ keyword{0,*} pick struct descrip name; #if !ConcurrentCOMPILER CURTSTATVAR(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ if (is:null(lastEventWin)) runerr(140, lastEventWin); if (is:null(amperPick)) fail; @@ -722,7 +722,7 @@ keyword{0,*} pick fail; } end -#else /* Graphics3D */ +#else /* Graphics3D */ keyword{0} pick abstract { return empty_type @@ -731,7 +731,7 @@ keyword{0} pick fail; } end -#endif /* Graphics3D */ +#endif /* Graphics3D */ "&pos - a variable containing the current focus in string scanning." @@ -744,7 +744,7 @@ keyword{1} pos /* there are not multiple programs, but don't threads have separate * copies of &pos? */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ return kywdpos(&kywd_pos); } end @@ -768,7 +768,7 @@ keyword{1} random #if !ConcurrentCOMPILER /* plausible to omit is there is only one program, one seed */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ return kywdint(&kywd_ran); } end @@ -786,27 +786,27 @@ keyword{3} regions * in order to talk to curstring, etc. */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ - suspend C_integer 0; /* static region */ + suspend C_integer 0; /* static region */ MUTEX_LOCKID(MTX_STRHEAP); allRegions = DiffPtrs(strend,strbase); for (rp = curstring->next; rp; rp = rp->next) - allRegions += DiffPtrs(rp->end,rp->base); + allRegions += DiffPtrs(rp->end,rp->base); for (rp = curstring->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->end,rp->base); + allRegions += DiffPtrs(rp->end,rp->base); MUTEX_UNLOCKID(MTX_STRHEAP); - suspend C_integer allRegions; /* string region */ + suspend C_integer allRegions; /* string region */ MUTEX_LOCKID(MTX_BLKHEAP); allRegions = DiffPtrs(blkend,blkbase); for (rp = curblock->next; rp; rp = rp->next) - allRegions += DiffPtrs(rp->end,rp->base); + allRegions += DiffPtrs(rp->end,rp->base); for (rp = curblock->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->end,rp->base); + allRegions += DiffPtrs(rp->end,rp->base); MUTEX_UNLOCKID(MTX_BLKHEAP); - return C_integer allRegions; /* block region */ + return C_integer allRegions; /* block region */ } end @@ -823,9 +823,9 @@ keyword{1} source /* proposed #endif !ConcurrentCOMPILER */ #ifndef CoExpr return k_main; -#else /* CoExpr */ +#else /* CoExpr */ return coexpr(topact(BlkD(k_current,Coexpr))); -#endif /* CoExpr */ +#endif /* CoExpr */ } end @@ -840,25 +840,25 @@ keyword{3} storage /* proposed if !ConcurrentCOMPILER rejected to omit curtstate */ CURTSTATE(); - suspend C_integer 0; /* static region */ - + suspend C_integer 0; /* static region */ + MUTEX_LOCKID(MTX_STRHEAP); allRegions = DiffPtrs(strfree,strbase); for (rp = curstring->next; rp; rp = rp->next) - allRegions += DiffPtrs(rp->free,rp->base); + allRegions += DiffPtrs(rp->free,rp->base); for (rp = curstring->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->free,rp->base); + allRegions += DiffPtrs(rp->free,rp->base); MUTEX_UNLOCKID(MTX_STRHEAP); - suspend C_integer allRegions; /* string region */ - + suspend C_integer allRegions; /* string region */ + MUTEX_LOCKID(MTX_BLKHEAP); allRegions = DiffPtrs(blkfree,blkbase); for (rp = curblock->next; rp; rp = rp->next) - allRegions += DiffPtrs(rp->free,rp->base); + allRegions += DiffPtrs(rp->free,rp->base); for (rp = curblock->prev; rp; rp = rp->prev) - allRegions += DiffPtrs(rp->free,rp->base); + allRegions += DiffPtrs(rp->free,rp->base); MUTEX_UNLOCKID(MTX_BLKHEAP); - return C_integer allRegions; /* block region */ + return C_integer allRegions; /* block region */ } end @@ -888,9 +888,9 @@ keyword{1} time * &time in this program = total time - time spent in other programs */ return C_integer millisec() - curpstate->Kywd_time_elsewhere; -#else /* MultiProgram */ +#else /* MultiProgram */ return C_integer millisec(); -#endif /* MultiProgram */ +#endif /* MultiProgram */ } end @@ -943,7 +943,7 @@ keyword{1} errno * so we should probably dismantle this !ConcurrentCOMPILER directive. */ CURTSTATE(); -#endif /* !ConcurrentCOMPILER */ +#endif /* !ConcurrentCOMPILER */ return kywdint(&erErrno); } #else /* PosixFns */ @@ -954,7 +954,7 @@ end #ifndef MultiProgram struct descrip kywd_xwin[2] = {{D_Null}}; -#endif /* MultiProgram */ +#endif /* MultiProgram */ "&window - variable containing the current graphics rendering context." #ifdef Graphics @@ -966,7 +966,7 @@ keyword{1} window return kywdwin(kywd_xwin + XKey_Window); } end -#else /* Graphics */ +#else /* Graphics */ keyword{0} window abstract { return empty_type @@ -975,65 +975,65 @@ keyword{0} window fail; } end -#endif /* Graphics */ +#endif /* Graphics */ #ifdef Graphics "&col - mouse horizontal position in text columns." keyword{1} col abstract { return kywdint } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else return kywdint(&erCol); } + else return kywdint(&erCol); } end "&row - mouse vertical position in text rows." keyword{1} row abstract { return kywdint } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else return kywdint(&erRow); } + else return kywdint(&erRow); } end "&x - mouse horizontal position." keyword{1} x abstract { return kywdint } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else return kywdint(&erX); } + else return kywdint(&erX); } end "&y - mouse vertical position." keyword{1} y abstract { return kywdint } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else return kywdint(&erY); } + else return kywdint(&erY); } end "&interval - milliseconds since previous event." keyword{1} interval abstract { return kywdint } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else return kywdint(&erInterval); } + else return kywdint(&erInterval); } end "&control - null if control key was down on last X event, else failure" keyword{0,1} control abstract { return null } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else if (xmod_control) return nulldesc; else fail; } + else if (xmod_control) return nulldesc; else fail; } end "&shift - null if shift key was down on last X event, else failure" keyword{0,1} shift abstract { return null } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else if (xmod_shift) return nulldesc; else fail; } + else if (xmod_shift) return nulldesc; else fail; } end "&meta - null if meta key was down on last X event, else failure" keyword{0,1} meta abstract { return null } inline { if (is:null(lastEventWin)) runerr(140, lastEventWin); - else if (xmod_meta) return nulldesc; else fail; } + else if (xmod_meta) return nulldesc; else fail; } end -#else /* Graphics */ +#else /* Graphics */ "&col - mouse horizontal position in text columns." keyword{0} col abstract { return empty_type } @@ -1081,7 +1081,7 @@ keyword{0} meta abstract { return empty_type } inline { fail; } end -#endif /* Graphics */ +#endif /* Graphics */ "&lpress - left button press." keyword{1} lpress @@ -1136,7 +1136,7 @@ constant '\ \xa3\xa4\xa5\xa6\xa7\xa8\xa9\xad\xbd\xc0\xc1\xc2\xc3\xc4\xc5\xc6\ \xc7\xc8\xc9\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe0\xe2\xe3\ \xe4\xe5\xe6\xe7\xe8\xe9\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9' -#else /* EBCDIC == 1 */ +#else /* EBCDIC == 1 */ constant '\ \000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\ \020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037\ @@ -1146,7 +1146,7 @@ constant '\ \120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137\ \140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157\ \160\161\162\163\164\165\166\167\170\171\172\173\174\175\176\177' -#endif /* EBCDIC == 1 */ +#endif /* EBCDIC == 1 */ end "&cset - a cset consisting of all the 256 characters." diff --git a/src/runtime/lmisc.r b/src/runtime/lmisc.r index 3d33854f0..271f2843b 100644 --- a/src/runtime/lmisc.r +++ b/src/runtime/lmisc.r @@ -13,12 +13,12 @@ continuation fnc; struct b_proc *cproc; int ntemps; int wrk_size; -#else /* COMPILER */ +#else /* COMPILER */ int Ocreate(entryp, cargp) word *entryp; register dptr cargp; -#endif /* COMPILER */ +#endif /* COMPILER */ { #ifdef CoExpr @@ -32,16 +32,16 @@ register dptr cargp; /* cproc is the Icon procedure that create occurs in */ cproc = BlkD(glbl_argp[0], Proc); -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Calculate number of arguments and number of local variables. */ #if COMPILER na = abs((int)cproc->nparam); -#else /* COMPILER */ +#else /* COMPILER */ na = pfp->pf_nargs + 1; /* includes Arg0 */ -#endif /* COMPILER */ +#endif /* COMPILER */ nl = (int)cproc->ndynam; /* @@ -57,48 +57,48 @@ register dptr cargp; * how much memory to reserve. */ if (!reserve(Blocks, (word)( - sizeof(struct b_list) * 3 + - sizeof(struct b_lelem) * 3 + - (CE_INBOX_SIZE + CE_OUTBOX_SIZE + CE_CEQUEUE_SIZE) * sizeof(struct descrip) + - sizeof(struct b_refresh) + - (nl - 1) * sizeof(struct descrip))) - ) + sizeof(struct b_list) * 3 + + sizeof(struct b_lelem) * 3 + + (CE_INBOX_SIZE + CE_OUTBOX_SIZE + CE_CEQUEUE_SIZE) * sizeof(struct descrip) + + sizeof(struct b_refresh) + + (nl - 1) * sizeof(struct descrip))) + ) #if COMPILER return NULL; -#else /* COMPILER */ +#else /* COMPILER */ Fail; -#endif /* COMPILER */ +#endif /* COMPILER */ -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef MultiProgram Protect(sblkp = alccoexp(0, 0), err_msg(0, NULL)); -#else /* MultiProgram */ +#else /* MultiProgram */ Protect(sblkp = alccoexp(), err_msg(0, NULL)); -#endif /* MultiProgram */ +#endif /* MultiProgram */ if (!sblkp) #if COMPILER return NULL; -#else /* COMPILER */ +#else /* COMPILER */ Fail; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Get a refresh block for the new co-expression. */ #if COMPILER Protect(rblkp = alcrefresh(na, nl, ntemps, wrk_size), err_msg(0,NULL)); -#else /* COMPILER */ +#else /* COMPILER */ Protect(rblkp = alcrefresh(entryp, na, nl),err_msg(0,NULL)); -#endif /* COMPILER */ +#endif /* COMPILER */ if (!rblkp) #if COMPILER return NULL; -#else /* COMPILER */ +#else /* COMPILER */ Fail; -#endif /* COMPILER */ +#endif /* COMPILER */ sblkp->freshblk.dword = D_Refresh; BlkLoc(sblkp->freshblk) = (union block *) rblkp; @@ -109,7 +109,7 @@ register dptr cargp; */ rblkp->pfmkr = *pfp; rblkp->pfmkr.pf_pfp = 0; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Copy arguments into refresh block. @@ -124,9 +124,9 @@ register dptr cargp; */ #if COMPILER dp = pfp->t.d; -#else /* COMPILER */ +#else /* COMPILER */ dp = &(pfp->pf_locals)[0]; -#endif /* COMPILER */ +#endif /* COMPILER */ for (i = 1; i <= nl; i++) *ndp++ = *dp++; @@ -145,7 +145,7 @@ register dptr cargp; } return sblkp; -#else /* COMPILER */ +#else /* COMPILER */ /* * Return the new co-expression. */ @@ -155,18 +155,18 @@ register dptr cargp; EVValD( &Arg0, E_CoCreate ); Return; -#endif /* COMPILER */ -#else /* CoExpr */ +#endif /* COMPILER */ +#else /* CoExpr */ err_msg(401, NULL); #if COMPILER return NULL; -#else /* COMPILER */ +#else /* COMPILER */ Fail; -#endif /* COMPILER */ -#endif /* CoExpr */ +#endif /* COMPILER */ +#endif /* CoExpr */ } - + /* * activate - activate a co-expression. */ @@ -184,7 +184,7 @@ dptr result; tended struct b_list *hp; ncp = BlkD(k_current, Coexpr); - if (!is:null(*val)){ + if (!is:null(*val)){ /* send */ hp = BlkD(ncp->outbox, List); @@ -192,11 +192,11 @@ dptr result; if (hp->size>=hp->max){ hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - } + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + } hp->full--; } c_put(&(ncp->outbox), val); @@ -209,26 +209,26 @@ dptr result; MUTEX_LOCKBLK_CONTROLLED(hp, "activate: list mutex"); if (hp->size==0){ - hp->empty++; + hp->empty++; while (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - DEC_NARTHREADS; - CV_WAIT_EMPTYBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->empty--; - if (hp->size==0){ /* This shouldn't be the case, but.. */ - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - return A_Resume; - } - } + CV_SIGNAL_FULLBLK(hp); + DEC_NARTHREADS; + CV_WAIT_EMPTYBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->empty--; + if (hp->size==0){ /* This shouldn't be the case, but.. */ + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + return A_Resume; + } + } c_get(hp, result); MUTEX_UNLOCKBLK(hp, "activate: list mutex"); - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); - return A_Continue; + return A_Continue; } else if (IS_TS_THREAD(ncp->status) && IS_TS_ASYNC(ncp->status)){ @@ -242,11 +242,11 @@ dptr result; if (hp->size>=hp->max){ hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - } + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + } hp->full--; } c_put(&(ncp->inbox), val); @@ -258,40 +258,40 @@ dptr result; hp = BlkD(ncp->outbox, List); MUTEX_LOCKBLK_CONTROLLED(hp, "activate: list mutex"); if (hp->size==0){ - hp->empty++; + hp->empty++; while (hp->size==0){ - if (hp->size==0 && ncp->alive<0){ - hp->empty--; - return A_Resume; - } - CV_SIGNAL_FULLBLK(hp); - DEC_NARTHREADS; - if (hp->size==0 && ncp->alive<0){ - hp->empty--; - return A_Resume; - } - CV_WAIT_EMPTYBLK(hp); - INC_NARTHREADS_CONTROLLED; - if (hp->size==0 && ncp->alive<0){ - hp->empty--; - return A_Resume; - } - } - hp->empty--; - if (hp->size==0){ /* This shouldn't be the case, but.. */ - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - return A_Resume; - } - } + if (hp->size==0 && ncp->alive<0){ + hp->empty--; + return A_Resume; + } + CV_SIGNAL_FULLBLK(hp); + DEC_NARTHREADS; + if (hp->size==0 && ncp->alive<0){ + hp->empty--; + return A_Resume; + } + CV_WAIT_EMPTYBLK(hp); + INC_NARTHREADS_CONTROLLED; + if (hp->size==0 && ncp->alive<0){ + hp->empty--; + return A_Resume; + } + } + hp->empty--; + if (hp->size==0){ /* This shouldn't be the case, but.. */ + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + return A_Resume; + } + } c_get(hp, result); MUTEX_UNLOCKBLK(hp, "activate: list mutex"); - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); - return A_Continue; + return A_Continue; } -#endif /* Concurrent */ +#endif /* Concurrent */ /* * Set activator in new co-expression. @@ -309,9 +309,9 @@ dptr result; else return A_Continue; -#else /* CoExpr */ +#else /* CoExpr */ RunErr(401,NULL); -#endif /* CoExpr */ +#endif /* CoExpr */ } #ifdef Concurrent @@ -320,7 +320,7 @@ int msg_receive( dccp, dncp, msg, timeout) dptr dccp; dptr dncp; /*dptr valloc; /* location of value being transmitted */ -dptr msg; /* location to put result */ +dptr msg; /* location to put result */ int timeout; { tended struct b_coexpr *ccp = BlkD(*dccp, Coexpr); @@ -334,104 +334,104 @@ int timeout; hp = BlkD(ccp->inbox, List); switch (timeout){ - case 0 : - if (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - *msg = nulldesc; - Fail; - } - - MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); - if (hp->size==0){ - *msg = nulldesc; - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - Fail; - } - c_get(hp, msg); - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); - - Return; - break; - - case -1 : - MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); - if (hp->size==0){ - hp->empty++; + case 0 : + if (hp->size==0){ + CV_SIGNAL_FULLBLK(hp); + *msg = nulldesc; + Fail; + } + + MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); + if (hp->size==0){ + *msg = nulldesc; + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + Fail; + } + c_get(hp, msg); + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); + + Return; + break; + + case -1 : + MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); + if (hp->size==0){ + hp->empty++; while (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - DEC_NARTHREADS; - CV_WAIT_EMPTYBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->empty--; - if (hp->size==0){ /* This shouldn't be the case, but.. */ - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - Fail; - } - } - c_get(hp, msg); - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); - - Return; - break; - - - case -2 : - if (hp->size == 0){ + CV_SIGNAL_FULLBLK(hp); + DEC_NARTHREADS; + CV_WAIT_EMPTYBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->empty--; + if (hp->size==0){ /* This shouldn't be the case, but.. */ + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + Fail; + } + } + c_get(hp, msg); + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); + + Return; + break; + + + case -2 : + if (hp->size == 0){ idelay(1); - if (hp->size == 0){ - if (!dncp) - idelay(-1); - else{ - MUTEX_LOCKBLK_CONTROLLED(BlkD(ncp->cequeue, List), - "receieve(): list mutex"); - c_put(&(ncp->cequeue), dccp); - MUTEX_UNLOCKBLK(BlkD(ncp->cequeue, List), - "receive(): list mutex"); - idelay(-1); - if (ccp->handdata != NULL){ - *msg = *(ccp->handdata); - ccp->handdata = NULL; - Return; - } - } - } + if (hp->size == 0){ + if (!dncp) + idelay(-1); + else{ + MUTEX_LOCKBLK_CONTROLLED(BlkD(ncp->cequeue, List), + "receieve(): list mutex"); + c_put(&(ncp->cequeue), dccp); + MUTEX_UNLOCKBLK(BlkD(ncp->cequeue, List), + "receive(): list mutex"); + idelay(-1); + if (ccp->handdata != NULL){ + *msg = *(ccp->handdata); + ccp->handdata = NULL; + Return; + } + } + } } - break; - default : - MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); - if (hp->size==0){ - struct timespec ts; - struct timeval tp; - gettimeofday(&tp, NULL); - /* Convert from timeval to timespec */ - ts.tv_sec = tp.tv_sec; - ts.tv_nsec = tp.tv_usec * 1000 + timeout % 1000; - ts.tv_sec += timeout / 1000; - - hp->empty++; - DEC_NARTHREADS; - CV_TIMEDWAIT_EMPTYBLK(hp, ts); - INC_NARTHREADS_CONTROLLED; - hp->empty--; - if (hp->size==0){ - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - Fail; - } - } - c_get(hp, msg); - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); - - Return; + break; + default : + MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); + if (hp->size==0){ + struct timespec ts; + struct timeval tp; + gettimeofday(&tp, NULL); + /* Convert from timeval to timespec */ + ts.tv_sec = tp.tv_sec; + ts.tv_nsec = tp.tv_usec * 1000 + timeout % 1000; + ts.tv_sec += timeout / 1000; + + hp->empty++; + DEC_NARTHREADS; + CV_TIMEDWAIT_EMPTYBLK(hp, ts); + INC_NARTHREADS_CONTROLLED; + hp->empty--; + if (hp->size==0){ + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + Fail; + } + } + c_get(hp, msg); + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); + + Return; } Fail; /* Unreachable */ } @@ -440,7 +440,7 @@ int msg_send( dccp, dncp, msg, timeout) dptr dccp; dptr dncp; /*dptr valloc; /* location of value being transmitted */ -dptr msg; /* location to put result */ +dptr msg; /* location to put result */ int timeout; { tended struct b_coexpr *ccp = BlkD(*dccp, Coexpr); @@ -449,27 +449,27 @@ int timeout; dptr ncpRQ = &(BlkD(*dncp, Coexpr)->inbox); hp = BlkD(*ncpRQ, List); MUTEX_LOCKBLK_CONTROLLED(hp, "msg_send(): list mutex"); - if (hp->size>=hp->max){ - if (timeout==0){ - MUTEX_UNLOCKBLK(hp, "msg_send(): list mutex"); - Fail; - } + if (hp->size>=hp->max){ + if (timeout==0){ + MUTEX_UNLOCKBLK(hp, "msg_send(): list mutex"); + Fail; + } hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->full--; - } + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->full--; + } c_put(ncpRQ, msg); MUTEX_UNLOCKBLK(hp, "msg_send(): list mutex"); CV_SIGNAL_EMPTYBLK(hp); MakeInt(hp->size, msg); Return; } - + /* check if any ce is waiting on my outbox */ hp = BlkD(ccp->cequeue, List); if (hp->size>0){ @@ -479,29 +479,29 @@ int timeout; BlkD(d, Coexpr)->handdata = msg; MUTEX_UNLOCKBLK(hp, "send(): list mutex"); if (BlkD(d, Coexpr)->alive > 0){ - sem_post(BlkD(d, Coexpr)->semp); - MakeInt(hp->size, msg); - Return; - } + sem_post(BlkD(d, Coexpr)->semp); + MakeInt(hp->size, msg); + Return; + } } /* no one is waiting, place the msg in my outbox */ hp = BlkD(ccp->outbox, List); MUTEX_LOCKBLK_CONTROLLED(hp, "send(): list mutex"); if (hp->size>=hp->max){ - if (timeout==0){ - MUTEX_UNLOCKBLK(hp, "msg_send(): list mutex"); - Fail; - } + if (timeout==0){ + MUTEX_UNLOCKBLK(hp, "msg_send(): list mutex"); + Fail; + } hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->full--; - } + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->full--; + } c_put(&(ccp->outbox), msg); MUTEX_UNLOCKBLK(hp, "send(): list mutex"); CV_SIGNAL_EMPTYBLK(hp); @@ -509,7 +509,7 @@ int timeout; Return; } -#endif /* Concurrent */ +#endif /* Concurrent */ "x@>y - non-blocking send." /* @@ -518,9 +518,9 @@ int timeout; * &null: put x the current thread's outbox. * file (socket): write x to y (assuming x can be converted to a string) * list: put x in y - * + * * fails if the value cannot be immediately sent to y (ex: y is full). - * produces the size of the list where x got added, except when + * produces the size of the list where x got added, except when * y is a socket where 1 is returned. */ operator{0,1} @> snd(x,y) @@ -538,7 +538,7 @@ operator{0,1} @> snd(x,y) * in the enclosing function. */ CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ L = (BlkD(k_current, Coexpr))->outbox; hp = BlkD(L, List); } @@ -547,7 +547,7 @@ operator{0,1} @> snd(x,y) hp = BlkD(L, List); } else -#endif /* Concurrent */ +#endif /* Concurrent */ if is:list(y) then inline { L = y; hp = BlkD(L, List); @@ -557,9 +557,9 @@ operator{0,1} @> snd(x,y) union f f; struct b_file *fblk = BlkD(y, File); word status = fblk->status; - + f.fp = BlkLoc(y)->File.fd.fp; - + /* * Convert the argument to a string, defaulting to a empty * string. @@ -567,41 +567,41 @@ operator{0,1} @> snd(x,y) if (!def:tmp_string(x,emptystr,t)) runerr(109, x); - /* - * Output the string. - */ + /* + * Output the string. + */ #ifdef PosixFns if (status & Fs_Socket) { MUTEX_LOCKID_CONTROLLED(fblk->mutexid); - if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { + if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { MUTEX_UNLOCKID(fblk->mutexid); - fail; - } + fail; + } MUTEX_UNLOCKID(fblk->mutexid); - return C_integer 1; - } -#endif - /* PosixFns */ + return C_integer 1; + } +#endif + /* PosixFns */ runerr(118, y); } - else + else runerr(118, y) body{ #ifdef Concurrent if (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - fail; - } + CV_SIGNAL_EMPTYBLK(hp); + fail; + } MUTEX_LOCKBLK_CONTROLLED(hp, "snd(): list mutex"); if (hp->size>=hp->max){ - MUTEX_UNLOCKBLK(hp, "snd(): list mutex"); - CV_SIGNAL_EMPTYBLK(hp); - fail; - } -#endif /* Concurrent */ + MUTEX_UNLOCKBLK(hp, "snd(): list mutex"); + CV_SIGNAL_EMPTYBLK(hp); + fail; + } +#endif /* Concurrent */ c_put(&L, &x); MUTEX_UNLOCKBLK(hp, "snd(): list mutex"); CV_SIGNAL_EMPTYBLK(hp); @@ -611,7 +611,7 @@ end "x@>>y - blocking send." /* - * The same sematics of x@>y above, except that this operation will block + * The same sematics of x@>y above, except that this operation will block * if the value cannot be sent immedialty to y (ex: y is full), * and wait until it can send. */ @@ -630,7 +630,7 @@ operator{0,1} @>> sndbk(x,y) * in the enclosing function. */ CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ L = (BlkD(k_current, Coexpr))->outbox; hp = BlkD(L, List); } @@ -639,7 +639,7 @@ operator{0,1} @>> sndbk(x,y) hp = BlkD(L, List); } else -#endif /* Concurrent */ +#endif /* Concurrent */ if is:list(y) then inline { L = y; hp = BlkD(L, List); @@ -649,9 +649,9 @@ operator{0,1} @>> sndbk(x,y) union f f; struct b_file *fblk = BlkD(y, File); word status = fblk->status; - + f.fp = BlkLoc(y)->File.fd.fp; - + /* * Convert the argument to a string, defaulting to a empty * string. @@ -659,29 +659,29 @@ operator{0,1} @>> sndbk(x,y) if (!def:tmp_string(x,emptystr,t)) runerr(109, x); - /* - * Output the string. - */ + /* + * Output the string. + */ #ifdef PosixFns if (status & Fs_Socket) { MUTEX_LOCKID_CONTROLLED(fblk->mutexid); - if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { + if (sock_write(f.fd, StrLoc(t), StrLen(t)) < 0) { MUTEX_UNLOCKID(fblk->mutexid); - fail; - } - if (sock_write(f.fd, "\n", 1) < 0){ + fail; + } + if (sock_write(f.fd, "\n", 1) < 0){ MUTEX_UNLOCKID(fblk->mutexid); - fail; - } + fail; + } MUTEX_UNLOCKID(fblk->mutexid); - return C_integer 1; - } -#endif - /* PosixFns */ + return C_integer 1; + } +#endif + /* PosixFns */ runerr(118, y); } - else + else runerr(106, y) body{ @@ -690,14 +690,14 @@ operator{0,1} @>> sndbk(x,y) if (hp->size>=hp->max){ hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->full--; - } -#endif /* Concurrent */ + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->full--; + } +#endif /* Concurrent */ c_put(&L, &x); MUTEX_UNLOCKBLK(hp, "send(): list mutex"); CV_SIGNAL_EMPTYBLK(hp); @@ -712,16 +712,16 @@ end * &null: get a value from the current thread's inbox. * file: the same semantics of read() * list: get a value from y - * + * * fails if a value is not available in y (ex: y is empty). * produces whatever value it reads from y; * - * Experimental: if x is not &null then this is a "query/set" operation + * Experimental: if x is not &null then this is a "query/set" operation * for the max size of the queue where if y is: - * list: - x==0: return the "max" size of y + * list: + x==0: return the "max" size of y x!=0: set the max size of y to abs(x) - * co-expression: + * co-expression: * x==0: return the size of the y's inbox * x>0 : set the size y's outbox to x * x<0 : set the size of y's inbox to -x @@ -736,33 +736,33 @@ operator{0,1} <@ rcv(x,y) #ifdef Concurrent if !is:null(x) then inline { C_integer xval; - if (!cnv:C_integer(x, xval)) + if (!cnv:C_integer(x, xval)) runerr(101, x); if (is:list(y)){ if (xval>0) BlkD(y, List)->max = xval; - else if (xval<0) BlkD(y, List)->max = xval; - return C_integer BlkD(y, List)->size; + else if (xval<0) BlkD(y, List)->max = xval; + return C_integer BlkD(y, List)->size; } else if (is:null(y)){ CURTSTATE(); - d = k_current; - } + d = k_current; + } else if (is:coexpr(y)) d = y; - else + else runerr(106, y); if (xval==0) return C_integer BlkD((BlkD(d, Coexpr))->inbox, List)->size; else if (xval>0) { BlkD((BlkD(d, Coexpr))->outbox, List)->max = xval; - return C_integer (BlkD(d, List))->size; - } + return C_integer (BlkD(d, List))->size; + } else { BlkD((BlkD(d, Coexpr))->inbox, List)->max = -xval; - return C_integer (BlkD(d, List))->size; - } + return C_integer (BlkD(d, List))->size; + } } if is:null(y) then inline { @@ -772,14 +772,14 @@ operator{0,1} <@ rcv(x,y) * in the enclosing function. */ CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ hp = BlkD(BlkD(k_current, Coexpr)->inbox, List); } else if is:coexpr(y) then inline { hp = BlkD(BlkD(y, Coexpr)->outbox, List); } else -#endif /* Concurrent */ +#endif /* Concurrent */ if is:list(y) then inline { hp = BlkD(y, List); } @@ -790,14 +790,14 @@ operator{0,1} <@ rcv(x,y) status = BlkD(y, File)->status; if (!(status & Fs_Read)) - runerr(212, y); + runerr(212, y); #ifdef Graphics if (status & Fs_Window) { - /* implement ready() on window */ + /* implement ready() on window */ fail; } -#endif /* Graphics */ +#endif /* Graphics */ #if defined(PseudoPty) if (status & Fs_Pty) { @@ -805,71 +805,71 @@ operator{0,1} <@ rcv(x,y) struct ptstruct *pt = BlkD(y, File)->fd.pt; #if NT DWORD tb; - if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) - && (tb>0)) { + if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) + && (tb>0)) { #else - int tb; - fd_set readset; - struct timeval tv; - FD_ZERO(&readset); - FD_SET(pt->master_fd, &readset); - tv.tv_sec = tv.tv_usec = 0; - if (select(pt->master_fd+1, &readset, NULL, NULL, &tv) > 0) { - /* performance bug: how many bytes are really available? */ - tb = 1; + int tb; + fd_set readset; + struct timeval tv; + FD_ZERO(&readset); + FD_SET(pt->master_fd, &readset); + tv.tv_sec = tv.tv_usec = 0; + if (select(pt->master_fd+1, &readset, NULL, NULL, &tv) > 0) { + /* performance bug: how many bytes are really available? */ + tb = 1; #endif - if (i == 0) i = tb; + if (i == 0) i = tb; else if (tb < i) i = tb; Protect(sbuf = alcstr(NULL, i), runerr(0)); - DEC_NARTHREADS; + DEC_NARTHREADS; #if NT status = ReadFile(pt->master_read, sbuf, i, &tb, NULL); #else - tb = read(pt->master_fd, sbuf, i); + tb = read(pt->master_fd, sbuf, i); status = (tb != -1); #endif - INC_NARTHREADS_CONTROLLED; - if (!status) fail; + INC_NARTHREADS_CONTROLLED; + if (!status) fail; StrLoc(desc) = sbuf; StrLen(desc) = tb; return desc; - } - else fail; - } -#endif /* PseudoPty */ + } + else fail; + } +#endif /* PseudoPty */ if (status & Fs_Buff) - runerr(1048, y); + runerr(1048, y); if (u_read(&y, i, status, &desc) == 0) - fail; + fail; return desc; } -#endif /* PosixFns */ - else +#endif /* PosixFns */ + else runerr(118, y) body{ if (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - fail; - } + CV_SIGNAL_FULLBLK(hp); + fail; + } MUTEX_LOCKBLK_CONTROLLED(hp, "rcv(): list mutex"); if (hp->size==0){ MUTEX_UNLOCKBLK(hp, "rcv(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - fail; - } + CV_SIGNAL_FULLBLK(hp); + fail; + } c_get(hp, &d); MUTEX_UNLOCKBLK(hp, "rcv(): list+ mutex"); #ifdef Concurrent if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); -#endif /* Concurrent */ + CV_SIGNAL_FULLBLK(hp); +#endif /* Concurrent */ - return d; + return d; } end @@ -878,7 +878,7 @@ end * same semantics of x<@y excpet this is a blocking operation that waits * for a value to become available if there isn't one already. * x is a timeout in milliseconds before giving up on waiting. - * fails if no value is available after x milliseconds + * fails if no value is available after x milliseconds * otherwise, produces the value read from y (queue) */ operator{0,1} <<@ rcvbk(x,y) @@ -899,14 +899,14 @@ operator{0,1} <<@ rcvbk(x,y) * in the enclosing function. */ CURTSTATE(); -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ hp = BlkD(BlkD(k_current, Coexpr)->inbox, List); } else if is:coexpr(y) then inline { hp = BlkD(BlkD(y, Coexpr)->outbox, List); } else -#endif /* Concurrent */ +#endif /* Concurrent */ if is:list(y) then inline { hp = BlkD(y, List); } @@ -918,7 +918,7 @@ operator{0,1} <<@ rcvbk(x,y) tended struct descrip s; #ifdef PosixFns SOCKET ws; -#endif /* PosixFns */ +#endif /* PosixFns */ status = BlkLoc(y)->File.status; @@ -933,137 +933,137 @@ operator{0,1} <<@ rcvbk(x,y) if (status & Fs_Socket) { StrLen(s) = 0; do { - DEC_NARTHREADS; - if ((slen = sock_getstrg(sbuf, MaxReadStr, &y)) == -1) { - /*IntVal(amperErrno) = errno; */ - INC_NARTHREADS_CONTROLLED; - fail; - } - INC_NARTHREADS_CONTROLLED; - if (slen == -3) - fail; - if (slen == 1 && *sbuf == '\n') - break; - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, rlen), runerr(0)); - if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) { - Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); - Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0)); - } - - Protect(sptr = alcstr(sbuf,rlen), runerr(0)); - if (StrLen(s) == 0) - StrLoc(s) = sptr; - StrLen(s) += rlen; - if (StrLoc(s) [ StrLen(s) - 1 ] == '\n') { StrLen(s)--; break; } - else { - /* no newline to trim; EOF? */ - } - } - while (slen > 0); + DEC_NARTHREADS; + if ((slen = sock_getstrg(sbuf, MaxReadStr, &y)) == -1) { + /*IntVal(amperErrno) = errno; */ + INC_NARTHREADS_CONTROLLED; + fail; + } + INC_NARTHREADS_CONTROLLED; + if (slen == -3) + fail; + if (slen == 1 && *sbuf == '\n') + break; + rlen = slen < 0 ? (word)MaxReadStr : slen; + + Protect(reserve(Strings, rlen), runerr(0)); + if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) { + Protect(reserve(Strings, StrLen(s)+rlen), runerr(0)); + Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0)); + } + + Protect(sptr = alcstr(sbuf,rlen), runerr(0)); + if (StrLen(s) == 0) + StrLoc(s) = sptr; + StrLen(s) += rlen; + if (StrLoc(s) [ StrLen(s) - 1 ] == '\n') { StrLen(s)--; break; } + else { + /* no newline to trim; EOF? */ + } + } + while (slen > 0); return s; - } -#endif /* PosixFns */ + } +#endif /* PosixFns */ runerr(118, y); } - else + else runerr(118, y) body{ switch (x){ case -1 : - MUTEX_LOCKBLK_CONTROLLED(hp, "rcvbk(): list mutex"); - if (hp->size==0){ + MUTEX_LOCKBLK_CONTROLLED(hp, "rcvbk(): list mutex"); + if (hp->size==0){ #ifdef Concurrent - hp->empty++; + hp->empty++; while (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - DEC_NARTHREADS; - CV_WAIT_EMPTYBLK(hp); - INC_NARTHREADS_CONTROLLED; - } - hp->empty--; -#endif /* Concurrent */ - if (hp->size==0){ /* This shouldn't be the case, but.. */ - MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - fail; - } - } - c_get(hp, &d); - MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + DEC_NARTHREADS; + CV_WAIT_EMPTYBLK(hp); + INC_NARTHREADS_CONTROLLED; + } + hp->empty--; +#endif /* Concurrent */ + if (hp->size==0){ /* This shouldn't be the case, but.. */ + MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + fail; + } + } + c_get(hp, &d); + MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); #ifdef Concurrent - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); -#endif /* Concurrent */ - return d; - - case 0 : - if (hp->size==0){ - CV_SIGNAL_FULLBLK(hp); - fail; - } - - MUTEX_LOCKBLK_CONTROLLED(hp, "rcvbk(): list mutex"); - if (hp->size==0){ - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - fail; - } - c_get(hp, &d); - MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); +#endif /* Concurrent */ + return d; + + case 0 : + if (hp->size==0){ + CV_SIGNAL_FULLBLK(hp); + fail; + } + + MUTEX_LOCKBLK_CONTROLLED(hp, "rcvbk(): list mutex"); + if (hp->size==0){ + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + fail; + } + c_get(hp, &d); + MUTEX_UNLOCKBLK(hp, "rcvbk(): list mutex"); #ifdef Concurrent - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); -#endif /* Concurrent */ - return d; - - default :{ - struct timespec ts; - struct timeval tp; - gettimeofday(&tp, NULL); - /* - * The argument is in milli seconds, - * timeval returns micro seconds - * timespec needs nano seconds - * Do the conversion: - */ - tp.tv_usec += (x % 1000) * 1000; - if(tp.tv_usec<1000000) { - ts.tv_sec = tp.tv_sec + x / 1000; - ts.tv_nsec = tp.tv_usec * 1000; - } - else { - /* make sure tv_usec overflows to seconds */ - ts.tv_sec = tp.tv_sec + x / 1000 + 1; - ts.tv_nsec = (tp.tv_usec-1000000) * 1000; - } - - MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); - if (hp->size==0){ + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); +#endif /* Concurrent */ + return d; + + default :{ + struct timespec ts; + struct timeval tp; + gettimeofday(&tp, NULL); + /* + * The argument is in milli seconds, + * timeval returns micro seconds + * timespec needs nano seconds + * Do the conversion: + */ + tp.tv_usec += (x % 1000) * 1000; + if(tp.tv_usec<1000000) { + ts.tv_sec = tp.tv_sec + x / 1000; + ts.tv_nsec = tp.tv_usec * 1000; + } + else { + /* make sure tv_usec overflows to seconds */ + ts.tv_sec = tp.tv_sec + x / 1000 + 1; + ts.tv_nsec = (tp.tv_usec-1000000) * 1000; + } + + MUTEX_LOCKBLK_CONTROLLED(hp, "receive(): list mutex"); + if (hp->size==0){ #ifdef Concurrent - hp->empty++; - DEC_NARTHREADS; - CV_TIMEDWAIT_EMPTYBLK(hp, ts); - INC_NARTHREADS_CONTROLLED; - hp->empty--; -#endif /* Concurrent */ - if (hp->size==0){ - MUTEX_UNLOCKBLK(hp, "rcv(): list mutex"); - CV_SIGNAL_FULLBLK(hp); - fail; - } - } - c_get(hp, &d); - MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); + hp->empty++; + DEC_NARTHREADS; + CV_TIMEDWAIT_EMPTYBLK(hp, ts); + INC_NARTHREADS_CONTROLLED; + hp->empty--; +#endif /* Concurrent */ + if (hp->size==0){ + MUTEX_UNLOCKBLK(hp, "rcv(): list mutex"); + CV_SIGNAL_FULLBLK(hp); + fail; + } + } + c_get(hp, &d); + MUTEX_UNLOCKBLK(hp, "receive(): list mutex"); #ifdef Concurrent - if (hp->size <= hp->max/50+1) - CV_SIGNAL_FULLBLK(hp); -#endif /* Concurrent */ - return d; - } /* default */ - } /* switch */ + if (hp->size <= hp->max/50+1) + CV_SIGNAL_FULLBLK(hp); +#endif /* Concurrent */ + return d; + } /* default */ + } /* switch */ fail; /* make rtt happy! */ } diff --git a/src/runtime/oarith.r b/src/runtime/oarith.r index aa914051f..0c792dc6e 100644 --- a/src/runtime/oarith.r +++ b/src/runtime/oarith.r @@ -9,7 +9,7 @@ #ifdef DataParallel int list_add(dptr x, dptr y, dptr z); -#endif /* DataParallel */ +#endif /* DataParallel */ #begdef ArithOp(icon_op, func_name, c_int_op, c_real_op, c_list_op) @@ -17,18 +17,18 @@ int list_add(dptr x, dptr y, dptr z); declare { #ifdef LargeInts tended struct descrip lx, ly; -#endif /* LargeInts */ - C_integer irslt; +#endif /* LargeInts */ + C_integer irslt; } #ifdef DataParallel if is:list(x) then { abstract { return type(x) ++ type(y) - } - inline { c_list_op(&x, &y, &result); return result; } + } + inline { c_list_op(&x, &y, &result); return result; } } else -#endif /* DataParallel */ +#endif /* DataParallel */ arith_case (x, y) of { C_integer: { abstract { @@ -98,7 +98,7 @@ end MakeInt(x,&lx); MakeInt(y,&ly); if (bigdiv(&lx,&ly,&result) == RunError) /* alcbignum failed */ - runerr(0); + runerr(0); return result; #else /* LargeInts */ runerr(203); @@ -140,9 +140,9 @@ ArithOp( / , divide , Divide , RealDivide, list_add /* bogus */) if (bigsub(&lx,&ly,&result) == RunError) /* alcbignum failed */ runerr(0); return result; -#else /* LargeInts */ +#else /* LargeInts */ runerr(203); -#endif /* LargeInts */ +#endif /* LargeInts */ } else return C_integer irslt; #enddef @@ -225,9 +225,9 @@ ArithOp( % , mod , IntMod , RealMod, list_add /* bogus */ ) if (bigmul(&lx,&ly,&result) == RunError) /* alcbignum failed */ runerr(0); return result; -#else /* LargeInts */ +#else /* LargeInts */ runerr(203); -#endif /* LargeInts */ +#endif /* LargeInts */ } else return C_integer irslt; #enddef @@ -236,7 +236,7 @@ ArithOp( % , mod , IntMod , RealMod, list_add /* bogus */ ) #define RealMpy(x,y) RealResult(x * y); ArithOp( * , mult , Mpy , RealMpy, list_add /* bogus */ ) - + "-x - negate x." @@ -246,21 +246,21 @@ operator{1} - neg(x) return integer } inline { - C_integer i; - int over_flow = 0; + C_integer i; + int over_flow = 0; - i = neg(x, &over_flow); - if (over_flow) { + i = neg(x, &over_flow); + if (over_flow) { #ifdef LargeInts - struct descrip tmp; - MakeInt(x,&tmp); - if (bigneg(&tmp, &result) == RunError) /* alcbignum failed */ - runerr(0); + struct descrip tmp; + MakeInt(x,&tmp); + if (bigneg(&tmp, &result) == RunError) /* alcbignum failed */ + runerr(0); return result; -#else /* LargeInts */ - irunerr(203,x); +#else /* LargeInts */ + irunerr(203,x); errorfail; -#endif /* LargeInts */ +#endif /* LargeInts */ } return C_integer i; } @@ -271,12 +271,12 @@ operator{1} - neg(x) return integer } inline { - if (bigneg(&x, &result) == RunError) /* alcbignum failed */ - runerr(0); - return result; + if (bigneg(&x, &result) == RunError) /* alcbignum failed */ + runerr(0); + return result; } } -#endif /* LargeInts */ +#endif /* LargeInts */ else { if !cnv:C_double(x) then runerr(102, x) @@ -285,12 +285,12 @@ operator{1} - neg(x) } inline { double drslt; - drslt = -x; + drslt = -x; return C_double drslt; } } end - + "+x - convert x to a number." /* @@ -314,7 +314,7 @@ operator{1} + number(x) return x; } } -#endif /* LargeInts */ +#endif /* LargeInts */ else if cnv:C_double(x) then { abstract { return real @@ -346,11 +346,11 @@ end MakeInt(x,&lx); MakeInt(y,&ly); if (bigadd(&lx, &ly, &result) == RunError) /* alcbignum failed */ - runerr(0); + runerr(0); return result; -#else /* LargeInts */ +#else /* LargeInts */ runerr(203); -#endif /* LargeInts */ +#endif /* LargeInts */ } else return C_integer irslt; #enddef @@ -358,7 +358,7 @@ end #define RealAdd(x,y) RealResult(x + y); ArithOp( + , plus , Add , RealAdd, list_add ) - + #ifdef DataParallel int list_add(dptr x, dptr y, dptr z) @@ -371,407 +371,407 @@ int list_add(dptr x, dptr y, dptr z) size1 = BlkLoc(*x)->List.size; size2 = BlkLoc(*y)->List.size; if (size1 != size2) return RunError; -#ifdef Arrays +#ifdef Arrays if ( BlkType(BlkD(*x,List)->listhead)==T_Realarray){ - double *a, *c; - - if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ /*the two are real arrays*/ - double *b; - if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - /* points to the three arrays data and copy! */ - a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; - b = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; - - for(i=0; ilisthead)==T_Intarray){ /*first arrays is real, second is int*/ - word *b; - - if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - - a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; - b = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; - /* a is real, b is int, hopefully the c compiler knows how to do it*/ - for(i=0; iList.listhead; - apc = (struct b_realarray *) BlkLoc(*z)->List.listhead; - - for (ep = BlkD(*y,List)->listhead; BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext){ - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - - if (!cnv:C_double(ep->Lelem.lslots[j], f)) - return RunError; - - apc->a[k] = apa->a[k] + f; - k++; - } - } - } - } + double *a, *c; + + if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ /*the two are real arrays*/ + double *b; + if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + /* points to the three arrays data and copy! */ + a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; + b = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; + + for(i=0; ilisthead)==T_Intarray){ /*first arrays is real, second is int*/ + word *b; + + if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + + a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; + b = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; + /* a is real, b is int, hopefully the c compiler knows how to do it*/ + for(i=0; iList.listhead; + apc = (struct b_realarray *) BlkLoc(*z)->List.listhead; + + for (ep = BlkD(*y,List)->listhead; BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext){ + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + + if (!cnv:C_double(ep->Lelem.lslots[j], f)) + return RunError; + + apc->a[k] = apa->a[k] + f; + k++; + } + } + } + } else if ( BlkType(BlkD(*x,List)->listhead)==T_Intarray){ - word *a; - - if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ /*first arrays is int, second is real*/ - double *b, *c; - if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - /* points to the three arrays data and copy! */ - a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; - b = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; - - for(i=0; ilisthead)==T_Intarray){ /*the two are int arrays*/ - word *b, *c; - - if (cpintarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - - a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; - b = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_intarray *) BlkLoc(*z)->List.listhead)->a; - /* a is real, b is int, hopefully the c compiler knows how to do it*/ - for(i=0; iList.listhead; - apc = (struct b_intarray *) BlkLoc(*z)->List.listhead; - - for (ep = BlkD(*y,List)->listhead; BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext){ - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - - /* default : The resutling array is of type int */ - if (Type(ep->Lelem.lslots[j]) == T_Integer ){ - if (!cnv:C_integer(ep->Lelem.lslots[j], d)) - return RunError; - apc->a[k] = apa->a[k] + d; - k++; - } - else{ - /* we might be able to continue with real, copy the elements to - * a new realarray and continue - */ - tended struct b_realarray *apc2; - double f; - word ii; - if (cpint2realarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - - apc2 = (struct b_realarray *) BlkLoc(*z)->List.listhead; - for (ii=0; iia[ii] = apc->a[ii]; - - /* where we stoped in the last list lelem*/ - ii=i; - /* no need to start over since elements were copied already*/ - for (/*ep = BlkD(*y,List)->listhead*/; - BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext){ - for (i = ii; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - if (!cnv:C_double(ep->Lelem.lslots[j], f)) - return RunError; - apc2->a[k] = apa->a[k] + f; - k++; - } - ii=0; - } - return Succeeded; - } - } /*for i=0 */ - } /* for ep = */ - } - } + word *a; + + if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ /*first arrays is int, second is real*/ + double *b, *c; + if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + /* points to the three arrays data and copy! */ + a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; + b = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead)->a; + + for(i=0; ilisthead)==T_Intarray){ /*the two are int arrays*/ + word *b, *c; + + if (cpintarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + + a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; + b = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_intarray *) BlkLoc(*z)->List.listhead)->a; + /* a is real, b is int, hopefully the c compiler knows how to do it*/ + for(i=0; iList.listhead; + apc = (struct b_intarray *) BlkLoc(*z)->List.listhead; + + for (ep = BlkD(*y,List)->listhead; BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext){ + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + + /* default : The resutling array is of type int */ + if (Type(ep->Lelem.lslots[j]) == T_Integer ){ + if (!cnv:C_integer(ep->Lelem.lslots[j], d)) + return RunError; + apc->a[k] = apa->a[k] + d; + k++; + } + else{ + /* we might be able to continue with real, copy the elements to + * a new realarray and continue + */ + tended struct b_realarray *apc2; + double f; + word ii; + if (cpint2realarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + + apc2 = (struct b_realarray *) BlkLoc(*z)->List.listhead; + for (ii=0; iia[ii] = apc->a[ii]; + + /* where we stoped in the last list lelem*/ + ii=i; + /* no need to start over since elements were copied already*/ + for (/*ep = BlkD(*y,List)->listhead*/; + BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext){ + for (i = ii; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + if (!cnv:C_double(ep->Lelem.lslots[j], f)) + return RunError; + apc2->a[k] = apa->a[k] + f; + k++; + } + ii=0; + } + return Succeeded; + } + } /*for i=0 */ + } /* for ep = */ + } + } else if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ - tended union block *ep; - tended struct b_realarray *apa, *apc; - word k=0; - double f; - - if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - - apa = (struct b_realarray *) BlkLoc(*y)->List.listhead; - apc = (struct b_realarray *) BlkLoc(*z)->List.listhead; - - for (ep = BlkD(*x,List)->listhead; BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext){ - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - - if (!cnv:C_double(ep->Lelem.lslots[j], f)) - return RunError; - - apc->a[k] = apa->a[k] + f; - k++; - } - } - } + tended union block *ep; + tended struct b_realarray *apa, *apc; + word k=0; + double f; + + if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + + apa = (struct b_realarray *) BlkLoc(*y)->List.listhead; + apc = (struct b_realarray *) BlkLoc(*z)->List.listhead; + + for (ep = BlkD(*x,List)->listhead; BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext){ + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + + if (!cnv:C_double(ep->Lelem.lslots[j], f)) + return RunError; + + apc->a[k] = apa->a[k] + f; + k++; + } + } + } else if ( BlkType(BlkD(*y,List)->listhead)==T_Intarray){ - tended union block *ep; - tended struct b_intarray *apa, *apc; - word k=0, d; - - if (cpintarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - - apa = (struct b_intarray *) BlkLoc(*y)->List.listhead; - apc = (struct b_intarray *) BlkLoc(*z)->List.listhead; - - for (ep = BlkD(*x,List)->listhead; BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext){ - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - - /* default : The resutling array is of type int */ - if (Type(ep->Lelem.lslots[j]) == T_Integer ){ - if (!cnv:C_integer(ep->Lelem.lslots[j], d)) - return RunError; - apc->a[k] = apa->a[k] + d; - k++; - } - else{ - /* we might be able to continue with real, copy the elements to - * a new realarray and continue - */ - tended struct b_realarray *apc2; - double f; - word ii; - if (cpint2realarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - - apc2 = (struct b_realarray *) BlkLoc(*z)->List.listhead; - for (ii=0; iia[ii] = apc->a[ii]; - /* where we stoped in the last list lelem*/ - ii=i; - /* no need to start over since elements were copied already*/ - for (/*ep = BlkD(*x,List)->listhead*/; - BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext){ - for (i = ii; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - if (!cnv:C_double(ep->Lelem.lslots[j], f)) - return RunError; - apc2->a[k] = apa->a[k] + f; - k++; - - } - ii=0; - } - return Succeeded; - - } - } /*for i=0*/ - } /* for ep */ - } + tended union block *ep; + tended struct b_intarray *apa, *apc; + word k=0, d; + + if (cpintarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + + apa = (struct b_intarray *) BlkLoc(*y)->List.listhead; + apc = (struct b_intarray *) BlkLoc(*z)->List.listhead; + + for (ep = BlkD(*x,List)->listhead; BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext){ + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + + /* default : The resutling array is of type int */ + if (Type(ep->Lelem.lslots[j]) == T_Integer ){ + if (!cnv:C_integer(ep->Lelem.lslots[j], d)) + return RunError; + apc->a[k] = apa->a[k] + d; + k++; + } + else{ + /* we might be able to continue with real, copy the elements to + * a new realarray and continue + */ + tended struct b_realarray *apc2; + double f; + word ii; + if (cpint2realarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + + apc2 = (struct b_realarray *) BlkLoc(*z)->List.listhead; + for (ii=0; iia[ii] = apc->a[ii]; + /* where we stoped in the last list lelem*/ + ii=i; + /* no need to start over since elements were copied already*/ + for (/*ep = BlkD(*x,List)->listhead*/; + BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext){ + for (i = ii; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + if (!cnv:C_double(ep->Lelem.lslots[j], f)) + return RunError; + apc2->a[k] = apa->a[k] + f; + k++; + + } + ii=0; + } + return Succeeded; + + } + } /*for i=0*/ + } /* for ep */ + } else{ /* the two lists are of type List */ -#endif /* Arrays */ - struct descrip *slotptr; - tended struct b_lelem *bp1; - if (cplist(x, z, (word)1, size1 + 1) == RunError) - return RunError; - /* add in values from y */ - - lp1 = (struct b_list *) BlkLoc(*y); - bp1 = (struct b_lelem *) lp1->listhead; - i = 1; - slot = 0; - while (size2 > 0) { - j = bp1->first + i - 1; - if (j >= bp1->nslots) - j -= bp1->nslots; - slotptr = BlkLoc(*z)->List.listhead->Lelem.lslots + slot++; - list_add(slotptr, bp1->lslots+j, slotptr); - if (++i > bp1->nused) { - i = 1; - bp1 = (struct b_lelem *) bp1->listnext; - } - size2--; - } +#endif /* Arrays */ + struct descrip *slotptr; + tended struct b_lelem *bp1; + if (cplist(x, z, (word)1, size1 + 1) == RunError) + return RunError; + /* add in values from y */ + + lp1 = (struct b_list *) BlkLoc(*y); + bp1 = (struct b_lelem *) lp1->listhead; + i = 1; + slot = 0; + while (size2 > 0) { + j = bp1->first + i - 1; + if (j >= bp1->nslots) + j -= bp1->nslots; + slotptr = BlkLoc(*z)->List.listhead->Lelem.lslots + slot++; + list_add(slotptr, bp1->lslots+j, slotptr); + if (++i > bp1->nused) { + i = 1; + bp1 = (struct b_lelem *) bp1->listnext; + } + size2--; + } #ifdef Arrays - } + } #endif } else if (is:list(*x)) { /* x a list, y a scalar */ #ifdef Arrays if ( BlkType(BlkD(*x,List)->listhead)==T_Realarray){ - double *a, *c, f; - size1 = BlkLoc(*x)->List.size; - - if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - if (!cnv:C_double(*y, f)) - return RunError; - - a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; - - for(i=0; iList.size; + + if (cprealarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + if (!cnv:C_double(*y, f)) + return RunError; + + a = ((struct b_realarray *) BlkLoc(*x)->List.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; + + for(i=0; ilisthead)==T_Intarray){ - word *a, d; - double f; - size1 = BlkLoc(*x)->List.size; - if ( Type ( *y ) == T_Integer ){ - word *c; - if (!cnv:C_integer(*y, d)) - return RunError; - if (cpintarray(x, z, (word) 1, size1 + 1) == RunError) - return RunError; - a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; - c = ((struct b_intarray *) BlkLoc(*z)->List.listhead )->a; - for(i=0; iList.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; - for(i=0; iList.size; + if ( Type ( *y ) == T_Integer ){ + word *c; + if (!cnv:C_integer(*y, d)) + return RunError; + if (cpintarray(x, z, (word) 1, size1 + 1) == RunError) + return RunError; + a = ((struct b_intarray *) BlkLoc(*x)->List.listhead )->a; + c = ((struct b_intarray *) BlkLoc(*z)->List.listhead )->a; + for(i=0; iList.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; + for(i=0; iList.size; - if (cplist(x, z, (word)1, size1 + 1) == RunError) - return RunError; - for (i=0; iList.listhead->Lelem.lslots + i; - list_add(slotptr, y, slotptr); - } -#ifdef Arrays +#endif /* Arrays*/ + struct descrip *slotptr; + size1 = BlkLoc(*x)->List.size; + if (cplist(x, z, (word)1, size1 + 1) == RunError) + return RunError; + for (i=0; iList.listhead->Lelem.lslots + i; + list_add(slotptr, y, slotptr); + } +#ifdef Arrays } -#endif /* Arrays */ +#endif /* Arrays */ } else if (is:list(*y)) { /* y a list, x a scalar */ -#ifdef Arrays +#ifdef Arrays if ( BlkType(BlkD(*y,List)->listhead)==T_Realarray){ - double *a, *c, f; - size1 = BlkLoc(*y)->List.size; - - if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - if (!cnv:C_double(*x, f)) - return RunError; - - a = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; - - for(i=0; iList.size; + + if (cprealarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + if (!cnv:C_double(*x, f)) + return RunError; + + a = ((struct b_realarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; + + for(i=0; ilisthead)==T_Intarray){ - word *a, d; - double f; - size1 = BlkLoc(*y)->List.size; - if ( Type ( *x ) == T_Integer ){ - word *c; - if (!cnv:C_integer(*x, d)) - return RunError; - if (cpintarray(y, z, (word) 1, size1 + 1) == RunError) - return RunError; - a = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; - c = ((struct b_intarray *) BlkLoc(*z)->List.listhead )->a; - for(i=0; iList.listhead )->a; - c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; - for(i=0; iList.size; + if ( Type ( *x ) == T_Integer ){ + word *c; + if (!cnv:C_integer(*x, d)) + return RunError; + if (cpintarray(y, z, (word) 1, size1 + 1) == RunError) + return RunError; + a = ((struct b_intarray *) BlkLoc(*y)->List.listhead )->a; + c = ((struct b_intarray *) BlkLoc(*z)->List.listhead )->a; + for(i=0; iList.listhead )->a; + c = ((struct b_realarray *) BlkLoc(*z)->List.listhead )->a; + for(i=0; iList.size; - if (cplist(y, z, (word)1, size1 + 1) == RunError) - return RunError; - for (i=0; iList.listhead->Lelem.lslots + i; - list_add(slotptr, x, slotptr); - } +#endif /* Arrays */ + struct descrip *slotptr; + size1 = BlkLoc(*y)->List.size; + if (cplist(y, z, (word)1, size1 + 1) == RunError) + return RunError; + for (i=0; iList.listhead->Lelem.lslots + i; + list_add(slotptr, x, slotptr); + } #ifdef Arrays - } -#endif /* Arrays */ + } +#endif /* Arrays */ } else { C_integer tmp, tmp2, irslt; double tmp3, tmp4; #ifdef LargeInts tended struct descrip lx, ly; -#endif /* LargeInts */ - +#endif /* LargeInts */ + /* x, y must be numeric */ if (cnv:(exact)C_integer(*x, tmp) && cnv:(exact)C_integer(*y, tmp2)) { irslt = add(tmp,tmp2); - if (over_flow) { + if (over_flow) { #ifdef LargeInts MakeInt(x,&lx); MakeInt(y,&ly); if (bigadd(&lx, &ly, z) == RunError) /* alcbignum failed */ return RunError; -#endif /* LargeInts */ - } - else MakeInt(irslt, z); +#endif /* LargeInts */ + } + else MakeInt(irslt, z); } else if (cnv:C_double(*x, tmp3) && cnv:C_double(*y, tmp4)) { } @@ -779,9 +779,9 @@ int list_add(dptr x, dptr y, dptr z) } return Succeeded; } -#endif /* DataParallel */ +#endif /* DataParallel */ + - "x ^ y - raise x to the y power." @@ -789,89 +789,89 @@ int list_add(dptr x, dptr y, dptr z) operator{1} ^ powr(x, y) if cnv:(exact)C_integer(y) then { if cnv:(exact)integer(x) then { - abstract { - return integer - } - inline { + abstract { + return integer + } + inline { #ifdef LargeInts - tended struct descrip ly; - MakeInt ( y, &ly ); - if (bigpow(&x, &ly, &result) == RunError) /* alcbignum failed */ - runerr(0); - return result; + tended struct descrip ly; + MakeInt ( y, &ly ); + if (bigpow(&x, &ly, &result) == RunError) /* alcbignum failed */ + runerr(0); + return result; #else - int over_flow; - C_integer r = iipow(IntVal(x), y, &over_flow); - if (over_flow) - runerr(203); - return C_integer r; + int over_flow; + C_integer r = iipow(IntVal(x), y, &over_flow); + if (over_flow) + runerr(203); + return C_integer r; #endif - } - } + } + } else { - if !cnv:C_double(x) then - runerr(102, x) - abstract { - return real - } - inline { - if (ripow( x, y, &result) == RunError) - runerr(0); - return result; - } - } + if !cnv:C_double(x) then + runerr(102, x) + abstract { + return real + } + inline { + if (ripow( x, y, &result) == RunError) + runerr(0); + return result; + } + } } #ifdef LargeInts else if cnv:(exact)integer(y) then { if cnv:(exact)integer(x) then { - abstract { - return integer - } - inline { - if (bigpow(&x, &y, &result) == RunError) /* alcbignum failed */ - runerr(0); - return result; - } - } + abstract { + return integer + } + inline { + if (bigpow(&x, &y, &result) == RunError) /* alcbignum failed */ + runerr(0); + return result; + } + } else { - if !cnv:C_double(x) then - runerr(102, x) - abstract { - return real - } - inline { - if ( bigpowri ( x, &y, &result ) == RunError ) - runerr(0); - return result; - } - } + if !cnv:C_double(x) then + runerr(102, x) + abstract { + return real + } + inline { + if ( bigpowri ( x, &y, &result ) == RunError ) + runerr(0); + return result; + } + } } -#endif /* LargeInts */ +#endif /* LargeInts */ else { if !cnv:C_double(x) then - runerr(102, x) + runerr(102, x) if !cnv:C_double(y) then - runerr(102, y) + runerr(102, y) abstract { - return real - } + return real + } inline { - double z; - if (x == 0.0 && y < 0.0) - runerr(204); - if (x < 0.0) - runerr(206); - z = pow(x, y); - if (isinf(z)) - runerr(204); - return C_double z; - } + double z; + if (x == 0.0 && y < 0.0) + runerr(204); + if (x < 0.0) + runerr(206); + z = pow(x, y); + if (isinf(z)) + runerr(204); + return C_double z; + } } end #if COMPILER || !(defined LargeInts) /* - * iipow - raise an integer to an integral power. + * iipow - raise an integer to an integral power. */ C_integer iipow(C_integer n1, C_integer n2, int *over_flowp) { @@ -881,37 +881,37 @@ C_integer iipow(C_integer n1, C_integer n2, int *over_flowp) *over_flowp = 0; switch ( n1 ) { case 1: - return 1; + return 1; case -1: - /* Result depends on whether n2 is even or odd */ - return ( n2 & 01 ) ? -1 : 1; + /* Result depends on whether n2 is even or odd */ + return ( n2 & 01 ) ? -1 : 1; case 0: - if ( n2 <= 0 ) - *over_flowp = 1; - return 0; + if ( n2 <= 0 ) + *over_flowp = 1; + return 0; default: - if (n2 < 0) - return 0; + if (n2 < 0) + return 0; } result = 1L; for ( ; ; ) { if (n2 & 01L) - { - result = mul(result, n1, over_flowp); - if (*over_flowp) - return 0; - } + { + result = mul(result, n1, over_flowp); + if (*over_flowp) + return 0; + } if ( ( n2 >>= 1 ) == 0 ) break; n1 = mul(n1, n1, over_flowp); if (*over_flowp) - return 0; + return 0; } *over_flowp = 0; return result; } -#endif /* COMPILER || !(defined LargeInts) */ +#endif /* COMPILER || !(defined LargeInts) */ /* @@ -925,7 +925,7 @@ dptr drslt; double retval; CURTSTATE(); - if (r == 0.0 && n <= 0) + if (r == 0.0 && n <= 0) ReturnErrNum(204, RunError); if (n < 0) { /* @@ -937,13 +937,13 @@ dptr drslt; r = 1.0 / r; retval = r; } - else + else retval = 1.0; /* multiply retval by r ^ n */ while (n > 0) { if (n & 01L) - retval *= r; + retval *= r; r *= r; n >>= 1; } @@ -952,9 +952,9 @@ dptr drslt; #ifdef DescriptorDouble drslt->vword.realval = retval; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ Protect(BlkLoc(*drslt) = (union block *)alcreal(retval), return RunError); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ drslt->dword = D_Real; return Succeeded; } diff --git a/src/runtime/oasgn.r b/src/runtime/oasgn.r index fd9d2fa50..0f06b0e69 100644 --- a/src/runtime/oasgn.r +++ b/src/runtime/oasgn.r @@ -38,8 +38,8 @@ } } tvmonitored: { -#ifdef MonitoredTrappedVar - abstract { +#ifdef MonitoredTrappedVar + abstract { store[store[type(x).trpd_monitored]] = type(y) } inline { @@ -49,23 +49,23 @@ #endif /* MonitoredTrappedVar */ } kywdevent: - body { - *VarLoc(x) = y; - } + body { + *VarLoc(x) = y; + } kywdwin: - body { + body { #ifdef Graphics - if (is:null(y)) - *VarLoc(x) = y; - else { - if ((!is:file(y)) || !(BlkD(y,File)->status & Fs_Window)) - runerr(140,y); - *VarLoc(x) = y; - } -#endif /* Graphics */ - } - kywdint: - { + if (is:null(y)) + *VarLoc(x) = y; + else { + if ((!is:file(y)) || !(BlkD(y,File)->status & Fs_Window)) + runerr(140,y); + *VarLoc(x) = y; + } +#endif /* Graphics */ + } + kywdint: + { /* * No side effect in the type realm - keyword x is still an int. */ @@ -77,11 +77,11 @@ IntVal(*VarLoc(x)) = i; #ifdef Graphics - if (xyrowcol(&x) == -1) - runerr(140,kywd_xwin[XKey_Window]); -#endif /* Graphics */ - } - } + if (xyrowcol(&x) == -1) + runerr(140,kywd_xwin[XKey_Window]); +#endif /* Graphics */ + } + } kywdpos: { /* * No side effect in the type realm - &pos is still an int. @@ -89,26 +89,26 @@ body { C_integer i; #ifndef Arrays - CURTSTATE(); -#endif /* Arrays */ + CURTSTATE(); +#endif /* Arrays */ if (!cnv:C_integer(y, i)) runerr(101, y); #if defined(MultiProgram) || ConcurrentCOMPILER - /* - * Assuming (ahem) that the address of &subject is the next - * descriptor following &pos, which is true in struct threadstate, - * then we can access it via our reference to &pos, rather than - * needing to lookup the curtstate to find the former global. - */ - i = cvpos((long)i, StrLen(*(VarLoc(x)+1))); -#else /* MultiProgram || ConcurrentCOMPILER */ + /* + * Assuming (ahem) that the address of &subject is the next + * descriptor following &pos, which is true in struct threadstate, + * then we can access it via our reference to &pos, rather than + * needing to lookup the curtstate to find the former global. + */ + i = cvpos((long)i, StrLen(*(VarLoc(x)+1))); +#else /* MultiProgram || ConcurrentCOMPILER */ i = cvpos((long)i, StrLen(k_subject)); -#endif /* MultiProgram || ConcurrentCOMPILER */ +#endif /* MultiProgram || ConcurrentCOMPILER */ if (i == CvtFail) fail; - IntVal(*VarLoc(x)) = i; + IntVal(*VarLoc(x)) = i; EVVal(k_pos, E_Spos); } @@ -122,13 +122,13 @@ runerr(103, y); inline { #ifndef Arrays - CURTSTATE(); -#endif /* Arrays */ + CURTSTATE(); +#endif /* Arrays */ #ifdef MultiProgram - IntVal(*(VarLoc(x)-1)) = 1; -#else /* MultiProgram */ + IntVal(*(VarLoc(x)-1)) = 1; +#else /* MultiProgram */ k_pos = 1; -#endif /* MultiProgram */ +#endif /* MultiProgram */ EVVal(k_pos, E_Spos); } } @@ -144,66 +144,66 @@ store[type(x)] = type(y) } inline { -#ifdef Arrays - if ( Offset(x)>0 ) { - /* don't know actual title, don't use checking BlkD macro */ - if (BlkLoc(x)->Realarray.title==T_Realarray){ - double yy; - if (cnv:C_double(y, yy)){ - *(double *)( (word *) VarLoc(x) + Offset(x)) = yy; - } - else{ /* y is not real, try to convert the realarray to list*/ - tended struct b_list *xlist= BlkD(x, Realarray)->listp; - tended struct descrip dlist; - word i; - - i = (Offset(x)*sizeof(word)-sizeof(struct b_realarray) - +sizeof(double)) / sizeof(double); - - dlist.vword.bptr = (union block *) xlist; - dlist.dword = D_List; - if (arraytolist(&dlist)!=Succeeded) fail; - - /* - * assuming the new list has one lelem block only, - * i should be in the first block. no need to loop - * through several blocks - */ - - *(dptr)(&xlist->listhead->Lelem.lslots[i]) = y; - } - } - /* don't know actual title, don't use checking BlkD macro */ - else if (BlkLoc(x)->Intarray.title==T_Intarray){ - C_integer ii; - if (cnv:(exact)C_integer(y, ii)) - *((word *)VarLoc(x) + Offset(x)) = ii; - else{ /* y is not integer, try to convert the intarray to list*/ - tended struct b_list *xlist= BlkD(x, Intarray)->listp; - tended struct descrip dlist; - word i; - - i = (Offset(x)*sizeof(word)-sizeof(struct b_intarray)+ - sizeof(word)) / sizeof(word); - - dlist.vword.bptr = (union block *) xlist; - dlist.dword = D_List; - if (arraytolist(&dlist)!=Succeeded) fail; - - /* - * assuming the new list has one lelem block only, - * i should be in the first block. no need to loop - * through several blocks - */ - - *(dptr)(&xlist->listhead->Lelem.lslots[i]) = y; - } - } - else - Asgn(x, y) - } - else -#endif /* Arrays */ +#ifdef Arrays + if ( Offset(x)>0 ) { + /* don't know actual title, don't use checking BlkD macro */ + if (BlkLoc(x)->Realarray.title==T_Realarray){ + double yy; + if (cnv:C_double(y, yy)){ + *(double *)( (word *) VarLoc(x) + Offset(x)) = yy; + } + else{ /* y is not real, try to convert the realarray to list*/ + tended struct b_list *xlist= BlkD(x, Realarray)->listp; + tended struct descrip dlist; + word i; + + i = (Offset(x)*sizeof(word)-sizeof(struct b_realarray) + +sizeof(double)) / sizeof(double); + + dlist.vword.bptr = (union block *) xlist; + dlist.dword = D_List; + if (arraytolist(&dlist)!=Succeeded) fail; + + /* + * assuming the new list has one lelem block only, + * i should be in the first block. no need to loop + * through several blocks + */ + + *(dptr)(&xlist->listhead->Lelem.lslots[i]) = y; + } + } + /* don't know actual title, don't use checking BlkD macro */ + else if (BlkLoc(x)->Intarray.title==T_Intarray){ + C_integer ii; + if (cnv:(exact)C_integer(y, ii)) + *((word *)VarLoc(x) + Offset(x)) = ii; + else{ /* y is not integer, try to convert the intarray to list*/ + tended struct b_list *xlist= BlkD(x, Intarray)->listp; + tended struct descrip dlist; + word i; + + i = (Offset(x)*sizeof(word)-sizeof(struct b_intarray)+ + sizeof(word)) / sizeof(word); + + dlist.vword.bptr = (union block *) xlist; + dlist.dword = D_List; + if (arraytolist(&dlist)!=Succeeded) fail; + + /* + * assuming the new list has one lelem block only, + * i should be in the first block. no need to loop + * through several blocks + */ + + *(dptr)(&xlist->listhead->Lelem.lslots[i]) = y; + } + } + else + Asgn(x, y) + } + else +#endif /* Arrays */ Asgn(x, y) } @@ -214,10 +214,10 @@ body { EVValD(&y, E_Value); } -#endif /* E_Value */ +#endif /* E_Value */ #enddef - + "x := y - assign y to x." @@ -235,8 +235,8 @@ operator{0,1} := asgn(underef x, y) inline { #ifdef PatternType if (is:tvsubs(x)) { - return BlkD(x, Tvsubs)->ssvar; - } + return BlkD(x, Tvsubs)->ssvar; + } #endif /* * The returned result is the variable to which assignment is being @@ -245,7 +245,7 @@ operator{0,1} := asgn(underef x, y) return x; } end - + "x <- y - assign y to x." " Reverses assignment if resumed." @@ -271,7 +271,7 @@ operator{0,1+} <- rasgn(underef x -> saved_x, y) fail; } end - + "x <-> y - swap values of x and y." " Reverses swap if resumed." @@ -298,7 +298,7 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) bp_x = (union block *)BlkD(x,Tvsubs); bp_y = (union block *)BlkD(y,Tvsubs); if (VarLoc(bp_x->Tvsubs.ssvar) == VarLoc(bp_y->Tvsubs.ssvar) && - Offset(bp_x->Tvsubs.ssvar) == Offset(bp_y->Tvsubs.ssvar)) { + Offset(bp_x->Tvsubs.ssvar) == Offset(bp_y->Tvsubs.ssvar)) { /* * x and y are both substrings of the same string, set * adj1 and adj2 for use in locating the substrings after @@ -311,7 +311,7 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) adj1 = bp_x->Tvsubs.sslen - bp_y->Tvsubs.sslen; else if (bp_y->Tvsubs.sspos > bp_x->Tvsubs.sspos) adj2 = bp_y->Tvsubs.sslen - bp_x->Tvsubs.sslen; - } + } } /* @@ -328,7 +328,7 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) * to account for the replacement of Arg1 by Arg2. */ Blk(bp_y, Tvsubs)->sspos += adj2; - } + } } /* @@ -345,7 +345,7 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) * of Arg1 to account for the replacement of Arg2 by Arg1. */ Blk(bp_x, Tvsubs)->sspos += adj1; - } + } } inline { @@ -360,7 +360,7 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) inline { if (adj2 != 0) { Blk(bp_y, Tvsubs)->sspos -= adj2; - } + } } GeneralAsgn(y, dy) @@ -368,14 +368,14 @@ operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy) inline { if (adj1 != 0) { Blk(bp_x,Tvsubs)->sspos -= adj1; - } + } } inline { fail; } end - + "x :=: y - swap values of x and y." @@ -403,7 +403,7 @@ operator{0,1} :=: swap(underef x -> dx, underef y -> dy) bp_x = (union block *)BlkD(x,Tvsubs); bp_y = (union block *)BlkD(y,Tvsubs); if (VarLoc(bp_x->Tvsubs.ssvar) == VarLoc(bp_y->Tvsubs.ssvar) && - Offset(bp_x->Tvsubs.ssvar) == Offset(bp_y->Tvsubs.ssvar)) { + Offset(bp_x->Tvsubs.ssvar) == Offset(bp_y->Tvsubs.ssvar)) { /* * x and y are both substrings of the same string, set * adj1 and adj2 for use in locating the substrings after @@ -416,7 +416,7 @@ operator{0,1} :=: swap(underef x -> dx, underef y -> dy) adj1 = bp_x->Tvsubs.sslen - bp_y->Tvsubs.sslen; else if (bp_y->Tvsubs.sspos > bp_x->Tvsubs.sspos) adj2 = bp_y->Tvsubs.sslen - bp_x->Tvsubs.sslen; - } + } } /* @@ -433,7 +433,7 @@ operator{0,1} :=: swap(underef x -> dx, underef y -> dy) * to account for the replacement of Arg1 by Arg2. */ Blk(bp_y,Tvsubs)->sspos += adj2; - } + } } /* @@ -450,7 +450,7 @@ operator{0,1} :=: swap(underef x -> dx, underef y -> dy) * of Arg1 to account for the replacement of Arg2 by Arg1. */ Blk(bp_x,Tvsubs)->sspos += adj1; - } + } } inline { @@ -506,27 +506,27 @@ const dptr src; * First, copy the portion of the substring string to the left of * the substring into the string space. */ - + memcpy(StrLoc(rsltstr), StrLoc(deststr), prelen); - + /* * Copy the string to be assigned into the string space, * effectively concatenating it. */ - + memcpy(StrLoc(rsltstr)+prelen, StrLoc(srcstr), StrLen(srcstr)); - + /* * Copy the portion of the substring to the right of * the substring into the string space, completing the * result. */ - - + + postlen = StrLen(deststr) - poststrt; - + memcpy(StrLoc(rsltstr)+prelen+StrLen(srcstr), StrLoc(deststr)+poststrt, postlen); - + /* * Perform the assignment and update the trapped variable. */ @@ -554,7 +554,7 @@ const dptr src; EVVal(tvsub->sslen, E_Ssasgn); return Succeeded; } - + /* * tvtbl_asgn - perform an assignment to a table element trapped variable, * inserting the element in the table if needed. @@ -574,41 +574,41 @@ const dptr src; * Allocate te now (even if we may not need it) * because slot cannot be tended. */ - bp = BlkD(*dest, Tvtbl); /* Save params to tended vars */ + bp = BlkD(*dest, Tvtbl); /* Save params to tended vars */ tval = *src; if (BlkType(bp->clink) == T_File) { int status = Blk(bp->clink,File)->status; #ifdef Dbm if (status & Fs_Dbm) { - int rv; - DBM *db; - datum key, content; - db = Blk(bp->clink,File)->fd.dbm; - /* - * we are doing an assignment to a subscripted DBM file, treat same - * as insert(). key is bp->tref, and value is src - */ - if (!cnv:string(bp->tref, bp->tref)) { /* key */ - ReturnErrVal(103, bp->tref, RunError); - } - if (!cnv:string(tval, tval)) { /* value */ - ReturnErrVal(103, tval, RunError); - } - key.dptr = StrLoc(bp->tref); - key.dsize = StrLen(bp->tref); - content.dptr = StrLoc(tval); - content.dsize = StrLen(tval); - if ((rv = dbm_store(db, key, content, DBM_REPLACE)) < 0) { - fprintf(stderr, "dbm_store returned %d\n", rv); - fflush(stderr); - return Failed; - } - return Succeeded; - } + int rv; + DBM *db; + datum key, content; + db = Blk(bp->clink,File)->fd.dbm; + /* + * we are doing an assignment to a subscripted DBM file, treat same + * as insert(). key is bp->tref, and value is src + */ + if (!cnv:string(bp->tref, bp->tref)) { /* key */ + ReturnErrVal(103, bp->tref, RunError); + } + if (!cnv:string(tval, tval)) { /* value */ + ReturnErrVal(103, tval, RunError); + } + key.dptr = StrLoc(bp->tref); + key.dsize = StrLen(bp->tref); + content.dptr = StrLoc(tval); + content.dsize = StrLen(tval); + if ((rv = dbm_store(db, key, content, DBM_REPLACE)) < 0) { + fprintf(stderr, "dbm_store returned %d\n", rv); + fflush(stderr); + return Failed; + } + return Succeeded; + } else -#endif /* Dbm */ - return Failed; /* should set runerr instead, or maybe syserr */ +#endif /* Dbm */ + return Failed; /* should set runerr instead, or maybe syserr */ } Protect(te = alctelem(), return RunError); @@ -639,8 +639,8 @@ const dptr src; te->hashnum = bp->hashnum; te->tref = bp->tref; te->tval = tval; - - if (TooCrowded(tp)) /* grow hash table if now too full */ + + if (TooCrowded(tp)) /* grow hash table if now too full */ hgrow((union block *)tp); } return Succeeded; @@ -648,7 +648,7 @@ const dptr src; #ifdef MonitoredTrappedVar -/* +/* * tvmonitored_asgn - perform an assignment to a monitored trapped variable * in the Target Program form the Monitor. */ diff --git a/src/runtime/ocat.r b/src/runtime/ocat.r index 1e6a4d831..1b65f21f4 100644 --- a/src/runtime/ocat.r +++ b/src/runtime/ocat.r @@ -3,57 +3,57 @@ */ #ifdef PatternType -"x || y - concatenate strings and patterns x and y." -#else /* PatternType */ -"x || y - concatenate strings x and y." -#endif /* PatternType */ +"x || y - concatenate strings and patterns x and y." +#else /* PatternType */ +"x || y - concatenate strings x and y." +#endif /* PatternType */ operator{1} || cater(x, y) #ifdef PatternType if is:pattern(x) then { abstract { - return pattern; - } + return pattern; + } body { - struct b_pattern *lp, *rp; - struct b_pelem *pe; - union block *bp; + struct b_pattern *lp, *rp; + struct b_pelem *pe; + union block *bp; - if (!cnv_pattern(&y, &y)) runerr(127, y); + if (!cnv_pattern(&y, &y)) runerr(127, y); - lp = (struct b_pattern *)BlkLoc(x); - rp = (struct b_pattern *)BlkLoc(y); + lp = (struct b_pattern *)BlkLoc(x); + rp = (struct b_pattern *)BlkLoc(y); - /* perform concatenation in patterns */ - pe = (struct b_pelem *)Concat(Copy((struct b_pelem *)lp->pe), Copy((struct b_pelem *)rp->pe), rp->stck_size); - bp = (union block *)pattern_make_pelem(lp->stck_size + rp->stck_size,pe); - return pattern(bp); - } + /* perform concatenation in patterns */ + pe = (struct b_pelem *)Concat(Copy((struct b_pelem *)lp->pe), Copy((struct b_pelem *)rp->pe), rp->stck_size); + bp = (union block *)pattern_make_pelem(lp->stck_size + rp->stck_size,pe); + return pattern(bp); + } } else if is:pattern(y) then { abstract { - return pattern; - } + return pattern; + } body { - struct b_pattern *lp, *rp; - struct b_pelem *pe; - union block *bp; + struct b_pattern *lp, *rp; + struct b_pelem *pe; + union block *bp; - if (!cnv_pattern(&x, &x)) runerr(127, x); + if (!cnv_pattern(&x, &x)) runerr(127, x); - lp = (struct b_pattern *)BlkLoc(x); - rp = (struct b_pattern *)BlkLoc(y); + lp = (struct b_pattern *)BlkLoc(x); + rp = (struct b_pattern *)BlkLoc(y); - /* perform concatenation in patterns */ - pe = (struct b_pelem *)Concat(Copy((struct b_pelem *)lp->pe), - Copy((struct b_pelem *)rp->pe), rp->stck_size); - bp = (union block *)pattern_make_pelem(lp->stck_size+rp->stck_size,pe); - return pattern(bp); - } + /* perform concatenation in patterns */ + pe = (struct b_pelem *)Concat(Copy((struct b_pelem *)lp->pe), + Copy((struct b_pelem *)rp->pe), rp->stck_size); + bp = (union block *)pattern_make_pelem(lp->stck_size+rp->stck_size,pe); + return pattern(bp); + } } else { -#endif /* PatternType */ +#endif /* PatternType */ if !cnv:string(x) then runerr(103, x) @@ -77,23 +77,23 @@ operator{1} || cater(x, y) return result; } else if ((StrLoc(x) + StrLen(x) == strfree) && - (DiffPtrs(strend,strfree) > StrLen(y))) { + (DiffPtrs(strend,strfree) > StrLen(y))) { /* * Optimization 2: The end of x is at the end of the string space. * Hence, x was the last string allocated and need not be * re-allocated. y is appended to the string space and the * result is pointed to the start of x. */ - result = x; - /* - * Append y to the end of the string space. - */ - Protect(alcstr(StrLoc(y),StrLen(y)), runerr(0)); - /* - * Set the length of the result and return. - */ - StrLen(result) = StrLen(x) + StrLen(y); - return result; + result = x; + /* + * Append y to the end of the string space. + */ + Protect(alcstr(StrLoc(y),StrLen(y)), runerr(0)); + /* + * Set the length of the result and return. + */ + StrLen(result) = StrLen(x) + StrLen(y); + return result; } /* @@ -113,10 +113,10 @@ operator{1} || cater(x, y) #ifdef PatternType } -#endif /* PatternType */ +#endif /* PatternType */ end - + "x ||| y - concatenate lists x and y." diff --git a/src/runtime/ocomp.r b/src/runtime/ocomp.r index e9fd56c18..7bae88b5e 100644 --- a/src/runtime/ocomp.r +++ b/src/runtime/ocomp.r @@ -1,7 +1,7 @@ /* * File: ocomp.r * Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge, - * numgt, numle, numlt, numne, eqv, neqv + * numgt, numle, numlt, numne, eqv, neqv */ /* @@ -29,7 +29,7 @@ inline { if (big_ ## c_op (x,y)) { return y; - } + } fail; } } @@ -104,7 +104,7 @@ operator{0,1} icon_op func_name(x,y) } if !cnv:tmp_string(x) then runerr(103,x) - if !is:string(y) then + if !is:string(y) then if cnv:tmp_string(y) then inline { temp_str = 1; @@ -133,14 +133,14 @@ operator{0,1} icon_op func_name(x,y) end #enddef -StrComp(==, lexeq, (StrLen(x) == StrLen(y)) &&, ==, Equal, equal to) +StrComp(==, lexeq, (StrLen(x) == StrLen(y)) &&, ==, Equal, equal to) StrComp(~==, lexne, (StrLen(x) != StrLen(y)) ||, !=, Equal, not equal to) -StrComp(>>=, lexge, , !=, Less, greater than or equal to) +StrComp(>>=, lexge, , !=, Less, greater than or equal to) StrComp(>>, lexgt, , ==, Greater, greater than) StrComp(<<=, lexle, , !=, Greater, less than or equal to) StrComp(<<, lexlt, , ==, Less, less than) - + "x === y - test equivalence of x and y." @@ -158,7 +158,7 @@ operator{0,1} === eqv(x,y) fail; } end - + "x ~=== y - test inequivalence of x and y." diff --git a/src/runtime/omisc.r b/src/runtime/omisc.r index 7c719d7aa..e91451838 100644 --- a/src/runtime/omisc.r +++ b/src/runtime/omisc.r @@ -23,12 +23,12 @@ operator{1} ^ refresh(x) */ #ifdef MultiProgram Protect(sblkp = alccoexp(0, 0), runerr(0)); -#else /* MultiProgram */ +#else /* MultiProgram */ Protect(sblkp = alccoexp(), runerr(0)); -#endif /* MultiProgram */ +#endif /* MultiProgram */ sblkp->freshblk = BlkD(x,Coexpr)->freshblk; - if (ChkNull(sblkp->freshblk)) /* &main cannot be refreshed */ + if (ChkNull(sblkp->freshblk)) /* &main cannot be refreshed */ runerr(215, x); /* @@ -46,17 +46,17 @@ operator{1} ^ refresh(x) PFDebug(sblkp->pf)->old_line = PFDebug(BlkLoc(x)->Coexpr.pf)->old_line; } -#endif /* COMPILER */ +#endif /* COMPILER */ return coexpr(sblkp); } -#else /* CoExpr */ +#else /* CoExpr */ operator{} ^ refresh(x) runerr(401) -#endif /* CoExpr */ +#endif /* CoExpr */ end - + "*x - return size of string or object x." @@ -81,74 +81,74 @@ operator{1} * size(x) register word i; i = BlkD(x,Cset)->size; - if (i < 0) - i = cssize(&x); + if (i < 0) + i = cssize(&x); return C_integer i; } coexpr: inline { -#ifdef Concurrent +#ifdef Concurrent struct b_coexpr *cp = BlkD(x, Coexpr); - if (IS_TS_THREAD(cp->status)) - return C_integer BlkD(cp->outbox, List)->size; -#endif /* Concurrent */ + if (IS_TS_THREAD(cp->status)) + return C_integer BlkD(cp->outbox, List)->size; +#endif /* Concurrent */ return C_integer BlkD(x,Coexpr)->size; } record: inline { C_integer siz; - union block *bp, *rd; - bp = BlkLoc(x); - rd = Blk(bp,Record)->recdesc; + union block *bp, *rd; + bp = BlkLoc(x); + rd = Blk(bp,Record)->recdesc; siz = Blk(BlkD(x,Record)->recdesc,Proc)->nfields; - /* - * if the record is an object, subtract 2 from the size - */ + /* + * if the record is an object, subtract 2 from the size + */ if (Blk(rd,Proc)->ndynam == -3) - siz -= 2; + siz -= 2; return C_integer siz; } file: inline { - int status = BlkD(x,File)->status; + int status = BlkD(x,File)->status; #ifdef Dbm - if ((status & Fs_Dbm) == Fs_Dbm) { - int count = 0; - DBM *db = BlkLoc(x)->File.fd.dbm; - datum key = dbm_firstkey(db); - while (key.dptr != NULL) { - count++; - key = dbm_nextkey(db); - } - return C_integer count; - } -#endif /* Dbm */ + if ((status & Fs_Dbm) == Fs_Dbm) { + int count = 0; + DBM *db = BlkLoc(x)->File.fd.dbm; + datum key = dbm_firstkey(db); + while (key.dptr != NULL) { + count++; + key = dbm_nextkey(db); + } + return C_integer count; + } +#endif /* Dbm */ #ifdef ISQL - if ((status & Fs_ODBC) == Fs_ODBC) { /* ODBC file */ - struct ISQLFile *fp; - int rc; - - SQLLEN numrows; /* was SQLINTEGER */ - fp = BlkLoc(x)->File.fd.sqlf; - rc = SQLRowCount(fp->hstmt, &numrows); - if (rc != SQL_SUCCESS) { - //TODO: handle failure - } - return C_integer(numrows); - } -#endif /* ISQL */ - runerr(1100, x); /* not ODBC file */ - } + if ((status & Fs_ODBC) == Fs_ODBC) { /* ODBC file */ + struct ISQLFile *fp; + int rc; + + SQLLEN numrows; /* was SQLINTEGER */ + fp = BlkLoc(x)->File.fd.sqlf; + rc = SQLRowCount(fp->hstmt, &numrows); + if (rc != SQL_SUCCESS) { + //TODO: handle failure + } + return C_integer(numrows); + } +#endif /* ISQL */ + runerr(1100, x); /* not ODBC file */ + } default: { /* * Try to convert it to a string. */ if !cnv:tmp_string(x) then - runerr(112, x); /* no notion of size */ + runerr(112, x); /* no notion of size */ inline { - return C_integer StrLen(x); + return C_integer StrLen(x); } } } end - + "=x - tab(match(x)). Reverses effects if resumed." @@ -159,176 +159,176 @@ operator{*} = tabmat(x) #ifdef PatternType if is:pattern(x) then { abstract { - return string - } + return string + } body { - int oldpos; - int start; - int stop; - struct b_pattern *pattern = NULL; - - tended struct b_pelem *phead = NULL; - - char * pattern_subject; - int subject_len; + int oldpos; + int start; + int stop; + struct b_pattern *pattern = NULL; + + tended struct b_pelem *phead = NULL; + + char * pattern_subject; + int subject_len; #if !ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ - /* - * set cursor position, and subject to match - */ - oldpos = k_pos; - pattern_subject = StrLoc(k_subject); - subject_len = StrLen(k_subject); - pattern = (struct b_pattern *)BlkD(x, Pattern); - - phead = (struct b_pelem *)ResolvePattern(pattern); - - /* - * runs a pattern match in the Anchored Mode and returns - * a sub-string if it succeeds. - */ - if (internal_match(pattern_subject, subject_len, pattern->stck_size, - x, phead, &start, &stop, k_pos - 1, 1)){ - /* - * Set new &pos. - */ - k_pos = stop + 1; - EVVal(k_pos, E_Spos); - oldpos = k_pos; - /* - * Suspend sub-string that matches pattern. - */ - suspend string(stop - start, StrLoc(k_subject)+ start); - - pattern_subject = StrLoc(k_subject); - if (subject_len != StrLen(k_subject)) { - k_pos += StrLen(k_subject) - subject_len; - subject_len = StrLen(k_subject); - } - } - /* - * If tab is resumed, restore the old position and fail. - */ - if (oldpos > StrLen(k_subject) + 1){ - - runerr(205, kywd_pos); - } - else { - k_pos = oldpos; - EVVal(k_pos, E_Spos); - } - fail; - } + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ + /* + * set cursor position, and subject to match + */ + oldpos = k_pos; + pattern_subject = StrLoc(k_subject); + subject_len = StrLen(k_subject); + pattern = (struct b_pattern *)BlkD(x, Pattern); + + phead = (struct b_pelem *)ResolvePattern(pattern); + + /* + * runs a pattern match in the Anchored Mode and returns + * a sub-string if it succeeds. + */ + if (internal_match(pattern_subject, subject_len, pattern->stck_size, + x, phead, &start, &stop, k_pos - 1, 1)){ + /* + * Set new &pos. + */ + k_pos = stop + 1; + EVVal(k_pos, E_Spos); + oldpos = k_pos; + /* + * Suspend sub-string that matches pattern. + */ + suspend string(stop - start, StrLoc(k_subject)+ start); + + pattern_subject = StrLoc(k_subject); + if (subject_len != StrLen(k_subject)) { + k_pos += StrLen(k_subject) - subject_len; + subject_len = StrLen(k_subject); + } + } + /* + * If tab is resumed, restore the old position and fail. + */ + if (oldpos > StrLen(k_subject) + 1){ + + runerr(205, kywd_pos); + } + else { + k_pos = oldpos; + EVVal(k_pos, E_Spos); + } + fail; + } } else if !cnv:string(x) then { -#else /* PatternType */ +#else /* PatternType */ if !cnv:string(x) then { -#endif /* PatternType */ +#endif /* PatternType */ runerr(103, x) } else { abstract { - return string - } + return string + } body { - register word l; - register char *s1, *s2; - C_integer i, j; - CURTSTATE(); - - /* - * Make a copy of &pos. - */ - i = k_pos; - - /* - * Fail if &subject[&pos:0] is not of sufficient length to contain x. - */ - j = StrLen(k_subject) - i + 1; - if (j < StrLen(x)) - fail; - - /* - * Get pointers to x (s1) and &subject (s2). Compare them on a - * byte-wise basis and fail if s1 doesn't match s2 for *s1 characters. - */ - s1 = StrLoc(x); - s2 = StrLoc(k_subject) + i - 1; - l = StrLen(x); - while (l-- > 0) { - if (*s1++ != *s2++) - fail; - } - - /* - * Increment &pos to tab over the matched string and suspend the - * matched string. - */ - l = StrLen(x); - k_pos += l; - - EVVal(k_pos, E_Spos); - - suspend x; - - /* - * tabmat has been resumed, restore &pos and fail. - */ - if (i > StrLen(k_subject) + 1) - runerr(205, kywd_pos); - else { - k_pos = i; - EVVal(k_pos, E_Spos); - } - fail; - } + register word l; + register char *s1, *s2; + C_integer i, j; + CURTSTATE(); + + /* + * Make a copy of &pos. + */ + i = k_pos; + + /* + * Fail if &subject[&pos:0] is not of sufficient length to contain x. + */ + j = StrLen(k_subject) - i + 1; + if (j < StrLen(x)) + fail; + + /* + * Get pointers to x (s1) and &subject (s2). Compare them on a + * byte-wise basis and fail if s1 doesn't match s2 for *s1 characters. + */ + s1 = StrLoc(x); + s2 = StrLoc(k_subject) + i - 1; + l = StrLen(x); + while (l-- > 0) { + if (*s1++ != *s2++) + fail; + } + + /* + * Increment &pos to tab over the matched string and suspend the + * matched string. + */ + l = StrLen(x); + k_pos += l; + + EVVal(k_pos, E_Spos); + + suspend x; + + /* + * tabmat has been resumed, restore &pos and fail. + */ + if (i > StrLen(k_subject) + 1) + runerr(205, kywd_pos); + else { + k_pos = i; + EVVal(k_pos, E_Spos); + } + fail; + } } end - + "i to j by k - generate successive values." operator{*} ... toby(from, to, by) if cnv:(exact)C_integer(by) && cnv:(exact)C_integer(from) then { - if !cnv:C_integer(to) then { runerr(101, to) } - abstract { - return integer + if !cnv:C_integer(to) then { runerr(101, to) } + abstract { + return integer } - inline { + inline { #if !ConcurrentCOMPILER - CURTSTATVAR(); -#endif /* !ConcurrentCOMPILER */ - /* - * by must not be zero. - */ - if (by == 0) { - irunerr(211, by); - errorfail; - } - /* - * Count up or down (depending on relationship of from and to) - * and suspend each value in sequence, failing - * when the limit has been exceeded. - */ - if (by > 0) - for ( ; from <= to; from += by) { - suspend C_integer from; - } - else - for ( ; from >= to; from += by) { - suspend C_integer from; + CURTSTATVAR(); +#endif /* !ConcurrentCOMPILER */ + /* + * by must not be zero. + */ + if (by == 0) { + irunerr(211, by); + errorfail; + } + /* + * Count up or down (depending on relationship of from and to) + * and suspend each value in sequence, failing + * when the limit has been exceeded. + */ + if (by > 0) + for ( ; from <= to; from += by) { + suspend C_integer from; + } + else + for ( ; from >= to; from += by) { + suspend C_integer from; } fail; - } - } + } + } else if cnv:C_double(from) && cnv:C_double(to) && cnv:C_double(by) then { abstract { return real } - inline { + inline { #if !ConcurrentCOMPILER - CURTSTATVAR(); + CURTSTATVAR(); #endif /* ConcurrentCOMPILER */ if (by == 0) { irunerr(211, by); @@ -342,9 +342,9 @@ operator{*} ... toby(from, to, by) for ( ; from >= to; from += by) { suspend C_double from; } - fail; - } - } + fail; + } + } else if cnv:(exact) integer(by) then { /* step by a large integer */ arith_case(from,to) of { C_integer: { @@ -363,7 +363,7 @@ operator{*} ... toby(from, to, by) } else runerr(102, by) end - + "i to j - generate successive values." @@ -379,22 +379,22 @@ operator{*} ... to(from, to) suspend C_integer from; } fail; - } - } + } + } integer : { abstract { return integer } inline { tended struct descrip d1, d2; - d1 = onedesc; + d1 = onedesc; for ( ; bigcmp(&from, &to)<=0; from=d2) { suspend from; - bigadd(&from, &d1, &d2); + bigadd(&from, &d1, &d2); } fail; - } - } + } + } C_double: { abstract { return real @@ -404,11 +404,11 @@ operator{*} ... to(from, to) suspend C_double from; } fail; - } - } - } + } + } + } end - + " [x1, x2, ... ] - create an explicitly specified list." @@ -423,12 +423,12 @@ operator{1} [...] llist(elems[n]) nslots = n; if (nslots == 0) nslots = MinListSlots; - + /* * Allocate the list and a list block. */ Protect(hp = alclist_raw(n, nslots), runerr(0)); - + /* * Assign each argument to a list element. */ diff --git a/src/runtime/oref.r b/src/runtime/oref.r index 327b7d014..b614d2176 100644 --- a/src/runtime/oref.r +++ b/src/runtime/oref.r @@ -26,7 +26,7 @@ operator{*} ! bang(underef x -> dx) for (i = 1; i <= StrLen(dx); i++) { suspend tvsubs(&x, i, (word)1); deref(&x, &dx); - if (!is:string(dx)) + if (!is:string(dx)) runerr(103, dx); } } @@ -35,60 +35,60 @@ operator{*} ! bang(underef x -> dx) integer: { abstract { return integer - } - inline { - C_integer from=1, to; - if (!cnv:C_integer(dx, to)) fail; - if (to < 1) fail; - for ( ; from <= to; from += 1) { - suspend C_integer from; - } - } - } + } + inline { + C_integer from=1, to; + if (!cnv:C_integer(dx, to)) fail; + if (to < 1) fail; + for ( ; from <= to; from += 1) { + suspend C_integer from; + } + } + } list: { abstract { return type(dx).lst_elem - } + } inline { #if E_Lsub word xi = 0; -#endif /* E_Lsub */ +#endif /* E_Lsub */ - /* static struct threadstate *curtstate; + /* static struct threadstate *curtstate; if (!curtstate) curtstate=&roottstate;*/ EVValD(&dx, E_Lbang); - + #ifdef Arrays - ep = BlkD(dx,List)->listhead; - if (BlkType(ep)==T_Realarray){ - tended struct b_realarray *ap = ( struct b_realarray * ) ep; - word asize = BlkD(dx,List)->size; - - for (i=0;ilisthead; + if (BlkType(ep)==T_Realarray){ + tended struct b_realarray *ap = ( struct b_realarray * ) ep; + word asize = BlkD(dx,List)->size; + + for (i=0;ia[i], ap); - } - } - else if ( BlkType(ep)==T_Intarray){ - tended struct b_intarray *ap = ( struct b_intarray * ) ep; - word asize = BlkD(dx,List)->size; - - for (i=0;isize; + + for (i=0;ia[i], ap); - } - } - else{ -#endif /* Arrays */ + } + } + else{ +#endif /* Arrays */ /* @@ -96,32 +96,32 @@ operator{*} ! bang(underef x -> dx) * each one, suspend with a variable pointing to each * element contained in the block. */ - for (ep = BlkD(dx,List)->listhead; - BlkType(ep) == T_Lelem; - ep = Blk(ep,Lelem)->listnext){ - for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; + for (ep = BlkD(dx,List)->listhead; + BlkType(ep) == T_Lelem; + ep = Blk(ep,Lelem)->listnext){ + for (i = 0; i < Blk(ep,Lelem)->nused; i++) { + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; #if E_Lsub - ++xi; - EVVal(xi, E_Lsub); -#endif /* E_Lsub */ - - suspend struct_var(&ep->Lelem.lslots[j], ep); - } - } -#ifdef Arrays - } -#endif /* Arrays */ + ++xi; + EVVal(xi, E_Lsub); +#endif /* E_Lsub */ + + suspend struct_var(&ep->Lelem.lslots[j], ep); + } + } +#ifdef Arrays + } +#endif /* Arrays */ } } file: { abstract { return string - } + } body { FILE *fd; char sbuf[MaxCvtLen]; @@ -129,20 +129,20 @@ operator{*} ! bang(underef x -> dx) register C_integer slen, rlen; word status; #ifdef Dbm - datum key; -#endif /* Dbm */ + datum key; +#endif /* Dbm */ #if ConcurrentCOMPILER && defined(Graphics) - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ /* * x is a file. Read the next line into the string space - * and suspend the newly allocated string. + * and suspend the newly allocated string. */ fd = BlkD(dx,File)->fd.fp; - + status = BlkLoc(dx)->File.status; - if ((status & Fs_Read) == 0) + if ((status & Fs_Read) == 0) runerr(212, dx); if (status & Fs_Writing) { @@ -153,100 +153,100 @@ operator{*} ! bang(underef x -> dx) status = BlkLoc(dx)->File.status; #ifdef PosixFns - if (status & Fs_Socket) { - for (;;) { - StrLen(result) = 0; - do { - DEC_NARTHREADS; - if ((slen = sock_getstrg(sbuf, MaxReadStr, &dx)) == -1) { - /* EOF is no error */ - INC_NARTHREADS_CONTROLLED; - fail; - } - INC_NARTHREADS_CONTROLLED; - if (slen == -3) { - /* sock_getstrg sets errornumber/text */ - fail; - } - if (slen == 1 && *sbuf == '\n') - break; - rlen = slen < 0 ? (word)MaxReadStr : slen; - - Protect(reserve(Strings, rlen), runerr(0)); - if (StrLen(result) > 0 && !InRange(strbase,StrLoc(result),strfree)) { - Protect(reserve(Strings, StrLen(result)+rlen), runerr(0)); - Protect((StrLoc(result) = alcstr(StrLoc(result),StrLen(result))), runerr(0)); - } - - Protect(sptr = alcstr(sbuf,rlen), runerr(0)); - if (StrLen(result) == 0) - StrLoc(result) = sptr; - StrLen(result) += rlen; - if (StrLoc(result) [ StrLen(result) - 1 ] == '\n') { - StrLen(result)--; break; - } - else { /* no newline to trim; EOF? */ - } - } - while (slen > 0); - suspend result; - } - } -#endif /* PosixFns */ + if (status & Fs_Socket) { + for (;;) { + StrLen(result) = 0; + do { + DEC_NARTHREADS; + if ((slen = sock_getstrg(sbuf, MaxReadStr, &dx)) == -1) { + /* EOF is no error */ + INC_NARTHREADS_CONTROLLED; + fail; + } + INC_NARTHREADS_CONTROLLED; + if (slen == -3) { + /* sock_getstrg sets errornumber/text */ + fail; + } + if (slen == 1 && *sbuf == '\n') + break; + rlen = slen < 0 ? (word)MaxReadStr : slen; + + Protect(reserve(Strings, rlen), runerr(0)); + if (StrLen(result) > 0 && !InRange(strbase,StrLoc(result),strfree)) { + Protect(reserve(Strings, StrLen(result)+rlen), runerr(0)); + Protect((StrLoc(result) = alcstr(StrLoc(result),StrLen(result))), runerr(0)); + } + + Protect(sptr = alcstr(sbuf,rlen), runerr(0)); + if (StrLen(result) == 0) + StrLoc(result) = sptr; + StrLen(result) += rlen; + if (StrLoc(result) [ StrLen(result) - 1 ] == '\n') { + StrLen(result)--; break; + } + else { /* no newline to trim; EOF? */ + } + } + while (slen > 0); + suspend result; + } + } +#endif /* PosixFns */ #ifdef Messaging - if (status & Fs_Messaging) { - struct MFile *mf = (struct MFile *)fd; - if (!MFIN(mf, READING)) { - Mstartreading(mf); - } - if (strcmp(mf->tp->uri.scheme, "pop") == 0) { - char buf[100]; - Tprequest_t req = {0, NULL, 0}; - unsigned msgnum; - long int msglen; - - req.args = buf; - msgnum = 1; - for (;;) { - snprintf(buf, sizeof(buf), "%d", msgnum); - if (mf->resp != NULL) - tp_freeresp(mf->tp, mf->resp); - - req.type = LIST; - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) - fail; - - if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) - runerr(1212, dx); - tp_freeresp(mf->tp, mf->resp); - - Protect(reserve(Strings, msglen), runerr(0)); - StrLen(result) = msglen; - StrLoc(result) = alcstr(NULL, msglen); - - req.type = RETR; - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) - runerr(1212, dx); - - tp_read(mf->tp, StrLoc(result), (size_t)msglen); - while (buf[0] != '.') - tp_readln(mf->tp, buf, sizeof(buf)); - - suspend result; - msgnum++; - } - } - } -#endif /* Messaging */ + if (status & Fs_Messaging) { + struct MFile *mf = (struct MFile *)fd; + if (!MFIN(mf, READING)) { + Mstartreading(mf); + } + if (strcmp(mf->tp->uri.scheme, "pop") == 0) { + char buf[100]; + Tprequest_t req = {0, NULL, 0}; + unsigned msgnum; + long int msglen; + + req.args = buf; + msgnum = 1; + for (;;) { + snprintf(buf, sizeof(buf), "%d", msgnum); + if (mf->resp != NULL) + tp_freeresp(mf->tp, mf->resp); + + req.type = LIST; + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) + fail; + + if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) + runerr(1212, dx); + tp_freeresp(mf->tp, mf->resp); + + Protect(reserve(Strings, msglen), runerr(0)); + StrLen(result) = msglen; + StrLoc(result) = alcstr(NULL, msglen); + + req.type = RETR; + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) + runerr(1212, dx); + + tp_read(mf->tp, StrLoc(result), (size_t)msglen); + while (buf[0] != '.') + tp_readln(mf->tp, buf, sizeof(buf)); + + suspend result; + msgnum++; + } + } + } +#endif /* Messaging */ #ifdef Dbm - if (status & Fs_Dbm) { - key = dbm_firstkey((DBM *)fd); - } -#endif /* Dbm */ + if (status & Fs_Dbm) { + key = dbm_firstkey((DBM *)fd); + } +#endif /* Dbm */ for (;;) { StrLen(result) = 0; do { @@ -255,84 +255,84 @@ operator{*} ! bang(underef x -> dx) pollctr >>= 1; pollctr++; if (status & Fs_Window) { slen = wgetstrg(sbuf,MaxCvtLen,fd); - if (slen == -1) - runerr(141); - else if (slen < -1) - runerr(143); + if (slen == -1) + runerr(141); + else if (slen < -1) + runerr(143); } else -#endif /* Graphics */ +#endif /* Graphics */ #if HAVE_LIBZ if (status & Fs_Compress) { - if (gzeof(fd)) fail; + if (gzeof(fd)) fail; if (gzgets((gzFile)fd,sbuf,MaxCvtLen+1) == Z_NULL) { - runerr(214); + runerr(214); } - slen = strlen(sbuf); + slen = strlen(sbuf); if (slen==MaxCvtLen && sbuf[slen-1]!='\n') slen = -2; else if (sbuf[slen-1] == '\n') { sbuf[slen-1] = '\0'; slen--; } - } + } else -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ #ifdef ReadDirectory #if !NT || defined(NTGCC) - if (status & Fs_Directory) { - struct dirent *d; - char *s, *p=sbuf; - DEC_NARTHREADS; - d = readdir((DIR *)fd); - INC_NARTHREADS_CONTROLLED; - if (d == NULL) fail; - s = d->d_name; - slen = 0; - while(*s && slen++ < MaxCvtLen) - *p++ = *s++; - if (slen == MaxCvtLen) - slen = -2; - } - else -#endif /* !NT */ -#endif /* ReadDirectory */ + if (status & Fs_Directory) { + struct dirent *d; + char *s, *p=sbuf; + DEC_NARTHREADS; + d = readdir((DIR *)fd); + INC_NARTHREADS_CONTROLLED; + if (d == NULL) fail; + s = d->d_name; + slen = 0; + while(*s && slen++ < MaxCvtLen) + *p++ = *s++; + if (slen == MaxCvtLen) + slen = -2; + } + else +#endif /* !NT */ +#endif /* ReadDirectory */ #ifdef Dbm - if (status & Fs_Dbm) { - DBM *db = (DBM *)fd; - datum content; - int i; - - if (key.dptr == NULL) - fail; - content = dbm_fetch(db, key); - if (content.dsize > MaxCvtLen) - slen = MaxCvtLen; - else - slen = content.dsize; - for (i = 0; i < slen; i++) - sbuf[i] = ((char *)(content.dptr))[i]; - key = dbm_nextkey(db); - } - else -#endif /* Dbm */ + if (status & Fs_Dbm) { + DBM *db = (DBM *)fd; + datum content; + int i; + + if (key.dptr == NULL) + fail; + content = dbm_fetch(db, key); + if (content.dsize > MaxCvtLen) + slen = MaxCvtLen; + else + slen = content.dsize; + for (i = 0; i < slen; i++) + sbuf[i] = ((char *)(content.dptr))[i]; + key = dbm_nextkey(db); + } + else +#endif /* Dbm */ if ((slen = getstrg(sbuf,MaxCvtLen,BlkD(dx,File))) == -1) fail; rlen = slen < 0 ? (word)MaxCvtLen : slen; - Protect(reserve(Strings, rlen), runerr(0)); + Protect(reserve(Strings, rlen), runerr(0)); #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ - if (!InRange(strbase,StrLoc(result),strfree)) { - Protect(reserve(Strings, StrLen(result)+rlen), runerr(0)); - Protect((StrLoc(result) = alcstr(StrLoc(result), + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ + if (!InRange(strbase,StrLoc(result),strfree)) { + Protect(reserve(Strings, StrLen(result)+rlen), runerr(0)); + Protect((StrLoc(result) = alcstr(StrLoc(result), StrLen(result))), runerr(0)); - } + } Protect(sptr = alcstr(sbuf,rlen), runerr(0)); if (StrLen(result) == 0) @@ -347,7 +347,7 @@ operator{*} ! bang(underef x -> dx) table: { abstract { return type(dx).tbl_val - } + } inline { struct b_tvtbl *tp; @@ -357,12 +357,12 @@ operator{*} ! bang(underef x -> dx) * x is a table. Chain down the element list in each bucket * and suspend a variable pointing to each element in turn. */ - for (ep = hgfirst(BlkLoc(dx), &state); ep != 0; - ep = hgnext(BlkLoc(dx), &state, ep)) { + for (ep = hgfirst(BlkLoc(dx), &state); ep != 0; + ep = hgnext(BlkLoc(dx), &state, ep)) { EVValD(&(Blk(ep,Telem)->tval), E_Tval); - Protect(tp = alctvtbl(&dx, &ep->Telem.tref, ep->Telem.hashnum), runerr(0)); - suspend tvtbl(tp); + Protect(tp = alctvtbl(&dx, &ep->Telem.tref, ep->Telem.hashnum), runerr(0)); + suspend tvtbl(tp); } } } @@ -377,18 +377,18 @@ operator{*} ! bang(underef x -> dx) * This is similar to the method for tables except that a * value is returned instead of a variable. */ - for (ep = hgfirst(BlkLoc(dx), &state); ep != 0; - ep = hgnext(BlkLoc(dx), &state, ep)) { + for (ep = hgfirst(BlkLoc(dx), &state); ep != 0; + ep = hgnext(BlkLoc(dx), &state, ep)) { EVValD(&(ep->Selem.setmem), E_Sval); suspend ep->Selem.setmem; } - } + } } record: { abstract { return type(dx).all_fields - } + } inline { /* * x is a record. Loop through the fields and suspend @@ -399,8 +399,8 @@ operator{*} ! bang(underef x -> dx) j = Blk(BlkD(dx,Record)->recdesc,Proc)->nfields; for (i = 0; i < j; i++) { - EVVal(i+1, E_Rsub); - suspend struct_var(&BlkLoc(dx)->Record.fields[i], + EVVal(i+1, E_Rsub); + suspend struct_var(&BlkLoc(dx)->Record.fields[i], BlkD(dx, Record)); } } @@ -430,8 +430,8 @@ operator{*} ! bang(underef x -> dx) inline { fail; } -end - +end + #define RandVal (RanScale*(k_random=(RandA*k_random+RandC)&0x7FFFFFFFL)) @@ -443,7 +443,7 @@ operator{0,1} ? random(underef x -> dx) declare { C_integer v = 0; } -#endif /* LargeInts */ +#endif /* LargeInts */ if is:variable(x) && is:string(dx) then { abstract { @@ -453,8 +453,8 @@ operator{0,1} ? random(underef x -> dx) C_integer val; double rval; #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ /* * A string from a variable is being banged. Produce a one @@ -462,8 +462,8 @@ operator{0,1} ? random(underef x -> dx) */ if ((val = StrLen(dx)) <= 0) fail; - rval = RandVal; /* This form is used to get around */ - rval *= val; /* a bug in a certain C compiler */ + rval = RandVal; /* This form is used to get around */ + rval *= val; /* a bug in a certain C compiler */ return tvsubs(&x, (word)rval + 1, (word)1); } } @@ -481,8 +481,8 @@ operator{0,1} ? random(underef x -> dx) C_integer val; double rval; #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ if ((val = StrLen(dx)) <= 0) fail; @@ -506,10 +506,10 @@ operator{0,1} ? random(underef x -> dx) body { C_integer val; double rval; - char ch; + char ch; #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ if ((val = StrLen(dx)) <= 0) fail; @@ -534,8 +534,8 @@ operator{0,1} ? random(underef x -> dx) register C_integer i, j; union block *bp; /* doesn't need to be tended */ #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ val = BlkD(dx,List)->size; if (val <= 0) fail; @@ -545,39 +545,39 @@ operator{0,1} ? random(underef x -> dx) EVValD(&dx, E_Lrand); EVVal(i, E_Lsub); - - bp = BlkD(dx,List)->listhead; + + bp = BlkD(dx,List)->listhead; #ifdef Arrays - if (BlkD(dx,List)->listtail!=NULL){ -#endif /* Arrays */ - - j = 1; - /* - * Work down chain list of list blocks and find the block that - * contains the selected element. - */ - while (i >= j + Blk(bp,Lelem)->nused) { - j += Blk(bp,Lelem)->nused; - bp = Blk(bp,Lelem)->listnext; - if (BlkType(bp) == T_List) - syserr("list reference out of bounds in random"); - } - /* - * Locate the appropriate element and return a variable - * that points to it. - */ - i += Blk(bp,Lelem)->first - j; - if (i >= bp->Lelem.nslots) - i -= bp->Lelem.nslots; - return struct_var(&(bp->Lelem.lslots[i]), bp); + if (BlkD(dx,List)->listtail!=NULL){ +#endif /* Arrays */ + + j = 1; + /* + * Work down chain list of list blocks and find the block that + * contains the selected element. + */ + while (i >= j + Blk(bp,Lelem)->nused) { + j += Blk(bp,Lelem)->nused; + bp = Blk(bp,Lelem)->listnext; + if (BlkType(bp) == T_List) + syserr("list reference out of bounds in random"); + } + /* + * Locate the appropriate element and return a variable + * that points to it. + */ + i += Blk(bp,Lelem)->first - j; + if (i >= bp->Lelem.nslots) + i -= bp->Lelem.nslots; + return struct_var(&(bp->Lelem.lslots[i]), bp); #ifdef Arrays - } - else if (BlkType(bp)==T_Realarray) - return struct_var(&((struct b_realarray *)(bp))->a[i-1], bp); - else /* if (Blk(bp, Intarray)->title==T_Intarray) assumed to be int array*/ - return struct_var(&((struct b_intarray *)(bp))->a[i-1], bp); -#endif /* Arrays */ + } + else if (BlkType(bp)==T_Realarray) + return struct_var(&((struct b_realarray *)(bp))->a[i-1], bp); + else /* if (Blk(bp, Intarray)->title==T_Intarray) assumed to be int array*/ + return struct_var(&((struct b_intarray *)(bp))->a[i-1], bp); +#endif /* Arrays */ } } @@ -595,11 +595,11 @@ operator{0,1} ? random(underef x -> dx) double rval; register C_integer i, j, n; union block *ep, *bp; /* doesn't need to be tended */ - struct b_slots *seg; - struct b_tvtbl *tp; + struct b_slots *seg; + struct b_tvtbl *tp; #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ bp = BlkLoc(dx); val = Blk(bp,Table)->size; @@ -614,17 +614,17 @@ operator{0,1} ? random(underef x -> dx) /* * Walk down the hash chains to find and return the nth element - * as a variable. + * as a variable. */ for (i=0; i < HSegs && (seg = Blk(bp,Table)->hdir[i])!=NULL;i++) for (j = segsize[i] - 1; j >= 0; j--) for (ep = seg->hslots[j]; - BlkType(ep) == T_Telem; - ep = Blk(ep,Telem)->clink) + BlkType(ep) == T_Telem; + ep = Blk(ep,Telem)->clink) if (--n <= 0) { - Protect(tp = alctvtbl(&dx, &(ep->Telem.tref), (ep->Telem.hashnum)), runerr(0)); - return tvtbl(tp); - } + Protect(tp = alctvtbl(&dx, &(ep->Telem.tref), (ep->Telem.hashnum)), runerr(0)); + return tvtbl(tp); + } syserr("table reference out of bounds in random"); } } @@ -642,10 +642,10 @@ operator{0,1} ? random(underef x -> dx) double rval; register C_integer i, j, n; union block *bp, *ep; /* doesn't need to be tended */ - struct b_slots *seg; + struct b_slots *seg; #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ bp = BlkLoc(dx); val = Blk(bp,Set)->size; @@ -663,9 +663,9 @@ operator{0,1} ? random(underef x -> dx) for (j = segsize[i] - 1; j >= 0; j--) for (ep = seg->hslots[j]; ep != NULL; ep = Blk(ep,Telem)->clink) if (--n <= 0) { - EVValD(&(ep->Selem.setmem), E_Selem); + EVValD(&(ep->Selem.setmem), E_Selem); return Blk(ep,Selem)->setmem; - } + } syserr("set reference out of bounds in random"); } } @@ -684,8 +684,8 @@ operator{0,1} ? random(underef x -> dx) double rval; struct b_record *rec; /* doesn't need to be tended */ #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ rec = BlkD(dx, Record); val = Blk(rec->recdesc,Proc)->nfields; @@ -708,10 +708,10 @@ operator{0,1} ? random(underef x -> dx) #ifdef LargeInts if !cnv:integer(dx) then runerr(113, dx) -#else /* LargeInts */ +#else /* LargeInts */ if !cnv:C_integer(dx,v) then runerr(113, dx) -#endif /* LargeInts */ +#endif /* LargeInts */ abstract { return integer ++ real @@ -722,27 +722,27 @@ operator{0,1} ? random(underef x -> dx) #ifdef LargeInts C_integer v; if (Type(dx) == T_Lrgint) { - if (bigrand(&dx, &result) == RunError) /* alcbignum failed */ - runerr(0); - return result; - } + if (bigrand(&dx, &result) == RunError) /* alcbignum failed */ + runerr(0); + return result; + } v = IntVal(dx); -#endif /* LargeInts */ +#endif /* LargeInts */ #if ConcurrentCOMPILER - CURTSTATE(); -#endif /* ConcurrentCOMPILER */ + CURTSTATE(); +#endif /* ConcurrentCOMPILER */ /* * x is an integer, be sure that it's non-negative. */ - if (v < 0) + if (v < 0) runerr(205, dx); /* * val contains the integer value of x. If val is 0, return - * a real in the range [0,1), else return an integer in the - * range [1,val]. + * a real in the range [0,1), else return an integer in the + * range [1,val]. */ if (v == 0) { rval = RandVal; @@ -757,7 +757,7 @@ operator{0,1} ? random(underef x -> dx) } } end - + "x[i:j] - form a substring or list section of x." operator{0,1} [:] sect(underef x -> dx, i, j) @@ -774,12 +774,12 @@ operator{0,1} [:] sect(underef x -> dx, i, j) * the out-of-range index. */ if !cnv:C_integer(i) then { - if cnv : integer(i) then inline { fail; } - runerr(101, i) - } + if cnv : integer(i) then inline { fail; } + runerr(101, i) + } if !cnv:C_integer(j) then { if cnv : integer(j) then inline { fail; } - runerr(101, j) + runerr(101, j) } body { @@ -798,21 +798,21 @@ operator{0,1} [:] sect(underef x -> dx, i, j) } #ifdef Arrays - if (BlkD(dx,List)->listtail!=NULL){ -#endif /* Arrays */ - if (cplist(&dx, &result, i, j) == RunError) - runerr(0); + if (BlkD(dx,List)->listtail!=NULL){ +#endif /* Arrays */ + if (cplist(&dx, &result, i, j) == RunError) + runerr(0); #ifdef Arrays - } - else if ( BlkType(BlkD(dx,List)->listhead)==T_Realarray){ - if (cprealarray(&dx, &result, i, j) == RunError) - runerr(0); - } - else /*if ( BlkType(BlkD(dx,List)->listhead)==T_Intarray)*/{ - if (cpintarray(&dx, &result, i, j) == RunError) - runerr(0); - } -#endif /* Arrays */ + } + else if ( BlkType(BlkD(dx,List)->listhead)==T_Realarray){ + if (cprealarray(&dx, &result, i, j) == RunError) + runerr(0); + } + else /*if ( BlkType(BlkD(dx,List)->listhead)==T_Intarray)*/{ + if (cpintarray(&dx, &result, i, j) == RunError) + runerr(0); + } +#endif /* Arrays */ return result; } } @@ -842,12 +842,12 @@ operator{0,1} [:] sect(underef x -> dx, i, j) * the out-of-range index. */ if !cnv:C_integer(i) then { - if cnv : integer(i) then inline { fail; } - runerr(101, i) - } + if cnv : integer(i) then inline { fail; } + runerr(101, i) + } if !cnv:C_integer(j) then { if cnv : integer(j) then inline { fail; } - runerr(101, j) + runerr(101, j) } body { @@ -859,14 +859,14 @@ operator{0,1} [:] sect(underef x -> dx, i, j) j = cvpos((long)j, (long)StrLen(dx)); if (j == CvtFail) fail; - if (i > j) { /* convert section to substring */ + if (i > j) { /* convert section to substring */ t = i; i = j; j = t - j; } else j = j - i; - + if (use_trap) { return tvsubs(&x, i, j); } @@ -875,7 +875,7 @@ operator{0,1} [:] sect(underef x -> dx, i, j) } } end - + "x[y] - access yth character or element of x." operator{0,1} [] subsc(underef x -> dx,y) @@ -885,114 +885,114 @@ operator{0,1} [] subsc(underef x -> dx,y) type_case dx of { file: { - abstract { - return string ++ integer /* bug: this value is for messaging */ - } + abstract { + return string ++ integer /* bug: this value is for messaging */ + } - body { - int status = BlkD(dx,File)->status; + body { + int status = BlkD(dx,File)->status; #ifdef Dbm - if (status & Fs_Dbm) { - struct b_tvtbl *tp; - - EVValD(&dx, E_Tref); - EVValD(&y, E_Tsub); - Protect(tp = alctvtbl(&dx, &y, 0), runerr(0)); - return tvtbl(tp); - } - else -#endif /* Dbm */ + if (status & Fs_Dbm) { + struct b_tvtbl *tp; + + EVValD(&dx, E_Tref); + EVValD(&y, E_Tsub); + Protect(tp = alctvtbl(&dx, &y, 0), runerr(0)); + return tvtbl(tp); + } + else +#endif /* Dbm */ #ifdef Messaging - if (status & Fs_Messaging) { - tended char *c_y; - long int msglen; - struct MFile *mf = BlkD(dx,File)->fd.mf; - if (!cnv:C_string(y, c_y)) { - runerr(103, y); - } - if ((mf->resp == NULL) && !MFIN(mf, READING)){ - Mstartreading(mf); - } - if (mf->resp == NULL) { - fail; - } - if (strcmp(c_y, "Status-Code") == 0 || - strcmp(c_y, "code") == 0) { - return C_integer mf->resp->sc; - } - else if (strcmp(c_y, "Reason-Phrase") == 0 || - strcmp(c_y, "message") == 0) { - if (mf->resp->msg != NULL && (msglen = strlen(mf->resp->msg)) > 0) { - /* - * we could just return string(strlen(mf->resp->msg), mf->resp->msg) - * but mf->resp->msg could be gone by the time the result is accessed - * if the user called close() so, just allocate a string and return it. - */ - - StrLen(result) = msglen; - StrLoc(result) = alcstr(mf->resp->msg, msglen); - return result; - } - else { - fail; - } - } - else if (c_y[0] >= '0' && c_y[0] <= '9' && - strcmp(mf->tp->uri.scheme, "pop") == 0) { - Tprequest_t req = { LIST, NULL, 0 }; - char buf[100]; - buf[0]='\0'; - - req.args = c_y; - tp_freeresp(mf->tp, mf->resp); - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) { - fail; - } - if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) { - runerr(1212, dx); - } - tp_freeresp(mf->tp, mf->resp); - - Protect(reserve(Strings, msglen), runerr(0)); - StrLen(result) = msglen; - StrLoc(result) = alcstr(NULL, msglen); - - req.type = RETR; - mf->resp = tp_sendreq(mf->tp, &req); - if (mf->resp->sc != 200) { - runerr(1212, dx); - } - tp_read(mf->tp, StrLoc(result), (size_t)msglen); - while (buf[0] != '.') { - tp_readln(mf->tp, buf, sizeof(buf)); - } - return result; - } - else { - char *val = tp_headerfield(mf->resp->header, c_y); - char *end; - tended char *tmp; - if (val == NULL) { - fail; - } - - if (((end = strchr(val, '\r')) != NULL) || - ((end = strchr(val, '\n')) != NULL)) { - Protect(tmp = alcstr(val, end-val), runerr(0)); - return string(end-val, tmp); - } - else { - Protect(tmp = alcstr(val, strlen(val)), runerr(0)); - return string(strlen(val), tmp); - } - } - } - else -#endif /* Messaging */ - runerr(114,dx); - } - } + if (status & Fs_Messaging) { + tended char *c_y; + long int msglen; + struct MFile *mf = BlkD(dx,File)->fd.mf; + if (!cnv:C_string(y, c_y)) { + runerr(103, y); + } + if ((mf->resp == NULL) && !MFIN(mf, READING)){ + Mstartreading(mf); + } + if (mf->resp == NULL) { + fail; + } + if (strcmp(c_y, "Status-Code") == 0 || + strcmp(c_y, "code") == 0) { + return C_integer mf->resp->sc; + } + else if (strcmp(c_y, "Reason-Phrase") == 0 || + strcmp(c_y, "message") == 0) { + if (mf->resp->msg != NULL && (msglen = strlen(mf->resp->msg)) > 0) { + /* + * we could just return string(strlen(mf->resp->msg), mf->resp->msg) + * but mf->resp->msg could be gone by the time the result is accessed + * if the user called close() so, just allocate a string and return it. + */ + + StrLen(result) = msglen; + StrLoc(result) = alcstr(mf->resp->msg, msglen); + return result; + } + else { + fail; + } + } + else if (c_y[0] >= '0' && c_y[0] <= '9' && + strcmp(mf->tp->uri.scheme, "pop") == 0) { + Tprequest_t req = { LIST, NULL, 0 }; + char buf[100]; + buf[0]='\0'; + + req.args = c_y; + tp_freeresp(mf->tp, mf->resp); + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) { + fail; + } + if (sscanf(mf->resp->msg, "%*s %*d %ld", &msglen) < 1) { + runerr(1212, dx); + } + tp_freeresp(mf->tp, mf->resp); + + Protect(reserve(Strings, msglen), runerr(0)); + StrLen(result) = msglen; + StrLoc(result) = alcstr(NULL, msglen); + + req.type = RETR; + mf->resp = tp_sendreq(mf->tp, &req); + if (mf->resp->sc != 200) { + runerr(1212, dx); + } + tp_read(mf->tp, StrLoc(result), (size_t)msglen); + while (buf[0] != '.') { + tp_readln(mf->tp, buf, sizeof(buf)); + } + return result; + } + else { + char *val = tp_headerfield(mf->resp->header, c_y); + char *end; + tended char *tmp; + if (val == NULL) { + fail; + } + + if (((end = strchr(val, '\r')) != NULL) || + ((end = strchr(val, '\n')) != NULL)) { + Protect(tmp = alcstr(val, end-val), runerr(0)); + return string(end-val, tmp); + } + else { + Protect(tmp = alcstr(val, strlen(val)), runerr(0)); + return string(strlen(val), tmp); + } + } + } + else +#endif /* Messaging */ + runerr(114,dx); + } + } list: { abstract { @@ -1002,13 +1002,13 @@ operator{0,1} [] subsc(underef x -> dx,y) * Make sure that y is a C integer. */ if !cnv:C_integer(y) then { - /* - * If it isn't a C integer, but is a large integer, - * fail on the out-of-range index. - */ - if cnv : integer(y) then inline { fail; } - runerr(101, y) - } + /* + * If it isn't a C integer, but is a large integer, + * fail on the out-of-range index. + */ + if cnv : integer(y) then inline { fail; } + runerr(101, y) + } body { word i, j; register union block *bp; /* doesn't need to be tended */ @@ -1017,16 +1017,16 @@ operator{0,1} [] subsc(underef x -> dx,y) EVValD(&dx, E_Lref); EVVal(y, E_Lsub); - /* - * Make sure that subscript y is in range. - */ + /* + * Make sure that subscript y is in range. + */ lp = BlkD(dx, List); - MUTEX_LOCKBLK_CONTROLLED(lp, "x[y]: lock list"); + MUTEX_LOCKBLK_CONTROLLED(lp, "x[y]: lock list"); i = cvpos((long)y, (long)lp->size); if (i == CvtFail || i > lp->size){ - MUTEX_UNLOCKBLK(lp, "x[y]: unlock list"); + MUTEX_UNLOCKBLK(lp, "x[y]: unlock list"); fail; - } + } /* * Locate the list-element block containing the * desired element. @@ -1034,35 +1034,35 @@ operator{0,1} [] subsc(underef x -> dx,y) bp = lp->listhead; #ifdef Arrays - if (lp->listtail!=NULL){ -#endif /* Arrays */ - /* - * y is in range, so bp can never be null here. if it was, a memory - * violation would occur in the code that follows, anyhow, so - * exiting the loop on a NULL bp makes no sense. - */ - j = 1; - while (i >= j + Blk(bp,Lelem)->nused) { - j += bp->Lelem.nused; - bp = bp->Lelem.listnext; - } - - /* - * Locate the desired element and return a pointer to it. - */ - i += bp->Lelem.first - j; - if (i >= bp->Lelem.nslots) - i -= bp->Lelem.nslots; - MUTEX_UNLOCKBLK(BlkD(dx,List), "x[y]: unlock list"); - return struct_var(&bp->Lelem.lslots[i], bp); + if (lp->listtail!=NULL){ +#endif /* Arrays */ + /* + * y is in range, so bp can never be null here. if it was, a memory + * violation would occur in the code that follows, anyhow, so + * exiting the loop on a NULL bp makes no sense. + */ + j = 1; + while (i >= j + Blk(bp,Lelem)->nused) { + j += bp->Lelem.nused; + bp = bp->Lelem.listnext; + } + + /* + * Locate the desired element and return a pointer to it. + */ + i += bp->Lelem.first - j; + if (i >= bp->Lelem.nslots) + i -= bp->Lelem.nslots; + MUTEX_UNLOCKBLK(BlkD(dx,List), "x[y]: unlock list"); + return struct_var(&bp->Lelem.lslots[i], bp); #ifdef Arrays - } - else if (BlkType(bp)==T_Realarray) - return struct_var(&((struct b_realarray *)(bp))->a[i-1], bp); - else { /* if (BlkType(bp)==T_Intarray) assumed to be int array*/ - return struct_var(&((struct b_intarray *)(bp))->a[i-1], bp); - } -#endif /* Arrays */ + } + else if (BlkType(bp)==T_Realarray) + return struct_var(&((struct b_realarray *)(bp))->a[i-1], bp); + else { /* if (BlkType(bp)==T_Intarray) assumed to be int array*/ + return struct_var(&((struct b_intarray *)(bp))->a[i-1], bp); + } +#endif /* Arrays */ } } @@ -1073,16 +1073,16 @@ operator{0,1} [] subsc(underef x -> dx,y) } /* * x is a table. Return a table element trapped variable - * representing the result; defer actual lookup until later. + * representing the result; defer actual lookup until later. */ body { uword hn; - struct b_tvtbl *tp; + struct b_tvtbl *tp; EVValD(&dx, E_Tref); EVValD(&y, E_Tsub); - hn = hash(&y); + hn = hash(&y); EVVal(hn, E_HashNum); Protect(tp = alctvtbl(&dx, &y, hn), runerr(0)); return tvtbl(tp); @@ -1097,57 +1097,57 @@ operator{0,1} [] subsc(underef x -> dx,y) * x is a record. Convert y to an integer and be sure that it * it is in range as a field number. */ - if !cnv:C_integer(y) then body { - if (!cnv:tmp_string(y,y)) - runerr(101,y); - else { - register union block *bp; /* doesn't need to be tended */ - register union block *bp2; /* doesn't need to be tended */ - register word i; - register int len; - char *loc; - int nf; - bp = BlkLoc(dx); - bp2 = BlkD(dx,Record)->recdesc; - nf = Blk(bp2,Proc)->nfields; - loc = StrLoc(y); - len = StrLen(y); - for(i=0; ilnames[i]) && - !strncmp(loc, StrLoc(Blk(bp2,Proc)->lnames[i]), len)) { - - EVValD(&dx, E_Rref); - EVVal(i+1, E_Rsub); - - /* - * Found the field, return a pointer to it. - */ - return struct_var(&(Blk(bp,Record)->fields[i]), bp); - } - } - fail; + if !cnv:C_integer(y) then body { + if (!cnv:tmp_string(y,y)) + runerr(101,y); + else { + register union block *bp; /* doesn't need to be tended */ + register union block *bp2; /* doesn't need to be tended */ + register word i; + register int len; + char *loc; + int nf; + bp = BlkLoc(dx); + bp2 = BlkD(dx,Record)->recdesc; + nf = Blk(bp2,Proc)->nfields; + loc = StrLoc(y); + len = StrLen(y); + for(i=0; ilnames[i]) && + !strncmp(loc, StrLoc(Blk(bp2,Proc)->lnames[i]), len)) { + + EVValD(&dx, E_Rref); + EVVal(i+1, E_Rsub); + + /* + * Found the field, return a pointer to it. + */ + return struct_var(&(Blk(bp,Record)->fields[i]), bp); + } + } + fail; } - } - else + } + else body { word i; register union block *bp; /* doesn't need to be tended */ - union block *rd; + union block *rd; bp = BlkLoc(dx); - rd = Blk(bp,Record)->recdesc; - /* - * check if the record is an object, if yes, add 2 to the subscript - */ + rd = Blk(bp,Record)->recdesc; + /* + * check if the record is an object, if yes, add 2 to the subscript + */ if (Blk(rd,Proc)->ndynam == -3) { - i = cvpos(y, (word)(Blk(rd,Proc)->nfields-2)); - i += 2; - } - else { - i = cvpos(y, (word)(Blk(rd,Proc)->nfields)); - } - + i = cvpos(y, (word)(Blk(rd,Proc)->nfields-2)); + i += 2; + } + else { + i = cvpos(y, (word)(Blk(rd,Proc)->nfields)); + } + if (i == CvtFail || i > Blk(Blk(bp,Record)->recdesc,Proc)->nfields) fail; @@ -1185,13 +1185,13 @@ operator{0,1} [] subsc(underef x -> dx,y) * Make sure that y is a C integer. */ if !cnv:C_integer(y) then { - /* - * If it isn't a C integer, but is a large integer, fail on - * the out-of-range index. - */ - if cnv : integer(y) then inline { fail; } - runerr(101, y) - } + /* + * If it isn't a C integer, but is a large integer, fail on + * the out-of-range index. + */ + if cnv : integer(y) then inline { fail; } + runerr(101, y) + } body { char ch; diff --git a/src/runtime/oset.r b/src/runtime/oset.r index 1699a309a..ee100bdb8 100644 --- a/src/runtime/oset.r +++ b/src/runtime/oset.r @@ -25,22 +25,22 @@ operator{1} ~ compl(x) */ Protect(cp = alccset(), runerr(0)); cpx = (struct b_cset *)BlkLoc(x); /* must come after alccset() */ - for (i = 0; i < CsetSize; i++) + for (i = 0; i < CsetSize; i++) cp->bits[i] = ~cpx->bits[i]; return cset(cp); } end - + "x -- y - difference of csets, sets or tables x and y." operator{1} -- diff(x,y) if is:table(x) && is:table(y) then { abstract { - return type(x) - } + return type(x) + } body { - int res; + int res; register int i; register word slotnum; tended union block *srcp, *tstp, *dstp; @@ -58,9 +58,9 @@ operator{1} -- diff(x,y) /* * For each element in table x if it is not in table y * copy it directly into the result table. - * - * np always has a new element ready for use. We get one in advance, - * and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in advance, + * and stay one ahead, because hook can't be tended. */ srcp = BlkLoc(x); tstp = BlkLoc(y); @@ -73,16 +73,16 @@ operator{1} -- diff(x,y) memb(tstp, &ep->tref, ep->hashnum, &res); if (res == 0) { hook = memb(dstp, &ep->tref, ep->hashnum, &res); - np->tref = ep->tref; - np->tval = ep->tval; - np->hashnum = ep->hashnum; + np->tref = ep->tref; + np->tval = ep->tval; + np->hashnum = ep->hashnum; addmem(Blk(dstp,Set), (struct b_selem *)np, hook); Protect(np = alctelem(), runerr(0)); } ep = (struct b_telem *)ep->clink; } } - deallocate((union block *)np); + deallocate((union block *)np); if (TooSparse(dstp)) hshrink(dstp); Desc_EVValD(dstp, E_Tcreate, D_Table); @@ -95,7 +95,7 @@ operator{1} -- diff(x,y) return type(x) } body { - int res; + int res; register int i; register word slotnum; tended union block *srcp, *tstp, *dstp; @@ -113,9 +113,9 @@ operator{1} -- diff(x,y) /* * For each element in set x if it is not in set y * copy it directly into the result set. - * - * np always has a new element ready for use. We get one in advance, - * and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in advance, + * and stay one ahead, because hook can't be tended. */ srcp = BlkLoc(x); tstp = BlkLoc(y); @@ -128,15 +128,15 @@ operator{1} -- diff(x,y) memb(tstp, &ep->setmem, ep->hashnum, &res); if (res == 0) { hook = memb(dstp, &ep->setmem, ep->hashnum, &res); - np->setmem = ep->setmem; - np->hashnum = ep->hashnum; + np->setmem = ep->setmem; + np->hashnum = ep->hashnum; addmem(Blk(dstp,Set), np, hook); Protect(np = alcselem(&nulldesc, (uword)0), runerr(0)); } ep = (struct b_selem *)ep->clink; } } - deallocate((union block *)np); + deallocate((union block *)np); if (TooSparse(dstp)) hshrink(dstp); Desc_EVValD(dstp, E_Screate, D_Set); @@ -169,19 +169,19 @@ operator{1} -- diff(x,y) } } end - + "x ** y - intersection of csets, sets or tables x and y." operator{1} ** inter(x,y) if is:table(x) && is:table(y) then { abstract { - return new table(store[type(x).tbl_key] ** store[type(y).tbl_key], - store[type(x).tbl_val] ** store[type(y).tbl_val], - store[type(x).tbl_dflt]) + return new table(store[type(x).tbl_key] ** store[type(y).tbl_key], + store[type(x).tbl_val] ** store[type(y).tbl_val], + store[type(x).tbl_dflt]) } body { - int res; + int res; register int i; register word slotnum; tended union block *srcp, *tstp, *dstp; @@ -201,12 +201,12 @@ operator{1} ** inter(x,y) * Using the left table as the source, * copy directly into the result each of its elements * that are also members of the other set. - * - * np always has a new element ready for use. We get one in advance, - * and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in advance, + * and stay one ahead, because hook can't be tended. */ - srcp = BlkLoc(x); - tstp = BlkLoc(y); + srcp = BlkLoc(x); + tstp = BlkLoc(y); Protect(np = alctelem(), runerr(0)); for (i = 0; i < HSegs && (seg = Blk(srcp,Table)->hdir[i]) != NULL; i++) for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--) { @@ -215,16 +215,16 @@ operator{1} ** inter(x,y) memb(tstp, &ep->tref, ep->hashnum, &res); if (res != 0) { hook = memb(dstp, &ep->tref, ep->hashnum, &res); - np->tref = ep->tref; - np->tval = ep->tval; - np->hashnum = ep->hashnum; + np->tref = ep->tref; + np->tval = ep->tval; + np->hashnum = ep->hashnum; addmem(Blk(dstp,Set), (struct b_selem *)np, hook); Protect(np = alctelem(), runerr(0)); } ep = (struct b_telem *)ep->clink; } } - deallocate((union block *)np); + deallocate((union block *)np); if (TooSparse(dstp)) hshrink(dstp); Desc_EVValD(dstp, E_Tcreate, D_Table); @@ -237,7 +237,7 @@ operator{1} ** inter(x,y) return new set(store[type(x).set_elem] ** store[type(y).set_elem]) } body { - int res; + int res; register int i; register word slotnum; tended union block *srcp, *tstp, *dstp; @@ -257,9 +257,9 @@ operator{1} ** inter(x,y) * Using the smaller of the two sets as the source * copy directly into the result each of its elements * that are also members of the other set. - * - * np always has a new element ready for use. We get one in advance, - * and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in advance, + * and stay one ahead, because hook can't be tended. */ if (BlkD(x,Set)->size <= BlkD(y,Set)->size) { srcp = BlkLoc(x); @@ -277,15 +277,15 @@ operator{1} ** inter(x,y) memb(tstp, &ep->setmem, ep->hashnum, &res); if (res != 0) { hook = memb(dstp, &ep->setmem, ep->hashnum, &res); - np->setmem = ep->setmem; - np->hashnum = ep->hashnum; + np->setmem = ep->setmem; + np->hashnum = ep->hashnum; addmem(Blk(dstp,Set), np, hook); Protect(np = alcselem(&nulldesc, (uword)0), runerr(0)); } ep = (struct b_selem *)ep->clink; } } - deallocate((union block *)np); + deallocate((union block *)np); if (TooSparse(dstp)) hshrink(dstp); Desc_EVValD(dstp, E_Screate, D_Set); @@ -321,21 +321,21 @@ operator{1} ** inter(x,y) } } end - + "x ++ y - union of csets, sets or tables x and y." operator{1} ++ union(x,y) if is:table(x) && is:table(y) then { abstract { - return new table(store[type(x).tbl_key] ++ store[type(y).tbl_key], - store[type(x).tbl_val] ++ store[type(y).tbl_val], - store[type(x).tbl_dflt]) - } + return new table(store[type(x).tbl_key] ++ store[type(y).tbl_key], + store[type(x).tbl_val] ++ store[type(y).tbl_val], + store[type(x).tbl_dflt]) + } body { - int res; - register int i; - register word slotnum; + int res; + register int i; + register word slotnum; tended union block *dstp; tended struct b_slots *seg; tended struct b_telem *ep; @@ -343,9 +343,9 @@ operator{1} ++ union(x,y) union block **hook; /* - * Unlike for sets, do not union whichever is smaller into - * whichever is larger. For tables, duplicate keys retain - * the values in the left operand. + * Unlike for sets, do not union whichever is smaller into + * whichever is larger. For tables, duplicate keys retain + * the values in the left operand. */ /* @@ -361,9 +361,9 @@ operator{1} ++ union(x,y) } /* * Copy each element from y into the result, if not already there. - * - * np always has a new element ready for use. We get one in - * advance, and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in + * advance, and stay one ahead, because hook can't be tended. */ dstp = BlkLoc(result); Protect(np = alctelem(), runerr(0)); @@ -373,22 +373,22 @@ operator{1} ++ union(x,y) while ((ep != NULL) && (BlkType(ep) != T_Table)) { hook = memb(dstp, &ep->tref, ep->hashnum, &res); if (res == 0) { - np->tref = ep->tref; - np->tval = ep->tval; - np->hashnum = ep->hashnum; - /* addmem() looks like it works on tables :-) */ + np->tref = ep->tref; + np->tval = ep->tval; + np->hashnum = ep->hashnum; + /* addmem() looks like it works on tables :-) */ addmem(Blk(dstp,Set), (struct b_selem *)np, hook); Protect(np = alctelem(), runerr(0)); } ep = (struct b_telem *)ep->clink; } } - deallocate((union block *)np); - if (TooCrowded(dstp)) { /* if the union got too big, enlarge */ + deallocate((union block *)np); + if (TooCrowded(dstp)) { /* if the union got too big, enlarge */ hgrow(dstp); } return result; - } + } } else if is:set(x) && is:set(y) then { @@ -396,9 +396,9 @@ operator{1} ++ union(x,y) return new set(store[type(x).set_elem] ++ store[type(y).set_elem]) } body { - int res; - register int i; - register word slotnum; + int res; + register int i; + register word slotnum; struct descrip d; tended union block *dstp; tended struct b_slots *seg; @@ -410,10 +410,10 @@ operator{1} ++ union(x,y) * Ensure that x is the larger set; if not, swap. */ if (BlkD(y,Set)->size > BlkD(x,Set)->size) { - d = x; - x = y; - y = d; - } + d = x; + x = y; + y = d; + } /* * Copy x and ensure there's room for *x + *y elements. */ @@ -427,9 +427,9 @@ operator{1} ++ union(x,y) } /* * Copy each element from y into the result, if not already there. - * - * np always has a new element ready for use. We get one in - * advance, and stay one ahead, because hook can't be tended. + * + * np always has a new element ready for use. We get one in + * advance, and stay one ahead, because hook can't be tended. */ dstp = BlkLoc(result); Protect(np = alcselem(&nulldesc, (uword)0), runerr(0)); @@ -439,20 +439,20 @@ operator{1} ++ union(x,y) while (ep != NULL) { hook = memb(dstp, &ep->setmem, ep->hashnum, &res); if (res == 0) { - np->setmem = ep->setmem; - np->hashnum = ep->hashnum; + np->setmem = ep->setmem; + np->hashnum = ep->hashnum; addmem(Blk(dstp,Set), np, hook); Protect(np = alcselem(&nulldesc, (uword)0), runerr(0)); } ep = (struct b_selem *)ep->clink; } } - deallocate((union block *)np); - if (TooCrowded(dstp)) { /* if the union got too big, enlarge */ + deallocate((union block *)np); + if (TooCrowded(dstp)) { /* if the union got too big, enlarge */ hgrow(dstp); } return result; - } + } } else { if !cnv:tmp_cset(x) then diff --git a/src/runtime/ovalue.r b/src/runtime/ovalue.r index e428868e8..237913b40 100644 --- a/src/runtime/ovalue.r +++ b/src/runtime/ovalue.r @@ -24,7 +24,7 @@ operator{0,1} \ nonnull(underef x -> dx) } end - + "/x - test x for null value." @@ -46,7 +46,7 @@ operator{0,1} / null(underef x -> dx) fail; } end - + ".x - produce value of x." @@ -58,7 +58,7 @@ operator{1} . value(x) return x; } end - + "x & y - produce value of y." diff --git a/src/runtime/ralc.r b/src/runtime/ralc.r index 95f4e12db..a77411254 100644 --- a/src/runtime/ralc.r +++ b/src/runtime/ralc.r @@ -9,25 +9,25 @@ #ifdef Concurrent static struct region *findgap(struct region *curr_private, word nbytes, int region); #define INIT_SHARED(blk) blk->shared = 0 -#else /* Concurrent */ -static struct region *findgap (struct region *curr, word nbytes); +#else /* Concurrent */ +static struct region *findgap (struct region *curr, word nbytes); #define INIT_SHARED(blk) -#endif /* Concurrent */ +#endif /* Concurrent */ extern word alcnum; #ifndef MultiProgram -word coexp_ser = 2; /* serial numbers for co-expressions; &main is 1 */ -word list_ser = 1; /* serial numbers for lists */ +word coexp_ser = 2; /* serial numbers for co-expressions; &main is 1 */ +word list_ser = 1; /* serial numbers for lists */ word intern_list_ser=-1;/* serial numbers for lists used internally by the RT system */ #ifdef PatternType -word pat_ser = 1; /* serial numbers for patterns */ -#endif /* PatternType */ -word set_ser = 1; /* serial numbers for sets */ -word table_ser = 1; /* serial numbers for tables */ -#endif /* MultiProgram */ +word pat_ser = 1; /* serial numbers for patterns */ +#endif /* PatternType */ +word set_ser = 1; /* serial numbers for sets */ +word table_ser = 1; /* serial numbers for tables */ +#endif /* MultiProgram */ + - /* * AlcBlk - allocate a block. */ @@ -74,7 +74,7 @@ word table_ser = 1; /* serial numbers for tables */ var->blksize = size; } #enddef - + /* * alcactiv - allocate a co-expression activation block. */ @@ -101,7 +101,7 @@ struct astkblk *alcactiv() abp->arec[0].activator = NULL; return abp; } - + #ifdef LargeInts #begdef alcbignum_macro(f,e_lrgint) /* @@ -128,11 +128,11 @@ struct b_bignum *f(word n) #ifdef MultiProgram alcbignum_macro(alcbignum_0,0) alcbignum_macro(alcbignum_1,E_Lrgint) -#else /* MultiProgram */ +#else /* MultiProgram */ alcbignum_macro(alcbignum,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ -#endif /* LargeInts */ +#endif /* LargeInts */ #ifdef Concurrent int alcce_q(dptr q, int size){ @@ -153,35 +153,35 @@ int alcce_queues(struct b_coexpr *ep){ ep->outbox = nulldesc; ep->cequeue = nulldesc; ep->handdata = NULL; - + /* * Initialize sender/receiver queues. * - * Make sure we have enough memory for all queues all at once to avoid + * Make sure we have enough memory for all queues all at once to avoid * multiple GC if we are at the end of a region. */ if (!reserve(Blocks, (word)( - sizeof(struct b_list) * 3 + - sizeof(struct b_lelem) * 3 + - (CE_INBOX_SIZE + CE_OUTBOX_SIZE + CE_CEQUEUE_SIZE) * sizeof(struct descrip))) - ) - return Failed; + sizeof(struct b_list) * 3 + + sizeof(struct b_lelem) * 3 + + (CE_INBOX_SIZE + CE_OUTBOX_SIZE + CE_CEQUEUE_SIZE) * sizeof(struct descrip))) + ) + return Failed; if (alcce_q(&(ep->outbox), 1024) == Failed) return Failed; if (alcce_q(&(ep->inbox), 1024) == Failed) return Failed; if (alcce_q(&(ep->cequeue), 64) == Failed) - return Failed; - + return Failed; + ep->handdata = NULL; INIT_SHARED(ep); - + return Succeeded; } -#endif /* Concurrent */ +#endif /* Concurrent */ /* @@ -234,9 +234,9 @@ struct b_coexpr *alccoexp() #ifdef NativeCoswitch ep->status = 0; -#else /* NativeCoswitch */ +#else /* NativeCoswitch */ ep->status = Ts_Posix; -#endif /* NativeCoswitch */ +#endif /* NativeCoswitch */ /* need to look at concurrent initialization for COMPILER and !COMPILER @@ -246,7 +246,7 @@ struct b_coexpr *alccoexp() if (alcce_queues(ep) == Failed) ReturnErrNum(307, NULL); - + ep->ini_blksize = rootblock.size/100; if (ep->ini_blksize < MinAbrSize) ep->ini_blksize = MinAbrSize; @@ -257,7 +257,7 @@ struct b_coexpr *alccoexp() #endif /* Concurrent */ - ep->es_tend = NULL; + ep->es_tend = NULL; #ifdef PthreadCoswitch { @@ -267,7 +267,7 @@ struct b_coexpr *alccoexp() ep->alive = 0; } -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ MUTEX_LOCKID(MTX_STKLIST); ep->nextstk = stklist; @@ -276,7 +276,7 @@ struct b_coexpr *alccoexp() INIT_SHARED(ep); return ep; } -#else /* COMPILER */ +#else /* COMPILER */ #ifdef MultiProgram /* * If this is a new program being loaded, an icodesize>0 gives the @@ -286,9 +286,9 @@ struct b_coexpr *alccoexp() */ struct b_coexpr *alccoexp(icodesize, stacksize) long icodesize, stacksize; -#else /* MultiProgram */ +#else /* MultiProgram */ struct b_coexpr *alccoexp() -#endif /* MultiProgram */ +#endif /* MultiProgram */ { struct b_coexpr *ep = NULL; @@ -306,11 +306,11 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); #ifdef MultiProgram if (icodesize > 0) { ep = (struct b_coexpr *) - calloc(1, (msize)(stacksize + icodesize + sizeof(struct progstate) + - sizeof(struct b_coexpr))); + calloc(1, (msize)(stacksize + icodesize + sizeof(struct progstate) + + sizeof(struct b_coexpr))); } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ ep = (struct b_coexpr *)malloc((msize)stksize); /* @@ -322,10 +322,10 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); #ifdef MultiProgram if (icodesize>0) { ep = (struct b_coexpr *) - malloc((msize)(mstksize+icodesize+sizeof(struct progstate))); + malloc((msize)(mstksize+icodesize+sizeof(struct progstate))); } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ ep = (struct b_coexpr *)malloc((msize)stksize); } if (ep == NULL){ @@ -333,7 +333,7 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); ReturnErrNum(305, NULL); } - alcnum++; /* increment allocation count since last g.c. */ + alcnum++; /* increment allocation count since last g.c. */ MUTEX_UNLOCKID(MTX_ALCNUM); @@ -348,20 +348,20 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); #ifdef NativeCoswitch ep->status = 0; -#else /* NativeCoswitch */ +#else /* NativeCoswitch */ ep->status = Ts_Posix; -#endif /* NativeCoswitch */ +#endif /* NativeCoswitch */ if (icodesize > 0) ep->id = 1; else{ -#endif /* MultiProgram */ +#endif /* MultiProgram */ MUTEX_LOCKID(MTX_COEXP_SER); ep->id = coexp_ser++; MUTEX_UNLOCKID(MTX_COEXP_SER); #ifdef MultiProgram } -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef Concurrent ep->Lastop = 0; @@ -384,7 +384,7 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); if (ep->ini_ssize < MinStrSpace) ep->ini_ssize = MinStrSpace; -#endif /* Concurrent */ +#endif /* Concurrent */ ep->es_tend = NULL; @@ -397,7 +397,7 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); ep->program->tstate = &ep->program->maintstate; } else ep->program = curpstate; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef PthreadCoswitch { @@ -412,14 +412,14 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); ep->tstate = ep->program->tstate; } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ { - ep->tstate = NULL; + ep->tstate = NULL; ep->isProghead = 0; } -#endif /* Concurrent */ +#endif /* Concurrent */ } -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ MUTEX_LOCKID(MTX_STKLIST); ep->nextstk = stklist; @@ -428,9 +428,9 @@ MUTEX_LOCKID_CONTROLLED(MTX_ALCNUM); return ep; } -#endif /* COMPILER */ +#endif /* COMPILER */ + - #begdef alccset_macro(f, e_cset) /* * alccset - allocate a cset in the block region. @@ -457,11 +457,11 @@ struct b_cset *f() #ifdef MultiProgram alccset_macro(alccset_0,0) alccset_macro(alccset_1,E_Cset) -#else /* MultiProgram */ +#else /* MultiProgram */ alccset_macro(alccset,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - #begdef alcfile_macro(f, e_file) /* * alcfile - allocate a file block in the block region. @@ -479,7 +479,7 @@ struct b_file *f(FILE *fd, int status, dptr name) blk->fname = tname; #ifdef Concurrent blk->mutexid = get_mutex(&rmtx_attr); -#endif /* Concurrent */ +#endif /* Concurrent */ return blk; } @@ -489,10 +489,10 @@ struct b_file *f(FILE *fd, int status, dptr name) #passthru #undef alcfile alcfile_macro(alcfile,0) alcfile_macro(alcfile_1,E_File) -#else /* MultiProgram */ +#else /* MultiProgram */ alcfile_macro(alcfile,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alchash_macro(f, e_table, e_set) /* * alchash - allocate a hashed structure (set or table header) in the block @@ -513,7 +513,7 @@ union block *f(int tcode) ps->id = table_ser++; MUTEX_UNLOCKID(MTX_TABLE_SER); } - else { /* tcode == T_Set */ + else { /* tcode == T_Set */ EVVal(sizeof(struct b_set), e_set); AlcFixBlk(ps, b_set, T_Set); MUTEX_LOCKID(MTX_SET_SER); @@ -532,10 +532,10 @@ union block *f(int tcode) #ifdef MultiProgram alchash_macro(alchash_0,0,0) alchash_macro(alchash_1,E_Table,E_Set) -#else /* MultiProgram */ +#else /* MultiProgram */ alchash_macro(alchash,0,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alcsegment_macro(f,e_slots) /* * alcsegment - allocate a slot block in the block region. @@ -560,10 +560,10 @@ struct b_slots *f(word nslots) #ifdef MultiProgram alcsegment_macro(alcsegment_0,0) alcsegment_macro(alcsegment_1,E_Slots) -#else /* MultiProgram */ +#else /* MultiProgram */ alcsegment_macro(alcsegment,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #ifdef PatternType @@ -573,7 +573,7 @@ struct b_pattern *f(word stck_size) { register struct b_pattern *pheader; CURTSTATE(); - + EVVal(sizeof (struct b_pattern), e_pattern); AlcFixBlk(pheader, b_pattern, T_Pattern) pheader->stck_size = stck_size; @@ -588,29 +588,29 @@ struct b_pattern *f(word stck_size) #ifdef MultiProgram alcpattern_macro(alcpattern_0,0,0) alcpattern_macro(alcpattern_1,E_Pattern,E_Pelem) -#else /* MultiProgram */ +#else /* MultiProgram */ alcpattern_macro(alcpattern,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef alcpelem_macro(f, e_pelem) #if COMPILER struct b_pelem *f( word patterncode) -#else /* COMPILER */ +#else /* COMPILER */ struct b_pelem *f( word patterncode, word *o_ipc) -#endif /* COMPILER */ +#endif /* COMPILER */ { register struct b_pelem *pelem; CURTSTATE(); - + EVVal(sizeof (struct b_pelem), e_pelem); AlcFixBlk(pelem, b_pelem, T_Pelem) pelem->pcode = patterncode; pelem->pthen = NULL; #if !COMPILER pelem->origin_ipc = o_ipc; -#endif /* COMPILER */ +#endif /* COMPILER */ pelem->parameter = nulldesc; return pelem; } @@ -619,12 +619,12 @@ struct b_pelem *f( word patterncode, word *o_ipc) #ifdef MultiProgram alcpelem_macro(alcpelem_0,0) alcpelem_macro(alcpelem_1,E_Pelem) -#else /* MultiProgram */ +#else /* MultiProgram */ alcpelem_macro(alcpelem,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ -#endif /* PatternType */ +#endif /* PatternType */ struct b_cons *alccons(union block *data) { @@ -654,7 +654,7 @@ struct b_list *alclisthdr(uword size, union block *bptr) INIT_SHARED(blk); #ifdef Arrays ( (struct b_realarray *) bptr)->listp = (union block *)blk; -#endif /* Arrays */ +#endif /* Arrays */ return blk; } @@ -689,15 +689,15 @@ struct b_list *f(uword size, uword nslots) if (size != -1) blk->id = list_ser++; else{ - /* - * size -1 is used to indicate an RT list, + /* + * size -1 is used to indicate an RT list, * reset size to 0 and use the "special" serial number */ size = 0; blk->id = intern_list_ser--; } MUTEX_UNLOCKID(MTX_LIST_SER); - blk->size = size; + blk->size = size; INIT_SHARED(blk); blk->listhead = blk->listtail = (union block *)lblk; @@ -719,9 +719,9 @@ struct b_list *f(uword size, uword nslots) #passthru #undef alclist_raw alclist_raw_macro(alclist_raw,0,0) alclist_raw_macro(alclist_raw_1,E_List,E_Lelem) -#else /* MultiProgram */ +#else /* MultiProgram */ alclist_raw_macro(alclist_raw,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef alclist_macro(f,e_list,e_lelem) @@ -740,9 +740,9 @@ struct b_list *f(uword size, uword nslots) MUTEX_LOCKID(MTX_LIST_SER); if (size != -1) blk->id = list_ser++; - else{ - /* - * size -1 is used to indicate an RT list, + else{ + /* + * size -1 is used to indicate an RT list, * reset size to 0 and use the "special" serial number */ size = 0; @@ -769,10 +769,10 @@ struct b_list *f(uword size, uword nslots) #ifdef MultiProgram alclist_macro(alclist_0,0,0) alclist_macro(alclist_1,E_List,E_Lelem) -#else /* MultiProgram */ +#else /* MultiProgram */ alclist_macro(alclist,0,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alclstb_macro(f,t_lelem) /* * alclstb - allocate a list element block in the block region. @@ -802,10 +802,10 @@ struct b_lelem *f(uword nslots, uword first, uword nused) #ifdef MultiProgram alclstb_macro(alclstb_0,0) alclstb_macro(alclstb_1,E_Lelem) -#else /* MultiProgram */ +#else /* MultiProgram */ alclstb_macro(alclstb,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alcreal_macro(f,e_real) /* * alcreal - allocate a real value in the block region. @@ -840,11 +840,11 @@ struct b_real *f(double val) #passthru #undef alcreal alcreal_macro(alcreal,0) alcreal_macro(alcreal_1,E_Real) -#else /* MultiProgram */ +#else /* MultiProgram */ alcreal_macro(alcreal,0) -#endif /* MultiProgram */ -#endif /* DescriptorDouble */ - +#endif /* MultiProgram */ +#endif /* DescriptorDouble */ + #begdef alcrecd_macro(f,e_record) /* * alcrecd - allocate record with nflds fields in the block region. @@ -869,10 +869,10 @@ struct b_record *f(int nflds, union block *recptr) #ifdef MultiProgram alcrecd_macro(alcrecd_0,0) alcrecd_macro(alcrecd_1,E_Record) -#else /* MultiProgram */ +#else /* MultiProgram */ alcrecd_macro(alcrecd,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + /* * alcrefresh - allocate a co-expression refresh block. */ @@ -894,7 +894,7 @@ int wrk_sz; blk->wrk_size = wrk_sz; return blk; } -#else /* COMPILER */ +#else /* COMPILER */ #begdef alcrefresh_macro(f,e_refresh) struct b_refresh *f(word *entryx, int na, int nl) @@ -913,11 +913,11 @@ struct b_refresh *f(word *entryx, int na, int nl) #ifdef MultiProgram alcrefresh_macro(alcrefresh_0,0) alcrefresh_macro(alcrefresh_1,E_Refresh) -#else /* MultiProgram */ +#else /* MultiProgram */ alcrefresh_macro(alcrefresh,0) -#endif /* MultiProgram */ -#endif /* COMPILER */ - +#endif /* MultiProgram */ +#endif /* COMPILER */ + #begdef alcselem_macro(f,e_selem) /* * alcselem - allocate a set element block. @@ -939,10 +939,10 @@ struct b_selem *f(dptr mbr,uword hn) #ifdef MultiProgram alcselem_macro(alcselem_0,0) alcselem_macro(alcselem_1,E_Selem) -#else /* MultiProgram */ +#else /* MultiProgram */ alcselem_macro(alcselem,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alcstr_macro(f,e_string) /* * alcstr - allocate a string in the string space. @@ -961,7 +961,7 @@ char *f(register char *s, register word slen) EVVal(slen, e_string); s = StrLoc(ts); } -#endif /* e_string */ +#endif /* e_string */ /* * Make sure there is enough room in the string space. @@ -986,12 +986,12 @@ char *f(register char *s, register word slen) ofree = d = strfree; if (s) { if (slen >= 4) { - memcpy(d, s, slen); - d+= slen; - } + memcpy(d, s, slen); + d+= slen; + } else - while (slen-- > 0) - *d++ = *s++; + while (slen-- > 0) + *d++ = *s++; } else d += slen; @@ -1005,10 +1005,10 @@ char *f(register char *s, register word slen) #passthru #undef alcstr alcstr_macro(alcstr,0) alcstr_macro(alcstr_1,E_String) -#else /* MultiProgram */ +#else /* MultiProgram */ alcstr_macro(alcstr,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alcsubs_macro(f, e_tvsubs) /* * alcsubs - allocate a substring trapped variable in the block region. @@ -1031,10 +1031,10 @@ struct b_tvsubs *f(word len, word pos, dptr var) #ifdef MultiProgram alcsubs_macro(alcsubs_0,0) alcsubs_macro(alcsubs_1,E_Tvsubs) -#else /* MultiProgram */ +#else /* MultiProgram */ alcsubs_macro(alcsubs,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alctelem_macro(f, e_telem) /* * alctelem - allocate a table element block in the block region. @@ -1057,10 +1057,10 @@ struct b_telem *f() #ifdef MultiProgram alctelem_macro(alctelem_0,0) alctelem_macro(alctelem_1,E_Telem) -#else /* MultiProgram */ +#else /* MultiProgram */ alctelem_macro(alctelem,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef alctvtbl_macro(f,e_tvtbl) /* * alctvtbl - allocate a table element trapped variable block in the block @@ -1085,9 +1085,9 @@ struct b_tvtbl *f(register dptr tbl, register dptr ref, uword hashnum) #ifdef MultiProgram alctvtbl_macro(alctvtbl_0,0) alctvtbl_macro(alctvtbl_1,E_Tvtbl) -#else /* MultiProgram */ +#else /* MultiProgram */ alctvtbl_macro(alctvtbl,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef EventMon #begdef alctvmonitored_macro(f) @@ -1105,13 +1105,13 @@ struct b_tvmonitored *f(register dptr tv, word count) blk->tv = vref; blk->cur_actv = count; return blk; - } + } #enddef alctvmonitored_macro(alctvmonitored) -#endif /* EventMon */ +#endif /* EventMon */ + - #begdef deallocate_macro(f,e_blkdealc) /* * deallocate - return a block to the heap. @@ -1125,14 +1125,14 @@ void f (union block *bp) CURTSTATE(); #ifdef Concurrent /* DO WE NEED THIS ? WE HAVE PRIVATE HEAPS NOW */ return; -#endif /* Concurrent */ +#endif /* Concurrent */ nbytes = BlkSize(bp); for (rp = curblock; rp; rp = rp->next) if ((char *)bp + nbytes == rp->free) break; if (!rp) for (rp = curblock->prev; rp; rp = rp->prev) - if ((char *)bp + nbytes == rp->free) + if ((char *)bp + nbytes == rp->free) break; if (!rp) syserr ("deallocation botch"); @@ -1145,10 +1145,10 @@ void f (union block *bp) #ifdef MultiProgram deallocate_macro(deallocate_0,0) deallocate_macro(deallocate_1,E_BlkDeAlc) -#else /* MultiProgram */ +#else /* MultiProgram */ deallocate_macro(deallocate,0) -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + #begdef reserve_macro(f,e_tenurestring,e_tenureblock) /* * reserve -- ensure space in either string or block region. @@ -1178,12 +1178,12 @@ char *f(int region, word nbytes) pcurr = &curtstring; else pcurr = &curtblock; -#else /* Concurrent */ +#else /* Concurrent */ if (region == Strings) pcurr = &curstring; else pcurr = &curblock; -#endif /* Concurrent */ +#endif /* Concurrent */ curr_private = *pcurr; @@ -1196,11 +1196,11 @@ char *f(int region, word nbytes) /* check all regions on chain */ #ifdef Concurrent if ((rp = findgap(curr_private, nbytes, region)) != 0) -#else /* Concurrent */ +#else /* Concurrent */ if ((rp = findgap(curr_private, nbytes)) != 0) -#endif /* Concurrent */ +#endif /* Concurrent */ { - *pcurr = rp; /* switch regions */ + *pcurr = rp; /* switch regions */ return rp->free; } @@ -1210,7 +1210,7 @@ char *f(int region, word nbytes) */ while (curr_private->next) curr_private = curr_private->next; - + /* * Need to collect garbage. To reduce thrashing, set a minimum requirement * of 10% of the size of the newest region, and collect regions until that @@ -1221,13 +1221,13 @@ char *f(int region, word nbytes) want = nbytes; for (rp = curr_private; rp; rp = rp->prev) - if (rp->size >= want) { /* if large enough to possibly succeed */ + if (rp->size >= want) { /* if large enough to possibly succeed */ *pcurr = rp; collect(region); if (DiffPtrs(rp->end,rp->free) >= want) return rp->free; } -#else /* Concurrent */ +#else /* Concurrent */ want = (curr_private->size / 100) * memcushion; if (want < nbytes) @@ -1255,19 +1255,19 @@ char *f(int region, word nbytes) /* if large enough to possibly succeed */ if (rp->size >= want && rp->size>=curr_private->size/2) { curr_private = swap2publicheap(curr_private, rp, p_publicheap); - *pcurr = curr_private; + *pcurr = curr_private; collect(region); if (DiffPtrs( curr_private->end, curr_private->free) >= want){ RESUME_THREADS(); return curr_private->free; } } - + /* * GC has failed so far to free enough memory, wake up all threads for now. - */ - RESUME_THREADS(); - #endif /* Concurrent */ + */ + RESUME_THREADS(); + #endif /* Concurrent */ /* * That didn't work. Allocate a new region with a size based on the @@ -1279,7 +1279,7 @@ char *f(int region, word nbytes) newsize = nbytes + memcushion; if (newsize < MinAbrSize) newsize = MinAbrSize; - + if ((rp = newregion(nbytes, newsize)) != 0) { #ifdef Concurrent /* a new region is allocated, swap the current private @@ -1287,14 +1287,14 @@ char *f(int region, word nbytes) */ if (region == Strings){ MUTEX_LOCKID_CONTROLLED(MTX_PUBLICSTRHEAP); - swap2publicheap(curr_private, NULL, &public_stringregion); + swap2publicheap(curr_private, NULL, &public_stringregion); MUTEX_UNLOCKID(MTX_PUBLICSTRHEAP); - } + } else{ MUTEX_LOCKID_CONTROLLED(MTX_PUBLICBLKHEAP); - swap2publicheap(curr_private, NULL, &public_blockregion); + swap2publicheap(curr_private, NULL, &public_blockregion); MUTEX_UNLOCKID(MTX_PUBLICBLKHEAP); - } + } /* * Set "curr_private" to point to newest region. @@ -1302,7 +1302,7 @@ char *f(int region, word nbytes) MUTEX_LOCKID(mtx_heap); while (curr_private->next) curr_private = curr_private->next; -#endif /* Concurrent */ +#endif /* Concurrent */ rp->prev = curr_private; rp->next = NULL; curr_private->next = rp; @@ -1328,7 +1328,7 @@ char *f(int region, word nbytes) } } } -#endif /* e_tenurestring || e_tenureblock */ +#endif /* e_tenurestring || e_tenureblock */ return rp->free; } @@ -1341,7 +1341,7 @@ char *f(int region, word nbytes) #ifdef Concurrent // fprintf(stderr, " !!! Low memory!! Trying all options !!!\n "); /* look in the public heaps, */ - SUSPEND_THREADS(); + SUSPEND_THREADS(); /* public heaps might have got updated, resync, no need to lock! */ if (region == Strings) @@ -1350,21 +1350,21 @@ char *f(int region, word nbytes) p_publicheap = &public_blockregion; for (rp = *p_publicheap; rp; rp = rp->Tnext) - if (rp->size >= want) { /* if not collected earlier */ + if (rp->size >= want) { /* if not collected earlier */ curr_private = swap2publicheap(curr_private, rp, p_publicheap); *pcurr = curr_private; collect(region); if (DiffPtrs(curr_private->end,curr_private->free) >= want){ - RESUME_THREADS(); + RESUME_THREADS(); return curr_private->free; } } - RESUME_THREADS(); + RESUME_THREADS(); if ((rp = findgap(curr_private, nbytes, region)) != 0) /* check all regions on chain */ - -#else /* Concurrent */ + +#else /* Concurrent */ for (rp = curr_private; rp; rp = rp->prev) - if (rp->size >= want) { /* if not collected earlier */ + if (rp->size >= want) { /* if not collected earlier */ *pcurr = rp; collect(region); if (DiffPtrs(rp->end,rp->free) >= want) @@ -1372,7 +1372,7 @@ char *f(int region, word nbytes) } if ((rp = findgap(curr_private, nbytes)) != 0) -#endif /* Concurrent */ +#endif /* Concurrent */ { *pcurr = rp; return rp->free; @@ -1393,9 +1393,9 @@ char *f(int region, word nbytes) #ifdef MultiProgram reserve_macro(reserve_0,0,0) reserve_macro(reserve_1,E_TenureString,E_TenureBlock) -#else /* MultiProgram */ +#else /* MultiProgram */ reserve_macro(reserve,0,0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef Concurrent @@ -1415,38 +1415,38 @@ struct region **p_public; /* pointer to the head of the list*/ curr_private->Tprev = curr_public->Tprev; if (curr_public->Tnext){ - curr_private->Tnext->Tprev = curr_private; - curr_public->Tnext = NULL; - if (curr_public->Tprev){ /* middle node*/ - curr_private->Tprev->Tnext = curr_private; - curr_public->Tprev = NULL; - } - else - *p_public = curr_private; - } + curr_private->Tnext->Tprev = curr_private; + curr_public->Tnext = NULL; + if (curr_public->Tprev){ /* middle node*/ + curr_private->Tprev->Tnext = curr_private; + curr_public->Tprev = NULL; + } + else + *p_public = curr_private; + } else if (curr_public->Tprev){ - curr_private->Tprev->Tnext = curr_private; - curr_public->Tprev = NULL; - } + curr_private->Tprev->Tnext = curr_private; + curr_public->Tprev = NULL; + } else - *p_public = curr_private; - } - else { /* NO SWAP: some thread is giving up his heap. - Just insert curr_private into the public heap. */ - curr_private->Tprev=NULL; - if (*p_public==NULL) - curr_private->Tnext=NULL; - else{ - curr_private->Tnext=*p_public; - curr_private->Tnext->Tprev=curr_private; - } - *p_public=curr_private; - return NULL; + *p_public = curr_private; + } + else { /* NO SWAP: some thread is giving up his heap. + Just insert curr_private into the public heap. */ + curr_private->Tprev=NULL; + if (*p_public==NULL) + curr_private->Tnext=NULL; + else{ + curr_private->Tnext=*p_public; + curr_private->Tnext->Tprev=curr_private; + } + *p_public=curr_private; + return NULL; } - + return curr_public; } -#endif /* Concurrent */ +#endif /* Concurrent */ /* * findgap - search region chain for a region having at least nbytes available @@ -1456,22 +1456,22 @@ static struct region *findgap(curr_private, nbytes, region) struct region *curr_private; word nbytes; int region; -#else /* Concurrent */ +#else /* Concurrent */ static struct region *findgap(curr, nbytes) struct region *curr; word nbytes; -#endif /* Concurrent */ +#endif /* Concurrent */ { struct region *rp; - + #ifdef Concurrent if (region == Strings){ MUTEX_LOCKID_CONTROLLED(MTX_PUBLICSTRHEAP); for (rp = public_stringregion; rp; rp = rp->Tnext) if (DiffPtrs(rp->end, rp->free) >= nbytes && rp->size>=curr_private->size/2) break; - - if (rp) + + if (rp) rp=swap2publicheap(curr_private, rp, &public_stringregion); MUTEX_UNLOCKID(MTX_PUBLICSTRHEAP); } @@ -1480,14 +1480,14 @@ word nbytes; for (rp = public_blockregion; rp; rp = rp->Tnext) if (DiffPtrs(rp->end, rp->free) >= nbytes && rp->size>=curr_private->size/2) break; - - if (rp) + + if (rp) rp=swap2publicheap(curr_private, rp, &public_blockregion); MUTEX_UNLOCKID(MTX_PUBLICBLKHEAP); } return rp; -#else /* Concurrent */ +#else /* Concurrent */ /* With ThreadHeap, skip this, we know we are at the front of the list */ for (rp = curr; rp; rp = rp->prev) if (DiffPtrs(rp->end, rp->free) >= nbytes) @@ -1496,9 +1496,9 @@ word nbytes; if (DiffPtrs(rp->end, rp->free) >= nbytes) return rp; return NULL; -#endif /* Concurrent */ +#endif /* Concurrent */ } - + /* * newregion - try to malloc a new region and tenure the old one, * backing off if the requested size fails. @@ -1514,7 +1514,7 @@ word nbytes,stdsize; return NULL; if ((uword)stdsize > (uword)MaxBlock) stdsize = (uword)MaxBlock; -#endif /* IntBits == 16 */ +#endif /* IntBits == 16 */ if ((uword)nbytes > minSize) minSize = (uword)nbytes; @@ -1525,10 +1525,10 @@ word nbytes,stdsize; #if IntBits == 16 if ((rp->size < nbytes) && (nbytes < (unsigned int)MaxBlock)) rp->size = Min(nbytes+stdsize,(unsigned int)MaxBlock); -#else /* IntBits == 16 */ +#else /* IntBits == 16 */ if (rp->size < nbytes) rp->size = Max(nbytes+stdsize, nbytes); -#endif /* IntBits == 16 */ +#endif /* IntBits == 16 */ do { rp->free = rp->base = (char *)AllocReg(rp->size); @@ -1536,9 +1536,9 @@ word nbytes,stdsize; rp->end = rp->base + rp->size; rp->next = rp->prev = NULL; #ifdef Concurrent - rp->Tnext=NULL; - rp->Tprev=NULL; -#endif /* Concurrent */ + rp->Tnext=NULL; + rp->Tprev=NULL; +#endif /* Concurrent */ return rp; } rp->size = (rp->size + nbytes)/2 - 1; @@ -1577,4 +1577,4 @@ struct b_realarray *alcrealarray(uword n) return blk; } -#endif /* Arrays */ +#endif /* Arrays */ diff --git a/src/runtime/raudio.r b/src/runtime/raudio.r index 00a1d4f95..4a935fca1 100644 --- a/src/runtime/raudio.r +++ b/src/runtime/raudio.r @@ -11,7 +11,7 @@ * TODO: contemplate whether alcOpenDevice() and alcCreateContext() are needed. */ #ifdef Audio - + struct sSources { ALuint source; @@ -78,7 +78,7 @@ int GetIndex() if (pthread_mutex_lock(&mutex) != 0) return -1; for(i = 0; i < 16; ++i) { if (arraySource[i].inUse == 0) - break; + break; } if (i < 16) arraySource[i].inUse += 1; @@ -137,12 +137,12 @@ int audioDevice(int channels, int rate) waveformater.nChannels = (WORD)channels; waveformater.wBitsPerSample = 16; waveformater.nBlockAlign = (WORD)((waveformater.wBitsPerSample>>3) * - waveformater.nChannels); + waveformater.nChannels); waveformater.nSamplesPerSec = rate; waveformater.nAvgBytesPerSec = waveformater.nSamplesPerSec * waveformater.nBlockAlign; if (waveOutOpen(&hwave,WAVE_MAPPER,&waveformater,(DWORD_PTR)PlayCallback, - (DWORD_PTR)&bufferinfo,CALLBACK_FUNCTION) == + (DWORD_PTR)&bufferinfo,CALLBACK_FUNCTION) == MMSYSERR_NOERROR ){ /* should report the error more specifically somehow. &errno? */ return 0; @@ -199,7 +199,7 @@ DWORD WINAPI PlayOggVorbisWIN32(void * params) waveformater.wBitsPerSample > 1; if (audioDevice(arraySource[index]vorbinfo->channels, - arraySource[index].vorbinfo->rate)){ + arraySource[index].vorbinfo->rate)){ /* * Error setting up audio device; fail. */ @@ -213,36 +213,36 @@ DWORD WINAPI PlayOggVorbisWIN32(void * params) } while (1) { for (okay=false; !okay; ) { - EnterCriticalSection(&bufferinfo.criticalsection); - if (bufferinfo.nuseddwBufferLength=0; header->dwBufferLengthlpData+header->dwBufferLength, - buffersize - header->dwBufferLength, 0, 2, 1, - ¤t_section ) ) <= 0 ) { - break; - } - header->dwBufferLength += ret; - totprogress+=header->dwBufferLength; - } + long ret = 0; + if ((ret = ov_read( &arraySource[index].vorbinfo, + header->lpData+header->dwBufferLength, + buffersize - header->dwBufferLength, 0, 2, 1, + ¤t_section ) ) <= 0 ) { + break; + } + header->dwBufferLength += ret; + totprogress+=header->dwBufferLength; + } currentbuffer = (currentbuffer + 1)% nbuffers; waveOutWrite(hwave, header, sizeof(WAVEHDR)); if (header->dwBufferLength==0) { - break; - } + break; + } } for (okay=false; !okay; ) { @@ -250,7 +250,7 @@ DWORD WINAPI PlayOggVorbisWIN32(void * params) okay = (bufferinfo.nused==0); LeaveCriticalSection(&bufferinfo.criticalsection); if (!okay) - WaitForSingleObject( bufferinfo.huponfree, INFINITE ); + WaitForSingleObject( bufferinfo.huponfree, INFINITE ); } waveOutReset(hwave); @@ -276,56 +276,56 @@ DWORD WINAPI PlayOggVorbisWIN32(void * params) #endif /*#if WIN32 && HAVE_LIBOGG */ #if !defined(WIN32) && defined(HAVE_LIBOPENAL) - + #passthru #include #else - DWORD dwThreadId; - HANDLE hThread; + DWORD dwThreadId; + HANDLE hThread; #endif /*function pointer for LOKI extensions */ -ALfloat (*talcGetAudioChannel)(ALuint channel); -void (*talcSetAudioChannel)(ALuint channel, ALfloat volume); +ALfloat (*talcGetAudioChannel)(ALuint channel); +void (*talcSetAudioChannel)(ALuint channel, ALfloat volume); -void (*talMute)(void); -void (*talUnMute)(void); +void (*talMute)(void); +void (*talUnMute)(void); -void (*talReverbScale)(ALuint sid, ALfloat param); -void (*talReverbDelay)(ALuint sid, ALfloat param); -void (*talBombOnError)(void); +void (*talReverbScale)(ALuint sid, ALfloat param); +void (*talReverbDelay)(ALuint sid, ALfloat param); +void (*talBombOnError)(void); -void (*talBufferi)(ALuint bid, ALenum param, ALint value); +void (*talBufferi)(ALuint bid, ALenum param, ALint value); -typedef void (*tbwd)(ALuint bid, ALenum format, ALvoid *data, - ALint size, ALint freq, ALenum iFormat); -void (*talBufferWriteData)(ALuint bid, ALenum format, ALvoid *data, - ALint size, ALint freq, ALenum iFormat); +typedef void (*tbwd)(ALuint bid, ALenum format, ALvoid *data, + ALint size, ALint freq, ALenum iFormat); +void (*talBufferWriteData)(ALuint bid, ALenum format, ALvoid *data, + ALint size, ALint freq, ALenum iFormat); ALuint (*talBufferAppendData)(ALuint bid, ALenum format, ALvoid *data, - ALint freq, ALint samples); + ALint freq, ALint samples); ALuint (*talBufferAppendWriteData)(ALuint bid, ALenum format, ALvoid *data, - ALint freq, ALint samples, - ALenum internalFormat); + ALint freq, ALint samples, + ALenum internalFormat); ALboolean (*alCaptureInit) ( ALenum format, ALuint rate, ALsizei bufferSize ); ALboolean (*alCaptureDestroy) ( void ); ALboolean (*alCaptureStart) ( void ); ALboolean (*alCaptureStop) ( void ); ALsizei (*alCaptureGetData) ( ALvoid* data, ALsizei n, ALenum format, - ALuint rate ); + ALuint rate ); /* new ones */ void (*talGenStreamingBuffers)(ALsizei n, ALuint *bids ); ALboolean (*talutLoadRAW_ADPCMData)(ALuint bid, - ALvoid *data, ALuint size, ALuint freq, - ALenum format); + ALvoid *data, ALuint size, ALuint freq, + ALenum format); ALboolean (*talutLoadIMA_ADPCMData)(ALuint bid, - ALvoid *data, ALuint size, ALuint freq, - ALenum format); + ALvoid *data, ALuint size, ALuint freq, + ALenum format); ALboolean (*talutLoadMS_ADPCMData)(ALuint bid, - ALvoid *data, ALuint size, ALuint freq, - ALenum format); + ALvoid *data, ALuint size, ALuint freq, + ALenum format); #define GP(x) alGetProcAddress((const ALchar *) x) @@ -346,7 +346,7 @@ void micro_sleep(unsigned int n) int fixup_function_pointers(void) { talcGetAudioChannel = (ALfloat (*)(ALuint channel)) - GP("alcGetAudioChannel_LOKI"); + GP("alcGetAudioChannel_LOKI"); if (talcGetAudioChannel == NULL) return 0; @@ -366,7 +366,7 @@ int fixup_function_pointers(void) */ return 0; } - talBufferi = (void (*)(ALuint, ALenum, ALint )) GP("alBufferi_LOKI"); + talBufferi = (void (*)(ALuint, ALenum, ALint )) GP("alBufferi_LOKI"); if (talBufferi == NULL) { /* * Could not GetProcAddress alBufferi_LOKI; fail. @@ -390,7 +390,7 @@ int fixup_function_pointers(void) talBufferAppendData = (ALuint (*)(ALuint, ALenum, ALvoid *, ALint, ALint)) GP("alBufferAppendData_LOKI"); talBufferAppendWriteData = (ALuint (*)(ALuint, ALenum, ALvoid *, ALint, - ALint, ALenum)) + ALint, ALenum)) GP("alBufferAppendWriteData_LOKI"); talGenStreamingBuffers = (void (*)(ALsizei n, ALuint *bids )) @@ -402,45 +402,45 @@ int fixup_function_pointers(void) return 0; } /* talutLoadRAW_ADPCMData = (ALboolean (*)(ALuint bid,ALvoid *data, - ALuint size, ALuint freq, - ALenum format)) + ALuint size, ALuint freq, + ALenum format)) GP("alutLoadRAW_ADPCMData_LOKI"); if (talutLoadRAW_ADPCMData == NULL) { - * + * * Could not GP alutLoadRAW_ADPCMData_LOKI; fail. * - return 0; + return 0; } talutLoadIMA_ADPCMData = (ALboolean (*)(ALuint bid,ALvoid *data, - ALuint size, ALuint freq, - ALenum format)) + ALuint size, ALuint freq, + ALenum format)) GP("alutLoadIMA_ADPCMData_LOKI"); if (talutLoadIMA_ADPCMData == NULL) { - * + * * Could not GP alutLoadIMA_ADPCMData_LOKI; fail. * - return 0; + return 0; } talutLoadMS_ADPCMData = (ALboolean (*)(ALuint bid,ALvoid *data, ALuint size, - ALuint freq,ALenum format)) + ALuint freq,ALenum format)) GP("alutLoadMS_ADPCMData_LOKI"); if( talutLoadMS_ADPCMData == NULL ) { - * + * * Could not GP alutLoadMS_ADPCMData_LOKI; fail. * - return 0; + return 0; } */ return 1; } -#endif /* HAVE_LIBOPENAL */ +#endif /* HAVE_LIBOPENAL */ #if defined(HAVE_LIBOPENAL) && defined(HAVE_LIBSDL) && defined(HAVE_LIBSMPEG) /* The following is for MP3 Support on top of OpenAL */ -#define DATABUFSIZE_MP3 (8 * 4098) -#define MP3_FUNC "alutLoadMP3_LOKI" +#define DATABUFSIZE_MP3 (8 * 4098) +#define MP3_FUNC "alutLoadMP3_LOKI" /* our mp3 extension */ typedef ALboolean (mp3Loader)(ALuint, ALvoid *, ALint); @@ -449,7 +449,7 @@ mp3Loader *alutLoadMP3p = NULL; static void initMP3( int index ) { alSourceQueueBuffers(arraySource[index].source, 1, - &(arraySource[index].mBuffer )); + &(arraySource[index].mBuffer )); alSourcei( arraySource[index].source, AL_LOOPING, AL_FALSE ); return; } @@ -548,7 +548,7 @@ void * OpenAL_PlayMP3( void * args ) #if defined(HAVE_LIBOPENAL) && defined(HAVE_LIBOGG) /* The following is for Ogg-Vorbis Support on top of OpenAL*/ -#define DATABUFSIZE (4096 * 16) +#define DATABUFSIZE (4096 * 16) /* * OggStreamBuf - read a buffer's worth of data from our Ogg stream. @@ -566,14 +566,14 @@ int OggStreamBuf(ALuint buffer, int index) size = 0; while (size < DATABUFSIZE) { result = ov_read(&arraySource[index].oggStream, pcm + size, - DATABUFSIZE - size, 0, 2, 1, §ion); + DATABUFSIZE - size, 0, 2, 1, §ion); if (result > 0) { size += result; - } + } else if (result < 0) { return 1; - } + } else break; } @@ -584,7 +584,7 @@ int OggStreamBuf(ALuint buffer, int index) active = 0; } alBufferData(buffer, arraySource[index].format, pcm, size, - arraySource[index].vorbisInfo->rate); + arraySource[index].vorbisInfo->rate); return active; } @@ -607,18 +607,18 @@ int OggPlayback(int index) else { /* some data, support up to 4 buffers */ arraySource[index].numBuffers++; if(OggStreamBuf(arraySource[index].buffer[1], index) != 1) { - arraySource[index].numBuffers++; - if(OggStreamBuf(arraySource[index].buffer[2], index) != 1) { - arraySource[index].numBuffers++; - if(OggStreamBuf(arraySource[index].buffer[3], index) != 1) { - arraySource[index].numBuffers++; - } - } - } + arraySource[index].numBuffers++; + if(OggStreamBuf(arraySource[index].buffer[2], index) != 1) { + arraySource[index].numBuffers++; + if(OggStreamBuf(arraySource[index].buffer[3], index) != 1) { + arraySource[index].numBuffers++; + } + } + } } alSourceQueueBuffers(arraySource[index].source, arraySource[index].numBuffers, - arraySource[index].buffer); + arraySource[index].buffer); alSourcePlay(arraySource[index].source); return 0; } @@ -671,15 +671,15 @@ void * OpenAL_PlayOgg(void * args) case OV_EVERSION: /* vorbis version mismatch */ case OV_EBADHEADER: /* bad vorbis bitstream header */ case OV_EFAULT: /* internal logic fault */ - ; - } + ; + } if (pthread_mutex_lock(&mutex) == 0) { - ov_clear(&arraySource[i].oggStream); - isPlaying -= 1; - arraySource[i].inUse -= 1; - pthread_mutex_unlock(&mutex); - } + ov_clear(&arraySource[i].oggStream); + isPlaying -= 1; + arraySource[i].inUse -= 1; + pthread_mutex_unlock(&mutex); + } pthread_exit(NULL); } arraySource[i].vorbisInfo = ov_info(&(arraySource[i].oggStream), -1); @@ -697,8 +697,8 @@ void * OpenAL_PlayOgg(void * args) } while(OggUpdate(i) == 0) { if(OggPlayback(i) == 1) { - goto errfail; - } + goto errfail; + } sleep(2); } errfail: @@ -706,7 +706,7 @@ void * OpenAL_PlayOgg(void * args) pthread_exit(NULL); } -#endif /* #if(HAVE_LIBOPENAL && HAVE_LIBOGG)*/ +#endif /* #if(HAVE_LIBOPENAL && HAVE_LIBOGG)*/ #ifdef HAVE_LIBOPENAL @@ -731,7 +731,7 @@ void * OpenAL_PlayWAV(void * args) arraySource[indexSource].wBuffer = alutCreateBufferFromFile(arraySource[indexSource].filename); alSourceQueueBuffers(arraySource[indexSource].source, 1, - &arraySource[indexSource].wBuffer); + &arraySource[indexSource].wBuffer); alSourcePlay(arraySource[indexSource].source); alGetSourcei(arraySource[indexSource].source, AL_SOURCE_STATE, &tState); while(tState == AL_PLAYING) { @@ -766,7 +766,7 @@ int StartAudioThread(char filename[]) alGenBuffers(1, &arraySource[i].mBuffer); alGenBuffers(1, &arraySource[i].wBuffer); arraySource[i].inUse = 0; - } + } isPlaying = 0; } if (pthread_mutex_unlock(&mutex) != 0) return -1; @@ -774,7 +774,7 @@ int StartAudioThread(char filename[]) while (isSet != 0) sleep(1); if ((i = GetIndex()) < 0) return -1; - + isSet = 1; gIndex = i; strcpy(arraySource[i].filename, filename); @@ -785,58 +785,58 @@ int StartAudioThread(char filename[]) #if defined(HAVE_LIBOPENAL) && defined(HAVE_LIBSDL) && defined(HAVE_LIBSMPEG) #ifndef WIN32 if (pthread_create(&arraySource[i].thread, &attrib, OpenAL_PlayMP3,NULL)){ - goto errfail; - } + goto errfail; + } return i; -#else /* !WIN32 */ +#else /* !WIN32 */ /* WIN32 : MP3 is not implemented yet */ goto errfail; -#endif /* !WIN32 */ -#else /* HAVE_LIBOPENAL && ... */ +#endif /* !WIN32 */ +#else /* HAVE_LIBOPENAL && ... */ goto errfail; -#endif /* HAVE_LIBOPENAL && ... */ - } +#endif /* HAVE_LIBOPENAL && ... */ + } else if ((strptr = strstr(filename,".ogg")) != NULL) { -#if defined(HAVE_LIBOGG) +#if defined(HAVE_LIBOGG) #ifndef WIN32 - if (pthread_create(&arraySource[i].thread, &attrib, - OpenAL_PlayOgg, NULL)) { - goto errfail; - } -#else /* !WIN32 */ - arraySource[i].hThread = - CreateThread(NULL, 0, PlayOggVorbisWIN32, NULL, 0, &dwThreadId); - if (arraySouce[i].hThread == NULL) { - goto errfail; - } -#endif /* !WIN32 */ - return i; -#else /* HAVE_LIBOGG */ - goto errfail; -#endif /* HAVE_LIBOGG */ - } + if (pthread_create(&arraySource[i].thread, &attrib, + OpenAL_PlayOgg, NULL)) { + goto errfail; + } +#else /* !WIN32 */ + arraySource[i].hThread = + CreateThread(NULL, 0, PlayOggVorbisWIN32, NULL, 0, &dwThreadId); + if (arraySouce[i].hThread == NULL) { + goto errfail; + } +#endif /* !WIN32 */ + return i; +#else /* HAVE_LIBOGG */ + goto errfail; +#endif /* HAVE_LIBOGG */ + } if((strptr = strstr(filename,".wav")) != NULL){ #ifdef HAVE_LIBOPENAL #ifndef WIN32 - if (pthread_create(&arraySource[i].thread, &attrib, - OpenAL_PlayWAV, NULL)) { - goto errfail; - } - return i; -#else /* !WIN32 */ - /* WIN32 : WAV is not implemented yet, you can use WinPlayMedia() */ - return -1; -#endif /* !WIN32 */ + if (pthread_create(&arraySource[i].thread, &attrib, + OpenAL_PlayWAV, NULL)) { + goto errfail; + } + return i; +#else /* !WIN32 */ + /* WIN32 : WAV is not implemented yet, you can use WinPlayMedia() */ + return -1; +#endif /* !WIN32 */ #else - goto errfail; + goto errfail; #endif - } + } errfail: if (pthread_mutex_lock(&mutex) == 0) { arraySource[i].inUse -= 1; - pthread_mutex_unlock(&mutex); + pthread_mutex_unlock(&mutex); } isSet = 0; return -1; @@ -848,7 +848,7 @@ void StopAudioThread(int index) if (index < 0 || index > 15) return; pthread_mutex_lock(&mutex); - if (arraySource[index].inUse > 0) + if (arraySource[index].inUse > 0) { isPlaying -= 1;; arraySource[index].inUse -= 1; @@ -865,8 +865,8 @@ void StopAudioThread(int index) /* * audio mixer - * Windows 32: Based on Windows Multimedia -lwinmm - * Linux : Based on the OSS APIs + * Windows 32: Based on Windows Multimedia -lwinmm + * Linux : Based on the OSS APIs * Author : Ziad Al-Sharif, zsharif@cs.uidaho.edu * Date : April 1, 2006 */ @@ -907,13 +907,13 @@ int OpenMixer() /* open mixer, read only */ mixer_fd = open("/dev/mixer", O_RDONLY); - if (mixer_fd == -1) { + if (mixer_fd == -1) { /* unable to open /dev/mixer */ return mixer_fd; } /* get needed information about the mixer */ - if ( ioctl(mixer_fd, SOUND_MIXER_READ_DEVMASK, &devmask) == -1 ) + if ( ioctl(mixer_fd, SOUND_MIXER_READ_DEVMASK, &devmask) == -1 ) return -1; /* ioctl failed */ if ( ioctl(mixer_fd, SOUND_MIXER_READ_STEREODEVS, &stereodevs) == -1) @@ -940,15 +940,15 @@ int CloseMixer() int SetMixerAttribute(char *dev, int value) { - int left, right, level; /* gain settings */ - int device; /* which mixer device to set */ - int i; /* general purpose loop counter */ + int left, right, level; /* gain settings */ + int device; /* which mixer device to set */ + int i; /* general purpose loop counter */ /* figure out which device to use */ for (i = 0 ; i < SOUND_MIXER_NRDEVICES ; i++) if (((1 << i) & devmask) && !strcmp(dev, sound_device_names[i])) - break; - if (i == SOUND_MIXER_NRDEVICES) { /* didn't find a match */ + break; + if (i == SOUND_MIXER_NRDEVICES) { /* didn't find a match */ /* "dev" is not a valid mixer device */ return -1; } @@ -982,14 +982,14 @@ int SetMixerAttribute(char *dev, int value) int GetMixerAttribute(char * dev) { int left, right, level; /* gain settings */ - int device; /* which mixer device to set */ - int i; /* general purpose loop counter */ + int device; /* which mixer device to set */ + int i; /* general purpose loop counter */ /* figure out which device to use */ for (i = 0 ; i < SOUND_MIXER_NRDEVICES ; i++) if (((1 << i) & devmask) && !strcmp(dev, sound_device_names[i])) - break; - if (i == SOUND_MIXER_NRDEVICES) { + break; + if (i == SOUND_MIXER_NRDEVICES) { /* didn't find a match */ /* dev is not a valid mixer device */ return -1; @@ -999,14 +999,14 @@ int GetMixerAttribute(char * dev) if ((1 << i) & stereodevs) { if (ioctl(mixer_fd, MIXER_READ(device), &level) == -1) - return -1; /* ioctl failed */ + return -1; /* ioctl failed */ left = level & 0xff; right = (level & 0xff00) >> 8; level = (left + right) / 2; } else { /* only one channel */ if (ioctl(mixer_fd, MIXER_READ(device), &level) == -1) - return -1; /* ioctl failed */ + return -1; /* ioctl failed */ level = level & 0xff; } return level; @@ -1024,48 +1024,48 @@ int LinuxMixer(char * cmd) /* cmd: eg. "vol=50" */ /*----------------parse cmd; */ p = strchr(cmd,'='); if (p != NULL) { /* cmd: "cmd=ival" */ - strptr = cmd; - while (strptr != p) cmdsVal[i++] = *strptr++; - cmdsVal[i] = '\0'; - i=0; - while(*++p != '\0') val[i++] = *p; - val[i] = '\0'; - cmdiVal = atoi(val); - } + strptr = cmd; + while (strptr != p) cmdsVal[i++] = *strptr++; + cmdsVal[i] = '\0'; + i=0; + while(*++p != '\0') val[i++] = *p; + val[i] = '\0'; + cmdiVal = atoi(val); + } else /* cmd: "cmd" */ - strcat(cmdsVal,cmd); + strcat(cmdsVal,cmd); /*----------------*/ if ( !strcmp(cmdsVal,"wave")) - strcpy(cmdsVal,"pcm"); + strcpy(cmdsVal,"pcm"); /*----------------*/ if (cmdiVal > -1){ - if ( !strcmp(cmdsVal,"mic")){ - SetMixerAttribute(cmdsVal, cmdiVal); - return SetMixerAttribute("igain", cmdiVal); - } - else - if ( !strcmp(cmdsVal,"phone")){ - SetMixerAttribute("phin", cmdiVal); /* phin: is phone */ - /* phout: is Master Mono */ - return SetMixerAttribute("phout", cmdiVal); - } - else - return SetMixerAttribute(cmdsVal, cmdiVal); - } + if ( !strcmp(cmdsVal,"mic")){ + SetMixerAttribute(cmdsVal, cmdiVal); + return SetMixerAttribute("igain", cmdiVal); + } + else + if ( !strcmp(cmdsVal,"phone")){ + SetMixerAttribute("phin", cmdiVal); /* phin: is phone */ + /* phout: is Master Mono */ + return SetMixerAttribute("phout", cmdiVal); + } + else + return SetMixerAttribute(cmdsVal, cmdiVal); + } else { - if (!strcmp(cmdsVal,"mic")){ - GetMixerAttribute(cmdsVal); - return GetMixerAttribute("igain"); - } - if (!strcmp(cmdsVal,"phone")){ - GetMixerAttribute("phin"); /* phin: is phone */ - return GetMixerAttribute("phout"); /* phout: is Master Mono */ - } - else - return GetMixerAttribute(cmdsVal); - } + if (!strcmp(cmdsVal,"mic")){ + GetMixerAttribute(cmdsVal); + return GetMixerAttribute("igain"); + } + if (!strcmp(cmdsVal,"phone")){ + GetMixerAttribute("phin"); /* phin: is phone */ + return GetMixerAttribute("phout"); /* phout: is Master Mono */ + } + else + return GetMixerAttribute(cmdsVal); + } } return -1; } @@ -1082,7 +1082,7 @@ int numlines=0; MIXERLINE * mxl_List[256]={NULL}; int VolumeDevmask[256]; int MuteDevmask[256]; -#define mxfactr 655.35 +#define mxfactr 655.35 /*void print_NameValue(int device);*/ void Clear(); @@ -1103,7 +1103,7 @@ void Clear() int i; for (i=0; i< numlines; ++i) { if(mxl_List[i] != NULL) - free(mxl_List[i]); + free(mxl_List[i]); VolumeDevmask[numlines] = -1; MuteDevmask[numlines] = -1; } @@ -1131,10 +1131,10 @@ int CloseMixer() { if (hmix != NULL) if(mixerClose(hmix) == MMSYSERR_NOERROR){ - hmix = NULL; - Clear(); - return 1; - } + hmix = NULL; + Clear(); + return 1; + } return -1; } @@ -1145,8 +1145,8 @@ int CloseMixer() int GetAllMixerLinesInfo() { unsigned int i,k,num; - MIXERLINE *pmxl; - MMRESULT res; + MIXERLINE *pmxl; + MMRESULT res; MIXERCAPS mxcaps; numlines=0; if (!opened) @@ -1160,34 +1160,34 @@ int GetAllMixerLinesInfo() pmxl->cbStruct = sizeof(MIXERLINE); pmxl->dwDestination = i; res = mixerGetLineInfo((HMIXEROBJ)hmix, pmxl, - MIXER_GETLINEINFOF_DESTINATION); + MIXER_GETLINEINFOF_DESTINATION); if (res == MMSYSERR_NOERROR){ - num = pmxl->cConnections; - /*---*/ - mxl_List[numlines]=pmxl; - VolumeDevmask[numlines]= -1; - MuteDevmask[numlines] = -1; - numlines++; - /*---*/ - for (k = 0 ; k < num ; k++){ - pmxl= (MIXERLINE*)malloc(sizeof(MIXERLINE)); + num = pmxl->cConnections; + /*---*/ + mxl_List[numlines]=pmxl; + VolumeDevmask[numlines]= -1; + MuteDevmask[numlines] = -1; + numlines++; + /*---*/ + for (k = 0 ; k < num ; k++){ + pmxl= (MIXERLINE*)malloc(sizeof(MIXERLINE)); if (pmxl == NULL) return -1; - pmxl->cbStruct = sizeof(MIXERLINE); - pmxl->dwDestination = i; - pmxl->dwSource = k; - res = mixerGetLineInfo((HMIXEROBJ)hmix, pmxl, - MIXER_GETLINEINFOF_SOURCE); - if (res == MMSYSERR_NOERROR){ - /*---*/ - mxl_List[numlines]=pmxl; - VolumeDevmask[numlines]= -1; - MuteDevmask[numlines] = -1; - numlines++; - /*---*/ - } - else free(pmxl); - } - } else free(pmxl); + pmxl->cbStruct = sizeof(MIXERLINE); + pmxl->dwDestination = i; + pmxl->dwSource = k; + res = mixerGetLineInfo((HMIXEROBJ)hmix, pmxl, + MIXER_GETLINEINFOF_SOURCE); + if (res == MMSYSERR_NOERROR){ + /*---*/ + mxl_List[numlines]=pmxl; + VolumeDevmask[numlines]= -1; + MuteDevmask[numlines] = -1; + numlines++; + /*---*/ + } + else free(pmxl); + } + } else free(pmxl); } loaded = 1; return 1; @@ -1196,7 +1196,7 @@ int GetAllMixerLinesInfo() int GetAllMixerLinesVolume() { unsigned int i; - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1219,27 +1219,27 @@ int GetAllMixerLinesVolume() mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix, &mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if ( res != MMSYSERR_NOERROR){ - VolumeDevmask[i] = -1; - } + VolumeDevmask[i] = -1; + } else { - mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); - mxcd.dwControlID = mxc.dwControlID; - mxcd.cChannels = 1; - mxcd.cMultipleItems = 0; - mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); - mxcd.paDetails = &mxcdVolume; - res = mixerGetControlDetails((HMIXEROBJ)hmix,&mxcd, - MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); - if( res != MMSYSERR_NOERROR){ - VolumeDevmask[i] = -1; - } - else { - dwVal = mxcdVolume.dwValue; - VolumeDevmask[i] = dwVal; - } - } + mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); + mxcd.dwControlID = mxc.dwControlID; + mxcd.cChannels = 1; + mxcd.cMultipleItems = 0; + mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); + mxcd.paDetails = &mxcdVolume; + res = mixerGetControlDetails((HMIXEROBJ)hmix,&mxcd, + MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); + if( res != MMSYSERR_NOERROR){ + VolumeDevmask[i] = -1; + } + else { + dwVal = mxcdVolume.dwValue; + VolumeDevmask[i] = dwVal; + } + } } loaded = 1; return dwVal; @@ -1247,7 +1247,7 @@ int GetAllMixerLinesVolume() int GetMixerLineVolume(unsigned int i) { - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1257,9 +1257,9 @@ int GetMixerLineVolume(unsigned int i) if (!opened) return -1; - /* res = mixerGetDevCaps(mixid,&mxcaps,sizeof(MIXERCAPS)); */ - /* if(res != MMSYSERR_NOERROR) */ - /* return -1; */ + /* res = mixerGetDevCaps(mixid,&mxcaps,sizeof(MIXERCAPS)); */ + /* if(res != MMSYSERR_NOERROR) */ + /* return -1; */ /* get dwControlID */ mxlc.cbStruct = sizeof(MIXERLINECONTROLS); @@ -1269,7 +1269,7 @@ int GetMixerLineVolume(unsigned int i) mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if ( res != MMSYSERR_NOERROR){ VolumeDevmask[i] = -1; } @@ -1281,14 +1281,14 @@ int GetMixerLineVolume(unsigned int i) mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); mxcd.paDetails = &mxcdVolume; res = mixerGetControlDetails((HMIXEROBJ)hmix,&mxcd,MIXER_OBJECTF_HMIXER | - MIXER_GETCONTROLDETAILSF_VALUE); + MIXER_GETCONTROLDETAILSF_VALUE); if (res != MMSYSERR_NOERROR){ - VolumeDevmask[i] = -1; - } + VolumeDevmask[i] = -1; + } else { - dwVal = mxcdVolume.dwValue; - VolumeDevmask[i] = dwVal; - } + dwVal = mxcdVolume.dwValue; + VolumeDevmask[i] = dwVal; + } } loaded = 1; return dwVal; @@ -1297,7 +1297,7 @@ int GetMixerLineVolume(unsigned int i) int SetAllMixerLinesVolume(DWORD Volume) { unsigned int i; - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1320,27 +1320,27 @@ int SetAllMixerLinesVolume(DWORD Volume) mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc,MIXER_OBJECTF_HMIXER | - MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_GETLINECONTROLSF_ONEBYTYPE); if ( res != MMSYSERR_NOERROR){ - VolumeDevmask[i] = -1; - } + VolumeDevmask[i] = -1; + } else { - mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); - mxcd.dwControlID = mxc.dwControlID; - mxcd.cChannels = 1; - mxcd.cMultipleItems = 0; - mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); - mxcd.paDetails = &mxcdVolume; - res = mixerSetControlDetails((HMIXEROBJ)hmix,&mxcd, - MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); - if (res != MMSYSERR_NOERROR) { - VolumeDevmask[i] = -1; - } - else { - dwVal = mxcdVolume.dwValue; - VolumeDevmask[i] = dwVal; - } - } + mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); + mxcd.dwControlID = mxc.dwControlID; + mxcd.cChannels = 1; + mxcd.cMultipleItems = 0; + mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); + mxcd.paDetails = &mxcdVolume; + res = mixerSetControlDetails((HMIXEROBJ)hmix,&mxcd, + MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); + if (res != MMSYSERR_NOERROR) { + VolumeDevmask[i] = -1; + } + else { + dwVal = mxcdVolume.dwValue; + VolumeDevmask[i] = dwVal; + } + } } loaded = 1; return dwVal; @@ -1371,7 +1371,7 @@ int SetMixerLineVolume(unsigned int i, DWORD Volume) mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if (res != MMSYSERR_NOERROR) { VolumeDevmask[i] = -1; } @@ -1383,14 +1383,14 @@ int SetMixerLineVolume(unsigned int i, DWORD Volume) mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED); mxcd.paDetails = &mxcdVolume; res = mixerSetControlDetails((HMIXEROBJ)hmix,&mxcd,MIXER_OBJECTF_HMIXER | - MIXER_GETCONTROLDETAILSF_VALUE); + MIXER_GETCONTROLDETAILSF_VALUE); if (res != MMSYSERR_NOERROR) { - VolumeDevmask[i] = -1; - } + VolumeDevmask[i] = -1; + } else { - dwVal = mxcdVolume.dwValue; - VolumeDevmask[i] = dwVal; - } + dwVal = mxcdVolume.dwValue; + VolumeDevmask[i] = dwVal; + } } loaded = 1; return dwVal; @@ -1399,7 +1399,7 @@ int SetMixerLineVolume(unsigned int i, DWORD Volume) int GetAllMixerLinesMuteState() { unsigned int i; - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1422,27 +1422,27 @@ int GetAllMixerLinesMuteState() mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if (res != MMSYSERR_NOERROR) { - MuteDevmask[i] = -1; - } + MuteDevmask[i] = -1; + } else { - mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); - mxcd.dwControlID = mxc.dwControlID; - mxcd.cChannels = 1; - mxcd.cMultipleItems = 0; - mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_BOOLEAN); /* new */ - mxcd.paDetails = &mxcdMute; - res = mixerGetControlDetails((HMIXEROBJ)hmix,&mxcd, - MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); - if (res != MMSYSERR_NOERROR) { - MuteDevmask[i] = -1; - } - else { - dwVal = mxcdMute.fValue; - MuteDevmask[i] = dwVal; - } - } + mxcd.cbStruct = sizeof(MIXERCONTROLDETAILS); + mxcd.dwControlID = mxc.dwControlID; + mxcd.cChannels = 1; + mxcd.cMultipleItems = 0; + mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_BOOLEAN); /* new */ + mxcd.paDetails = &mxcdMute; + res = mixerGetControlDetails((HMIXEROBJ)hmix,&mxcd, + MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); + if (res != MMSYSERR_NOERROR) { + MuteDevmask[i] = -1; + } + else { + dwVal = mxcdMute.fValue; + MuteDevmask[i] = dwVal; + } + } } loaded = 1; return dwVal; @@ -1450,7 +1450,7 @@ int GetAllMixerLinesMuteState() int GetMixerLineMuteState(unsigned int i) { - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1472,7 +1472,7 @@ int GetMixerLineMuteState(unsigned int i) mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if ( res != MMSYSERR_NOERROR){ MuteDevmask[i] = -1; } @@ -1484,14 +1484,14 @@ int GetMixerLineMuteState(unsigned int i) mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_BOOLEAN); /*new */ mxcd.paDetails = &mxcdMute; res = mixerGetControlDetails((HMIXEROBJ)hmix, &mxcd, - MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); + MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); if (res != MMSYSERR_NOERROR) { - MuteDevmask[i] = -1; - } + MuteDevmask[i] = -1; + } else { - dwVal = mxcdMute.fValue; - MuteDevmask[i] = dwVal; - } + dwVal = mxcdMute.fValue; + MuteDevmask[i] = dwVal; + } } loaded = 1; return dwVal; @@ -1500,7 +1500,7 @@ int GetMixerLineMuteState(unsigned int i) /* Val=[0|1], 1 means MUTE=ON, 0 means Mute=OFF */ int SetMixerLineMuteState(unsigned int i, LONG Val) { - MMRESULT res; + MMRESULT res; MIXERCAPS mxcaps; MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; @@ -1522,7 +1522,7 @@ int SetMixerLineMuteState(unsigned int i, LONG Val) mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; res = mixerGetLineControls((HMIXEROBJ)hmix,&mxlc, - MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); + MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE); if (res != MMSYSERR_NOERROR) { MuteDevmask[i] = -1; } @@ -1534,14 +1534,14 @@ int SetMixerLineMuteState(unsigned int i, LONG Val) mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_BOOLEAN); /* new */ mxcd.paDetails = &mxcdMute; res = mixerSetControlDetails((HMIXEROBJ)hmix, &mxcd, - MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); + MIXER_OBJECTF_HMIXER | MIXER_GETCONTROLDETAILSF_VALUE); if (res != MMSYSERR_NOERROR) { - MuteDevmask[i] = -1; - } + MuteDevmask[i] = -1; + } else { - dwVal = mxcdMute.fValue; - MuteDevmask[i] = dwVal; - } + dwVal = mxcdMute.fValue; + MuteDevmask[i] = dwVal; + } } loaded = 1; return dwVal; @@ -1558,58 +1558,58 @@ int WinMixer(char * cmd) /* cmd: eg. "vol=50" */ "Volume Contro","Wave","SW Synth","Telephone","PC Speaker", "CD Audio","Line In","Microphone","IIS","Phone Line"}; char * attribs[10] = {"vol","wave","synth","telephone","speaker", - "cd","line","mic","iis","phoneline"}; + "cd","line","mic","iis","phoneline"}; if (MixInitialize()) { /*----------------parse cmd */ p = strchr(cmd,'='); if (p != NULL){ /* cmd: "cmd=ival" */ - strptr=cmd; - while(strptr != p) cmdsVal[i++]=*strptr++; - cmdsVal[i]='\0'; - i=0; - while(*++p != '\0') val[i++]=*p; - val[i]='\0'; - cmdiVal = atoi(val); - } + strptr=cmd; + while(strptr != p) cmdsVal[i++]=*strptr++; + cmdsVal[i]='\0'; + i=0; + while(*++p != '\0') val[i++]=*p; + val[i]='\0'; + cmdiVal = atoi(val); + } else /* cmd: "cmd" */ - strcat(cmdsVal,cmd); + strcat(cmdsVal,cmd); /*----------------*/ if( !strcmp(cmdsVal,"pcm")) - strcpy(cmdsVal,"wave"); + strcpy(cmdsVal,"wave"); if( !strcmp(cmdsVal,"phone")){ - strcpy(cmdsVal,"phoneline"); - i=9; - } + strcpy(cmdsVal,"phoneline"); + i=9; + } else - for(i=0; i < 10; ++i) - if(strstr(cmdsVal,attribs[i])){ - break; - } + for(i=0; i < 10; ++i) + if(strstr(cmdsVal,attribs[i])){ + break; + } if(i != 10){ - for(k=0; k < numlines; ++k){ - if (strstr(mxl_List[k]->szName,DevNames[i])) { - if(VolumeDevmask[k] != -1) - if(cmdiVal > -1){ - if(cmdiVal == 0){ /* do mute */ - SetMixerLineMuteState((unsigned int) k, - 1 /*(DWORD) cmdiVal*/); - return (int)(SetMixerLineVolume((unsigned int) k, - (DWORD)cmdiVal)/mxfactr); - } - else { /* do unmute */ - SetMixerLineMuteState((unsigned int) k, - 0 /*(DWORD) cmdiVal*/); - return (int)(SetMixerLineVolume((unsigned int) k, - (DWORD)cmdiVal) / mxfactr); - } - } - else { - return (int)(GetMixerLineVolume((unsigned int)k)/mxfactr); - } - } - } - } + for(k=0; k < numlines; ++k){ + if (strstr(mxl_List[k]->szName,DevNames[i])) { + if(VolumeDevmask[k] != -1) + if(cmdiVal > -1){ + if(cmdiVal == 0){ /* do mute */ + SetMixerLineMuteState((unsigned int) k, + 1 /*(DWORD) cmdiVal*/); + return (int)(SetMixerLineVolume((unsigned int) k, + (DWORD)cmdiVal)/mxfactr); + } + else { /* do unmute */ + SetMixerLineMuteState((unsigned int) k, + 0 /*(DWORD) cmdiVal*/); + return (int)(SetMixerLineVolume((unsigned int) k, + (DWORD)cmdiVal) / mxfactr); + } + } + else { + return (int)(GetMixerLineVolume((unsigned int)k)/mxfactr); + } + } + } + } } return -1; } @@ -1620,10 +1620,10 @@ int MixInitialize() if (OpenMixer() >= 0) { #ifdef WIN32 if (GetAllMixerLinesInfo() >= 0) - if (GetAllMixerLinesVolume() >= 0) - if (GetAllMixerLinesMuteState() >= 0){ - return 1; - } + if (GetAllMixerLinesVolume() >= 0) + if (GetAllMixerLinesMuteState() >= 0){ + return 1; + } #else return 1; #endif @@ -1637,4 +1637,4 @@ void MixUnInitialize() } #else /**/ -#endif /* Audio */ +#endif /* Audio */ diff --git a/src/runtime/rbgirsc.ri b/src/runtime/rbgirsc.ri index 4c5c05a1c..831b75851 100644 --- a/src/runtime/rbgirsc.ri +++ b/src/runtime/rbgirsc.ri @@ -15,7 +15,7 @@ wcp alc_context(wbp w) { GRFX_LINK(wc, wcntxts); return wc; } - + /* * allocate a window state structure */ diff --git a/src/runtime/rcoexpr.r b/src/runtime/rcoexpr.r index 12028c131..d2dee3963 100644 --- a/src/runtime/rcoexpr.r +++ b/src/runtime/rcoexpr.r @@ -8,27 +8,27 @@ */ #if !ConcurrentCOMPILER static continuation coexpr_fnc; -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ #ifdef Concurrent void tlschain_add(struct threadstate *tstate, struct b_coexpr *cp); void tlschain_remove(struct threadstate *tstate); -#define TRANSFER_KLEVEL(ncp, ccp) do { \ - if (IS_TS_SYNC(ncp->status) && ncp->program == ccp->program) { \ - if (ncp->tstate) \ - ncp->tstate->K_level = ccp->tstate->K_level; \ - else \ - ncp->tmplevel = ccp->tstate->K_level; \ - } \ +#define TRANSFER_KLEVEL(ncp, ccp) do { \ + if (IS_TS_SYNC(ncp->status) && ncp->program == ccp->program) { \ + if (ncp->tstate) \ + ncp->tstate->K_level = ccp->tstate->K_level; \ + else \ + ncp->tmplevel = ccp->tstate->K_level; \ + } \ } while (0) -#else /* Concurrent */ +#else /* Concurrent */ #define TRANSFER_KLEVEL(ncp, ccp) -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef PthreadCoswitch int pthreadcoswitch(struct b_coexpr *old, struct b_coexpr *new, word ostat, word nstat); -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ /* * co_init - use the contents of the refresh block to initialize the @@ -39,14 +39,14 @@ struct b_coexpr *sblkp; { #ifndef CoExpr syserr("co_init() called, but co-expressions not implemented"); -#else /* CoExpr */ +#else /* CoExpr */ register dptr dp, dsp; int na, nl, i; #if COMPILER int nt; #else register word *newsp; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Get pointer to refresh block. */ @@ -71,15 +71,15 @@ struct b_coexpr *sblkp; frame_size = sizeof(struct p_frame) + sizeof(struct descrip) * (nl + na + nt - 1) + rblkp->wrk_size; stack_strt = (word)((char *)&sblkp->pf + frame_size + StackAlign*WordSize); -#else /* UpStack */ +#else /* UpStack */ stack_strt = (word)((char *)sblkp + stksize - WordSize); -#endif /* UpStack */ +#endif /* UpStack */ sblkp->cstate[0] = stack_strt & ~(WordSize * StackAlign - 1); sblkp->es_argp = &sblkp->pf.t.d[nl + nt]; /* args follow temporaries */ } -#else /* COMPILER */ +#else /* COMPILER */ na = (rblkp->pfmkr).pf_nargs + 1; /* number of arguments */ nl = (int)rblkp->nlocals; /* number of locals */ @@ -89,7 +89,7 @@ struct b_coexpr *sblkp; * C stack starts at end of stack region on machines with down-growing C * stacks and somewhere in the middle of the region. * - * The C stack is aligned on a doubleword boundary. For up-growing + * The C stack is aligned on a doubleword boundary. For up-growing * stacks, the C stack starts in the middle of the stack portion * of the static block. For down-growing stacks, the C stack starts * at the last word of the static block. @@ -101,11 +101,11 @@ struct b_coexpr *sblkp; sblkp->cstate[0] = ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2) &~((word)WordSize*StackAlign-1)); -#else /* UpStack */ +#else /* UpStack */ sblkp->cstate[0] = - ((word)((char *)sblkp + stksize - WordSize) + ((word)((char *)sblkp + stksize - WordSize) &~((word)WordSize*StackAlign-1)); -#endif /* UpStack */ +#endif /* UpStack */ sblkp->es_argp = (dptr)newsp; /* args are first thing on stack */ #ifdef StackCheck @@ -113,8 +113,8 @@ struct b_coexpr *sblkp; sblkp->es_stackend = (word *) ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2) &~((word)WordSize*StackAlign-1)); -#endif /* StackCheck */ -#endif /* COMPILER */ +#endif /* StackCheck */ +#endif /* COMPILER */ /* * Copy arguments onto new stack. @@ -136,21 +136,21 @@ struct b_coexpr *sblkp; sblkp->pf.t.previous = NULL; sblkp->pf.t.num = nl + na + nt; sblkp->es_actstk = NULL; -#else /* COMPILER */ +#else /* COMPILER */ *((struct pf_marker *)dsp) = rblkp->pfmkr; sblkp->es_pfp = (struct pf_marker *)dsp; #ifdef PatternType if (!is_in_a_block_region((char *)(sblkp->es_pfp->pattern_cache)) || (sblkp->es_pfp->pattern_cache->title != T_Table)) sblkp->es_pfp->pattern_cache = NULL; -#endif /* PatternType */ +#endif /* PatternType */ sblkp->es_tend = NULL; dsp = (dptr)((word *)dsp + Vwsizeof(*pfp)); sblkp->es_ipc.opnd = rblkp->ep; sblkp->es_gfp = 0; sblkp->es_efp = 0; sblkp->es_ilevel = 0; -#endif /* COMPILER */ +#endif /* COMPILER */ sblkp->tvalloc = NULL; /* @@ -158,7 +158,7 @@ struct b_coexpr *sblkp; */ #if COMPILER dsp = sblkp->pf.t.d; -#endif /* COMPILER */ +#endif /* COMPILER */ for (i = 1; i <= nl; i++) *dsp++ = *dp++; @@ -168,7 +168,7 @@ struct b_coexpr *sblkp; */ for (i = 1; i <= nt; i++) *dsp++ = nulldesc; -#else /* COMPILER */ +#else /* COMPILER */ /* * Push two null descriptors on the stack. */ @@ -176,9 +176,9 @@ struct b_coexpr *sblkp; *dsp++ = nulldesc; sblkp->es_sp = (word *)dsp - 1; -#endif /* COMPILER */ +#endif /* COMPILER */ -#endif /* CoExpr */ +#endif /* CoExpr */ } /* @@ -193,7 +193,7 @@ int first; { #ifndef CoExpr syserr("co_chng() called, but co-expressions not implemented"); -#else /* CoExpr */ +#else /* CoExpr */ register struct b_coexpr *ccp; CURTSTATE_AND_CE(); @@ -202,8 +202,8 @@ int first; ccp = BlkD(k_current, Coexpr); #ifndef NativeCoswitch - /* - * We don't have Native co-expressions. If this is the first + /* + * We don't have Native co-expressions. If this is the first * activation for ncp create a thread for it. */ if (first == 0) @@ -217,34 +217,34 @@ int first; * A_MTEvent does not generate an event. */ case A_MTEvent: - break; + break; case A_Coact: EVValX(ncp,E_Coact); - if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { - curpstate->parent->eventsource.dword = D_Coexpr; - BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; - } - TRANSFER_KLEVEL(ncp, ccp); - break; + if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { + curpstate->parent->eventsource.dword = D_Coexpr; + BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; + } + TRANSFER_KLEVEL(ncp, ccp); + break; case A_Coret: EVValX(ncp,E_Coret); - if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { - curpstate->parent->eventsource.dword = D_Coexpr; - BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; - } - TRANSFER_KLEVEL(ncp, ccp); - break; + if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { + curpstate->parent->eventsource.dword = D_Coexpr; + BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; + } + TRANSFER_KLEVEL(ncp, ccp); + break; case A_Cofail: EVValX(ncp,E_Cofail); - if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { - curpstate->parent->eventsource.dword = D_Coexpr; - BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; - } - TRANSFER_KLEVEL(ncp, ccp); - break; + if (!is:null(curpstate->eventmask) && ncp->program == curpstate) { + curpstate->parent->eventsource.dword = D_Coexpr; + BlkLoc(curpstate->parent->eventsource) = (union block *)ncp; + } + TRANSFER_KLEVEL(ncp, ccp); + break; } -#endif /* MultiProgram */ -#endif /* COMPILER */ +#endif /* MultiProgram */ +#endif /* COMPILER */ /* * Determine if we need to transmit a value. @@ -253,49 +253,49 @@ int first; #if !COMPILER /* - * Determine if we need to dereference the transmitted value. + * Determine if we need to dereference the transmitted value. */ if (Var(*valloc)) retderef(valloc, (word *)glbl_argp, sp); -#endif /* COMPILER */ +#endif /* COMPILER */ #ifdef Concurrent if (IS_TS_ASYNC(ccp->status) && IS_TS_ASYNC(ncp->status)){ /* * The CE thread is genereating a new value, it should go into the outbox. - * ccp is the "k_current" CE. k_current is used to avoid invalid ccp - * because of GC. + * ccp is the "k_current" CE. k_current is used to avoid invalid ccp + * because of GC. */ - struct b_list *hp; - MUTEX_LOCKBLK_CONTROLLED(BlkD(ccp->outbox, List), "co_chng(): list mutex"); - hp = BlkD(BlkD(k_current,Coexpr)->outbox, List); - if (hp->size>=hp->max){ + struct b_list *hp; + MUTEX_LOCKBLK_CONTROLLED(BlkD(ccp->outbox, List), "co_chng(): list mutex"); + hp = BlkD(BlkD(k_current,Coexpr)->outbox, List); + if (hp->size>=hp->max){ hp->full++; while (hp->size>=hp->max){ - CV_SIGNAL_EMPTYBLK(hp); - DEC_NARTHREADS; - CV_WAIT_FULLBLK(hp); - INC_NARTHREADS_CONTROLLED; - hp = BlkD(BlkD(k_current,Coexpr)->outbox, List); - } - hp->full--; - } + CV_SIGNAL_EMPTYBLK(hp); + DEC_NARTHREADS; + CV_WAIT_FULLBLK(hp); + INC_NARTHREADS_CONTROLLED; + hp = BlkD(BlkD(k_current,Coexpr)->outbox, List); + } + hp->full--; + } c_put(&(BlkD(k_current,Coexpr)->outbox), valloc); - MUTEX_UNLOCKBLK(BlkD(BlkD(k_current,Coexpr)->outbox, List), "co_chng(): list mutex"); - CV_SIGNAL_EMPTYBLK(BlkD(BlkD(k_current,Coexpr)->outbox, List)); - if (IS_TS_THREAD(ccp->status) && - (swtch_typ == A_Coret || swtch_typ == A_Cofail)){ - /* + MUTEX_UNLOCKBLK(BlkD(BlkD(k_current,Coexpr)->outbox, List), "co_chng(): list mutex"); + CV_SIGNAL_EMPTYBLK(BlkD(BlkD(k_current,Coexpr)->outbox, List)); + if (IS_TS_THREAD(ccp->status) && + (swtch_typ == A_Coret || swtch_typ == A_Cofail)){ + /* * On return or fail, the thread is done and should exit - */ - #ifdef CoClean - coclean(ccp); - #endif /* CoClean */ + */ + #ifdef CoClean + coclean(ccp); + #endif /* CoClean */ } - return A_Continue; + return A_Continue; } else -#endif /* Concurrent */ +#endif /* Concurrent */ if (ncp->tvalloc != NULL) *ncp->tvalloc = *valloc; } @@ -303,20 +303,20 @@ int first; #ifdef Concurrent /* * exit if this is a returning/failing thread. - * May want to check/fix thread activator initialization + * May want to check/fix thread activator initialization * depending on desired join semantics. * coclean calls pthread_exit() in this case. */ if (IS_TS_THREAD(ccp->status) && #ifdef SoftThreads !IS_TS_SOFTTHREAD(ccp->status) && -#endif /* SoftThreads */ +#endif /* SoftThreads */ (swtch_typ == A_Coret || swtch_typ == A_Cofail)){ #ifdef CoClean - coclean(ccp); - #endif /* CoClean */ + coclean(ccp); + #endif /* CoClean */ } -#endif /* Concurrent */ +#endif /* Concurrent */ ncp->tvalloc = NULL; ccp->tvalloc = rsltloc; @@ -330,14 +330,14 @@ int first; } if (debug_info) -#endif /* !COMPILER */ +#endif /* !COMPILER */ { - if (k_trace + if (k_trace #ifdef MultiProgram - && (swtch_typ != A_MTEvent) - #endif /* MultiProgram */ + && (swtch_typ != A_MTEvent) + #endif /* MultiProgram */ ) - cotrace(ccp, ncp, swtch_typ, valloc); + cotrace(ccp, ncp, swtch_typ, valloc); } /* @@ -348,14 +348,14 @@ int first; #ifdef Concurrent -#if !COMPILER +#if !COMPILER if (ccp->program == ncp->program) -#endif +#endif if (!IS_TS_ATTACHED(ncp->status)){ curtstate->c = ncp; ncp->tstate = curtstate; } -#else /* Concurrent */ +#else /* Concurrent */ ccp->es_pfp = pfp; ccp->es_tend = tend; @@ -375,8 +375,8 @@ int first; ipc = ncp->es_ipc; sp = ncp->es_sp; ilevel = ncp->es_ilevel; -#endif /* !COMPILER */ -#endif /* Concurrent */ +#endif /* !COMPILER */ +#endif /* Concurrent */ #if !COMPILER /* @@ -391,8 +391,8 @@ int first; curtstate = ncp->tstate; global_curtstate = ncp->tstate; } -#endif /* Concurrent */ -#endif /* !COMPILER */ +#endif /* Concurrent */ +#endif /* !COMPILER */ @@ -404,16 +404,16 @@ int first; } #if COMPILER || ConcurrentCOMPILER coexpr_fnc = ncp->fnc; - #endif /* COMPILER && !ConcurrentCOMPILER */ + #endif /* COMPILER && !ConcurrentCOMPILER */ #endif /* NativeCoswitch */ -#else /* Concurrent */ +#else /* Concurrent */ glbl_argp = ncp->es_argp; BlkLoc(k_current) = (union block *)ncp; #if COMPILER && !ConcurrentCOMPILER /* ConcurrentCOMPILER moved this into the nctramp trampoline? */ coexpr_fnc = ncp->fnc; - #endif /* COMPILER && !ConcurrentCOMPILER */ -#endif /* Concurrent */ + #endif /* COMPILER && !ConcurrentCOMPILER */ +#endif /* Concurrent */ #ifdef MultiProgram /* @@ -421,7 +421,7 @@ int first; */ if (swtch_typ == A_MTEvent) swtch_typ = A_Coact; -#endif /* MultiProgram */ +#endif /* MultiProgram */ ncp->coexp_act = swtch_typ; @@ -433,7 +433,7 @@ int first; /* * Time to switch context to the new co-expression. * the type of switch depends on whether the new co-expression - * has its own attached thread or not or if it is of type + * has its own attached thread or not or if it is of type * posix and being activated for the first time */ @@ -446,11 +446,11 @@ int first; pthreadcoswitch(ccp, ncp, ccp->status, ncp->status ); } else -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ { /* - * with native coswitch, the OS-level thread is reattaching - * to the new co-expression and will be no longer attached + * with native coswitch, the OS-level thread is reattaching + * to the new co-expression and will be no longer attached * to the current co-expression */ SET_FLAG(ncp->status, Ts_Attached); @@ -458,14 +458,14 @@ int first; UNSET_FLAG(ccp->status, Ts_Attached); #ifdef NativeCoswitch coswitch(ccp->cstate, ncp->cstate, first); -#else /* NativeCoswitch */ - /* +#else /* NativeCoswitch */ + /* * This should never happen: if pthread and coswitch are not available * we would not have coexpressions in the first place, * but just to make it clear: */ syserr("coswitch() is required but not implemented"); -#endif /* NativeCoswitch */ +#endif /* NativeCoswitch */ } /* @@ -477,11 +477,11 @@ int first; #ifdef Concurrent curtstate = global_curtstate ? global_curtstate : pthread_getspecific(tstate_key); -#endif /* Concurrent */ +#endif /* Concurrent */ return BlkD(k_current,Coexpr)->coexp_act; -#endif /* CoExpr */ +#endif /* CoExpr */ } #ifdef CoExpr @@ -506,15 +506,15 @@ dptr cargp; else #if COMPILER syserr("new_context() called with no coexpr_fnc defined"); -#else /* COMPILER */ -#ifdef TSTATARG +#else /* COMPILER */ +#ifdef TSTATARG interp(fsig, cargp, CURTSTATARG); -#else /* TSTATARG */ +#else /* TSTATARG */ interp(fsig, cargp); -#endif /* TSTATARG */ -#endif /* COMPILER */ +#endif /* TSTATARG */ +#endif /* COMPILER */ } -#else /* CoExpr */ +#else /* CoExpr */ /* dummy new_context if co-expressions aren't supported */ void new_context(fsig,cargp) int fsig; @@ -522,7 +522,7 @@ dptr cargp; { syserr("new_context() called, but co-expressions not implemented"); } -#endif /* CoExpr */ +#endif /* CoExpr */ #ifdef PthreadCoswitch @@ -541,7 +541,7 @@ dptr cargp; */ #if 0 -static int pco_inited = 0; /* has first-time initialization been done? */ +static int pco_inited = 0; /* has first-time initialization been done? */ #endif /* @@ -550,16 +550,16 @@ static int pco_inited = 0; /* has first-time initialization been done? */ int pthreadcoswitch(struct b_coexpr *old, struct b_coexpr *new, word ostat, word nstat) { - sem_post(new->semp); /* unblock the new thread */ - SEM_WAIT(old->semp); /* block this thread */ + sem_post(new->semp); /* unblock the new thread */ + SEM_WAIT(old->semp); /* block this thread */ if (old->alive<1) { - pthread_exit(NULL); /* if unblocked because unwanted */ + pthread_exit(NULL); /* if unblocked because unwanted */ } //SYNC_GLOBAL_CURTSTATE(); - return 0; /* else return to continue running */ + return 0; /* else return to continue running */ } /* @@ -607,7 +607,7 @@ void coclean(struct b_coexpr *cp) { #endif /* NO_COEXPR_SEMAPHORE_FIX */ return; } - + } else if (cp->alive==1) { /* the current thread is done, called this to exit */ /* give up the heaps owned by the thread */ @@ -620,13 +620,13 @@ void coclean(struct b_coexpr *cp) { MUTEX_LOCKID_CONTROLLED(MTX_PUBLICSTRHEAP); swap2publicheap(strregion, NULL, &public_stringregion); MUTEX_UNLOCKID(MTX_PUBLICSTRHEAP); - } + } #endif /* Concurrent */ cp->alive = -8; CV_SIGNAL_EMPTYBLK(BlkD(cp->outbox, List)); CV_SIGNAL_FULLBLK(BlkD(cp->inbox, List)); - DEC_NARTHREADS; + DEC_NARTHREADS; cp->alive = -1; #ifndef NO_COEXPR_SEMAPHORE_FIX if (cp->semp) {SEM_CLOSE(cp->semp); cp->semp = NULL;} @@ -645,8 +645,8 @@ void coclean(struct b_coexpr *cp) { #endif /* NO_COEXPR_SEMAPHORE_FIX */ #ifdef Concurrent /* - * Give up the heaps owned by the old thread, - * only GC thread is running, no need to lock + * Give up the heaps owned by the old thread, + * only GC thread is running, no need to lock */ if (CHECK_FLAG(cp->status, Ts_Posix) && blkregion){ MUTEX_LOCKID_CONTROLLED(MTX_PUBLICBLKHEAP); @@ -666,18 +666,18 @@ void coclean(struct b_coexpr *cp) { * makesem(cp) -- initialize semaphore in co-expression. */ void makesem(struct b_coexpr *cp) { - #ifdef NamedSemaphores /* if cannot use unnamed semaphores */ + #ifdef NamedSemaphores /* if cannot use unnamed semaphores */ char name[50]; sprintf(name, "i%ld-%ld.sem", (long)getpid(), (long) cp->id); cp->semp = sem_open(name, O_CREAT, S_IRUSR | S_IWUSR, 0); if (cp->semp == (sem_t *)SEM_FAILED) handle_thread_error(errno, FUNC_SEM_OPEN, "make_sem():cannot create semaphore"); sem_unlink(name); - #else /* NamedSemaphores */ + #else /* NamedSemaphores */ if (sem_init(&cp->sema, 0, 0) == -1) handle_thread_error(errno, FUNC_SEM_INIT, "make_sem():cannot init semaphore"); cp->semp = &cp->sema; - #endif /* NamedSemaphores */ + #endif /* NamedSemaphores */ } #if defined(Concurrent) && !defined(HAVE_KEYWORD__THREAD) @@ -688,7 +688,7 @@ struct threadstate * alloc_tstate() if (ts == NULL) syserr("alloc_tstate(): Out of memory"); return ts; } -#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ +#endif /* Concurrent && !HAVE_KEYWORD__THREAD */ /* * nctramp() -- trampoline for calling new_context(0,0). @@ -703,20 +703,20 @@ void *nctramp(void *arg) struct threadstate *curtstate; curtstate = (ce->tstate ? ce->tstate : alloc_tstate()); pthread_setspecific(tstate_key, (void *) curtstate); -#endif /* HAVE_KEYWORD__THREAD */ +#endif /* HAVE_KEYWORD__THREAD */ - /* + /* * Mask all allowed signals, the main thread takes care of them */ -/* sigfillset(&mask); +/* sigfillset(&mask); pthread_sigmask(SIG_BLOCK, &mask, NULL); */ curtstate->c = ce; #if ConcurrentCOMPILER - coexpr_fnc = ce->fnc; -#endif /* ConcurrentCOMPILER */ + coexpr_fnc = ce->fnc; +#endif /* ConcurrentCOMPILER */ init_threadstate(curtstate); tlschain_add(curtstate, ce); @@ -739,7 +739,7 @@ void *nctramp(void *arg) #if !COMPILER stack = ce->es_stack; stackend = ce->es_stackend; -#endif /* !COMPILER */ +#endif /* !COMPILER */ glbl_argp = ce->es_argp; k_current.dword = D_Coexpr; BlkLoc(k_current) = (union block *)ce; @@ -750,15 +750,15 @@ void *nctramp(void *arg) init_threadheap(curtstate, ce->ini_blksize, ce->ini_ssize, NULL); #endif -#endif /* Concurrent */ - SEM_WAIT(ce->semp); /* wait for signal */ - new_context(0, 0); /* call new_context; will not return */ +#endif /* Concurrent */ + SEM_WAIT(ce->semp); /* wait for signal */ + new_context(0, 0); /* call new_context; will not return */ syserr("new_context returned to nctramp"); return NULL; } -#endif /* PthreadCoswitch */ +#endif /* PthreadCoswitch */ -#ifdef Concurrent +#ifdef Concurrent pthread_mutexattr_t rmtx_attr; /* recursive mutex attr ready to be used */ pthread_t TCthread; @@ -770,21 +770,21 @@ pthread_cond_t cond_tc; sem_t sem_tc; #endif /* NamedSemaphores */ -/* - * sem_tcp points to sem_tc on non Mac systems and to the return - * from sem_open() on Macs +/* + * sem_tcp points to sem_tc on non Mac systems and to the return + * from sem_open() on Macs */ -sem_t *sem_tcp; +sem_t *sem_tcp; pthread_cond_t **condvars; word* condvarsmtxs; word maxcondvars; -word ncondvars; +word ncondvars; pthread_mutex_t **mutexes; word maxmutexes; -word nmutexes; +word nmutexes; void init_threads() { @@ -804,7 +804,7 @@ void init_threads() CV_INIT(&cond_tc, "init_threads()"); -#ifdef NamedSemaphores +#ifdef NamedSemaphores /* Mac OS X has sem_init(), so it is POSIX compliant. * Unfortunately, POSIX compliance does not mean it must work, just be there. * On OS X, sem_init() always fails, so we use named semaphores instead. @@ -815,16 +815,16 @@ void init_threads() sem_tcp = sem_open(name, O_CREAT, S_IRUSR | S_IWUSR, 1); if (sem_tcp == (sem_t *)SEM_FAILED) handle_thread_error(errno, FUNC_SEM_OPEN, - "thread_init():cannot create GC semaphore"); + "thread_init():cannot create GC semaphore"); /* There's not much we can do if sem_unlink fails, so ignore return value */ (void) sem_unlink(name); } #else - sem_tcp = &sem_tc; + sem_tcp = &sem_tc; if (0 != sem_init(sem_tcp, 0, 1)) handle_thread_error(errno, FUNC_SEM_INIT, - "thread_init():cannot init GC semaphore"); + "thread_init():cannot init GC semaphore"); #endif /* NamedSemaphores */ maxmutexes = 1024; @@ -842,7 +842,7 @@ void init_threads() for(i=0; iend - curtblock->free) / (double) curtblock->size < 0.09) { - if (!reserve(Blocks, curtblock->end - curtblock->free + 100)) - fprintf(stderr, " Disaster! in thread_control. \n"); - return; - } + if (!reserve(Blocks, curtblock->end - curtblock->free + 100)) + fprintf(stderr, " Disaster! in thread_control. \n"); + return; + } - /* The thread that gets here should block and wait for TC to finish. */ + /* The thread that gets here should block and wait for TC to finish. */ - /* - * Lock MUTEX_COND_TC mutex and wait on the condition variable cond_gc. - * note that pthread_cond_wait will block the thread and will automatically - * and atomically unlock mutex while it waits. - */ + /* + * Lock MUTEX_COND_TC mutex and wait on the condition variable cond_gc. + * note that pthread_cond_wait will block the thread and will automatically + * and atomically unlock mutex while it waits. + */ - MUTEX_LOCKID(MTX_COND_TC); - MUTEX_LOCKID(MTX_NARTHREADS); - NARthreads--; - MUTEX_UNLOCKID(MTX_NARTHREADS); - CV_WAIT_ON_EXPR(thread_call, &cond_tc, MTX_COND_TC); - MUTEX_UNLOCKID(MTX_COND_TC); + MUTEX_LOCKID(MTX_COND_TC); + MUTEX_LOCKID(MTX_NARTHREADS); + NARthreads--; + MUTEX_UNLOCKID(MTX_NARTHREADS); + CV_WAIT_ON_EXPR(thread_call, &cond_tc, MTX_COND_TC); + MUTEX_UNLOCKID(MTX_COND_TC); - /* - * wake up call received! TC is over. increment NARthread - * and go back to work - */ + /* + * wake up call received! TC is over. increment NARthread + * and go back to work + */ - INC_NARTHREADS_CONTROLLED; + INC_NARTHREADS_CONTROLLED; return; - } /* default */ - } /* switch (action_in_progress) */ - break; + } /* default */ + } /* switch (action_in_progress) */ + break; /*---------------------------------*/ - } + } case TC_WAKEUPCALL:{ if (tc_queue){ /* Other threads are waiting for TC to take control */ - /* lock MUTEX_COND_TC mutex and wait on the condition variable - * cond_gc. - * note that pthread_cond_wait will block the thread and will - * automatically and atomically unlock the mutex while it is - * blocking the thread. - */ - - MUTEX_UNLOCKID(MTX_NARTHREADS); - MUTEX_UNLOCKID(MTX_THREADCONTROL); - - MUTEX_LOCKID(MTX_COND_TC); - /* wake up another TCthread and go to sleep */ - sem_post(sem_tcp); - - CV_WAIT_ON_EXPR(thread_call, &cond_tc, MTX_COND_TC); - - MUTEX_UNLOCKID(MTX_COND_TC); - - /* Another TC thread just woke me up! - * TC is over. Increment NARthreads and return. - */ - MUTEX_LOCKID(MTX_NARTHREADS); - NARthreads++; - MUTEX_UNLOCKID(MTX_NARTHREADS); - return; + /* lock MUTEX_COND_TC mutex and wait on the condition variable + * cond_gc. + * note that pthread_cond_wait will block the thread and will + * automatically and atomically unlock the mutex while it is + * blocking the thread. + */ + + MUTEX_UNLOCKID(MTX_NARTHREADS); + MUTEX_UNLOCKID(MTX_THREADCONTROL); + + MUTEX_LOCKID(MTX_COND_TC); + /* wake up another TCthread and go to sleep */ + sem_post(sem_tcp); + + CV_WAIT_ON_EXPR(thread_call, &cond_tc, MTX_COND_TC); + + MUTEX_UNLOCKID(MTX_COND_TC); + + /* Another TC thread just woke me up! + * TC is over. Increment NARthreads and return. + */ + MUTEX_LOCKID(MTX_NARTHREADS); + NARthreads++; + MUTEX_UNLOCKID(MTX_NARTHREADS); + return; } - /* - * GC is over, reset GCthread and wakeup all threads. + /* + * GC is over, reset GCthread and wakeup all threads. * reset (post) sem_gc to be ready for the next GC round */ @@ -1028,16 +1028,16 @@ int action; /* timing for GC, for testing and performance tuning */ gettimeofday(&tp, NULL); - tmp = tp.tv_sec * 1000000 + tp.tv_usec-t_init; + tmp = tp.tv_sec * 1000000 + tp.tv_usec-t_init; if (gc_count>0){ - tot += tmp; - printf("========total GC time (ms):%d av=%d\n", tmp/1000, - tot/1000/gc_count); + tot += tmp; + printf("========total GC time (ms):%d av=%d\n", tmp/1000, + tot/1000/gc_count); } - else - printf("========total GC time (ms):%d\n", tmp/1000); + else + printf("========total GC time (ms):%d\n", tmp/1000); - t_init = 0; + t_init = 0; first_thread=0; #endif @@ -1050,28 +1050,28 @@ int action; } case TC_STOPALLTHREADS:{ - /* - * First make sure this thread is not requesting this - * in the middle of another request made by the same thread. - * typically this happens if something went bad like - * a segfault in the middle of an ongoing GC. - * If this is the case, we can safely return. - */ - if (master_thread == curtstate->c->id) - return; + /* + * First make sure this thread is not requesting this + * in the middle of another request made by the same thread. + * typically this happens if something went bad like + * a segfault in the middle of an ongoing GC. + * If this is the case, we can safely return. + */ + if (master_thread == curtstate->c->id) + return; /* * If there is a pending TC request, then block/sleep. * Make sure we do not start a GC in the middle of starting * a new Async thread. Precaution to avoid problems. */ - + MUTEX_LOCKID(MTX_NARTHREADS); NARthreads--; tc_queue++; MUTEX_UNLOCKID(MTX_NARTHREADS); - /* Allow only one thread to pass at a time!! */ + /* Allow only one thread to pass at a time!! */ SEM_WAIT(sem_tcp); #ifdef GC_TIMING_TUNING @@ -1082,23 +1082,23 @@ int action; gc_count++; gettimeofday(&tp, NULL); - thrd_t = t_init = tp.tv_sec * 1000000 + tp.tv_usec; + thrd_t = t_init = tp.tv_sec * 1000000 + tp.tv_usec; - if (lastgc_t!=0){ + if (lastgc_t!=0){ if (gc_count>0){ - tot_lastgc+=thrd_t-lastgc_t; - printf("+++++++++++++\ntime (ms) since last GC: %d av=%d\n***********\n", - (t_init-lastgc_t)/1000, tot_lastgc/1000/gc_count); - } + tot_lastgc+=thrd_t-lastgc_t; + printf("+++++++++++++\ntime (ms) since last GC: %d av=%d\n***********\n", + (t_init-lastgc_t)/1000, tot_lastgc/1000/gc_count); + } else - printf("+++++++++++++\ntime (ms) since last GC: %d\n***********\n", - (t_init-lastgc_t)/1000); + printf("+++++++++++++\ntime (ms) since last GC: %d\n***********\n", + (t_init-lastgc_t)/1000); } - lastgc_t=t_init; + lastgc_t=t_init; - } + } #endif /* If another TCthread just woke me up, ensure that he is gone to sleep already! */ @@ -1109,27 +1109,27 @@ int action; TCthread = pthread_self(); thread_call = 1; - /* NARthreads should reach and stay at zero during TC*/ - while (1) { - MUTEX_LOCKID(MTX_NARTHREADS); - if (NARthreads <= 0) break; /* unlock MTX_NARTHREADS after GC*/ - MUTEX_UNLOCKID(MTX_NARTHREADS); - usleep(50); - } + /* NARthreads should reach and stay at zero during TC*/ + while (1) { + MUTEX_LOCKID(MTX_NARTHREADS); + if (NARthreads <= 0) break; /* unlock MTX_NARTHREADS after GC*/ + MUTEX_UNLOCKID(MTX_NARTHREADS); + usleep(50); + } #ifdef GC_TIMING_TUNING /* timing for GC, for testing and performance tuning */ gettimeofday(&tp, NULL); - tmp = tp.tv_sec * 1000000 + tp.tv_usec; - if (gc_count>0 && first_thread){ - tot_gcwait +=tmp-t_init; - first_thread=0; - printf("@@@SUSPEND TIME: time (microsec) I waited to start GC=%d Av=%d \n", - tmp-thrd_t, tot_gcwait/gc_count); - } - else - printf("SAME GC Cycle:time (microsec) I waited to start GC=%d\n", tmp-thrd_t); - thrd_t = tmp; + tmp = tp.tv_sec * 1000000 + tp.tv_usec; + if (gc_count>0 && first_thread){ + tot_gcwait +=tmp-t_init; + first_thread=0; + printf("@@@SUSPEND TIME: time (microsec) I waited to start GC=%d Av=%d \n", + tmp-thrd_t, tot_gcwait/gc_count); + } + else + printf("SAME GC Cycle:time (microsec) I waited to start GC=%d\n", tmp-thrd_t); + thrd_t = tmp; #endif @@ -1137,21 +1137,21 @@ int action; * Now it is safe to proceed with TC with only the current thread running */ tc_queue--; - master_thread = curtstate->c->id; + master_thread = curtstate->c->id; return; } case TC_KILLALLTHREADS:{ - /* wait until only this thread is running */ + /* wait until only this thread is running */ thread_call = 1; action_in_progress = action; - while (1) { - if (NARthreads <= 1) break; /* unlock MTX_NARTHREADS after GC*/ - usleep(50); - } + while (1) { + if (NARthreads <= 1) break; /* unlock MTX_NARTHREADS after GC*/ + usleep(50); + } /*action_in_progress = TC_NONE;*/ - master_thread = curtstate->c->id; - return; + master_thread = curtstate->c->id; + return; } default:{ @@ -1167,7 +1167,7 @@ void howmanyblock() { int i=0; struct region *rp; - + printf("here is what I have:\n"); rp = curpstate->stringregion; while (rp){ i++; rp = rp->Gnext; } @@ -1200,7 +1200,7 @@ void howmanyblock() printf(" local block= %d\n", i); } #endif /* ConcurrentCOMPILER */ -#endif /* DEBUG */ +#endif /* DEBUG */ void tlschain_add(struct threadstate *tstate, struct b_coexpr *cp) { @@ -1225,13 +1225,13 @@ void tlschain_add(struct threadstate *tstate, struct b_coexpr *cp) void tlschain_remove(struct threadstate *tstate) { - /* - * This function assumes that MTX_TLS_CHAIN is locked/unlocked + /* + * This function assumes that MTX_TLS_CHAIN is locked/unlocked * if needed. GCthread doesn't need to lock for example. */ if (!tstate || !tstate->prev) return; - + tstate->prev->next = tstate->next; if (tstate->next) tstate->next->prev = tstate->prev; @@ -1239,28 +1239,28 @@ void tlschain_remove(struct threadstate *tstate) /* CurrentCOMPILER has tstate but no pstate */ curstring->size += tstate->stringtotal; curblock->size += tstate->blocktotal; -#else /* ConcurrentCOMPILER */ +#else /* ConcurrentCOMPILER */ rootpstate.stringtotal += tstate->stringtotal; rootpstate.blocktotal += tstate->blocktotal; -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ if (tstate->c && tstate->c->isProghead) return; - + free(tstate); } /* * reuse_region - search region chain for a region having at least nbytes available - * updated Mar 8 2017: Relax the requirments to only require the region size - * to be >= nbytes but not necessarily nbytes/4 >= freebytes. - * The rational is that some of that memory could be reclaimed - * after doing a garbage collection. + * updated Mar 8 2017: Relax the requirments to only require the region size + * to be >= nbytes but not necessarily nbytes/4 >= freebytes. + * The rational is that some of that memory could be reclaimed + * after doing a garbage collection. */ static struct region *reuse_region(word nbytes, int region) { struct region *curr, **pubregion, *pick=NULL; word freebytes = nbytes / 4; int mtx_id; - + if (region == Strings){ mtx_id = MTX_PUBLICSTRHEAP; MUTEX_LOCKID_CONTROLLED(mtx_id); @@ -1271,21 +1271,21 @@ static struct region *reuse_region(word nbytes, int region) MUTEX_LOCKID_CONTROLLED(mtx_id); pubregion = &public_blockregion; } - + for (curr = *pubregion; curr; curr = curr->Tnext) { if (curr->size >= nbytes) { // find a region that is big enough if (!pick) - pick = curr; + pick = curr; if (DiffPtrs(curr->end, curr->free) >= freebytes) { - // if the region has "enough" free memory just take it - // and end the search - pick = curr; - break; + // if the region has "enough" free memory just take it + // and end the search + pick = curr; + break; } else if (DiffPtrs(pick->end, pick->free) < DiffPtrs(curr->end, curr->free)) - // if this region has more free memory, switch to it - pick = curr; + // if this region has more free memory, switch to it + pick = curr; } } @@ -1294,14 +1294,14 @@ static struct region *reuse_region(word nbytes, int region) pick->Tprev->Tnext = pick->Tnext; else *pubregion = pick->Tnext; - + if (pick->Tnext) pick->Tnext->Tprev = pick->Tprev; - + pick->Tnext= NULL; pick->Tprev = NULL; } - + MUTEX_UNLOCKID(mtx_id); return pick; } @@ -1315,15 +1315,15 @@ static struct region *reuse_region(word nbytes, int region) * nctramp() you are a new thread in the current program. Called from * initprogram() in init.r, you are a newly loaded program (newp). * - * + * */ #if COMPILER void init_threadheap(struct threadstate *ts, word blksiz, word strsiz) #else void init_threadheap(struct threadstate *ts, word blksiz, word strsiz, - struct progstate *newp) + struct progstate *newp) #endif -{ +{ struct region *rp; #if !COMPILER @@ -1352,14 +1352,14 @@ void init_threadheap(struct threadstate *ts, word blksiz, word strsiz, #else /* attach rp after program's string region on prev/next */ if (newp->stringregion) { - rp->prev = newp->stringregion; - rp->next = newp->stringregion->next; - if (newp->stringregion->next) - newp->stringregion->next->prev = rp; - newp->stringregion->next = rp; - } + rp->prev = newp->stringregion; + rp->next = newp->stringregion->next; + if (newp->stringregion->next) + newp->stringregion->next->prev = rp; + newp->stringregion->next = rp; + } else - newp->stringregion = rp; + newp->stringregion = rp; #endif /* attach rp after curstring on Gprev/Gnext. */ @@ -1388,14 +1388,14 @@ void init_threadheap(struct threadstate *ts, word blksiz, word strsiz, #else /* attach rp after program's block region on prev/next */ if (newp->blockregion) { - rp->prev = newp->blockregion; - rp->next = newp->blockregion->next; - if (newp->blockregion->next) - newp->blockregion->next->prev = rp; - newp->blockregion->next = rp; - } + rp->prev = newp->blockregion; + rp->next = newp->blockregion->next; + if (newp->blockregion->next) + newp->blockregion->next->prev = rp; + newp->blockregion->next = rp; + } else - newp->blockregion = rp; + newp->blockregion = rp; #endif /* attach rp after curblock on Gprev/Gnext. */ @@ -1411,7 +1411,7 @@ void init_threadheap(struct threadstate *ts, word blksiz, word strsiz, syserr(" init_threadheap: insufficient memory for block region"); } -#endif /* Concurrent */ +#endif /* Concurrent */ #if HAVE_LIBPTHREAD @@ -1431,11 +1431,11 @@ void handle_thread_error(int val, int func, char* msg) switch(val) { case EINVAL: fatalerr(180, NULL); - break; + break; case EBUSY: - /* EBUSY is handled somewhere else, we shouldn't get here */ - return; - } + /* EBUSY is handled somewhere else, we shouldn't get here */ + return; + } break; case FUNC_MUTEX_INIT: @@ -1446,13 +1446,13 @@ void handle_thread_error(int val, int func, char* msg) fprintf(stderr, "\nDestroy mutex error-%s:", msg); switch(val) { case EBUSY: -/* fprintf(stderr, "The implementation has detected an attempt to destroy the object referenced by mutex while it is locked or referenced (for example, while being used in a pthread_cond_wait() or pthread_cond_timedwait()) by another thread."); +/* fprintf(stderr, "The implementation has detected an attempt to destroy the object referenced by mutex while it is locked or referenced (for example, while being used in a pthread_cond_wait() or pthread_cond_timedwait()) by another thread."); */ - return; - default: - fprintf(stderr, " pthread function error!\n "); - return; - } + return; + default: + fprintf(stderr, " pthread function error!\n "); + return; + } case FUNC_THREAD_JOIN: fprintf(stderr, "\nThread join error-%s:", msg); @@ -1464,19 +1464,19 @@ void handle_thread_error(int val, int func, char* msg) case EAGAIN: fprintf(stderr, "Insufficient resources to create another thread, or a system imposed limit on the number of threads was encountered.\n"); #if 0 - { - struct rlimit rlim; - getrlimit(RLIMIT_NPROC, &rlim); - fprintf(stderr," Soft Limit: %u\n Hard Limit: %u\n", - (unsigned int) rlim.rlim_cur, (unsigned int) rlim.rlim_max); - } + { + struct rlimit rlim; + getrlimit(RLIMIT_NPROC, &rlim); + fprintf(stderr," Soft Limit: %u\n Hard Limit: %u\n", + (unsigned int) rlim.rlim_cur, (unsigned int) rlim.rlim_max); + } #endif - break; - } + break; + } case FUNC_COND_INIT: fprintf(stderr, "cond init error-%s\n ", msg); - break; + break; case FUNC_SEM_OPEN: fprintf(stderr, "sem open error-%s\n ", msg); diff --git a/src/runtime/rcomp.r b/src/runtime/rcomp.r index 81f364a0a..20b1a62c3 100644 --- a/src/runtime/rcomp.r +++ b/src/runtime/rcomp.r @@ -3,7 +3,7 @@ * Contents: anycmp, equiv, lexcmp */ -#define SORTN 1 /* Treat integers and reals collectively */ +#define SORTN 1 /* Treat integers and reals collectively */ #define SORTT 2 /* Treat integers and reals separately */ /* @@ -45,7 +45,7 @@ int sortType; return lexcmp(dp1,dp2); t1 = Type(*dp1); - if ((o1 == 1) && (o2 == 1)) { /* numeric */ + if ((o1 == 1) && (o2 == 1)) { /* numeric */ t2 = Type(*dp2); if ((t1 == T_Real) || (t2 == T_Real)) { cnv_c_dbl(dp1, &rres1); @@ -63,7 +63,7 @@ int sortType; #ifdef LargeInts case T_Integer: - if (Type(*dp2) != T_Lrgint) { + if (Type(*dp2) != T_Lrgint) { v1 = IntVal(*dp1); v2 = IntVal(*dp2); if (v1 < v2) @@ -73,15 +73,15 @@ int sortType; else return Greater; } - /* if dp2 is a Lrgint, flow into next case */ + /* if dp2 is a Lrgint, flow into next case */ case T_Lrgint: - lresult = bigcmp(dp1, dp2); - if (lresult == 0) - return Equal; - return ((lresult > 0) ? Greater : Less); + lresult = bigcmp(dp1, dp2); + if (lresult == 0) + return Equal; + return ((lresult > 0) ? Greater : Less); -#else /* LargeInts */ +#else /* LargeInts */ case T_Integer: v1 = IntVal(*dp1); @@ -93,7 +93,7 @@ int sortType; else return Greater; -#endif /* LargeInts */ +#endif /* LargeInts */ case T_Coexpr: /* @@ -106,42 +106,42 @@ int sortType; case T_Cset: return csetcmp((unsigned int *)BlkD(*dp1,Cset)->bits, - (unsigned int *)BlkD(*dp2,Cset)->bits); + (unsigned int *)BlkD(*dp2,Cset)->bits); case T_File: /* * Collate on file name or window label. */ - { - dptr ps1 = &(BlkD(*dp1,File)->fname); - dptr ps2 = &(BlkD(*dp2,File)->fname); + { + dptr ps1 = &(BlkD(*dp1,File)->fname); + dptr ps2 = &(BlkD(*dp2,File)->fname); #ifdef Graphics - struct descrip s1, s2; /* live only long enough to lexcmp them */ - if (BlkLoc(*dp1)->File.status & Fs_Window) { - wbp w = BlkLoc(*dp1)->File.fd.wb; - if (w->window) { - StrLoc(s1) = w->window->windowlabel; - StrLen(s1) = strlen(StrLoc(s1)); + struct descrip s1, s2; /* live only long enough to lexcmp them */ + if (BlkLoc(*dp1)->File.status & Fs_Window) { + wbp w = BlkLoc(*dp1)->File.fd.wb; + if (w->window) { + StrLoc(s1) = w->window->windowlabel; + StrLen(s1) = strlen(StrLoc(s1)); + } + else { + StrLoc(s1) = ""; + StrLen(s1) = 0; } - else { - StrLoc(s1) = ""; - StrLen(s1) = 0; - } - ps1 = &s1; - } - if (BlkLoc(*dp2)->File.status & Fs_Window) { - wbp w = BlkLoc(*dp2)->File.fd.wb; - if (w->window) { - StrLoc(s2) = w->window->windowlabel; - StrLen(s2) = strlen(StrLoc(s2)); + ps1 = &s1; + } + if (BlkLoc(*dp2)->File.status & Fs_Window) { + wbp w = BlkLoc(*dp2)->File.fd.wb; + if (w->window) { + StrLoc(s2) = w->window->windowlabel; + StrLen(s2) = strlen(StrLoc(s2)); } - else { - StrLoc(s2) = ""; - StrLen(s2) = 0; + else { + StrLoc(s2) = ""; + StrLen(s2) = 0; } - ps2 = &s2; - } -#endif /* Graphics */ + ps2 = &s2; + } +#endif /* Graphics */ return lexcmp(ps1, ps2); } @@ -168,9 +168,9 @@ int sortType; GetReal(dp1,rres1); GetReal(dp2,rres2); rresult = rres1 - rres2; - if (rresult == 0.0) - return Equal; - return ((rresult > 0.0) ? Greater : Less); + if (rresult == 0.0) + return Equal; + return ((rresult > 0.0) ? Greater : Less); case T_Record: /* @@ -180,7 +180,7 @@ int sortType; &(BlkD(*dp2,Record)->recdesc->Proc.pname)); if (iresult == Equal) { lresult = (BlkD(*dp1,Record)->id - BlkD(*dp2,Record)->id); - if (lresult > 0) /* coded this way because of code-generation */ + if (lresult > 0) /* coded this way because of code-generation */ return Greater; /* bug in MSC++ 7.0A; do not change. */ else if (lresult < 0) return Less; @@ -216,25 +216,25 @@ int sortType; if (lresult == 0) return Equal; return ((lresult > 0) ? Greater : Less); -#endif /* PatternType */ +#endif /* PatternType */ case T_External: - /* + /* * Collate these values according to the relative positions of * their blocks in the heap. - */ + */ lresult = ((word)BlkLoc(*dp1) - (word)BlkLoc(*dp2)); if (lresult == 0) return Equal; return ((lresult > 0) ? Greater : Less); default: - syserr("anycmp: unknown datatype."); - /*NOTREACHED*/ - return 0; /* avoid gcc warning */ + syserr("anycmp: unknown datatype."); + /*NOTREACHED*/ + return 0; /* avoid gcc warning */ } } - + /* * order(x) - return collating number for object x. */ @@ -244,53 +244,53 @@ dptr dp; int sortType; { if (Qual(*dp)) - return 3; /* string */ + return 3; /* string */ switch (Type(*dp)) { case T_Null: - return 0; + return 0; case T_Integer: - return 1; + return 1; #ifdef LargeInts case T_Lrgint: - return 1; -#endif /* LargeInts */ + return 1; +#endif /* LargeInts */ case T_Real: /* Treat integers and reals collectively or separately? */ - return sortType; + return sortType; /* string: return 3 (see above) */ case T_Cset: - return 4; + return 4; case T_File: - return 5; + return 5; case T_Coexpr: - return 6; + return 6; case T_Proc: - return 7; + return 7; case T_List: - return 8; + return 8; case T_Set: - return 9; + return 9; case T_Table: - return 10; + return 10; case T_Record: - return 11; + return 11; #ifdef PatternType case T_Pattern: - return 12; -#endif /* PatternType */ + return 12; +#endif /* PatternType */ case T_External: return 13; default: - syserr("order: unknown datatype."); - /*NOTREACHED*/ - return 0; /* avoid gcc warning */ + syserr("order: unknown datatype."); + /*NOTREACHED*/ + return 0; /* avoid gcc warning */ } } - + /* * equiv - test equivalence of two objects. */ @@ -319,50 +319,50 @@ dptr dp1, dp2; if ((i = StrLen(*dp1)) == StrLen(*dp2)) { - s1 = StrLoc(*dp1); - s2 = StrLoc(*dp2); - result = 1; - while (i--) - if (*s1++ != *s2++) { - result = 0; - break; - } + s1 = StrLoc(*dp1); + s2 = StrLoc(*dp2); + result = 1; + while (i--) + if (*s1++ != *s2++) { + result = 0; + break; + } - } + } } else if (dp1->dword == dp2->dword) switch (Type(*dp1)) { - /* - * For integers and reals, just compare the values. - */ - case T_Integer: - result = (IntVal(*dp1) == IntVal(*dp2)); - break; + /* + * For integers and reals, just compare the values. + */ + case T_Integer: + result = (IntVal(*dp1) == IntVal(*dp2)); + break; #ifdef LargeInts - case T_Lrgint: - result = (bigcmp(dp1, dp2) == 0); - break; -#endif /* LargeInts */ + case T_Lrgint: + result = (bigcmp(dp1, dp2) == 0); + break; +#endif /* LargeInts */ - case T_Real: + case T_Real: GetReal(dp1, rres1); GetReal(dp2, rres2); result = (rres1 == rres2); - break; - - case T_Cset: - /* - * Compare the bit arrays of the csets. - */ - result = 1; - for (i = 0; i < CsetSize; i++) - if (BlkD(*dp1,Cset)->bits[i] != BlkD(*dp2,Cset)->bits[i]) { - result = 0; - break; - } - } + break; + + case T_Cset: + /* + * Compare the bit arrays of the csets. + */ + result = 1; + for (i = 0; i < CsetSize; i++) + if (BlkD(*dp1,Cset)->bits[i] != BlkD(*dp2,Cset)->bits[i]) { + result = 0; + break; + } + } else /* * dp1 and dp2 are of different types, so they can't be @@ -372,7 +372,7 @@ dptr dp1, dp2; return result; } - + /* * lexcmp - lexically compare two strings. */ @@ -419,7 +419,7 @@ dptr dp1, dp2; return Less; } - + /* * csetcmp - compare two cset bit arrays. * The order defined by this function is identical to the lexical order of @@ -448,52 +448,52 @@ unsigned int *cs1, *cs2; */ for (cs_end = cs1 + CsetSize; cs1 < cs_end; cs1++, cs2++) if (*cs1 != *cs2) { - /* - * Let n be the position at which the bits first differ within - * the word. Set nbit to some integer for which the nth bit - * is the first bit in the word that is one. Note here and in the - * following, that bits go from right to left within a word, so - * the _first_ bit is the _rightmost_ bit. - */ - nbit = *cs1 ^ *cs2; - - /* Set mask to an integer that has all zeros in bit positions - * upto and including position n, and all ones in bit positions - * _after_ bit position n. - */ - for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1); - - /* - * nbit & ~mask contains zeros everywhere except position n, which - * is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit - * of *cs2 is one. - */ - if (*cs2 & (nbit & ~mask)) { - /* - * If there are bits set in cs1 after bit position n in the - * current word, then cs1 is lexically greater than cs2. - */ - if (*cs1 & mask) return Greater; - while (++cs1 < cs_end) - if (*cs1) return Greater; - - /* - * Otherwise cs1 is a proper prefix of cs2 and is therefore - * lexically less. - */ - return Less; - } - - /* - * If the nth bit of *cs2 isn't one, then the nth bit of cs1 - * must be one. Just reverse the logic for the previous - * case. - */ - if (*cs2 & mask) return Less; - cs_end = cs2 + (cs_end - cs1); - while (++cs2 < cs_end) - if (*cs2) return Less; - return Greater; - } + /* + * Let n be the position at which the bits first differ within + * the word. Set nbit to some integer for which the nth bit + * is the first bit in the word that is one. Note here and in the + * following, that bits go from right to left within a word, so + * the _first_ bit is the _rightmost_ bit. + */ + nbit = *cs1 ^ *cs2; + + /* Set mask to an integer that has all zeros in bit positions + * upto and including position n, and all ones in bit positions + * _after_ bit position n. + */ + for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1); + + /* + * nbit & ~mask contains zeros everywhere except position n, which + * is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit + * of *cs2 is one. + */ + if (*cs2 & (nbit & ~mask)) { + /* + * If there are bits set in cs1 after bit position n in the + * current word, then cs1 is lexically greater than cs2. + */ + if (*cs1 & mask) return Greater; + while (++cs1 < cs_end) + if (*cs1) return Greater; + + /* + * Otherwise cs1 is a proper prefix of cs2 and is therefore + * lexically less. + */ + return Less; + } + + /* + * If the nth bit of *cs2 isn't one, then the nth bit of cs1 + * must be one. Just reverse the logic for the previous + * case. + */ + if (*cs2 & mask) return Less; + cs_end = cs2 + (cs_end - cs1); + while (++cs2 < cs_end) + if (*cs2) return Less; + return Greater; + } return Equal; } diff --git a/src/runtime/rd3d.ri b/src/runtime/rd3d.ri index 6457679ca..ba61ef9bb 100644 --- a/src/runtime/rd3d.ri +++ b/src/runtime/rd3d.ri @@ -8,10 +8,10 @@ * Unicon runtime system convention: * Strange (small negative) return values indicate success, failure, or error * for those functions where a nonpositive outcome is possible. -#define Failed -5 -#define Defaulted -6 -#define Succeeded -7 -#define Error -8 +#define Failed -5 +#define Defaulted -6 +#define Succeeded -7 +#define Error -8 */ @@ -52,7 +52,7 @@ void cylinder(double radius1, double radius2, double height, * traverse the given list and set material properties. * RGBA are given in X11-style 0-65535 range */ -int determinematerial(temp, r, g, b, a) +int determinematerial(temp, r, g, b, a) char *temp; C_integer r, g, b, a; { @@ -92,7 +92,7 @@ int getmaterials(char* buf) * gen==1 means use texture. */ void sphere(double radius, double x, double y, double z, - int slices, int rings, int gen) + int slices, int rings, int gen) { } @@ -102,12 +102,12 @@ void sphere(double radius, double x, double y, double z, * gen==1 means use texture. */ void torus(double radius1, double radius2, double x,double y, double z, - int slices, int rings, int gen) + int slices, int rings, int gen) { } /* other helper functions */ - + /* * pop a matrix from either the projection or the modelview matrix stack */ @@ -242,7 +242,7 @@ int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height) * made portable or adapted from ropengl.ri */ int TexFillRect(wbp w, int texhandle, int x, int y, int width, int height, - int isfg) + int isfg) { return Failed; } @@ -267,8 +267,8 @@ int TexReadImage(wbp w, int texhandle, int x, int y,struct imgdata *imd) /* * Copy an area (from a window) directly into some texture memory. */ -int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, - int height, int xt, int yt, int width2, int height2) +int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, + int height, int xt, int yt, int width2, int height2) { return Failed; } diff --git a/src/runtime/rdb.r b/src/runtime/rdb.r index aa9df720a..faaf636d0 100644 --- a/src/runtime/rdb.r +++ b/src/runtime/rdb.r @@ -56,16 +56,16 @@ FILE *isql_open(char *db, dptr table, dptr user, dptr password) if (ISQLEnv==NULL) { ISQLEnv=SQL_NULL_HENV; if (SQLAllocEnv(&ISQLEnv)!=SQL_SUCCESS) { - odbcerror(fp, ALLOC_ENV_ERR); + odbcerror(fp, ALLOC_ENV_ERR); isql_open_fail: free(fp); - return 0; - } + return 0; + } #passthru #if (ODBCVER >= 0x0300) SQLSetEnvAttr(ISQLEnv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER) SQL_OV_ODBC3, SQL_IS_INTEGER); -#passthru #endif /* ODBCVER >= 0x0300 */ +#passthru #endif /* ODBCVER >= 0x0300 */ } if (SQLAllocConnect(ISQLEnv, &(fp->hdbc))!=SQL_SUCCESS) { @@ -74,9 +74,9 @@ isql_open_fail: } if (SQLConnect(fp->hdbc, - (SQLCHAR *) db, (SQLSMALLINT)strlen(db), - (SQLCHAR *) StrLoc(*user), (SQLSMALLINT)StrLen(*user), - (SQLCHAR *) StrLoc(*password), (SQLSMALLINT)StrLen(*password)) == + (SQLCHAR *) db, (SQLSMALLINT)strlen(db), + (SQLCHAR *) StrLoc(*user), (SQLSMALLINT)StrLen(*user), + (SQLCHAR *) StrLoc(*password), (SQLSMALLINT)StrLen(*password)) == SQL_ERROR){ odbcerror(fp, CONNECT_ERR); failed_connect: @@ -201,7 +201,7 @@ int dbfetch(struct ISQLFile *fp, dptr pR) * might be a bad idea on some platforms. */ colsz = (long)(int) (colsz & 0xFFFFFFFF); -#endif /* WordBits == 64 */ +#endif /* WordBits == 64 */ /* * reserve contiguous space for this column @@ -225,10 +225,10 @@ int dbfetch(struct ISQLFile *fp, dptr pR) case SQL_FLOAT: case SQL_REAL: #ifdef DescriptorDouble - r->fields[p].vword.realval = atof(buff); -#else /* DescriptorDouble */ + r->fields[p].vword.realval = atof(buff); +#else /* DescriptorDouble */ BlkLoc(r->fields[p])=(union block *) alcreal(atof(buff)); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ (r->fields[p]).dword=D_Real; break; @@ -254,7 +254,7 @@ int dbfetch(struct ISQLFile *fp, dptr pR) t_errorvalue = nulldesc; t_have_val = 0; return RunError; - /* used to return Failed for strange types */ + /* used to return Failed for strange types */ } StrLen(r->fields[p])=colsz>0?colsz:0; @@ -270,17 +270,17 @@ int dbfetch(struct ISQLFile *fp, dptr pR) rc=SQLGetData(fp->hstmt, i, SQL_C_CHAR, StrLoc(r->fields[p])+len-1, BUFF_SZ, &colsz); #if WordBits == 64 - /* - * On Fedora Core 3 AMD64, SQLGetData seems to be filling - * in the least-significant 32-bits of colsz. This workaround - * might be a bad idea on some platforms. - */ - colsz = (long)(int) (colsz & 0xFFFFFFFF); -#endif /* WordBits == 64 */ + /* + * On Fedora Core 3 AMD64, SQLGetData seems to be filling + * in the least-significant 32-bits of colsz. This workaround + * might be a bad idea on some platforms. + */ + colsz = (long)(int) (colsz & 0xFFFFFFFF); +#endif /* WordBits == 64 */ len+=colsz>BUFF_SZ?BUFF_SZ-2:colsz; - } + } break; - } /* switch */ + } /* switch */ } } /* for */ @@ -311,19 +311,19 @@ void odbcerror(struct ISQLFile *fp, int errornum) k_errornumber=errornum; if (fp && (SQLError(ISQLEnv, fp->hdbc, fp->hstmt, SQLState, &NativeErr, - (SQLCHAR *) ErrMsg, SQL_MAX_MESSAGE_LENGTH-1, &ErrMsgLen) != - SQL_NO_DATA_FOUND)) { + (SQLCHAR *) ErrMsg, SQL_MAX_MESSAGE_LENGTH-1, &ErrMsgLen) != + SQL_NO_DATA_FOUND)) { StrLoc(k_errortext) = alcstr(ErrMsg, ErrMsgLen); StrLen(k_errortext) = ErrMsgLen; } else { if (errornum - NOT_ODBC_FILE_ERR < sizeof(errmsg)/sizeof(char *)) - StrLoc(k_errortext)=errmsg[errornum-NOT_ODBC_FILE_ERR]; + StrLoc(k_errortext)=errmsg[errornum-NOT_ODBC_FILE_ERR]; else StrLoc(k_errortext) = "unidentified odbc error"; StrLen(k_errortext)=strlen(StrLoc(k_errortext)); } } -#else /* ISQL */ +#else /* ISQL */ /* static char junk ; */ -#endif /* ISQL */ +#endif /* ISQL */ diff --git a/src/runtime/rdebug.r b/src/runtime/rdebug.r index ddb053fd9..6b7f1d790 100644 --- a/src/runtime/rdebug.r +++ b/src/runtime/rdebug.r @@ -11,11 +11,11 @@ static int keyref (union block *bp, dptr dp); static void showline (char *f, int l); static void showlevel (register int n); #if !COMPILER -static void ttrace (FILE *f); -#endif /* !COMPILER */ +static void ttrace (FILE *f); +#endif /* !COMPILER */ static void xtrace (struct b_proc *bp, word nargs, dptr arg, int pline, char *pfile, FILE *logfile); - + /* * tracebk - print a trace of procedure calls. */ @@ -23,22 +23,22 @@ void tracebk(lcl_pfp, argp, logfptr) #if COMPILER struct p_frame *lcl_pfp; -#else /* COMPILER */ +#else /* COMPILER */ struct pf_marker *lcl_pfp; -#endif /* COMPILER */ +#endif /* COMPILER */ dptr argp; -FILE *logfptr; +FILE *logfptr; { struct b_proc *cproc; #if COMPILER struct debug *debug; -#else /* COMPILER */ +#else /* COMPILER */ long depth = 0, iteration = 0; struct pf_marker *origpfp; dptr arg; inst cipc; -#endif /* COMPILER */ +#endif /* COMPILER */ CURTSTATE_AND_CE(); #if COMPILER @@ -49,7 +49,7 @@ FILE *logfptr; cproc = debug->proc; xtrace(cproc, (word)abs((int)cproc->nparam), argp, debug->old_line, debug->old_fname, logfptr); -#else /* COMPILER */ +#else /* COMPILER */ origpfp = pfp; /* * Chain back through the procedure frame markers, looking for the @@ -68,35 +68,35 @@ FILE *logfptr; while (pfp) { arg = &((dptr)pfp)[-(pfp->pf_nargs) - 1]; - cproc = (struct b_proc *)BlkLoc(arg[0]); + cproc = (struct b_proc *)BlkLoc(arg[0]); /* * The ipc in the procedure frame points after the "invoke n". */ cipc = pfp->pf_ipc; --cipc.opnd; --cipc.op; - + xtrace(cproc, pfp->pf_nargs, &arg[0], findline(cipc.opnd), findfile(cipc.opnd), logfptr); - + /* * On the last call, show both the call and the offending expression. */ if (pfp == origpfp) { - if(logfptr != NULL) - ttrace(logfptr); - ttrace(stderr); - if (logfptr != NULL) - fprintf(logfptr, "\n\n\n"); + if(logfptr != NULL) + ttrace(logfptr); + ttrace(stderr); + if (logfptr != NULL) + fprintf(logfptr, "\n\n\n"); break; } - + pfp = (struct pf_marker *)(pfp->pf_efp); iteration++; } -#endif /* COMPILER */ +#endif /* COMPILER */ } - + /* * xtrace - procedure *bp is being called with nargs arguments, the first * of which is at arg; produce a trace message. @@ -107,64 +107,64 @@ word nargs; dptr arg; int pline; char *pfile; -FILE *logfile; +FILE *logfile; { fprintf(stderr, " "); if (logfile != NULL) - fprintf(logfile, " "); + fprintf(logfile, " "); if (bp == NULL) { fprintf(stderr, "????"); if (logfile != NULL) - fprintf(logfile, "????"); + fprintf(logfile, "????"); } else { #if COMPILER putstr(stderr, &(bp->pname)); -#else /* COMPILER */ +#else /* COMPILER */ if (arg[0].dword == D_Proc) { - putstr(stderr, &(bp->pname)); - if (logfile != NULL) - putstr(logfile, &(bp->pname)); - } + putstr(stderr, &(bp->pname)); + if (logfile != NULL) + putstr(logfile, &(bp->pname)); + } else { - outimage(stderr, arg, 0); - if(logfile != NULL) - outimage(logfile, arg, 0); - } + outimage(stderr, arg, 0); + if(logfile != NULL) + outimage(logfile, arg, 0); + } arg++; -#endif /* COMPILER */ +#endif /* COMPILER */ putc('(', stderr); if (logfile != NULL) - putc('(', logfile); + putc('(', logfile); while (nargs--) { - if (logfile != NULL) - outimage(logfile, arg, 0); - outimage(stderr, arg++, 0); - if (nargs) { + if (logfile != NULL) + outimage(logfile, arg, 0); + outimage(stderr, arg++, 0); + if (nargs) { putc(',', stderr); - if (logfile != NULL) - putc(',', logfile); - } - } + if (logfile != NULL) + putc(',', logfile); + } + } putc(')', stderr); if (logfile != NULL) - putc(')', logfile); + putc(')', logfile); } if (pline != 0) { fprintf(stderr, " from line %d in %s", pline, pfile); if (logfile != NULL) - fprintf(logfile, " from line %d in %s", pline, pfile); + fprintf(logfile, " from line %d in %s", pline, pfile); } putc('\n', stderr); if (logfile != NULL) - putc('\n', logfile); + putc('\n', logfile); fflush(stderr); } - + /* * get_name -- function to get print name of variable. @@ -176,7 +176,7 @@ int get_name(dptr dp1,dptr dp0) dptr arg1; /* 1st parameter */ dptr loc1; /* 1st local */ struct b_proc *proc; /* address of procedure block */ - char sbuf[100]; /* buffer; might be too small */ + char sbuf[100]; /* buffer; might be too small */ char *s, *s2; word i, j, k; int t; @@ -185,11 +185,11 @@ int get_name(dptr dp1,dptr dp0) arg1 = glbl_argp; loc1 = pfp->t.d; proc = PFDebug(*pfp)->proc; -#else /* COMPILER */ +#else /* COMPILER */ arg1 = &glbl_argp[1]; loc1 = pfp->pf_locals; proc = BlkD(*glbl_argp,Proc); -#endif /* COMPILER */ +#endif /* COMPILER */ type_case *dp1 of { tvsubs: { @@ -200,19 +200,19 @@ int get_name(dptr dp1,dptr dp0) k = StrLen(*dp0); j = strlen(sbuf); - /* - * allocate space for both the name and the subscript image, - * and then copy both parts into the allocated space - */ - Protect(s = alcstr(NULL, k + j), return RunError); - s2 = StrLoc(*dp0); - StrLoc(*dp0) = s; + /* + * allocate space for both the name and the subscript image, + * and then copy both parts into the allocated space + */ + Protect(s = alcstr(NULL, k + j), return RunError); + s2 = StrLoc(*dp0); + StrLoc(*dp0) = s; StrLen(*dp0) = j + k; - for (i = 0; i < k; i++) - *s++ = *s2++; - s2 = sbuf; - for (i = 0; i < j; i++) - *s++ = *s2++; + for (i = 0; i < k; i++) + *s++ = *s2++; + s2 = sbuf; + for (i = 0; i < j; i++) + *s++ = *s2++; } tvtbl: { @@ -236,7 +236,7 @@ int get_name(dptr dp1,dptr dp0) StrLen(*dp0) = 7; StrLoc(*dp0) = "&ftrace"; } -#endif /* FncTrace */ +#endif /* FncTrace */ else if (VarLoc(*dp1) == &kywd_dmp) { StrLen(*dp0) = 5; @@ -251,7 +251,7 @@ int get_name(dptr dp1,dptr dp0) StrLen(*dp0) = 6; StrLoc(*dp0) = "&errno"; } -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Graphics else if (VarLoc(*dp1) == &erCol) { StrLen(*dp0) = 4; @@ -273,10 +273,10 @@ int get_name(dptr dp1,dptr dp0) StrLen(*dp0) = 9; StrLoc(*dp0) = "&interval"; } -#endif /* Graphics */ +#endif /* Graphics */ else syserr("name: unknown integer keyword variable"); - + kywdevent: #ifdef MultiProgram if (VarLoc(*dp1) == &curpstate->eventsource) { @@ -292,9 +292,9 @@ int get_name(dptr dp1,dptr dp0) StrLoc(*dp0) = "&eventcode"; } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ syserr("name: unknown event keyword variable"); - + kywdwin: { StrLen(*dp0) = 7; StrLoc(*dp0) = "&window"; @@ -319,50 +319,50 @@ int get_name(dptr dp1,dptr dp0) if (Offset(*dp1) == 0) { /* * Must(?) be a named variable. - * (When used internally, could be reference to nameless - * temporary stack variables as occurs for string scanning). + * (When used internally, could be reference to nameless + * temporary stack variables as occurs for string scanning). */ - dp = VarLoc(*dp1); /* get address of variable */ + dp = VarLoc(*dp1); /* get address of variable */ if (InRange(globals,dp,eglobals)) { - *dp0 = gnames[dp - globals]; /* global */ - return GlobalName; - } + *dp0 = gnames[dp - globals]; /* global */ + return GlobalName; + } else if (InRange(statics,dp,estatics)) { - i = dp - statics - proc->fstatic; /* static */ + i = dp - statics - proc->fstatic; /* static */ if (i < 0 || i >= proc->nstatic) syserr("name: unreferencable static variable"); i += abs((int)proc->nparam) + abs((int)proc->ndynam); *dp0 = proc->lnames[i]; - return StaticName; + return StaticName; } else if (InRange(arg1, dp, &arg1[abs((int)proc->nparam)])) { *dp0 = proc->lnames[dp - arg1]; /* argument */ - return ParamName; - } + return ParamName; + } else if (InRange(loc1, dp, &loc1[proc->ndynam])) { *dp0 = proc->lnames[dp - loc1 + abs((int)proc->nparam)]; - return LocalName; + return LocalName; } else { - StrLen(*dp0) = 6; - StrLoc(*dp0) = "(temp)"; - return Failed; + StrLen(*dp0) = 6; + StrLoc(*dp0) = "(temp)"; + return Failed; /* syserr("name: cannot determine variable name"); */ - } + } } else { - if (is:string(*dp1) || (!is:variable(*dp1))) { /* non-variable! */ - StrLen(*dp0) = 14; - StrLoc(*dp0) = "(non-variable)"; - return Failed; - } + if (is:string(*dp1) || (!is:variable(*dp1))) { /* non-variable! */ + StrLen(*dp0) = 14; + StrLoc(*dp0) = "(non-variable)"; + return Failed; + } /* * Must be an element of a structure. */ blkptr = (union block *)VarLoc(*dp1); varptr = (dptr)((word *)VarLoc(*dp1) + Offset(*dp1)); switch ((int)BlkType(blkptr)) { - case T_Lelem: /* list */ + case T_Lelem: /* list */ i = varptr - &Blk(blkptr,Lelem)->lslots[blkptr->Lelem.first] + 1; if (i < 1) i += blkptr->Lelem.nslots; @@ -371,33 +371,33 @@ int get_name(dptr dp1,dptr dp0) i += blkptr->Lelem.nused; } sprintf(sbuf,"list_%ld[%ld]", - (long)Blk(Blk(blkptr,Lelem)->listprev,List)->id, (long)i); + (long)Blk(Blk(blkptr,Lelem)->listprev,List)->id, (long)i); i = strlen(sbuf); Protect(StrLoc(*dp0) = alcstr(sbuf,i), return RunError); StrLen(*dp0) = i; break; - case T_Record: /* record */ + case T_Record: /* record */ i = varptr - Blk(blkptr,Record)->fields; proc = &blkptr->Record.recdesc->Proc; sprintf(sbuf,"record %s_%ld.%s", StrLoc(proc->recname), - (long)(Blk(blkptr,Record)->id), - StrLoc(proc->lnames[i])); + (long)(Blk(blkptr,Record)->id), + StrLoc(proc->lnames[i])); i = strlen(sbuf); Protect(StrLoc(*dp0) = alcstr(sbuf,i), return RunError); StrLen(*dp0) = i; break; - case T_Telem: /* table */ + case T_Telem: /* table */ t = keyref(blkptr,dp0); if (t == RunError) return RunError; break; - default: /* none of the above */ + default: /* none of the above */ #ifdef MultiProgram - StrLen(*dp0) = 8; - StrLoc(*dp0) = "(struct)"; - return Failed; + StrLen(*dp0) = 8; + StrLoc(*dp0) = "(struct)"; + return Failed; #else syserr("name: invalid structure reference"); #endif /* MultiProgram */ @@ -407,7 +407,7 @@ int get_name(dptr dp1,dptr dp0) } return Succeeded; } - + #if COMPILER #begdef PTraceSetup() struct b_proc *proc; @@ -420,7 +420,7 @@ int get_name(dptr dp1,dptr dp0) proc = PFDebug(*pfp)->proc; /* get address of procedure block */ putstr(stderr, &proc->pname); #enddef - + /* * ctrace - a procedure is being called; produce a trace message. */ @@ -443,7 +443,7 @@ void ctrace() putc('\n', stderr); fflush(stderr); } - + /* * rtrace - a procedure is returning; produce a trace message. */ @@ -457,7 +457,7 @@ void rtrace() putc('\n', stderr); fflush(stderr); } - + /* * failtrace - procedure named s is failing; produce a trace message. */ @@ -469,7 +469,7 @@ void failtrace() fprintf(stderr, " failed\n"); fflush(stderr); } - + /* * strace - a procedure is suspending; produce a trace message. */ @@ -483,7 +483,7 @@ void strace() putc('\n', stderr); fflush(stderr); } - + /* * atrace - a procedure is being resumed; produce a trace message. */ @@ -494,8 +494,8 @@ void atrace() fprintf(stderr, " resumed\n"); fflush(stderr); } -#endif /* COMPILER */ - +#endif /* COMPILER */ + /* * keyref(bp,dp) -- print name of subscripted table */ @@ -504,11 +504,11 @@ static int keyref(bp, dp) dptr dp; { char *s, *s2; - char sbuf[256]; /* buffer; might be too small */ + char sbuf[256]; /* buffer; might be too small */ int len; if (getimage(&((bp->Telem.tref)),dp) == RunError) - return RunError; + return RunError; /* * Allocate space, and copy the image surrounded by "table_n[" and "]" @@ -525,7 +525,7 @@ static int keyref(bp, dp) sprintf(sbuf, "dbmfile(%s)[", StrLoc(Blk(bp,File)->fname)); } else -#endif /* Dbm */ +#endif /* Dbm */ sprintf(sbuf, "table_%ld[", (long)(Blk(bp,Table)->id)); { char * dest = sbuf + strlen(sbuf); strncpy(dest, s2, len); @@ -538,7 +538,7 @@ static int keyref(bp, dp) StrLen(*dp) = len; return Succeeded; } - + #ifdef CoExpr /* * cotrace -- a co-expression context switch; produce a trace message. @@ -553,7 +553,7 @@ dptr valloc; #if !COMPILER inst t_ipc; -#endif /* !COMPILER */ +#endif /* !COMPILER */ CURTSTATE_AND_CE(); --k_trace; @@ -561,7 +561,7 @@ dptr valloc; #if COMPILER showline(ccp->file_name, ccp->line_num); proc = PFDebug(*ccp->es_pfp)->proc; /* get address of procedure block */ -#else /* COMPILER */ +#else /* COMPILER */ /* * Compute the ipc of the instruction causing the context switch. @@ -569,7 +569,7 @@ dptr valloc; t_ipc.op = ipc.op - 1; showline(findfile(t_ipc.opnd), findline(t_ipc.opnd)); proc = BlkD(*glbl_argp, Proc); -#endif /* COMPILER */ +#endif /* COMPILER */ showlevel(k_level); putstr(stderr, &proc->pname); @@ -578,7 +578,7 @@ dptr valloc; if (IS_TS_THREAD(ccp->status)) fprintf(stderr,"; thread_%ld ", (long)ccp->id); else -#endif /* Concurrent */ +#endif /* Concurrent */ fprintf(stderr,"; co-expression_%ld ", (long)ccp->id); switch (swtch_typ) { @@ -601,13 +601,13 @@ dptr valloc; if (IS_TS_THREAD(ncp->status)) fprintf(stderr,"thread_%ld", (long)ncp->id); else -#endif /* Concurrent */ +#endif /* Concurrent */ fprintf(stderr,"co-expression_%ld\n", (long)ncp->id); fflush(stderr); } -#endif /* CoExpr */ - +#endif /* CoExpr */ + /* * showline - print file and line number information. */ @@ -621,9 +621,9 @@ int l; #if MVS while (i > 22) { -#else /* MVS */ +#else /* MVS */ while (i > 13) { -#endif /* MVS */ +#endif /* MVS */ f++; i--; } @@ -633,14 +633,14 @@ int l; fprintf(stderr, "%-22s: %4d ",f, l); else fprintf(stderr, " : "); -#else /* MVS */ +#else /* MVS */ fprintf(stderr, "%-13s: %4d ",f, l); else fprintf(stderr, " : "); -#endif /* MVS */ +#endif /* MVS */ } - + /* * showlevel - print "| " n times. */ @@ -659,25 +659,25 @@ register int n; #ifndef MultiProgram -extern struct descrip value_tmp; /* argument of Op_Apply */ -#endif /* MultiProgram */ +extern struct descrip value_tmp; /* argument of Op_Apply */ +#endif /* MultiProgram */ extern struct b_proc *opblks[]; - + /* * ttrace - show offending expression. */ static void ttrace(f) -FILE *f; +FILE *f; { struct b_proc *bp; word nargs; - dptr reset; + dptr reset; CURTSTATE_AND_CE(); fprintf(f, " "); - reset = xargp; + reset = xargp; switch ((int)lastop) { @@ -688,11 +688,11 @@ FILE *f; case Op_Invoke: nargs = xnargs; if (xargp[0].dword == D_Proc) { - bp = BlkD(*xargp, Proc); - if (bp) + bp = BlkD(*xargp, Proc); + if (bp) putstr(f, &(bp->pname)); - else fprintf(f,"???"); - } + else fprintf(f,"???"); + } else outimage(f, xargp, 0); putc('(', f); @@ -720,19 +720,19 @@ FILE *f; #if EBCDIC != 1 putc('[', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('<', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ outimage(f, ++xargp, 0); #if EBCDIC != 1 putc(']', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('>', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ putc('}', f); break; @@ -743,10 +743,10 @@ FILE *f; #if EBCDIC != 1 putc('[', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('<', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ outimage(f, ++xargp, 0); putc(':', f); @@ -754,10 +754,10 @@ FILE *f; #if EBCDIC != 1 putc(']', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('>', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ putc('}', f); break; @@ -790,12 +790,12 @@ FILE *f; putc('{', f); outimage(f, ++xargp, 0); fprintf(f, " . "); - ++xargp; - if (IntVal(*xargp) < 0 && fnames-efnames < IntVal(*xargp)) + ++xargp; + if (IntVal(*xargp) < 0 && fnames-efnames < IntVal(*xargp)) fprintf(f, "%s", StrLoc(efnames[IntVal(*xargp)])); - else if (0 <= IntVal(*xargp) && IntVal(*xargp) < efnames - fnames) + else if (0 <= IntVal(*xargp) && IntVal(*xargp) < efnames - fnames) fprintf(f, "%s", StrLoc(fnames[IntVal(*xargp)])); - else + else fprintf(f, "field"); putc('}', f); @@ -810,16 +810,16 @@ FILE *f; #if EBCDIC != 1 fprintf(f,"[ ... ]"); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ fputs("$< ... $>", f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ break; - + default: bp = opblks[lastop]; - if (!bp) break; + if (!bp) break; nargs = abs((int)bp->nparam); putc('{', f); if (lastop == Op_Bang || lastop == Op_Random) @@ -829,22 +829,22 @@ FILE *f; putc(' ', f); putstr(f, &(bp->pname)); putc(' ', f); - } + } else oneop: putstr(f, &(bp->pname)); outimage(f, ++xargp, 0); putc('}', f); } - + if (ipc.opnd != NULL) fprintf(f, " from line %d in %s", findline(ipc.opnd), findfile(ipc.opnd)); putc('\n', f); - xargp = reset; + xargp = reset; fflush(f); } - + /* * ctrace - procedure named s is being called with nargs arguments, the first @@ -870,7 +870,7 @@ dptr arg; putc('\n', stderr); fflush(stderr); } - + /* * rtrace - procedure named s is returning *rval; produce a trace message. */ @@ -894,7 +894,7 @@ dptr rval; putc('\n', stderr); fflush(stderr); } - + /* * failtrace - procedure named s is failing; produce a trace message. */ @@ -916,7 +916,7 @@ dptr dp; putc('\n', stderr); fflush(stderr); } - + /* * strace - procedure named s is suspending *rval; produce a trace message. */ @@ -940,7 +940,7 @@ dptr rval; putc('\n', stderr); fflush(stderr); } - + /* * atrace - procedure named s is being resumed; produce a trace message. */ @@ -962,7 +962,7 @@ dptr dp; putc('\n', stderr); fflush(stderr); } - + #ifdef CoExpr /* * coacttrace -- co-expression is being activated; produce a trace message. @@ -988,7 +988,7 @@ struct b_coexpr *ncp; if (IS_TS_THREAD(ccp->status)) fprintf(stderr,"; thread_%ld : ", (long)ccp->id); else -#endif +#endif fprintf(stderr,"; co-expression_%ld : ", (long)ccp->id); outimage(stderr, (dptr)(sp - 3), 0); @@ -997,12 +997,12 @@ struct b_coexpr *ncp; if (IS_TS_THREAD(ncp->status)) fprintf(stderr," @ thread_%ld\n", (long)ncp->id); else -#endif +#endif fprintf(stderr," @ co-expression_%ld\n", (long)ncp->id); fflush(stderr); } - + /* * corettrace -- return from co-expression; produce a trace message. */ @@ -1027,7 +1027,7 @@ struct b_coexpr *ncp; if (IS_TS_THREAD(ccp->status)) fprintf(stderr,"; thread_%ld returned ", (long)ccp->id); else -#endif +#endif fprintf(stderr,"; co-expression_%ld returned ", (long)ccp->id); outimage(stderr, (dptr)(&ncp->es_sp[-3]), 0); @@ -1036,12 +1036,12 @@ struct b_coexpr *ncp; if (IS_TS_THREAD(ncp->status)) fprintf(stderr," to thread_%ld\n", (long)ncp->id); else -#endif +#endif fprintf(stderr," to co-expression_%ld\n", (long)ncp->id); fflush(stderr); } - + /* * cofailtrace -- failure return from co-expression; produce a trace message. */ @@ -1065,24 +1065,24 @@ struct b_coexpr *ncp; #ifdef Concurrent if (IS_TS_THREAD(ccp->status) && IS_TS_THREAD(ncp->status)) fprintf(stderr,"; thread_%ld failed to thread_%ld\n", - (long)ccp->id, (long)ncp->id); + (long)ccp->id, (long)ncp->id); else if (IS_TS_THREAD(ccp->status) && !IS_TS_THREAD(ncp->status)) fprintf(stderr,"; thread_%ld failed to co-expression_%ld\n", - (long)ccp->id, (long)ncp->id); + (long)ccp->id, (long)ncp->id); else if (!IS_TS_THREAD(ccp->status) && IS_TS_THREAD(ncp->status)) fprintf(stderr,"; coexpression_%ld failed to thread_%ld\n", - (long)ccp->id, (long)ncp->id); + (long)ccp->id, (long)ncp->id); else -#endif +#endif fprintf(stderr,"; co-expression_%ld failed to co-expression_%ld\n", - (long)ccp->id, (long)ncp->id); + (long)ccp->id, (long)ncp->id); fflush(stderr); } -#endif /* CoExpr */ -#endif /* !COMPILER */ - +#endif /* CoExpr */ +#endif /* !COMPILER */ + /* * Service routine to display variables in given number of * procedure calls to file f. @@ -1091,9 +1091,9 @@ struct b_coexpr *ncp; int xdisp(fp,dp,count,f) #if COMPILER struct p_frame *fp; -#else /* COMPILER */ +#else /* COMPILER */ struct pf_marker *fp; -#endif /* COMPILER */ +#endif /* COMPILER */ register dptr dp; int count; FILE *f; @@ -1103,19 +1103,19 @@ int xdisp(fp,dp,count,f) struct b_proc *bp; word nglobals, *indices; - while (count--) { /* go back through 'count' frames */ + while (count--) { /* go back through 'count' frames */ if (fp == NULL) break; /* needed because &level is wrong in co-expressions */ #if COMPILER - bp = PFDebug(*fp)->proc; /* get address of procedure block */ -#else /* COMPILER */ + bp = PFDebug(*fp)->proc; /* get address of procedure block */ +#else /* COMPILER */ bp = BlkD(*dp, Proc); /* get addr of procedure block */ dp++; /* * #%#% was: no post-increment here, but *pre*increment dp below */ -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Print procedure name. @@ -1141,9 +1141,9 @@ int xdisp(fp,dp,count,f) */ #if COMPILER dp = fp->t.d; -#else /* COMPILER */ +#else /* COMPILER */ dp = &fp->pf_locals[0]; -#endif /* COMPILER */ +#endif /* COMPILER */ for (n = bp->ndynam; n > 0; n--) { fprintf(f, " "); putstr(f, np); @@ -1169,10 +1169,10 @@ int xdisp(fp,dp,count,f) #if COMPILER dp = fp->old_argp; fp = fp->old_pfp; -#else /* COMPILER */ +#else /* COMPILER */ dp = fp->pf_argp; fp = fp->pf_pfp; -#endif /* COMPILER */ +#endif /* COMPILER */ } /* @@ -1181,9 +1181,9 @@ int xdisp(fp,dp,count,f) #if COMPILER nglobals = n_globals; -#else /* COMPILER */ +#else /* COMPILER */ nglobals = eglobals - globals; -#endif /* COMPILER */ +#endif /* COMPILER */ indices = (word *)malloc((msize)nglobals * sizeof(word)); if (indices == NULL) @@ -1216,7 +1216,7 @@ char *pi, *pj; register word j = *(word *)pj; return lexcmp(&gnames[i], &gnames[j]); } - + #ifdef DebugHeap void heaperr(char *msg, union block *p, int t) @@ -1225,7 +1225,7 @@ void heaperr(char *msg, union block *p, int t) sprintf(buf, "%s : %p : %ld / %d\n",msg,p,ValidPtr(p)?p->File.title:-1,t); syserr(buf); } -#endif /* DebugHeap */ +#endif /* DebugHeap */ #ifdef DEVELOPMODE @@ -1259,7 +1259,7 @@ void dbgUTrace() { CURTSTATE_AND_CE(); tracebk(pfp, glbl_argp, NULL); -} +} /* This function may be used in test code where the criterion for a * break point is complex (it may be easier easier to write C code and diff --git a/src/runtime/rgfxsys.r b/src/runtime/rgfxsys.r index fe6d70b34..082cb5490 100644 --- a/src/runtime/rgfxsys.r +++ b/src/runtime/rgfxsys.r @@ -6,6 +6,6 @@ #ifdef Graphics -#else /* Graphics */ -/* static char junk; /* avoid empty module */ -#endif /* Graphics */ +#else /* Graphics */ +/* static char junk; /* avoid empty module */ +#endif /* Graphics */ diff --git a/src/runtime/rlocal.r b/src/runtime/rlocal.r index 1054815d3..de9ce6278 100644 --- a/src/runtime/rlocal.r +++ b/src/runtime/rlocal.r @@ -6,7 +6,7 @@ /* IMPORTANT NOTE: Because of the way RTL works, this file should not * contain any includes of system files, as in * - * include + * include * * Instead, such includes should be placed in h/sys.h. */ @@ -19,7 +19,7 @@ #if PORT /* place for anything system-specific */ Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if NT char *internal_cmds[] = { @@ -31,7 +31,7 @@ Deliberate Syntax Error int is_internal(char *s) { int i = 0; - char cmd[12], *cmdp, *s_ptr, *p; + char cmd[12], *cmdp, *s_ptr, *p; if ( p = strchr(s, ' ')){ cmdp=cmd; s_ptr=s; @@ -42,7 +42,7 @@ int is_internal(char *s) } else cmdp=s; - + while (internal_cmds[i]) { if (! strcmp(cmdp, internal_cmds[i])) return 1; i++; @@ -51,17 +51,17 @@ int is_internal(char *s) } #endif /* NT */ - + /*********************************** MSDOS ***********************************/ #if MSDOS #if TURBO extern unsigned _stklen = 16 * 1024; -#endif /* TURBO */ +#endif /* TURBO */ + +#endif /* MSDOS */ -#endif /* MSDOS */ - /*********************************** UNIX ***********************************/ #if UNIX @@ -75,8 +75,8 @@ extern unsigned _stklen = 16 * 1024; * Reduced code size by using variables pr and pnr instead of array refs. */ -#if ! defined __NR_vfork && defined __UCLIBC_HAS_MMU__ -#define vfork fork +#if ! defined __NR_vfork && defined __UCLIBC_HAS_MMU__ +#define vfork fork #endif struct filepid { @@ -108,9 +108,9 @@ void clear_all_filepids(){ while (temp) { if (temp->status == Fs_BPipe) - kill(temp->pid, SIGPIPE); + kill(temp->pid, SIGPIPE); else - kill(temp->pid, EOF); + kill(temp->pid, EOF); temp2 = temp; temp = temp->next; @@ -128,37 +128,37 @@ FILE *popen (const char *command, const char *mode) reading = (mode[0] == 'r'); if ((!reading && (mode[0] != 'w')) || mode[1]) { #if 0 - __set_errno(EINVAL); /* Invalid mode arg. */ + __set_errno(EINVAL); /* Invalid mode arg. */ #else - errno = EINVAL; + errno = EINVAL; #endif } else if (pipe(pipe_fd) == 0) { - pr = pipe_fd[reading]; - pnr = pipe_fd[1-reading]; - if ((fp = fdopen(pnr, mode)) != NULL) { - if ((pid = vfork()) == 0) { /* vfork -- child */ - close(pnr); - close(reading); - if (pr != reading) { - dup2(pr, reading); - close(pr); - } - execl("/bin/sh", "sh", "-c", command, (char *) 0); - _exit(255); /* execl failed! */ - } else { /* vfork -- parent or failed */ - close(pr); - if (pid > 0) { /* vfork -- parent */ - push_filepid(pid, fp, Fs_Pipe); - return fp; - } else { /* vfork -- failed! */ - fclose(fp); - } - } - } else { /* fdopen failed */ - close(pr); - close(pnr); - } + pr = pipe_fd[reading]; + pnr = pipe_fd[1-reading]; + if ((fp = fdopen(pnr, mode)) != NULL) { + if ((pid = vfork()) == 0) { /* vfork -- child */ + close(pnr); + close(reading); + if (pr != reading) { + dup2(pr, reading); + close(pr); + } + execl("/bin/sh", "sh", "-c", command, (char *) 0); + _exit(255); /* execl failed! */ + } else { /* vfork -- parent or failed */ + close(pr); + if (pid > 0) { /* vfork -- parent */ + push_filepid(pid, fp, Fs_Pipe); + return fp; + } else { /* vfork -- failed! */ + fclose(fp); + } + } + } else { /* fdopen failed */ + close(pr); + close(pnr); + } } return NULL; } @@ -167,42 +167,42 @@ int pclose(FILE *fd) { struct filepid *temp, *temp2, *tail = NULL; int pid; - int waitstat; - if (fclose(fd) != 0) { - return EOF; - } + int waitstat; + if (fclose(fd) != 0) { + return EOF; + } MUTEX_LOCKID(MTX_ROOT_FILEPIDS); - temp = root_of_all_filepids; - while (temp) { - if (temp->f == fd) { - pid = temp->pid; - if (temp->status == Fs_BPipe) - kill(pid, SIGPIPE); - else - kill(pid, EOF); - if (pid==waitpid(pid, &waitstat, 0 )){ /* we are good */ - if ((temp2 = temp->next)) { - *temp = *(temp->next); - free(temp2); - } - else if (temp == root_of_all_filepids) { - free(temp); - root_of_all_filepids = NULL; - } - else if (tail && tail->next==temp) { - tail->next = temp->next; - free(temp); - } - MUTEX_UNLOCKID(MTX_ROOT_FILEPIDS); - return waitstat; - } - } - tail = temp; - temp = temp->next; - } + temp = root_of_all_filepids; + while (temp) { + if (temp->f == fd) { + pid = temp->pid; + if (temp->status == Fs_BPipe) + kill(pid, SIGPIPE); + else + kill(pid, EOF); + if (pid==waitpid(pid, &waitstat, 0 )){ /* we are good */ + if ((temp2 = temp->next)) { + *temp = *(temp->next); + free(temp2); + } + else if (temp == root_of_all_filepids) { + free(temp); + root_of_all_filepids = NULL; + } + else if (tail && tail->next==temp) { + tail->next = temp->next; + free(temp); + } + MUTEX_UNLOCKID(MTX_ROOT_FILEPIDS); + return waitstat; + } + } + tail = temp; + temp = temp->next; + } MUTEX_UNLOCKID(MTX_ROOT_FILEPIDS); - wait(&waitstat ); - return waitstat; + wait(&waitstat ); + return waitstat; } #endif @@ -225,8 +225,8 @@ int pclose(FILE *fd) int rchar(int with_echo); -int getch(void) { return rchar(0); } -int getche(void) { return rchar(1); } +int getch(void) { return rchar(0); } +int getche(void) { return rchar(1); } int rchar(int with_echo) { @@ -234,7 +234,7 @@ int rchar(int with_echo) char c; int n; - tcgetattr(STDIN, &otty); /* get current tty attributes */ + tcgetattr(STDIN, &otty); /* get current tty attributes */ tty = otty; tty.c_lflag &= ~ICANON; @@ -242,15 +242,15 @@ int rchar(int with_echo) tty.c_lflag |= ECHO; else tty.c_lflag &= ~ECHO; - tcsetattr(STDIN, TCSANOW, &tty); /* set temporary attributes */ + tcsetattr(STDIN, TCSANOW, &tty); /* set temporary attributes */ checkpollevent(); - n = read(STDIN, &c, 1); /* read one char from stdin */ - - tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ + n = read(STDIN, &c, 1); /* read one char from stdin */ + + tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ - if (n == 1) /* if read succeeded */ + if (n == 1) /* if read succeeded */ return c & 0xFF; else return -1; @@ -266,28 +266,28 @@ int kbhit(void) unsigned i; ioctl(0, FIONREAD, &i); return i != 0; -#else /* KbhitIoctl */ +#else /* KbhitIoctl */ struct termios otty, tty; fd_set fds; struct timeval tv; int rv; - tcgetattr(STDIN, &otty); /* get current tty attributes */ + tcgetattr(STDIN, &otty); /* get current tty attributes */ tty = otty; - tty.c_lflag &= ~ICANON; /* disable input batching */ - tcsetattr(STDIN, TCSANOW, &tty); /* set attribute temporarily */ + tty.c_lflag &= ~ICANON; /* disable input batching */ + tcsetattr(STDIN, TCSANOW, &tty); /* set attribute temporarily */ - FD_ZERO(&fds); /* initialize fd struct */ - FD_SET(STDIN, &fds); /* set STDIN bit */ - tv.tv_sec = tv.tv_usec = 0; /* set immediate return */ + FD_ZERO(&fds); /* initialize fd struct */ + FD_SET(STDIN, &fds); /* set STDIN bit */ + tv.tv_sec = tv.tv_usec = 0; /* set immediate return */ rv = select(STDIN + 1, &fds, NULL, NULL, &tv); - tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ + tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ if (rv == -1) return 0; if (FD_ISSET(0, &fds)) return 1; -#endif /* KbhitIoctl */ +#endif /* KbhitIoctl */ return 0; } @@ -302,22 +302,22 @@ int kbhit_ms(int n) struct pollfd fd_stdin; int rv; - tcgetattr(STDIN, &otty); /* get current tty attributes */ + tcgetattr(STDIN, &otty); /* get current tty attributes */ tty = otty; - tty.c_lflag &= ~ICANON; /* disable input batching */ - tcsetattr(STDIN, TCSANOW, &tty); /* set attribute temporarily */ + tty.c_lflag &= ~ICANON; /* disable input batching */ + tcsetattr(STDIN, TCSANOW, &tty); /* set attribute temporarily */ fd_stdin.fd = fileno(stdin); fd_stdin.events = POLLIN; rv = poll(&fd_stdin, 1, n); - tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ - return rv == 1; /* return result */ + tcsetattr(STDIN, TCSANOW, &otty); /* reset tty to original state */ + return rv == 1; /* return result */ } -#endif /* UNIX */ +#endif /* UNIX */ /*********************************** VMS ***********************************/ @@ -349,25 +349,25 @@ typedef struct _descr { } descriptor; typedef struct _pipe { - long pid; /* process id of child */ - long status; /* exit status of child */ - long flags; /* LIB$SPAWN flags */ - int channel; /* MBX channel number */ - int efn; /* Event flag to wait for */ - char mode; /* the open mode */ - FILE *fptr; /* file pointer (for fun) */ - unsigned running : 1; /* 1 if child is running */ + long pid; /* process id of child */ + long status; /* exit status of child */ + long flags; /* LIB$SPAWN flags */ + int channel; /* MBX channel number */ + int efn; /* Event flag to wait for */ + char mode; /* the open mode */ + FILE *fptr; /* file pointer (for fun) */ + unsigned running : 1; /* 1 if child is running */ } Pipe; -Pipe _pipes[_NFILE]; /* one for every open file */ +Pipe _pipes[_NFILE]; /* one for every open file */ -#define NOWAIT 1 -#define NOCLISYM 2 -#define NOLOGNAM 4 -#define NOKEYPAD 8 -#define NOTIFY 16 -#define NOCONTROL 32 -#define SFLAGS (NOWAIT|NOKEYPAD|NOCONTROL) +#define NOWAIT 1 +#define NOCLISYM 2 +#define NOLOGNAM 4 +#define NOKEYPAD 8 +#define NOTIFY 16 +#define NOCONTROL 32 +#define SFLAGS (NOWAIT|NOKEYPAD|NOCONTROL) /* * delay_vms - delay for n milliseconds @@ -389,21 +389,21 @@ int n; * popen - open a pipe command * Last modified 2-Apr-86/chj * - * popen("command", mode) + * popen("command", mode) */ FILE *popen(cmd, mode) char *cmd; char *mode; { - FILE *pfile; /* the Pfile */ - Pipe *pd; /* _pipe database */ - descriptor mbxname; /* name of mailbox */ - descriptor command; /* command string descriptor */ - descriptor nl; /* null device descriptor */ - char mname[65]; /* mailbox name string */ - int chan; /* mailbox channel number */ - int status; /* system service status */ + FILE *pfile; /* the Pfile */ + Pipe *pd; /* _pipe database */ + descriptor mbxname; /* name of mailbox */ + descriptor command; /* command string descriptor */ + descriptor nl; /* null device descriptor */ + char mname[65]; /* mailbox name string */ + int chan; /* mailbox channel number */ + int status; /* system service status */ int efn; struct { short len; @@ -444,7 +444,7 @@ char *mode; return (0); } /* Save file information now */ - pd = &_pipes[fileno(pfile)]; /* get Pipe pointer */ + pd = &_pipes[fileno(pfile)]; /* get Pipe pointer */ pd->mode = _tolower(mode[0]); pd->fptr = pfile; pd->pid = pd->status = pd->running = 0; @@ -457,8 +457,8 @@ char *mode; command.length = strlen(cmd); command.ptr = cmd; status = LIB_SPAWN(&command, - (pd->mode == 'r') ? 0 : &mbxname, /* input file */ - (pd->mode == 'r') ? &mbxname : 0, /* output file */ + (pd->mode == 'r') ? 0 : &mbxname, /* input file */ + (pd->mode == 'r') ? &mbxname : 0, /* output file */ &pd->flags, 0, &pd->pid, &pd->status, &pd->efn, 0, 0, 0, 0); if (!(status & 1)) { LIB_FREE_EF(&efn); @@ -469,7 +469,7 @@ char *mode; } return (pfile); } - + /* * pclose - close a pipe * Last modified 2-Apr-86/chj @@ -485,7 +485,7 @@ FILE *pfile; pd = fileno(pfile) ? &_pipes[fileno(pfile)] : 0; if (pd == NULL) return (-1); - fflush(pd->fptr); /* flush buffers */ + fflush(pd->fptr); /* flush buffers */ fstatus = fclose(pfile); if (pd->mode == 'w') { status = SYS_QIOW(0, pd->channel, IO__WRITEOF, 0, 0, 0, 0, 0, 0, 0, 0, 0); @@ -496,12 +496,12 @@ FILE *pfile; pd->running = 0; return (fstatus); } - + /* * redirect(&argc,argv,nfargs) - redirect standard I/O - * int *argc number of command arguments (from call to main) - * char *argv[] command argument list (from call to main) - * int nfargs number of filename arguments to process + * int *argc number of command arguments (from call to main) + * char *argv[] command argument list (from call to main) + * int nfargs number of filename arguments to process * * argc and argv will be adjusted by redirect. * @@ -513,9 +513,9 @@ FILE *pfile; * Files are redirected based on syntax or position of command arguments. * Arguments of the following forms always redirect a file: * - * file redirects standard output to write to the given file - * >>file redirects standard output to append to the given file + * file redirects standard output to write to the given file + * >>file redirects standard output to append to the given file * * It is often useful to allow alternate input and output files as the * first two command arguments without requiring the file @@ -541,36 +541,36 @@ char *argv[]; int i; i = 1; - while (i < *argc) { /* for every command argument... */ - switch (argv[i][0]) { /* check first character */ - case '<': /* ': /* >file or >>file redirects stdout */ + case '>': /* >file or >>file redirects stdout */ if (argv[i][1] == '>') filearg(argc,argv,i,2,stdout,"a"); else filearg(argc,argv,i,1,stdout,"w"); break; - default: /* not recognized, go on to next arg */ + default: /* not recognized, go on to next arg */ i++; } } - if (nfargs >= 1 && *argc > 1) /* if positional redirection & 1 arg */ - filearg(argc,argv,1,0,stdin,"r"); /* then redirect stdin */ - if (nfargs >= 2 && *argc > 1) /* likewise for 2nd arg if wanted */ + if (nfargs >= 1 && *argc > 1) /* if positional redirection & 1 arg */ + filearg(argc,argv,1,0,stdin,"r"); /* then redirect stdin */ + if (nfargs >= 2 && *argc > 1) /* likewise for 2nd arg if wanted */ filearg(argc,argv,1,0,stdout,"w");/* redirect stdout */ } /* filearg(&argc,argv,n,i,fp,mode) - redirect and remove file argument - * int *argc number of command arguments (from call to main) - * char *argv[] command argument list (from call to main) - * int n argv entry to use as file name and then delete - * int i first character of file name to use (skip '<' etc.) - * FILE *fp file pointer for file to reopen (typically stdin etc.) - * char mode[] file access mode (see freopen spec) + * int *argc number of command arguments (from call to main) + * char *argv[] command argument list (from call to main) + * int n argv entry to use as file name and then delete + * int i first character of file name to use (skip '<' etc.) + * FILE *fp file pointer for file to reopen (typically stdin etc.) + * char mode[] file access mode (see freopen spec) */ filearg(argc,argv,n,i,fp,mode) @@ -578,17 +578,17 @@ int *argc, n, i; char *argv[], mode[]; FILE *fp; { - if (strcmp(argv[n]+i,"-")) /* alter file if arg not "-" */ + if (strcmp(argv[n]+i,"-")) /* alter file if arg not "-" */ fp = freopen(argv[n]+i,mode,fp); - if (fp == NULL) { /* abort on error */ + if (fp == NULL) { /* abort on error */ fprintf(stderr,"%%can't open %s",argv[n]+i); exit(EXIT_FAILURE); } - for ( ; n < *argc; n++) /* move down following arguments */ + for ( ; n < *argc; n++) /* move down following arguments */ argv[n] = argv[n+1]; - *argc = *argc - 1; /* decrement argument count */ + *argc = *argc - 1; /* decrement argument count */ } - + #ifdef KeyboardFncs short channel; @@ -612,14 +612,14 @@ int echo_on; char_available = 0; if (echo_on) SYS_QIOW(2, channel, IO__WRITEVBLK, 0, 0, 0, &char_typed, 1, - 0, 32, 0, 0); + 0, 32, 0, 0); goto return_char; } if (echo_on) SYS_QIOW(1, channel, IO__TTYREADALL, 0, 0, 0, &char_typed, 1, 0, 0, 0, 0); else SYS_QIOW(1, channel, IO__TTYREADALL | IO_M_NOECHO, 0, 0, 0, - &char_typed, 1, 0, 0, 0, 0); + &char_typed, 1, 0, 0, 0, 0); return_char: if (char_typed == '\003' && kill(getpid(), SIGINT) == -1) { @@ -659,11 +659,11 @@ int kbhit() return char_available; } -#endif /* KeyboardFncs */ +#endif /* KeyboardFncs */ -#endif /* VMS */ +#endif /* VMS */ /* * End of operating-system specific code. */ -/* static char xjunk; /* avoid empty module */ +/* static char xjunk; /* avoid empty module */ diff --git a/src/runtime/rlrgint.r b/src/runtime/rlrgint.r index 4501b02bf..f54914022 100644 --- a/src/runtime/rlrgint.r +++ b/src/runtime/rlrgint.r @@ -30,7 +30,7 @@ * pairs specifying unsigned base-B digit strings. The sign handling * is done in the bigxxx routines. */ - + /* * Type for doing arithmetic on (2 * NB)-bit nonnegative numbers. * Normally unsigned but may be signed (with NB reduced appropriately) @@ -95,37 +95,37 @@ * Prototypes. */ -static int mkdesc (struct b_bignum *x, dptr dx); -static void itobig (word i, struct b_bignum *x, dptr dx); +static int mkdesc (struct b_bignum *x, dptr dx); +static void itobig (word i, struct b_bignum *x, dptr dx); -static void decout (FILE *f, DIGIT *n, word l); +static void decout (FILE *f, DIGIT *n, word l); -int bigaddi (dptr da, word i, dptr dx); -int bigsubi (dptr da, word i, dptr dx); -static int bigmuli (dptr da, word i, dptr dx); -static int bigdivi (dptr da, word i, dptr dx); -static int bigmodi (dptr da, word i, dptr dx); -static int bigpowi (dptr da, word i, dptr dx); -static int bigpowii (word a, word i, dptr dx); -static word bigcmpi (dptr da, word i); +int bigaddi (dptr da, word i, dptr dx); +int bigsubi (dptr da, word i, dptr dx); +static int bigmuli (dptr da, word i, dptr dx); +static int bigdivi (dptr da, word i, dptr dx); +static int bigmodi (dptr da, word i, dptr dx); +static int bigpowi (dptr da, word i, dptr dx); +static int bigpowii (word a, word i, dptr dx); +static word bigcmpi (dptr da, word i); -static DIGIT add1 (DIGIT *u, DIGIT *v, DIGIT *w, word n); -static word sub1 (DIGIT *u, DIGIT *v, DIGIT *w, word n); -static void mul1 (DIGIT *u, DIGIT *v, DIGIT *w, word n, word m); -static int div1 +static DIGIT add1 (DIGIT *u, DIGIT *v, DIGIT *w, word n); +static word sub1 (DIGIT *u, DIGIT *v, DIGIT *w, word n); +static void mul1 (DIGIT *u, DIGIT *v, DIGIT *w, word n, word m); +static int div1 (DIGIT *a, DIGIT *b, DIGIT *q, DIGIT *r, word m, word n, struct b_bignum *b1, struct b_bignum *b2); -static void compl1 (DIGIT *u, DIGIT *w, word n); -static word cmp1 (DIGIT *u, DIGIT *v, word n); -static DIGIT addi1 (DIGIT *u, word k, DIGIT *w, word n); -static void subi1 (DIGIT *u, word k, DIGIT *w, word n); -static DIGIT muli1 (DIGIT *u, word k, int c, DIGIT *w, word n); -static DIGIT divi1 (DIGIT *u, word k, DIGIT *w, word n); -static DIGIT shifti1 (DIGIT *u, word k, DIGIT c, DIGIT *w, word n); -static word cmpi1 (DIGIT *u, word k, word n); +static void compl1 (DIGIT *u, DIGIT *w, word n); +static word cmp1 (DIGIT *u, DIGIT *v, word n); +static DIGIT addi1 (DIGIT *u, word k, DIGIT *w, word n); +static void subi1 (DIGIT *u, word k, DIGIT *w, word n); +static DIGIT muli1 (DIGIT *u, word k, int c, DIGIT *w, word n); +static DIGIT divi1 (DIGIT *u, word k, DIGIT *w, word n); +static DIGIT shifti1 (DIGIT *u, word k, DIGIT c, DIGIT *w, word n); +static word cmpi1 (DIGIT *u, word k, word n); #define bdzero(dest,l) memset(dest, '\0', (l) * sizeof(DIGIT)) #define bdcopy(src, dest, l) memcpy(dest, src, (l) * sizeof(DIGIT)) - + /* * mkdesc -- put value into a descriptor */ @@ -155,9 +155,9 @@ dptr dx; word i; for (i = x->msd; ++i <= x->lsd; ) - val = (word)((uword)val << NB) - x->digits[i]; + val = (word)((uword)val << NB) - x->digits[i]; if (!x->sign) - val = -val; + val = -val; dx->dword = D_Integer; IntVal(*dx) = val; } @@ -179,7 +179,7 @@ dptr dx; { #ifdef DebugHeap x->title = T_Lrgint; -#endif /* DebugHeap */ +#endif /* DebugHeap */ x->lsd = WORDLEN - 1; x->msd = WORDLEN; x->sign = 0; @@ -200,7 +200,7 @@ dptr dx; *DIG(x,0) = d; x->sign = 1; } - + while (i != 0) { x->msd--; *DIG(x,0) = lo(i); @@ -210,9 +210,9 @@ dptr dx; dx->dword = D_Lrgint; BlkLoc(*dx) = (union block *)x; } - + /* - * string -> bignum + * string -> bignum */ word bigradix(sign, r, s, end_s, result) @@ -241,7 +241,7 @@ union numeric *result; /* output T_Integer or T_Lrgint */ c = ((s < end_s) ? *s++ : ' ')) { c = tonum(c); if (c >= r) - return CvtFail; + return CvtFail; muli1(bd, (word)r, c, bd, len); } @@ -320,11 +320,11 @@ dptr da, dx; *DIG(b,i) = d; x -= d; } - + b->sign = sgn; return mkdesc(b, dx); } - + /* * bignum -> string */ @@ -363,18 +363,18 @@ dptr da, dx; (word)10, DIG(temp,0), alen); -#endif /* VMS */ +#endif /* VMS */ if (a->sign) *--p = '-'; StrLen(*dx) = q - p; StrLoc(*dx) = p; - return NoCvt; /* The mnemonic is wrong, but the signal means */ - /* that the string is allocated and not null- */ - /* terminated. */ + return NoCvt; /* The mnemonic is wrong, but the signal means */ + /* that the string is allocated and not null- */ + /* terminated. */ } /* - * bignum -> file + * bignum -> file */ void bigprint(f, da) @@ -387,9 +387,9 @@ dptr da; struct b_bignum *blk = BlkD(*da,Lrgint); slen = blk->lsd - blk->msd; - dlen = slen * NB * 0.3010299956639812 /* 1 / log2(10) */ + dlen = slen * NB * 0.3010299956639812 /* 1 / log2(10) */ + log((double)blk->digits[blk->msd]) * 0.4342944819032518 + 0.5; - /* 1 / ln(10) */ + /* 1 / ln(10) */ if (dlen >= MaxDigits) { fprintf(f, "integer(~10^%ld)",(long)dlen); return; @@ -442,7 +442,7 @@ dptr da, dx; x->sign = a->sign; return mkdesc(x, dx); } - + /* * da + db -> dx */ @@ -558,7 +558,7 @@ dptr dx; /* * da - db -> dx - */ + */ int bigsub(da, db, dx) dptr da, db, dx; @@ -727,7 +727,7 @@ dptr da, db, dx; itobig(IntVal(*da), (struct b_bignum *)tdigits, &td); return bigsubi(&td, IntVal(*db), dx); } - + } /* @@ -770,7 +770,7 @@ dptr da, db, dx; /* * da / db -> dx */ - + int bigdiv(da, db, dx) dptr da, db, dx; { @@ -845,7 +845,7 @@ dptr da, db, dx; b = LrgInt(db); Protect(x = alcbignum(blen), return RunError); if (blen == 1) { - Protect(temp = alcbignum(alen), return RunError); + Protect(temp = alcbignum(alen), return RunError); *DIG(x,0) = divi1(DIG(a,0), (word)*DIG(b,0), @@ -865,7 +865,7 @@ dptr da, db, dx; x->sign = a->sign; return mkdesc(x, dx); } - else /* bignum % integer */ + else /* bignum % integer */ return bigmodi(da, IntVal(*db), dx); } @@ -906,63 +906,63 @@ dptr da, db, dx; b = LrgInt ( db ); if (Type(*da) == T_Lrgint) { - if ( b->sign ) { - /* bignum ^ -bignum = 0 */ - *dx = zerodesc; - return Succeeded; - } - else - /* bignum ^ +bignum = guaranteed overflow */ - ReturnErrNum(307, RunError); - } + if ( b->sign ) { + /* bignum ^ -bignum = 0 */ + *dx = zerodesc; + return Succeeded; + } + else + /* bignum ^ +bignum = guaranteed overflow */ + ReturnErrNum(307, RunError); + } else if ( b->sign ) - /* integer ^ -bignum */ - switch ( IntVal ( *da ) ) { - case 1: - *dx = onedesc; - return Succeeded; - case -1: - /* Result is +1 / -1, depending on whether *b is even or odd. */ - if ( ( b->digits[ b->lsd ] ) & 01 ) - MakeInt ( -1, dx ); - else - *dx = onedesc; - return Succeeded; - case 0: - ReturnErrNum(204,RunError); - default: - /* da ^ (negative int) = 0 for all non-special cases */ - *dx = zerodesc; - return Succeeded; - } + /* integer ^ -bignum */ + switch ( IntVal ( *da ) ) { + case 1: + *dx = onedesc; + return Succeeded; + case -1: + /* Result is +1 / -1, depending on whether *b is even or odd. */ + if ( ( b->digits[ b->lsd ] ) & 01 ) + MakeInt ( -1, dx ); + else + *dx = onedesc; + return Succeeded; + case 0: + ReturnErrNum(204,RunError); + default: + /* da ^ (negative int) = 0 for all non-special cases */ + *dx = zerodesc; + return Succeeded; + } else { - /* integer ^ +bignum */ - word n, blen; - register DIGIT nth_dig, mask; - - b = LrgInt ( db ); - blen = LEN ( b ); - - /* We scan the bits of b from the most to least significant. - * The bit position in b is represented by the pair ( n, mask ) - * where n is the DIGIT number (0 = most sig.) and mask is the - * the bit mask for the current bit. - * - * For each bit (most sig to least) in b, - * for each zero, square the partial result; - * for each one, square it and multiply it by a */ - *dx = onedesc; - for ( n = 0; n < blen; ++n ) { - nth_dig = *DIG ( b, n ); - for ( mask = 1U << ( NB - 1 ); mask; mask >>= 1 ) { - if ( bigmul ( dx, dx, dx ) == RunError ) - return RunError; - if ( nth_dig & mask ) - if ( bigmul ( dx, da, dx ) == RunError ) - return RunError; - } - } - } + /* integer ^ +bignum */ + word n, blen; + register DIGIT nth_dig, mask; + + b = LrgInt ( db ); + blen = LEN ( b ); + + /* We scan the bits of b from the most to least significant. + * The bit position in b is represented by the pair ( n, mask ) + * where n is the DIGIT number (0 = most sig.) and mask is the + * the bit mask for the current bit. + * + * For each bit (most sig to least) in b, + * for each zero, square the partial result; + * for each one, square it and multiply it by a */ + *dx = onedesc; + for ( n = 0; n < blen; ++n ) { + nth_dig = *DIG ( b, n ); + for ( mask = 1U << ( NB - 1 ); mask; mask >>= 1 ) { + if ( bigmul ( dx, dx, dx ) == RunError ) + return RunError; + if ( nth_dig & mask ) + if ( bigmul ( dx, da, dx ) == RunError ) + return RunError; + } + } + } return Succeeded; } else if (Type(*da) == T_Lrgint) /* bignum ^ integer */ @@ -986,9 +986,9 @@ dptr db, drslt; blen = LEN ( b ); if ( b->sign ) { if ( a == 0.0 ) - ReturnErrNum(204, RunError); + ReturnErrNum(204, RunError); else - a = 1.0 / a; + a = 1.0 / a; } /* We scan the bits of b from the most to least significant. @@ -1003,17 +1003,17 @@ dptr db, drslt; for ( n = 0; n < blen; ++n ) { nth_dig = *DIG ( b, n ); for ( mask = 1U << ( NB - 1 ); mask; mask >>= 1 ) { - retval *= retval; - if ( nth_dig & mask ) - retval *= a; - } + retval *= retval; + if ( nth_dig & mask ) + retval *= a; + } } #ifdef DescriptorDouble drslt->vword.realval = retval; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ Protect(BlkLoc(*drslt) = (union block *)alcreal(retval), return RunError); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ drslt->dword = D_Real; return Succeeded; } @@ -1049,7 +1049,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1061,9 +1061,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] & bd[i]; @@ -1093,7 +1093,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1105,9 +1105,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] & bd[i]; @@ -1137,7 +1137,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1149,9 +1149,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] & bd[i]; @@ -1199,7 +1199,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1211,9 +1211,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] | bd[i]; @@ -1243,7 +1243,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1255,9 +1255,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] | bd[i]; @@ -1287,7 +1287,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1299,9 +1299,9 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } - + for (i = 0; i < xlen; i++) *DIG(x,i) = ad[i] | bd[i]; @@ -1349,7 +1349,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1361,7 +1361,7 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } for (i = 0; i < xlen; i++) @@ -1393,7 +1393,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1405,7 +1405,7 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } for (i = 0; i < xlen; i++) @@ -1437,7 +1437,7 @@ dptr da, db, dx; bdcopy(DIG(a,0), &ad[xlen-alen], alen); if (a->sign) - compl1(ad, ad, xlen); + compl1(ad, ad, xlen); } if (blen == xlen && !b->sign) @@ -1449,7 +1449,7 @@ dptr da, db, dx; bdcopy(DIG(b,0), &bd[xlen-blen], blen); if (b->sign) - compl1(bd, bd, xlen); + compl1(bd, bd, xlen); } for (i = 0; i < xlen; i++) @@ -1571,7 +1571,7 @@ dptr da, db; /* * ?da -> dx - */ + */ int bigrand(da, dx) dptr da, dx; @@ -1591,7 +1591,7 @@ dptr da, dx; rval = RandVal; d[i] = rval * B; } - + Protect(tu = alcbignum(alen + 2), return RunError); Protect(tv = alcbignum(alen), return RunError); if (div1(d, DIG(a,0), @@ -1605,7 +1605,7 @@ dptr da, dx; alen); return mkdesc(x, dx); } - + /* * da + i -> dx */ @@ -1614,9 +1614,9 @@ int bigaddi(da, i, dx) dptr da, dx; word i; { - tended struct b_bignum *a; - struct b_bignum *x; - word alen; + tended struct b_bignum *a; + struct b_bignum *x; + word alen; if (i < 0 && i > MinLong) return bigsubi(da, -i, dx); @@ -1631,7 +1631,7 @@ word i; alen = LEN(LrgInt(da)); a = LrgInt(da); if (a->sign) { - Protect(x = alcbignum(alen), return RunError); + Protect(x = alcbignum(alen), return RunError); subi1(DIG(a,0), i, DIG(x,0), @@ -1658,8 +1658,8 @@ int bigsubi(da, i, dx) dptr da, dx; word i; { - tended struct b_bignum *a; - struct b_bignum *x; + tended struct b_bignum *a; + struct b_bignum *x; word alen; if (i < 0 && i > MinLong) @@ -1702,8 +1702,8 @@ static int bigmuli(da, i, dx) dptr da, dx; word i; { - tended struct b_bignum *a; - struct b_bignum *x; + tended struct b_bignum *a; + struct b_bignum *x; word alen; if (i <= -B || i >= B) { @@ -1740,8 +1740,8 @@ static int bigdivi(da, i, dx) dptr da, dx; word i; { - tended struct b_bignum *a; - struct b_bignum *x; + tended struct b_bignum *a; + struct b_bignum *x; word alen; if (i <= -B || i >= B) { @@ -1791,14 +1791,14 @@ word i; else { alen = LEN(LrgInt(da)); a = LrgInt(da); - temp = a; /* avoid trash pointer */ + temp = a; /* avoid trash pointer */ Protect(temp = alcbignum(alen), return RunError); x = divi1(DIG(a,0), Abs(i), DIG(temp,0), alen); if (a->sign) - x = -x; + x = -x; MakeInt(x, dx); return Succeeded; } @@ -1813,21 +1813,21 @@ dptr da, dx; word i; { int n = WordBits; - + if (i > 0) { /* scan bits left to right. skip leading 1. */ while (--n >= 0) if (i & ((uword)1 << n)) - break; + break; /* then, for each zero, square the partial result; for each one, square it and multiply it by a */ *dx = *da; while (--n >= 0) { if (bigmul(dx, dx, dx) == RunError) - return RunError; + return RunError; if (i & ((uword)1 << n)) if (bigmul(dx, da, dx) == RunError) - return RunError; + return RunError; } } else if (i == 0) { @@ -1861,7 +1861,7 @@ dptr dx; } if (a == -1) { /* -1 ^ [odd,even] -> [-1,+1] */ if (!(i & 1)) - a = 1; + a = 1; } else if (a != 1) { /* 1 ^ any -> 1 */ a = 0; @@ -1876,15 +1876,15 @@ dptr dx; /* scan bits left to right. skip leading 1. */ while (--n >= 0) if (i & ((uword)1 << n)) - break; + break; /* then, for each zero, square the partial result; for each one, square it and multiply it by a */ x = a; while (--n >= 0) { if (isbig) { if (bigmul(dx, dx, dx) == RunError) - return RunError; - } + return RunError; + } else { y = mul(x, x, &over_flow); if (!over_flow) @@ -1892,15 +1892,15 @@ dptr dx; else { itobig(x, (struct b_bignum *)tdigits, &td); if (bigmul(&td, &td, dx) == RunError) - return RunError; + return RunError; isbig = (Type(*dx) == T_Lrgint); - } + } } if (i & ((uword)1 << n)) { if (isbig) { if (bigmuli(dx, a, dx) == RunError) - return RunError; - } + return RunError; + } else { y = mul(x, a, &over_flow); if (!over_flow) @@ -1908,15 +1908,15 @@ dptr dx; else { itobig(x, (struct b_bignum *)tdigits, &td); if (bigmuli(&td, a, dx) == RunError) - return RunError; + return RunError; isbig = (Type(*dx) == T_Lrgint); } } } } if (!isbig) { - MakeInt(x, dx); - } + MakeInt(x, dx); + } } return Succeeded; } @@ -1925,8 +1925,8 @@ dptr dx; * negative if da < i * zero if da == i * positive if da > i - */ - + */ + static word bigcmpi(da, i) dptr da; word i; @@ -1937,16 +1937,16 @@ word i; if (i > -B && i < B) { if (i >= 0) if (a->sign) - return -1; + return -1; else - return cmpi1(DIG(a,0), - i, alen); + return cmpi1(DIG(a,0), + i, alen); else if (a->sign) - return -cmpi1(DIG(a,0), - -i, alen); + return -cmpi1(DIG(a,0), + -i, alen); else - return 1; + return 1; } else { struct descrip td; @@ -1957,7 +1957,7 @@ word i; } } - + /* These are all straight out of Knuth vol. 2, Sec. 4.3.1. */ /* @@ -1970,7 +1970,7 @@ static DIGIT add1(u, v, w, n) DIGIT *u, *v, *w; word n; { - uword dig, carry; + uword dig, carry; word i; carry = 0; @@ -1992,7 +1992,7 @@ static word sub1(u, v, w, n) DIGIT *u, *v, *w; word n; { - uword dig, carry; + uword dig, carry; word i; carry = 0; @@ -2073,7 +2073,7 @@ struct b_bignum *tu, *tv; qhat -= 1; rhat += v[0]; } - + /* D4 */ carry = 0; for (i = n; i > 0; i--) { @@ -2087,12 +2087,12 @@ struct b_bignum *tu, *tv; /* D5 */ if (q) - q[j] = qhat; + q[j] = qhat; /* D6 */ if (carry) { if (q) - q[j] -= 1; + q[j] -= 1; carry = 0; for (i = n; i > 0; i--) { dig = (uword)u[i+j] + v[i-1] + carry; @@ -2160,7 +2160,7 @@ word n; { uword dig, carry; word i; - + carry = k; for (i = n; --i >= 0; ) { dig = (uword)u[i] + carry; @@ -2184,7 +2184,7 @@ word n; { uword dig, carry; word i; - + carry = -k; for (i = n; --i >= 0; ) { dig = (uword)u[i] + carry; @@ -2246,7 +2246,7 @@ word n; * ((u,n) << k) + c -> (w,n) * * k in 0 .. NB-1 - * c in 0 .. B-1 + * c in 0 .. B-1 * returns carry, 0 .. B-1 */ @@ -2262,7 +2262,7 @@ word n; bdcopy(u, w, n); return 0; } - + for (i = n; --i >= 0; ) { dig = ((uword)u[i] << k) + c; w[i] = lo(dig); @@ -2286,12 +2286,12 @@ word n; for (i = 0; i < n-1; i++) if (u[i]) - return 1; + return 1; if (u[n - 1] == (DIGIT)k) return 0; return u[n - 1] > (DIGIT)k ? 1 : -1; } - -#else /* LargeInts */ -/* static char junk; /* prevent empty module */ -#endif /* LargeInts */ + +#else /* LargeInts */ +/* static char junk; /* prevent empty module */ +#endif /* LargeInts */ diff --git a/src/runtime/rmac.ri b/src/runtime/rmac.ri index 7abd877e8..e236d0f02 100644 --- a/src/runtime/rmac.ri +++ b/src/runtime/rmac.ri @@ -6,9 +6,9 @@ #passthru #ifndef __QUICKDRAW__ struct RGBColor { - unsigned short red; /*magnitude of red component*/ - unsigned short green; /*magnitude of green component*/ - unsigned short blue; /*magnitude of blue component*/ + unsigned short red; /*magnitude of red component*/ + unsigned short green; /*magnitude of green component*/ + unsigned short blue; /*magnitude of blue component*/ }; typedef struct RGBColor RGBColor, *RGBColorPtr, **RGBColorHdl; #passthru #endif @@ -23,17 +23,17 @@ extern long gNumColors; /* * Prototypes */ -int CreateWindow (wbp wb); -int seticonicstate (wbp w, char *s); -void unsetclip (wbp w); -int seticonpos (wbp w, char *s); -int setdisplay (wbp w, char *s); +int CreateWindow (wbp wb); +int seticonicstate (wbp w, char *s); +void unsetclip (wbp w); +int seticonpos (wbp w, char *s); +int setdisplay (wbp w, char *s); /* * allocates a window binding, a context and a state, then calls * CreateWindow to draw the window on screen */ - + FILE *wopen(name, lp, attr, n, err_index) char *name; struct b_list *lp; @@ -52,24 +52,24 @@ int n, *err_index; tended struct descrip attrrslt; tlp = lp; - - for(i=0;i8) && - !strncmp("display=",StrLoc(attr[i]),8)) - { + (StrLen(attr[i])>8) && + !strncmp("display=",StrLoc(attr[i]),8)) + { strncpy(dispchrs,StrLoc(attr[i])+8,StrLen(attr[i])-8); dispchrs [ StrLen(attr[i])-8 ] = '\0'; - display = dispchrs; + display = dispchrs; } } - + /* * Allocate a binding, a state and a context */ - + Protect(wb = alc_wbinding(), return NULL); Protect(wb->window = alc_winstate(), { free_binding(wb); return NULL; }); Protect(wb->context = alc_context(wb), { free_binding(wb); return NULL; }); @@ -86,7 +86,7 @@ int n, *err_index; ws->posy = 60; ws->posx = 20; ws->visible = kVisible; - + /* * some window attributes */ @@ -100,20 +100,20 @@ int n, *err_index; * write the attribute, * except "display=" attribute, which is done earlier */ - if((StrLen(attr[i])<9)||strncmp(StrLoc(attr[i]),"display=",8)) + if((StrLen(attr[i])<9)||strncmp(StrLoc(attr[i]),"display=",8)) { - switch (wattrib((wbp) wb, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt, answer)) - { - case RunError: - *err_index = i; - return NULL; - case Failed: - free_binding((wbp)wb); - return NULL; - } - } + switch (wattrib((wbp) wb, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt, answer)) + { + case RunError: + *err_index = i; + return NULL; + case Failed: + free_binding((wbp)wb); + return NULL; + } + } } - + /* set window color according to context */ @@ -124,24 +124,24 @@ int n, *err_index; /* * Creates a window and shows it on screen */ - + int CreateWindow(wbp wb) { Rect winRect; QDErr errGWorld; STDLOCALS (wb); - + /* * create the window */ - - SetRect (&winRect, - ws->posx, ws->posy, - (ws->posx)+(ws->width), + + SetRect (&winRect, + ws->posx, ws->posy, + (ws->posx)+(ws->width), (ws->posy)+(ws->height)); - + ws->theWindow = NewCWindow (nil, &winRect, "\pUntitled", @@ -150,7 +150,7 @@ int CreateWindow(wbp wb) kMoveToFront, kHasGoAway, kNilRefCon); - + /* * creating offscreen graphics world */ @@ -192,7 +192,7 @@ int x, y, width, height, x2, y2; SetRect (&sourceRect, x, y, x+width, y+height); SetRect (&destRect, x2, y2, x2+width, y2+width); - + CopyBits (&(((GrafPtr)(wb1->window->theWindow))->portBits), &(((GrafPtr)(wb2->window->theWindow))->portBits), &sourceRect, &destRect, srcCopy, nil); @@ -223,7 +223,7 @@ int x, y, width, height; { Rect r; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); SetRect (&r, x - 1, @@ -231,8 +231,8 @@ int x, y, width, height; (width == 0) ? (ws->posx + ws->width) : (x - 1 + width), (height == 0) ? (ws->posy + ws->height) : (y - 1 + height) ); EraseRect (&r); - -/* */ + +/* */ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); EraseRect (&r); @@ -312,15 +312,15 @@ int i; { RGBColor c; STDLOCALS (wb); - + if (-i > gNumColors) return Failed; GetEntryColor (gPal, -i-1, &c); wc->contextPtr->fgColor = c; - + SetPort (ws->theWindow); PmForeColor (-i - 1); -/* */ +/* */ GetGWorld (&(ws->origPort), &(ws->origDev)); SetGWorld (ws->offScreenGWorld, nil); ws->lockOK = LockPixels (ws->offScreenPMHandle); @@ -340,11 +340,11 @@ int i; { RGBColor c; STDLOCALS (wb); - + if (-i > gNumColors) return Failed; GetEntryColor (gPal, -i-1, &c); wc->contextPtr->bgColor = c; - + SetPort (ws->theWindow); PmBackColor (-i - 1); } @@ -356,13 +356,13 @@ char *s; long r, g, b; RGBColor c; STDLOCALS (wb); - + if (parsecolor (NULL, s, &r, &g, &b) == Succeeded) { RED (c) = r; GREEN (c) = g; BLUE (c) = b; wc->contextPtr->fgColor = c; - + SetPort (ws->theWindow); RGBForeColor (&c); @@ -376,8 +376,8 @@ char *s; } else return Failed; - - return Succeeded; + + return Succeeded; } int setbg(wb,s) @@ -387,7 +387,7 @@ char *s; long r, g, b; RGBColor c; STDLOCALS (wb); - + if (parsecolor (NULL, s, &r, &g, &b) == Succeeded) { RED (c) = r; GREEN (c) = g; @@ -398,8 +398,8 @@ char *s; } else return Failed; - - return Succeeded; + + return Succeeded; } int nativecolor(w, s, r, g, b) @@ -438,7 +438,7 @@ char *s; { RGBColor c; STDLOCALS (wb); - + SetPort (ws->theWindow); GetCPixel (x, y, &c); *rv = ((c.red << 8) + c.green) << 8 + c.blue; @@ -468,7 +468,7 @@ char *answer; */ #passthru #if (DMAXCOLORS > 256) #passthru Deliberate Syntax error -#passthru #endif /* DMAXCOLORS */ +#passthru #endif /* DMAXCOLORS */ int getimstr(w, x, y, width, height, paltbl, data) wbp w; @@ -489,7 +489,7 @@ wbp wb; char *s; { STDLOCALS (wb); - + if (ws->theWindow == (WindowPtr) (NULL)) sprintf (s, "absent"); else @@ -516,7 +516,7 @@ char *s; STDLOCALS(wb); if (!strcmp(s, "iconic")) { - return Failed; /* not supported */ + return Failed; /* not supported */ } else if (!strcmp(s, "normal")) { ws->visible = kVisible; @@ -526,7 +526,7 @@ char *s; } } else if (!strcmp(s, "maximal")) { - return Failed; /* not supported */ + return Failed; /* not supported */ } else if (!strcmp(s, "hidden")) { ws->visible = kInvisible; @@ -645,7 +645,7 @@ int mute_index; RGBColor c; char *tmp = malloc (28); STDLOCALS (wb); - + if (-mute_index > gNumColors) return NULL; GetEntryColor (gPal, -mute_index - 1, &c); sprintf(tmp, "%d", mute_index); @@ -661,7 +661,7 @@ char *s; long r, g, b; RGBColor c; STDLOCALS (wb); - + if (parsecolor (NULL, s, &r, &g, &b) != Succeeded ) return Failed; c.red = r; @@ -670,12 +670,12 @@ char *s; AnimateEntry (ws->theWindow, -i - 1, &c); ActivatePalette (ws->theWindow); -/* +/* ws->lockOK = LockPixels (ws->offScreenPMHandle); AnimateEntry ((WindowPtr)(ws->offScreenGWorld), -i-1, &c); ActivatePalette ((WindowPtr)(ws->offScreenGWorld)); UnlockPixels (ws->offScreenPMHandle); - */ + */ return Succeeded; } @@ -700,7 +700,7 @@ int *retval; { STDLOCALS(wb); - + gNumColors++; if (gNumColors == 1) { gPal = NewPalette (gNumColors, nil, pmAnimated, kZeroTolerance); @@ -710,7 +710,7 @@ int *retval; SetEntryUsage (gPal, gNumColors-1, pmAnimated, kZeroTolerance); } SetPalette (ws->theWindow, gPal, true); - + /* */ ws->lockOK = LockPixels (ws->offScreenPMHandle); SetPalette((WindowPtr)(ws->offScreenGWorld), gPal, true); @@ -718,9 +718,9 @@ int *retval; /* */ /* set the color */ - + if (argc > 0) { - if (argc != 1) + if (argc != 1) return RunError; else if (argv[0].dword == D_Integer) { @@ -740,13 +740,13 @@ int *retval; } SetEntryColor (gPal, gNumColors-1, &c); ActivatePalette (ws->theWindow); -/* +/* ws->lockOK = LockPixels (ws->offScreenPMHandle); ActivatePalette ((WindowPtr)(ws->offScreenGWorld)); UnlockPixels (ws->offScreenPMHandle); */ } - + *retval = -gNumColors; return Succeeded; } @@ -755,9 +755,9 @@ int *retval; int setleading(wb, i) wbp wb; int i; -{ +{ STDLOCALS(wb); - + if (i<0) return Failed; wc->font->fInfo.leading = i; return Succeeded; @@ -771,7 +771,7 @@ wbp wb; LONG linewid; { STDLOCALS(wb); - + if (linewid < 0) return Failed; wc->contextPtr->pnSize.h = linewid; wc->contextPtr->pnSize.v = linewid; @@ -804,7 +804,7 @@ XPoint *pp; { Point mousePt; STDLOCALS (wb); - + SetPort (ws->theWindow); GetMouse (&mousePt); pp->x = mousePt.h; @@ -853,7 +853,7 @@ wbp wb; { Rect r; STDLOCALS(wb); - + SetRect (&r, wc->clipx, wc->clipy, wc->clipx+wc->clipw, wc->clipy+wc->cliph); SetPort (ws->theWindow); ClipRect (&r); @@ -863,15 +863,15 @@ void unsetclip(w) wbp w; { } - -int allowresize(w, on) + +int allowresize(w, on) wbp w; int on; { return 0; } -int setgamma(w, gamma) +int setgamma(w, gamma) wbp w; double gamma; { @@ -888,7 +888,7 @@ char *val; } /* - * setcursor() - + * setcursor() - */ int setcursor(w, on) wbp w; @@ -919,7 +919,7 @@ char **s; { short theFontNum; STDLOCALS(wb); - + GetFNum (CtoPstr (*s), &theFontNum); wc->contextPtr->txFont = theFontNum; return Succeeded; @@ -978,7 +978,7 @@ int wclose(wb) wbp wb; { STDLOCALS (wb); - + DisposeWindow (ws->theWindow); DisposeGWorld (ws->offScreenGWorld); } @@ -1017,12 +1017,12 @@ int x, y; /* can't change cursor location, Inside Mac, Imaging: 8-4 */ } -int walert(w, volume) +int walert(w, volume) wbp w; long volume; { long oldVol; - + GetDefaultOutputVolume(&oldVol); SetDefaultOutputVolume(volume); SysBeep (30); @@ -1043,6 +1043,6 @@ wsp GetActiveWindow(void) { } -#else /* Graphics */ -/* static char junk; /* avoid empty module */ -#endif /* Graphics */ +#else /* Graphics */ +/* static char junk; /* avoid empty module */ +#endif /* Graphics */ diff --git a/src/runtime/rmacrsc.ri b/src/runtime/rmacrsc.ri index f3044848a..78f2a3846 100644 --- a/src/runtime/rmacrsc.ri +++ b/src/runtime/rmacrsc.ri @@ -18,15 +18,15 @@ wcp alc_context(wbp w) GRFX_ALLOC(wc, _wcontext); GRFX_LINK(wc, wcntxts); - + /* set default values */ - + wc->contextPtr = malloc(sizeof ContextType); SETCONTEXTDEFAULT(wc->contextPtr); - + return wc; } - + /* * allocate a window state structure */ @@ -34,9 +34,9 @@ wsp alc_winstate() { int i; wsp ws; - + GRFX_ALLOC(ws, _wstate); - ws->bits = 1024; /* echo ON; others OFF */ + ws->bits = 1024; /* echo ON; others OFF */ ws->filep = nulldesc; ws->listp = nulldesc; GRFX_LINK(ws, wstates); @@ -49,26 +49,26 @@ wsp alc_winstate() int free_window(wsp ws) { ws->refcount--; - if(ws->refcount == 0) + if(ws->refcount == 0) { - if (ws->theWindow != nil) + if (ws->theWindow != nil) { - CloseWindow (ws->theWindow); - DisposeWindow (ws->theWindow); - } + CloseWindow (ws->theWindow); + DisposeWindow (ws->theWindow); + } GRFX_UNLINK(ws, wstates); } return 0; } - - + + /* * free a window context */ void free_context(wcp wc) { wc->refcount--; - if(wc->refcount == 0) + if(wc->refcount == 0) { GRFX_UNLINK(wc, wcntxts); } @@ -80,13 +80,13 @@ void free_context(wcp wc) void drawstrng(wbp wb, int x, int y, char *str, int slen) { STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); MoveTo (x, y); DrawText (str, 0, slen); - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); MoveTo (x, y); @@ -108,7 +108,7 @@ void getfntnam (wbp wb, char *answer) { Str255 fName; STDLOCALS(wb); - + GetFontName (wc->contextPtr->txFont, fName); answer = PtoCstr (fName); } @@ -150,7 +150,7 @@ wbp wb; wc->dy = wc2->dy; wc->fillstyle = wc2->fillstyle; wc->drawop = wc2->drawop; - + return wc; } @@ -165,26 +165,26 @@ void drawrectangles(wbp wb, XRectangle *recs, int nrecs) int i; Rect r; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); - for (i = 0; i < nrecs; i++) + for (i = 0; i < nrecs; i++) { SetRect (&r, recs[i].x - 1, - recs[i].y - 1, - recs[i].x - 1 + recs[i].width, + recs[i].y - 1, + recs[i].x - 1 + recs[i].width, recs[i].y - 1 + recs[i].height); FrameRect (&r); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); - for (i = 0; i < nrecs; i++) + for (i = 0; i < nrecs; i++) { SetRect (&r, recs[i].x - 1, - recs[i].y - 1, - recs[i].x - 1 + recs[i].width, + recs[i].y - 1, + recs[i].x - 1 + recs[i].width, recs[i].y - 1 + recs[i].height); FrameRect (&r); } @@ -194,23 +194,23 @@ void drawrectangles(wbp wb, XRectangle *recs, int nrecs) } /* - * drawpoints() - + * drawpoints() - * Parameters - the window binding for output, an array of points (assumed * to be fixed up for bitmap) and the number of points */ -void drawpoints(wbinding *wb, XPoint *points, int npoints) +void drawpoints(wbinding *wb, XPoint *points, int npoints) { int i; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT(wc->contextPtr); for (i = 0; i < npoints; i++) { MoveTo (points[i].x-1, points[i].y-1); LineTo (points[i].x-1, points[i].y-1); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); for (i = 0; i < npoints; i++) { @@ -223,13 +223,13 @@ void drawpoints(wbinding *wb, XPoint *points, int npoints) } /* - * drawlines - + * drawlines - */ void drawlines(wbinding *wb, XPoint *points, int npoints) { int i; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); for (i = 0; i < (npoints - 1); i++) @@ -237,8 +237,8 @@ void drawlines(wbinding *wb, XPoint *points, int npoints) MoveTo (points[i].x - 1, points[i].y - 1); LineTo (points[i+1].x - 1, points[i+1].y - 1); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); for (i = 0; i < (npoints - 1); i++) @@ -254,11 +254,11 @@ void drawlines(wbinding *wb, XPoint *points, int npoints) /* * drawsegments() - */ -void drawsegments(wbinding *wb, XSegment *segs, int nsegs) +void drawsegments(wbinding *wb, XSegment *segs, int nsegs) { int i; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); for (i = 0; i < nsegs; i++) @@ -266,8 +266,8 @@ void drawsegments(wbinding *wb, XSegment *segs, int nsegs) MoveTo (segs[i].x1 - 1, segs[i].y1 - 1); LineTo (segs[i].x2 - 1, segs[i].y2 - 1); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); for (i = 0; i < nsegs; i++) @@ -288,7 +288,7 @@ void drawarcs(wbinding *wb, XArc *arcs, int narcs) int i; Rect r; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); for (i = 0; i < narcs; i++) @@ -300,8 +300,8 @@ void drawarcs(wbinding *wb, XArc *arcs, int narcs) /* converts xarc spec to mac arc apec then pass it to FrameArc */ FrameArc (&r, (360 - arcs[i].angle1*64 + 90), arcs[i].angle2*64 * -1); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); for (i = 0; i < narcs; i++) @@ -320,12 +320,12 @@ void drawarcs(wbinding *wb, XArc *arcs, int narcs) /* * fillarcs */ -void fillarcs(wbp wb, XArc *arcs, int narcs) +void fillarcs(wbp wb, XArc *arcs, int narcs) { int i; Rect r; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); for (i = 0; i < narcs; i++) @@ -338,8 +338,8 @@ void fillarcs(wbp wb, XArc *arcs, int narcs) FillArc (&r, (360 - arcs[i].angle1*64 + 90), arcs[i].angle2*64 * -1, &wc->contextPtr->fillPat); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); for (i = 0; i < narcs; i++) @@ -373,54 +373,54 @@ void fillpolygon(wbp wb, XPoint *pts, int npts) } MoveTo (pts[0].x, pts[0].y); ClosePoly (); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); FillPoly (myPoly, &wc->contextPtr->fillPat); -/*begin quote*/ +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); FillPoly (myPoly, &wc->contextPtr->fillPat); UnlockPixels (ws->offScreenPMHandle); SetGWorld (ws->origPort, ws->origDev); /*end quote*/ - - KillPoly (myPoly); + + KillPoly (myPoly); } /* * fillrectangles * Parameters - the window binding for output, an array of rectangle * structures (assumed to be fixed up for the bitmap), - * a count of the number of structures -> the number of - * rectangles + * a count of the number of structures -> the number of + * rectangles */ void fillrectangles(wbp wb, XRectangle *recs, int nrecs) { int i; Rect r; STDLOCALS (wb); - + SetPort (ws->theWindow); COPYCONTEXT (wc->contextPtr); - for (i = 0; i < nrecs; i++) + for (i = 0; i < nrecs; i++) { SetRect (&r, recs[i].x - 1, - recs[i].y - 1, - recs[i].x - 1 + recs[i].width, + recs[i].y - 1, + recs[i].x - 1 + recs[i].width, recs[i].y - 1 + recs[i].height); PaintRect (&r); } - -/*begin quote*/ + +/*begin quote*/ PREPAREGWORLD (ws); COPYCONTEXT (wc->contextPtr); - for (i = 0; i < nrecs; i++) + for (i = 0; i < nrecs; i++) { SetRect (&r, recs[i].x - 1, - recs[i].y - 1, - recs[i].x - 1 + recs[i].width, + recs[i].y - 1, + recs[i].x - 1 + recs[i].width, recs[i].y - 1 + recs[i].height); PaintRect (&r); } @@ -442,10 +442,10 @@ int SetPattern (wbp w, char *name, int len) { } -/* +/* * Event processing */ - + int pollevent () { GetEvents (); @@ -459,7 +459,7 @@ void GetEvents () struct descrip d; int eventCode = 0; Point newMouseLoc; - + done = false; while (!done) { if (WaitNextEvent (everyEvent, &event, kSleep, nil)) @@ -484,14 +484,14 @@ void GetEvents () } MakeInt (eventCode, &d); qevent (gMouseInfo.ws, &d, - gMouseInfo.where.h, gMouseInfo.where.v, + gMouseInfo.where.h, gMouseInfo.where.v, gMouseInfo.when, gMouseInfo.modKey); - } /* if (newMouseLoc ...) */ - } /* if (StillDown ...) */ + } /* if (newMouseLoc ...) */ + } /* if (StillDown ...) */ else { gMouseInfo.wasDown = false; } - } /* if (wasDown ...) */ + } /* if (wasDown ...) */ done = true; } } @@ -501,29 +501,29 @@ void DoEvent (EventRecord *eventPtr) { char theChar; Boolean becomingActive; - + switch (eventPtr->what) { case mouseDown: DoMouseDown (eventPtr); break; - + case mouseUp: DoMouseUp (eventPtr); break; - + case autoKey: case keyDown: theChar = eventPtr->message & charCodeMask; - if ( (eventPtr->modifiers & cmdKey) != 0) + if ( (eventPtr->modifiers & cmdKey) != 0) HandleMenuChoice (MenuKey (theChar)); else DoKey (eventPtr, FrontWindow ()); break; - + case updateEvt: DoUpdate (eventPtr); break; - + case activateEvt: becomingActive = ( (eventPtr->modifiers & activeFlag) == activeFlag); DoActivate ( (WindowPtr)eventPtr->message, becomingActive); @@ -540,7 +540,7 @@ void DoMouseUp (EventRecord *eventPtr) struct descrip d; wbp wb; wsp ws; - + thePart = FindWindow (eventPtr->where, &whichWindow); if (thePart == inContent) { SelectWindow (whichWindow); @@ -551,22 +551,22 @@ void DoMouseUp (EventRecord *eventPtr) if ( ((eventPtr->modifiers & optionKey) ==0) && ((eventPtr->modifiers & cmdKey) == 0) ) eventCode = MOUSELEFTUP; MakeInt(eventCode,&d); - + if ((eventPtr->modifiers & controlKey)!=0) modKey |= ControlMask; if ((eventPtr->modifiers & shiftKey)!=0) modKey |= ShiftMask; if ((eventPtr->modifiers & optionKey)!=0) modKey |= Mod1Mask; - + for (wb = wbndngs; wb; wb = wb->next) { ws = wb->window; if (ws->theWindow == whichWindow) { qevent(ws, &d, - eventPtr->where.h, eventPtr->where.v, + eventPtr->where.h, eventPtr->where.v, (uword)(eventPtr->when), modKey); } } } } - + void DoMouseDown (EventRecord *eventPtr) { WindowPtr whichWindow; @@ -578,63 +578,63 @@ void DoMouseDown (EventRecord *eventPtr) wbp wb; wsp ws; Point newMouseLoc; - + thePart = FindWindow (eventPtr->where, &whichWindow); switch (thePart) { case inGoAway: DisposeWindow (whichWindow); break; - + case inMenuBar: menuChoice = MenuSelect (eventPtr->where); HandleMenuChoice (menuChoice); break; - + case inSysWindow: SystemClick (eventPtr, whichWindow); break; - + case inDrag: DragWindow (whichWindow, eventPtr->where, &qd.screenBits.bounds); break; - + case inGrow: DoGrowWindow (eventPtr, whichWindow); break; - + case inContent: SelectWindow (whichWindow); SetPort (whichWindow); GlobalToLocal (&eventPtr->where); - + /* left = click mid = option-click right = command-click */ - + if ( ((eventPtr->modifiers & cmdKey) != 0) && ((eventPtr->modifiers & optionKey) ==0) ) eventCode = MOUSERIGHT; if ( ((eventPtr->modifiers & optionKey) !=0) && ((eventPtr->modifiers & cmdKey) == 0) ) eventCode = MOUSEMID; if ( ((eventPtr->modifiers & optionKey) ==0) && ((eventPtr->modifiers & cmdKey) == 0) ) eventCode = MOUSELEFT; - + MakeInt(eventCode,&d); - + if ((eventPtr->modifiers & controlKey)!=0) modKey |= ControlMask; if ((eventPtr->modifiers & shiftKey)!=0) modKey |= ShiftMask; if ((eventPtr->modifiers & optionKey)!=0) modKey |= Mod1Mask; - + for (wb = wbndngs; wb; wb = wb->next) { ws = wb->window; if (ws->theWindow == whichWindow) { qevent(ws, &d, - eventPtr->where.h, eventPtr->where.v, + eventPtr->where.h, eventPtr->where.v, (uword)(eventPtr->when), modKey); gMouseInfo.ws = ws; break; } } - + gMouseInfo.wasDown = true; gMouseInfo.when = (uword)(eventPtr->when); gMouseInfo.where = eventPtr->where; @@ -644,30 +644,30 @@ void DoMouseDown (EventRecord *eventPtr) } void DoKey (EventRecord *eventPtr, WindowPtr whichWindow) -{ +{ char theChar; int modKey = 0; wbp wb; wsp ws; struct descrip d; - + if (whichWindow == nil) return; - + modKey = 0; theChar = eventPtr->message & charCodeMask; StrLen(d) = 1; StrLoc(d) = (char *)&allchars[theChar]; - + if ((eventPtr->modifiers & controlKey)!=0) modKey |= ControlMask; if ((eventPtr->modifiers & shiftKey)!=0) modKey |= ShiftMask; if ((eventPtr->modifiers & optionKey)!=0) modKey |= Mod1Mask; - + for (wb = wbndngs; wb; wb = wb->next) { ws = wb->window; if (ws->theWindow == whichWindow) { qevent(ws, &d, - wb->context->contextPtr->pnLoc.h, - wb->context->contextPtr->pnLoc.v, + wb->context->contextPtr->pnLoc.h, + wb->context->contextPtr->pnLoc.v, (uword)(eventPtr->when), modKey); } } @@ -681,7 +681,7 @@ void DoGrowWindow (EventRecord *eventPtr, WindowPtr whichWindow) wsp ws; wcp wc; RgnHandle locUpdateRgn; - + SetRect (&limitRect, kMinDocSize, kMinDocSize, kMaxDocSize, kMaxDocSize); growSize = GrowWindow (whichWindow, eventPtr->where, &limitRect); @@ -689,12 +689,12 @@ void DoGrowWindow (EventRecord *eventPtr, WindowPtr whichWindow) for (wb = wbndngs; wb; wb = wb->next) { ws = wb->window; wc = wb->context; - if (ws->theWindow == whichWindow) { + if (ws->theWindow == whichWindow) { SizeWindow (whichWindow, LoWord(growSize), HiWord(growSize), true); InvalRect (&(ws->theWindow->portRect)); return; } - } + } } } @@ -708,11 +708,11 @@ void HandleMenuChoice (long menuChoice) { short menu; short item; - + if (menuChoice != 0) { menu = HiWord (menuChoice); item = LoWord (menuChoice); - + switch (menu) { case kAppleMenu: HandleAppleChoice (item); @@ -733,7 +733,7 @@ void HandleAppleChoice (short item) MenuHandle appleMenu; Str255 accName; short accNumber; - + switch (item) { case kAboutMItem: SysBeep (20); @@ -758,7 +758,7 @@ void HandleFileChoice (short item) char buf[256]; char *tmpStr; MenuHandle menu; - + switch (item) { case kQuitMItem: abort (); @@ -782,7 +782,7 @@ void HandleFileChoice (short item) } else break; - + tmpStr = malloc (strlen ("ICONX ") + strlen (fileName) + 1 + strlen (cmlArgs) + 1); strcpy (tmpStr, "ICONX "); strcat (tmpStr, fileName); @@ -790,7 +790,7 @@ void HandleFileChoice (short item) strcat (tmpStr, cmlArgs); sprintf (buf, "%#s", tmpStr); argc = ParseCmdLineStr (buf, tmpStr, argv); - + MacMain (argc, argv); break; } @@ -809,7 +809,7 @@ void HandleOptionsChoice (short item) Rect itemRect; char *tmpStr; Str255 itemText; - + switch (item) { case kRInMItem: typeList[0] = 'TEXT'; @@ -840,16 +840,16 @@ void HandleOptionsChoice (short item) GetDItem (dialog, kArgStringField, &itemType, &textItemHandle, &itemRect); GetDItem (dialog, ok, &itemType, &okItemHandle, &itemRect); - + textHandle = GetString (kStringID); HLock ((Handle) textHandle); SetIText (textItemHandle, *textHandle); HUnlock ((Handle) textHandle); SelIText (dialog, kArgStringField, 0, 32767); - + ShowWindow (dialog); SetPort (dialog); - + SetDialogDefaultItem (dialog, ok); SetDialogCancelItem (dialog, cancel); SetDialogTracksCursor (dialog, true); @@ -865,14 +865,14 @@ void HandleOptionsChoice (short item) } if (itemHit == ok) { GetIText (textItemHandle, itemText); - + SetHandleSize ((Handle) textHandle, (Size) (itemText[0] + 1)); HLock ((Handle) textHandle); GetIText (textItemHandle, *textHandle); HUnlock ((Handle) textHandle); ChangedResource ((Handle) textHandle); WriteResource ((Handle) textHandle); - + tmpStr = PtoCstr (itemText); cmlArgs = malloc (strlen (tmpStr) + 1); strcpy (cmlArgs, tmpStr); @@ -884,11 +884,11 @@ void HandleOptionsChoice (short item) break; } } - + void DoUpdate (EventRecord *eventPtr) { WindowPtr whichWindow; - + whichWindow = (WindowPtr)eventPtr->message; BeginUpdate (whichWindow); @@ -906,7 +906,7 @@ void RedrawWindow (WindowPtr whichWindow) wcp wc; wbp wb; GWorldFlags updateOK; - + for (wb = wbndngs; wb; wb = wb->next) { ws = wb->window; wc = wb->context; @@ -927,31 +927,31 @@ void RedrawWindow (WindowPtr whichWindow) static int ParseCmdLineStr(char *s, char *t, char **argv) { - int c, quote = 0, argc = 0; - - while (c = *s++) { - if (c == ' ') - continue; - if (argc < kNARGS) - argv[argc++] = t; - do { - if (c == '\\' && *s) - c = *s++; - else if (c == '"' || c == '\'') { - if (!quote) { - quote = c; - continue; - } - if (c == quote) { - quote = 0; - continue; - } - } - *t++ = c; - } while (*s && ((c = *s++) != ' ' || quote)); - *t++ = 0; - } - return(argc); + int c, quote = 0, argc = 0; + + while (c = *s++) { + if (c == ' ') + continue; + if (argc < kNARGS) + argv[argc++] = t; + do { + if (c == '\\' && *s) + c = *s++; + else if (c == '"' || c == '\'') { + if (!quote) { + quote = c; + continue; + } + if (c == quote) { + quote = 0; + continue; + } + } + *t++ = c; + } while (*s && ((c = *s++) != ' ' || quote)); + *t++ = 0; + } + return(argc); } /* diff --git a/src/runtime/rmemmgt.r b/src/runtime/rmemmgt.r index cbf3bfb04..fbc09068c 100644 --- a/src/runtime/rmemmgt.r +++ b/src/runtime/rmemmgt.r @@ -7,29 +7,29 @@ /* * Prototypes */ -static void postqual (dptr dp); -static void markblock (dptr dp); -static void markptr (union block **ptr); -static void sweep (struct b_coexpr *ce); -static void reclaim (void); -static void cofree (void); -static void scollect (word extra); -static int qlcmp (dptr *q1,dptr *q2); -static void adjust (char *source, char *dest); -static void compact (char *source); -static void mvc (uword n, char *src, char *dest); +static void postqual (dptr dp); +static void markblock (dptr dp); +static void markptr (union block **ptr); +static void sweep (struct b_coexpr *ce); +static void reclaim (void); +static void cofree (void); +static void scollect (word extra); +static int qlcmp (dptr *q1,dptr *q2); +static void adjust (char *source, char *dest); +static void compact (char *source); +static void mvc (uword n, char *src, char *dest); #ifdef MultiProgram -static void markprogram (struct progstate *pstate); -#endif /* MultiProgram */ +static void markprogram (struct progstate *pstate); +#endif /* MultiProgram */ #ifdef Concurrent static void markthreads(); -#endif /* Concurrent */ +#endif /* Concurrent */ #if COMPILER static void sweep_pfps(struct p_frame *fp); #else -static void sweep_stk (struct b_coexpr *ce); -#endif /* COMPILER */ +static void sweep_stk (struct b_coexpr *ce); +#endif /* COMPILER */ #ifdef VerifyHeap static void vrfyCrash(const char *fmt, ...); @@ -41,7 +41,7 @@ static void vrfyRegion(int expected); #ifdef Arrays static void vrfy_Intarray(struct b_intarray *b); static void vrfy_Realarray(struct b_realarray *b); -#endif /* Arrays */ +#endif /* Arrays */ static void vrfy_File(struct b_file *b); static void vrfy_Cons(struct b_cons *b); static void vrfy_Record(struct b_record *b); @@ -64,7 +64,7 @@ word coll_stat = 0; /* collections in static region */ word coll_str = 0; /* collections in string region */ word coll_blk = 0; /* collections in block region */ word coll_tot = 0; /* total collections */ -#endif /* MultiProgram */ +#endif /* MultiProgram */ word alcnum = 0; /* co-expressions allocated since g.c. */ dptr *quallist; /* string qualifier list */ @@ -81,7 +81,7 @@ int qualfail; /* flag: qualifier list overflow */ postqual(&(d)); \ else if (Pointer(d))\ markblock(&(d)); - + /* * Allocated block size table (sizes given in bytes). A size of -1 is used * for types that have no blocks; a size of 0 indicates that the @@ -95,9 +95,9 @@ int bsizes[] = { 0, /* T_Lrgint (2), large integer */ #ifdef DescriptorDouble -1, -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ sizeof(struct b_real), /* T_Real (3), real number */ -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ sizeof(struct b_cset), /* T_Cset (4), cset */ sizeof(struct b_file), /* T_File (5), file block */ 0, /* T_Proc (6), procedure block */ @@ -122,21 +122,21 @@ int bsizes[] = { -1, /* T_Kywdevent (25), event keyword variable */ #ifdef PatternType sizeof(struct b_pattern), /* T_Pattern (26), pattern block */ - sizeof(struct b_pelem), /* T_Pattern (27), pattern element */ -#else /* PatternType */ + sizeof(struct b_pelem), /* T_Pattern (27), pattern element */ +#else /* PatternType */ 0, 0, -#endif /* PatternType */ +#endif /* PatternType */ #ifdef EventMon sizeof(struct b_tvmonitored), -#else /* EventMon */ +#else /* EventMon */ 0, -#endif /* EventMon */ - 0, /* T_Intarray (29), int array */ - 0, /* T_Realarray (30), real array */ - sizeof(struct b_cons), /* T_Cons (31), cons cell */ +#endif /* EventMon */ + 0, /* T_Intarray (29), int array */ + 0, /* T_Realarray (30), real array */ + sizeof(struct b_cons), /* T_Cons (31), cons cell */ }; - + /* * Table of offsets (in bytes) to first descriptor in blocks. -1 is for * types not allocated, 0 for blocks with no descriptors. @@ -150,30 +150,30 @@ int firstd[] = { #ifdef Concurrent 4*WordSize, /* T_File (5), file block */ -#else /* Concurrent */ +#else /* Concurrent */ 3*WordSize, /* T_File (5), file block */ #endif #ifdef MultiProgram 8*WordSize, /* T_Proc (6), procedure block */ -#else /* MultiProgram */ +#else /* MultiProgram */ 7*WordSize, /* T_Proc (6), procedure block */ -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef Concurrent 6*WordSize, /* T_Record (7), record block */ -#else /* Concurrent */ +#else /* Concurrent */ 4*WordSize, /* T_Record (7), record block */ -#endif /* Concurrent */ +#endif /* Concurrent */ 0, /* T_List (8), list header block */ 7*WordSize, /* T_Lelem (9), list element block */ 0, /* T_Set (10), set header block */ 3*WordSize, /* T_Selem (11), set element block */ #ifdef Concurrent (6+HSegs)*WordSize, /* T_Table (12), table header block */ -#else /* Concurrent */ +#else /* Concurrent */ (4+HSegs)*WordSize, /* T_Table (12), table header block */ -#endif /* Concurrent */ +#endif /* Concurrent */ 3*WordSize, /* T_Telem (13), table element block */ 3*WordSize, /* T_Tvtbl (14), table element trapped variable */ 0, /* T_Slots (15), set/table hash block */ @@ -181,9 +181,9 @@ int firstd[] = { #if COMPILER 2*WordSize, /* T_Refresh (17), refresh block */ -#else /* COMPILER */ +#else /* COMPILER */ (4+Wsizeof(struct pf_marker))*WordSize, /* T_Refresh (17), refresh block */ -#endif /* COMPILER */ +#endif /* COMPILER */ -1, /* T_Coexpr (18), co-expression block */ 0, /* T_External (19), external block */ @@ -193,14 +193,14 @@ int firstd[] = { -1, /* T_Kywdwin (23), keyword &window */ -1, /* T_Kywdstr (24), string keyword variable */ -1, /* T_Kywdevent (25), event keyword variable */ - 0, /* T_Pattern (26), pattern block */ + 0, /* T_Pattern (26), pattern block */ 5*WordSize, /* T_Pelem (27), pattern element */ - 2*WordSize, /* T_Tvmonitored */ - 0, /* T_Intarray (29), integer array */ - 0, /* T_Realarray (30), real array */ - 0, /* T_Cons (31), cons cell */ + 2*WordSize, /* T_Tvmonitored */ + 0, /* T_Intarray (29), integer array */ + 0, /* T_Realarray (30), real array */ + 0, /* T_Cons (31), cons cell */ }; - + /* * Table of offsets (in bytes) to first pointer in blocks. -1 is for * types not allocated, 0 for blocks with no pointers. @@ -220,14 +220,14 @@ int firstp[] = { 6*WordSize, /* T_Set (10), set header block */ 1*WordSize, /* T_Selem (11), set element block */ 6*WordSize, /* T_Table (12), table header block */ -#else /* Concurrent */ +#else /* Concurrent */ 3*WordSize, /* T_Record (7), record block */\ 3*WordSize, /* T_List (8), list header block */ 2*WordSize, /* T_Lelem (9), list element block */ 4*WordSize, /* T_Set (10), set header block */ 1*WordSize, /* T_Selem (11), set element block */ 4*WordSize, /* T_Table (12), table header block */ -#endif /* Concurrent */ +#endif /* Concurrent */ 1*WordSize, /* T_Telem (13), table element block */ 1*WordSize, /* T_Tvtbl (14), table element trapped variable */ 2*WordSize, /* T_Slots (15), set/table hash block */ @@ -243,12 +243,12 @@ int firstp[] = { -1, /* T_Kywdevent (25), event keyword variable */ 3*WordSize, /* T_Pattern(26) pattern block*/ 2*WordSize, /* T_Pelem(27) pattern element block*/ - -1, /* T_Tvmonitored (28) */ - 2*WordSize, /* T_Intarray (29), integer array */ - 2*WordSize, /* T_Realarray (30), integer array */ - 1*WordSize, /* T_Cons (31), cons cell */ + -1, /* T_Tvmonitored (28) */ + 2*WordSize, /* T_Intarray (29), integer array */ + 2*WordSize, /* T_Realarray (30), integer array */ + 1*WordSize, /* T_Cons (31), cons cell */ }; - + /* * Table of number of pointers in blocks. -1 is for types not allocated and * types without pointers, 0 for pointers through the end of the block. @@ -282,12 +282,12 @@ int ptrno[] = { -1, /* T_Kywdevent (25), event keyword variable */ 1, /* T_Pattern (26), pattern block */ 1, /* T_Pelem (27), pattern element block */ - -1, /* T_Tvmonitored (28) */ - 2, /* T_Intarray (29), integer array */ - 2, /* T_Realarray (30), real array */ - 2, /* T_Cons (31), cons cell */ + -1, /* T_Tvmonitored (28) */ + 2, /* T_Intarray (29), integer array */ + 2, /* T_Realarray (30), real array */ + 2, /* T_Cons (31), cons cell */ }; - + /* * Table of block names used by debugging functions. */ @@ -320,37 +320,37 @@ char *blkname[] = { "illegal object", /* T_Kywdevent (25) */ "pattern", /* T_Pattern (26) */ "pattern element", /* T_Pelem (27) */ - "monitor trapped variable", /* T_Tvmonitored (28) */ - "integer array", /* T_Intarray (29) */ - "real array", /* T_Realarray (30) */ - "cons", /* T_Cons (31) */ + "monitor trapped variable", /* T_Tvmonitored (28) */ + "integer array", /* T_Intarray (29) */ + "real array", /* T_Realarray (30) */ + "cons", /* T_Cons (31) */ }; - + /* * Sizes of hash chain segments. * Table size must equal or exceed HSegs. */ uword segsize[] = { - ((uword)HSlots), /* segment 0 */ - ((uword)HSlots), /* segment 1 */ - ((uword)HSlots) << 1, /* segment 2 */ - ((uword)HSlots) << 2, /* segment 3 */ - ((uword)HSlots) << 3, /* segment 4 */ - ((uword)HSlots) << 4, /* segment 5 */ - ((uword)HSlots) << 5, /* segment 6 */ - ((uword)HSlots) << 6, /* segment 7 */ - ((uword)HSlots) << 7, /* segment 8 */ - ((uword)HSlots) << 8, /* segment 9 */ - ((uword)HSlots) << 9, /* segment 10 */ - ((uword)HSlots) << 10, /* segment 11 */ - ((uword)HSlots) << 11, /* segment 12 */ - ((uword)HSlots) << 12, /* segment 13 */ - ((uword)HSlots) << 13, /* segment 14 */ - ((uword)HSlots) << 14, /* segment 15 */ - ((uword)HSlots) << 15, /* segment 16 */ - ((uword)HSlots) << 16, /* segment 17 */ - ((uword)HSlots) << 17, /* segment 18 */ - ((uword)HSlots) << 18, /* segment 19 */ + ((uword)HSlots), /* segment 0 */ + ((uword)HSlots), /* segment 1 */ + ((uword)HSlots) << 1, /* segment 2 */ + ((uword)HSlots) << 2, /* segment 3 */ + ((uword)HSlots) << 3, /* segment 4 */ + ((uword)HSlots) << 4, /* segment 5 */ + ((uword)HSlots) << 5, /* segment 6 */ + ((uword)HSlots) << 6, /* segment 7 */ + ((uword)HSlots) << 7, /* segment 8 */ + ((uword)HSlots) << 8, /* segment 9 */ + ((uword)HSlots) << 9, /* segment 10 */ + ((uword)HSlots) << 10, /* segment 11 */ + ((uword)HSlots) << 11, /* segment 12 */ + ((uword)HSlots) << 12, /* segment 13 */ + ((uword)HSlots) << 13, /* segment 14 */ + ((uword)HSlots) << 14, /* segment 15 */ + ((uword)HSlots) << 15, /* segment 16 */ + ((uword)HSlots) << 16, /* segment 17 */ + ((uword)HSlots) << 17, /* segment 18 */ + ((uword)HSlots) << 18, /* segment 19 */ }; /* @@ -362,13 +362,13 @@ void initalloc() { #ifdef Concurrent CURTSTATE(); -#endif /* Concurrent */ -#else /* COMPILER */ +#endif /* Concurrent */ +#else /* COMPILER */ #ifdef MultiProgram void initalloc(word codesize, struct progstate *p) -#else /* MultiProgram */ +#else /* MultiProgram */ void initalloc(word codesize) -#endif /* MultiProgram */ +#endif /* MultiProgram */ { #ifdef MultiProgram struct region *ps, *pb; @@ -381,18 +381,18 @@ void initalloc(word codesize) */ #ifdef MultiProgram if (codesize) -#endif /* MultiProgram */ +#endif /* MultiProgram */ if ((code = (char *)AllocReg(codesize)) == NULL) error(NULL, - "insufficient memory, corrupted icode file, or wrong platform"); -#endif /* COMPILER */ + "insufficient memory, corrupted icode file, or wrong platform"); +#endif /* COMPILER */ /* - * Set up allocated memory. The regions are: - * Static memory region (not used) - * Allocated string region - * Allocate block region - * Qualifier list + * Set up allocated memory. The regions are: + * Static memory region (not used) + * Allocated string region + * Allocate block region + * Qualifier list */ #ifdef MultiProgram @@ -413,7 +413,7 @@ void initalloc(word codesize) error(NULL, "insufficient memory for qualifier list"); equallist = (dptr *)((char *)quallist + qualsize); } -#else /* MultiProgram */ +#else /* MultiProgram */ { uword t1, t2; #if ConcurrentCOMPILER @@ -439,9 +439,9 @@ void initalloc(word codesize) error(NULL, "insufficient memory for qualifier list"); equallist = (dptr *)((char *)quallist + qualsize); } -#endif /* MultiProgram */ +#endif /* MultiProgram */ } - + /* * collect - do a garbage collection of currently active regions. */ @@ -459,7 +459,7 @@ int region; /* what is this and why? */ curblock = curtblock; curstring = curtstring; -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef VerifyHeap vrfyStart(); @@ -474,8 +474,8 @@ int region; char *s; setrlimit_firsttime = 0; if ((s=getenv("SETRLIMIT_COUNT"))) { - setrlimit_count = atoi(s); - } + setrlimit_count = atoi(s); + } } getrlimit(RLIMIT_STACK , &rl); @@ -487,13 +487,13 @@ int region; if (rl.rlim_cur < curblock->size) { rl.rlim_cur = curblock->size; if (setrlimit(RLIMIT_STACK , &rl) == -1) { - if (setrlimit_count != 0) { - fprintf(stderr,"iconx setrlimit(%lu) failed %d\n", - (unsigned long)(rl.rlim_cur),errno); - fflush(stderr); - setrlimit_count--; - } - } + if (setrlimit_count != 0) { + fprintf(stderr,"iconx setrlimit(%lu) failed %d\n", + (unsigned long)(rl.rlim_cur),errno); + fflush(stderr); + setrlimit_count--; + } + } } #endif @@ -502,8 +502,8 @@ int region; #if E_Collect if (!noMTevents) EVVal((word)region,E_Collect); -#endif /* E_Collect */ -#endif /* Concurrent */ +#endif /* E_Collect */ +#endif /* Concurrent */ switch (region) { case Static: @@ -512,7 +512,7 @@ int region; case Strings: coll_str++; break; - case Blocks: + case Blocks: coll_blk++; break; } @@ -531,7 +531,7 @@ int region; #endif /* VerifyHeap */ return 0; } -#endif /* !COMPILER */ +#endif /* !COMPILER */ /* * Sync the values (used by sweep) in the coexpr block for ¤t @@ -543,12 +543,12 @@ int region; /* This is replaced by a better mechanism: point directly to the ce variable * and don't host any of these variables in tstate. * Ex: - * instead of "tend" refering to + * instead of "tend" refering to * tstate->Tend - * it will refer directly to - * tstate->c->es_tend + * it will refer directly to + * tstate->c->es_tend * - * The code here will be kept until we are are sure the alternative is a + * The code here will be kept until we are are sure the alternative is a * better option and we don't have surprises. * { struct threadstate *tstate; @@ -566,7 +566,7 @@ int region; * */ -#else /* Concurrent */ +#else /* Concurrent */ { struct b_coexpr *cp; cp = BlkD(k_current, Coexpr); @@ -578,9 +578,9 @@ int region; cp->es_gfp = gfp; cp->es_efp = efp; cp->es_sp = sp; -#endif /* !COMPILER */ +#endif /* !COMPILER */ } -#endif /* Concurrent */ +#endif /* Concurrent */ /* * Reset qualifier list. @@ -596,8 +596,8 @@ int region; #else #if ConcurrentCOMPILER markthreads(); -#endif /* ConcurrentCOMPILER */ -#endif /* MultiProgram */ +#endif /* ConcurrentCOMPILER */ +#endif /* MultiProgram */ markblock(&k_main); markblock(&k_current); @@ -610,8 +610,8 @@ int region; #if !ConcurrentCOMPILER postqual(&k_subject); postqual(&kywd_prog); -#endif /* ConcurrentCOMPILER */ -#endif /* MultiProgram */ +#endif /* ConcurrentCOMPILER */ +#endif /* MultiProgram */ #ifdef Concurrent /* turn the non-concurrent maps2 and maps3 code into a loop over all threads */ @@ -619,16 +619,16 @@ int region; struct threadstate *curtstate; /* do NOT change this name, the maps[23] macros depend on it */ for (curtstate = &roottstate; curtstate != NULL; curtstate = curtstate->next) { #endif - if (Qual(maps2)) /* caution: the cached arguments of */ - postqual(&maps2); /* map may not be strings. */ - else if (Pointer(maps2)) - markblock(&maps2); - if (Qual(maps3)) - postqual(&maps3); - else if (Pointer(maps3)) - markblock(&maps3); + if (Qual(maps2)) /* caution: the cached arguments of */ + postqual(&maps2); /* map may not be strings. */ + else if (Pointer(maps2)) + markblock(&maps2); + if (Qual(maps3)) + postqual(&maps3); + else if (Pointer(maps3)) + markblock(&maps3); #ifdef Concurrent - } /* These two braces match the curtstate loop */ + } /* These two braces match the curtstate loop */ } /* and struct threadstate declaration above */ #endif /* Concurrent */ @@ -642,42 +642,42 @@ int region; for (ws = wstates; ws ; ws = ws->next) { #ifdef GraphicsGL - /* + /* * For some reason, the 2d display doesn't get marked because * the title word of {BlkLoc(ws->filep)} would contain the address - * of {ws->funclist2d} as it was getting explicitly marked, + * of {ws->funclist2d} as it was getting explicitly marked, * resulting in the 2d display not getting marked * at all and a subsequent memory violation after GC. * It would seem that shouldn't happen during GC, but I believe * I've checked for all buffer overflows in drawgeometry2d()... * What's worse is this memory violation is sporadic... - * - * For now, try marking the display list before the Unicon window + * + * For now, try marking the display list before the Unicon window * values. It seems to work...? * - Gigi */ if (is:list(ws->funclist2d)) - markblock(&(ws->funclist2d)); -#endif /* GraphicsGL */ + markblock(&(ws->funclist2d)); +#endif /* GraphicsGL */ - if (is:file(ws->filep)) - markblock(&(ws->filep)); - if (is:list(ws->listp)) - markblock(&(ws->listp)); + if (is:file(ws->filep)) + markblock(&(ws->filep)); + if (is:list(ws->listp)) + markblock(&(ws->listp)); #ifdef Graphics3D if (is:list(ws->funclist)) - markblock(&(ws->funclist)); + markblock(&(ws->funclist)); #endif /* Graphics3D */ } #ifdef Graphics3D for (wc = wcntxts; wc ; wc = wc->next) { - if (wc->normals) markptr((union block **)&(wc->normals)); - if (wc->texcoords) markptr((union block **)(&(wc->texcoords))); - } + if (wc->normals) markptr((union block **)&(wc->normals)); + if (wc->texcoords) markptr((union block **)(&(wc->texcoords))); + } #endif /* Graphics3D */ } -#endif /* Graphics */ +#endif /* Graphics */ /* * Mark the globals and the statics. @@ -687,15 +687,15 @@ int region; { register struct descrip *dp; for (dp = globals; dp < eglobals; dp++) if (Qual(*dp)) - postqual(dp); + postqual(dp); else if (Pointer(*dp)) - markblock(dp); + markblock(dp); for (dp = statics; dp < estatics; dp++) if (Qual(*dp)) - postqual(dp); + postqual(dp); else if (Pointer(*dp)) - markblock(dp); + markblock(dp); } #ifdef Graphics @@ -703,16 +703,16 @@ int region; markblock(&(kywd_xwin[XKey_Window])); if (is:file(lastEventWin)) markblock(&(lastEventWin)); -#endif /* Graphics */ -#endif /* MultiProgram */ +#endif /* Graphics */ +#endif /* MultiProgram */ #if COMPILER sweep_pfps(pfp); -#endif /* COMPILER */ +#endif /* COMPILER */ #if NT markptr((union block **) &LstTmpFiles); -#endif /* NT */ +#endif /* NT */ reclaim(); @@ -724,7 +724,7 @@ int region; char *source = br->base, *free = br->free; uword NoMark = (uword) ~F_Mark; while (source < free) { - BlkType(source) &= NoMark; + BlkType(source) &= NoMark; source += BlkSize(source); } } @@ -732,7 +732,7 @@ int region; char *source = br->base, *free = br->free; uword NoMark = (uword) ~F_Mark; while (source < free) { - BlkType(source) &= NoMark; + BlkType(source) &= NoMark; source += BlkSize(source); } } @@ -744,8 +744,8 @@ int region; mmrefresh(); EVValD(&nulldesc, E_EndCollect); } -#endif /* instrument allocation events */ -#endif /* Concurrent */ +#endif /* instrument allocation events */ +#endif /* Concurrent */ #ifdef VerifyHeap vrfyEnd(); @@ -753,7 +753,7 @@ int region; return 1; } - + #if defined(MultiProgram) || ConcurrentCOMPILER /* * use threadstate in order to sync VM registers @@ -768,7 +768,7 @@ static void markthread(struct threadstate *tcp) if(!is:null(tcp->Value_tmp)) { PostDescrip(tcp->Value_tmp); } -#endif /* ConcurrentCOMPILER */ +#endif /* ConcurrentCOMPILER */ if(!is:null(tcp->Kywd_pos)) { PostDescrip(tcp->Kywd_pos); } @@ -808,11 +808,11 @@ static void markthreads() markthread(&roottstate); for (t = roottstate.next; t != NULL; t = t->next) if (t->c && (IS_TS_THREAD(t->c->status))){ - markthread(t); - } + markthread(t); + } } -#endif /* Concurrent */ -#endif /* MultiProgram || ConcurrentCOMPILER */ +#endif /* Concurrent */ +#endif /* MultiProgram || ConcurrentCOMPILER */ #ifdef MultiProgram /* @@ -828,9 +828,9 @@ struct progstate *pstate; */ #ifdef Concurrent markthreads(); -#else /* Concurrent */ +#else /* Concurrent */ markthread(pstate->tstate); -#endif /* Concurrent */ +#endif /* Concurrent */ PostDescrip(pstate->K_main); @@ -843,7 +843,7 @@ struct progstate *pstate; #ifdef Graphics3D PostDescrip(pstate->AmperPick); -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* Kywd_err, &error, always an integer */ /* Kywd_pos, &pos, always an integer */ @@ -858,27 +858,27 @@ struct progstate *pstate; */ for (dp = pstate->Globals; dp < pstate->Eglobals; dp++) if (Qual(*dp)) - postqual(dp); + postqual(dp); else if (Pointer(*dp)) - markblock(dp); + markblock(dp); for (dp = pstate->Statics; dp < pstate->Estatics; dp++) if (Qual(*dp)) - postqual(dp); + postqual(dp); else if (Pointer(*dp)) - markblock(dp); + markblock(dp); /* * no marking for &x, &y, &row, &col, &interval, all integers */ #ifdef Graphics - PostDescrip(pstate->LastEventWin); /* last Event() win */ - PostDescrip(pstate->Kywd_xwin[XKey_Window]); /* &window */ -#endif /* Graphics */ + PostDescrip(pstate->LastEventWin); /* last Event() win */ + PostDescrip(pstate->Kywd_xwin[XKey_Window]); /* &window */ +#endif /* Graphics */ } -#endif /* MultiProgram */ - +#endif /* MultiProgram */ + /* * postqual - mark a string qualifier. Strings outside the string space * are ignored. @@ -890,7 +890,7 @@ dptr dp; char *newqual; CURTSTATE(); - if (InRange(strbase,StrLoc(*dp),strfree + 1)) { + if (InRange(strbase,StrLoc(*dp),strfree + 1)) { /* * The string is in the string space. Add it to the string qualifier * list, but before adding it, expand the string qualifier list if @@ -898,24 +898,24 @@ dptr dp; */ if (qualfree >= equallist) { - /* reallocate a new qualifier list that's twice as large */ - newqual = (char *)realloc((char *)quallist, (msize)(2 * qualsize)); - if (newqual) { - quallist = (dptr *)newqual; - qualfree = (dptr *)(newqual + qualsize); - qualsize *= 2; - equallist = (dptr *)(newqual + qualsize); - } - else { + /* reallocate a new qualifier list that's twice as large */ + newqual = (char *)realloc((char *)quallist, (msize)(2 * qualsize)); + if (newqual) { + quallist = (dptr *)newqual; + qualfree = (dptr *)(newqual + qualsize); + qualsize *= 2; + equallist = (dptr *)(newqual + qualsize); + } + else { qualfail = 1; return; - } + } } *qualfree++ = dp; } } - + /* * markblock - mark each accessible block in the block region and build * back-list of descriptors pointing to that block. (Phase I of garbage @@ -985,15 +985,15 @@ dptr dp; * The block contains pointers; mark each pointer. */ ptr = (union block **)(block + fdesc); - numptr = ptrno[type]; - if (numptr > 0) - lastptr = ptr + numptr; - else - lastptr = (union block **)endblock; - for (; ptr < lastptr; ptr++) - if (*ptr != NULL) + numptr = ptrno[type]; + if (numptr > 0) + lastptr = ptr + numptr; + else + lastptr = (union block **)endblock; + for (; ptr < lastptr; ptr++) + if (*ptr != NULL) markptr(ptr); - } + } if ((fdesc = firstd[type]) > 0) /* * The block contains descriptors; mark each descriptor. @@ -1031,7 +1031,7 @@ dptr dp; */ markprogram(((struct b_coexpr *)block)->program); } -#endif /* MultiProgram */ +#endif /* MultiProgram */ #ifdef CoExpr /* @@ -1055,17 +1055,17 @@ dptr dp; markblock(&((struct b_coexpr *)block)->freshblk); #ifdef Concurrent - + if (!is:null(cp->inbox)) - markblock(&(cp->inbox)); + markblock(&(cp->inbox)); if (!is:null(cp->outbox)) - markblock(&(cp->outbox)); + markblock(&(cp->outbox)); if (!is:null(cp->cequeue)) - markblock(&(cp->cequeue)); - if (cp->handdata!=NULL) - markblock((cp->handdata)); + markblock(&(cp->cequeue)); + if (cp->handdata!=NULL) + markblock((cp->handdata)); -#endif /* Concurrent */ +#endif /* Concurrent */ #endif /* CoExpr */ } @@ -1076,7 +1076,7 @@ dptr dp; * Look for this block in other allocated block regions. */ for (rp = curblock->Gnext; rp; rp = rp->Gnext) - if (InRange(rp->base,block,rp->free)) break; + if (InRange(rp->base,block,rp->free)) break; if (rp == NULL) for (rp = curblock->Gprev; rp; rp = rp->Gprev) @@ -1106,22 +1106,22 @@ dptr dp; */ endblock = block + BlkSize(block); - BlkType(block) |= F_Mark; /* mark the block */ + BlkType(block) |= F_Mark; /* mark the block */ if ((fdesc = firstp[type]) > 0) { /* * The block contains pointers; mark each pointer. */ ptr = (union block **)(block + fdesc); - numptr = ptrno[type]; - if (numptr > 0) - lastptr = ptr + numptr; - else - lastptr = (union block **)endblock; - for (; ptr < lastptr; ptr++) - if (*ptr != NULL) + numptr = ptrno[type]; + if (numptr > 0) + lastptr = ptr + numptr; + else + lastptr = (union block **)endblock; + for (; ptr < lastptr; ptr++) + if (*ptr != NULL) markptr(ptr); - } + } if ((fdesc = firstd[type]) > 0) /* * The block contains descriptors; mark each descriptor. @@ -1135,7 +1135,7 @@ dptr dp; } } } - + int is_in_a_block_region(char *block) { struct region *rp; @@ -1232,7 +1232,7 @@ union block **ptr; * Look for this block in other allocated block regions. */ for (rp = curblock->Gnext;rp;rp = rp->Gnext) - if (InRange(rp->base,block,rp->free)) break; + if (InRange(rp->base,block,rp->free)) break; if (rp == NULL) for (rp = curblock->Gprev;rp;rp = rp->Gprev) @@ -1262,7 +1262,7 @@ union block **ptr; */ endblock = block + BlkSize(block); - BlkType(block) |= F_Mark; /* mark the block */ + BlkType(block) |= F_Mark; /* mark the block */ if ((fdesc = firstp[type]) > 0) { /* @@ -1271,13 +1271,13 @@ union block **ptr; ptr1 = (union block **)(block + fdesc); numptr = ptrno[type]; if (numptr > 0) - lastptr = ptr1 + numptr; - else - lastptr = (union block **)endblock; - for (; ptr1 < lastptr; ptr1++) - if (*ptr1 != NULL) + lastptr = ptr1 + numptr; + else + lastptr = (union block **)endblock; + for (; ptr1 < lastptr; ptr1++) + if (*ptr1 != NULL) markptr(ptr1); - } + } if ((fdesc = firstd[type]) > 0) /* * The block contains descriptors; mark each descriptor. @@ -1291,7 +1291,7 @@ union block **ptr; } } } - + /* * sweep - sweep the chain of tended descriptors for a co-expression * marking the descriptors. @@ -1310,7 +1310,7 @@ struct b_coexpr *ce; else if (Pointer(tp->d[i])) { if(BlkLoc(tp->d[i]) != NULL) markblock(&tp->d[i]); - } + } } } #if COMPILER @@ -1319,7 +1319,7 @@ struct b_coexpr *ce; sweep_stk(ce); #endif } - + #if COMPILER static void sweep_pfps(struct p_frame *fp) @@ -1327,10 +1327,10 @@ static void sweep_pfps(struct p_frame *fp) #ifdef PatternType while (fp != NULL) { if (fp->pattern_cache != NULL) - markptr((union block **)&(fp->pattern_cache)); + markptr((union block **)&(fp->pattern_cache)); fp = fp->old_pfp; } -#endif /* PatternType */ +#endif /* PatternType */ } #else /* @@ -1373,15 +1373,15 @@ struct b_coexpr *ce; #ifdef MultiProgram if (fp == 0) { if (is:list(* (dptr) (s_sp - 1))) { - /* - * this is the argument list of an un-started task - */ + /* + * this is the argument list of an un-started task + */ if (Pointer(*((dptr)(&s_sp[-1])))) { markblock((dptr)&s_sp[-1]); - } - } + } + } } -#endif /* MultiProgram */ +#endif /* MultiProgram */ while ((fp != 0) || nargs) { /* Keep going until current fp is 0 and no arguments are left. */ @@ -1392,11 +1392,11 @@ struct b_coexpr *ce; #ifdef PatternType if ((fp != NULL) && is_in_a_block_region((char *)(fp->pattern_cache))) { - if (fp->pattern_cache->title == T_Table) { - markptr((union block **)&(fp->pattern_cache)); - } + if (fp->pattern_cache->title == T_Table) { + markptr((union block **)&(fp->pattern_cache)); + } } -#endif +#endif s_efp = fp->pf_efp; /* Get saved efp out of frame */ s_gfp = fp->pf_gfp; /* Get save gfp */ @@ -1451,15 +1451,15 @@ struct b_coexpr *ce; postqual((dptr)&s_sp[-1]); else if (Pointer(*((dptr)(&s_sp[-1])))) { markblock((dptr)&s_sp[-1]); - } + } s_sp -= 2; /* Move past descriptor. */ if (nargs) /* Decrement argument count if in an*/ nargs--; /* argument list. */ } } } -#endif /* !COMPILER */ - +#endif /* !COMPILER */ + /* * reclaim - reclaim space in the allocated memory regions. The marking * phase has already been completed. @@ -1490,7 +1490,7 @@ static void reclaim() */ compact(blkbase); } - + /* * cofree - collect co-expression blocks. This is done after * the marking phase of garbage collection and the stacks that are @@ -1509,9 +1509,9 @@ static void cofree() #ifdef MultiProgram rootpstate.Mainhead->title = T_Coexpr; -#else /* MultiProgram */ +#else /* MultiProgram */ BlkLoc(k_main)->Coexpr.title = T_Coexpr; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * The co-expression blocks are linked together through their @@ -1537,14 +1537,14 @@ static void cofree() if ( xabp->nactivators == 0 ) free((pointer)xabp); #if 0 - else - fprintf(stderr,"Warning: internal gc error: activator list is not empty.\n"); + else + fprintf(stderr,"Warning: internal gc error: activator list is not empty.\n"); #endif - } /* for abp */ + } /* for abp */ #ifdef CoClean - coclean(xep); - #endif /* CoClean */ + coclean(xep); + #endif /* CoClean */ free((pointer)xep); } @@ -1554,7 +1554,7 @@ static void cofree() } } } - + /* * scollect - collect the string space. quallist is a list of pointers to * descriptors for all the reachable strings in the string space. For @@ -1624,7 +1624,7 @@ word extra; *dest++ = *source++; strfree = dest; } - + /* * qlcmp - compare the location fields of two string qualifiers for qsort. */ @@ -1647,7 +1647,7 @@ dptr *q1, *q2; #endif /* IntBits == 16 */ } - + /* * adjust - adjust pointers into the block region, beginning with block oblk * and basing the "new" block region at nblk. (Phase II of garbage @@ -1684,7 +1684,7 @@ char *source, *dest; source += BlkSize(source); } } - + /* * compact - compact good blocks in the block region. (Phase III of garbage * collection.) @@ -1727,7 +1727,7 @@ char *source; */ blkfree = dest; } - + /* * mvc - move n bytes from src to dest * @@ -1806,7 +1806,7 @@ register char *src, *dest; * Note that src == dest implies no action */ } - + #ifdef DeBugIconx /* * descr - dump a descriptor. Used only for debugging. @@ -1838,7 +1838,7 @@ dptr dp; } fprintf(stderr," %08lx %08lx\n",(long)dp->dword,(long)IntVal(*dp)); } - + /* * blkdump - dump the allocated block region. Used only for debugging. * NOTE: Not adapted for multiple regions. @@ -1882,9 +1882,9 @@ void blkdump() */ #if NT unsigned long long int memorysize(int available) -#else /* NT */ +#else /* NT */ unsigned long memorysize(int available) -#endif /* NT */ +#endif /* NT */ { FILE *f; char buf[80], *p, *fieldname; @@ -1898,10 +1898,10 @@ unsigned long memorysize(int available) */ #if defined(_SC_PHYS_PAGES) && defined(_SC_PAGE_SIZE) if (!available) return sysconf(_SC_PHYS_PAGES) * sysconf(_SC_PAGE_SIZE); -#endif /* _SC_PHYS_PAGES && _SC_PAGE_SIZE */ +#endif /* _SC_PHYS_PAGES && _SC_PAGE_SIZE */ #if defined(_SC_AVPHYS_PAGES) && defined(_SC_PAGE_SIZE) if (available) return sysconf(_SC_AVPHYS_PAGES) * sysconf(_SC_PAGE_SIZE); -#endif /* _SC_AVPHYS_PAGES && _SC_PAGE_SIZE */ +#endif /* _SC_AVPHYS_PAGES && _SC_PAGE_SIZE */ /* * Method #2: call sysctlbyname(). MacOS and maybe BSD too. @@ -1916,7 +1916,7 @@ unsigned long memorysize(int available) i = mem; return i; } -#endif /* MacOS */ +#endif /* MacOS */ /* * Method #3: read /proc/meminfo. Linux. @@ -1925,29 +1925,29 @@ unsigned long memorysize(int available) if ((f = fopen("/proc/meminfo", "r")) != NULL) { while (fgets(buf, 80, f)) { - if (!strncmp(fieldname, buf, strlen(fieldname))) { - p = buf+strlen(fieldname); - while (isspace(*p)) p++; - i = atol(p); - while (isdigit(*p)) p++; - while (isspace(*p)) p++; - if (!strncmp(p, "kB",2)) i *= 1024; - else if (!strncmp(p, "MB", 2)) i *= 1024 * 1024; - fclose(f); - return i; - } - } + if (!strncmp(fieldname, buf, strlen(fieldname))) { + p = buf+strlen(fieldname); + while (isspace(*p)) p++; + i = atol(p); + while (isdigit(*p)) p++; + while (isspace(*p)) p++; + if (!strncmp(p, "kB",2)) i *= 1024; + else if (!strncmp(p, "MB", 2)) i *= 1024 * 1024; + fclose(f); + return i; + } + } fclose(f); } -#endif /* UNIX */ +#endif /* UNIX */ #if NT - MEMORYSTATUSEX ms; + MEMORYSTATUSEX ms; ms.dwLength = sizeof(ms); GlobalMemoryStatusEx(&ms); return (available ? ms.ullAvailPhys : ms.ullTotalPhys); -#endif /* NT */ +#endif /* NT */ /* * Out of methods. Could try "top", but don't want to launch @@ -1960,9 +1960,9 @@ unsigned long memorysize(int available) #if NT unsigned long long int physicalmemorysize() -#else /* NT */ +#else /* NT */ unsigned long physicalmemorysize() -#endif /* NT */ +#endif /* NT */ { return memorysize(0); } @@ -1986,7 +1986,7 @@ typedef char vlogmessage[64]; static vlogmessage vlog[VRFY_LOGSIZE]; #else static vlogmessage vlog[2000]; -#endif /* VRFY_LOGSIZE */ +#endif /* VRFY_LOGSIZE */ static int vlogNext; /* Insert a (formatted) message into the log buffer with parameters */ @@ -2104,7 +2104,7 @@ static void vrfyStart() * and don't have Unicon source files longer than 99999 lines". */ snprintf(fl, sizeof(vlogmessage), "%.57s %.5d", -#if COMPILER +#if COMPILER file_name, line_num #else findfile(curtstate->c->es_ipc.opnd), @@ -2502,7 +2502,7 @@ static void vrfy_Realarray(struct b_realarray *b) } } } -#endif /* Arrays */ +#endif /* Arrays */ static void vrfy_File(struct b_file *b) { @@ -2529,7 +2529,7 @@ static void vrfy_File(struct b_file *b) || ((status & (Fs_Buff | Fs_Unbuf)) == (Fs_Buff | Fs_Unbuf)) || ((status & (Fs_Socket | Fs_Directory)) == (Fs_Socket | Fs_Directory)) || ((status & (Fs_BPipe | Fs_Directory)) == (Fs_BPipe | Fs_Directory)) -#endif /* PosixFns */ +#endif /* PosixFns */ ) { vrfyCrash("File at %p: bogus status value (0x%lx)", b, status); } @@ -2669,7 +2669,7 @@ static void vrfy_Lelem(struct b_lelem *b) vrfyCrash("Lelem at %p: bad slots (%ld > %d)", b, b->nslots, MaxListSlots); } -#endif /* MaxListSlots */ +#endif /* MaxListSlots */ if (b->nused > b->nslots) { vrfyCrash("Lelem at %p: bad used slots (%ld > %ld)", b, b->nused, b->nslots); diff --git a/src/runtime/rmisc.r b/src/runtime/rmisc.r index f64a9301c..85abbf808 100644 --- a/src/runtime/rmisc.r +++ b/src/runtime/rmisc.r @@ -1,7 +1,7 @@ /* * File: rmisc.r * Contents: eq, getkeyword, getvar, hash, outimage, - * qtos, pushact, popact, topact, [dumpact], + * qtos, pushact, popact, topact, [dumpact], * findline, findipc, findfile, doimage, getimage * findsyntax, hitsyntax * printable, retderef, sig_rsm, cmd_line, varargs. @@ -12,32 +12,32 @@ /* * Prototypes. */ -static void listimage (FILE *f,struct b_list *lp, int noimage); -static void printimage (FILE *f,int c,int q); -static char * csname (dptr dp); +static void listimage (FILE *f,struct b_list *lp, int noimage); +static void printimage (FILE *f,int c,int q); +static char * csname (dptr dp); static int construct_funcimage(union block *pe, int aicode, int bpcode, dptr result, int index); -int find_cindex(union block *l, union block *r); +int find_cindex(union block *l, union block *r); - -/* + +/* * eq - compare two Icon strings for equality */ int eq(d1, d2) dptr d1, d2; { - char *s1, *s2; - int i; - - if (StrLen(*d1) != StrLen(*d2)) - return 0; - s1 = StrLoc(*d1); - s2 = StrLoc(*d2); - for (i = 0; i < StrLen(*d1); i++) - if (*s1++ != *s2++) - return 0; - return 1; + char *s1, *s2; + int i; + + if (StrLen(*d1) != StrLen(*d2)) + return 0; + s1 = StrLoc(*d1); + s2 = StrLoc(*d2); + for (i = 0; i < StrLen(*d1); i++) + if (*s1++ != *s2++) + return 0; + return 1; } - + #ifdef PatternType /* * getkeyword() - return a descriptor with current value of non-variable @@ -54,43 +54,43 @@ int getkeyword(char *s, dptr vp) switch(*s++) { case 'a': if (!strcmp(s, "scii")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_ascii; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_ascii; + return Succeeded; + } break; case 'c': if (!strcmp(s, "set")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_cset; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_cset; + return Succeeded; + } break; case 'd': if (!strcmp(s, "igits")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_digits; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_digits; + return Succeeded; + } break; case 'l': if (!strcmp(s, "etters")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_letters; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_letters; + return Succeeded; + } else if (!strcmp(s, "case")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_lcase; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_lcase; + return Succeeded; + } break; case 'u': if (!strcmp(s, "case")) { - vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_ucase; - return Succeeded; - } + vp->dword = D_Cset; vp->vword.bptr = (union block *)&k_ucase; + return Succeeded; + } break; } } return Failed; } -#endif /* PatternType */ +#endif /* PatternType */ /* * Get variable descriptor from name. Returns the (integer-encoded) scope @@ -107,27 +107,27 @@ int getvar(s,vp) struct b_proc *bp; #if COMPILER struct descrip sdp; -#else /* COMPILER */ +#else /* COMPILER */ struct pf_marker *fp; #endif CURTSTATE_AND_CE(); #if COMPILER - if (!debug_info) + if (!debug_info) fatalerr(402,NULL); StrLoc(sdp) = s; StrLen(sdp) = strlen(s); -#else /* COMPILER */ +#else /* COMPILER */ fp = pfp; -#endif /* COMPILER */ +#endif /* COMPILER */ /* * Is it a keyword that's a variable? */ if (*s == '&') { - if (strcmp(s,"&error") == 0) { /* must put basic one first */ + if (strcmp(s,"&error") == 0) { /* must put basic one first */ vp->dword = D_Kywdint; VarLoc(*vp) = &kywd_err; return Succeeded; @@ -138,7 +138,7 @@ int getvar(s,vp) VarLoc(*vp) = &erErrno; return Succeeded; } -#endif /* PosixFns */ +#endif /* PosixFns */ else if (strcmp(s,"&pos") == 0) { vp->dword = D_Kywdpos; VarLoc(*vp) = &kywd_pos; @@ -171,7 +171,7 @@ int getvar(s,vp) VarLoc(*vp) = &kywd_ftrc; return Succeeded; } -#endif /* FncTrace */ +#endif /* FncTrace */ else if (strcmp(s,"&dump") == 0) { vp->dword = D_Kywdint; @@ -184,7 +184,7 @@ int getvar(s,vp) VarLoc(*vp) = &(kywd_xwin[XKey_Window]); return Succeeded; } -#endif /* Graphics */ +#endif /* Graphics */ #ifdef MultiProgram else if (strcmp(s,"&eventvalue") == 0) { @@ -202,7 +202,7 @@ int getvar(s,vp) VarLoc(*vp) = (dptr)&(curpstate->eventcode); return Succeeded; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ else return Failed; } @@ -212,7 +212,7 @@ int getvar(s,vp) * parameters, and static names in each Icon procedure frame on the * stack. If not found among the locals, check the global variables. * If a variable with name is found, variable() returns a variable - * descriptor that points to the corresponding value descriptor. + * descriptor that points to the corresponding value descriptor. * If no such variable exits, it fails. */ @@ -223,31 +223,31 @@ int getvar(s,vp) */ if (pfp == NULL) goto glbvars; -#endif /* !COMPILER */ +#endif /* !COMPILER */ dp = glbl_argp; #if COMPILER bp = PFDebug(*pfp)->proc; /* get address of procedure block */ -#else /* COMPILER */ - bp = &(BlkLoc(*dp)->Proc); /* get address of procedure block */ +#else /* COMPILER */ + bp = &(BlkLoc(*dp)->Proc); /* get address of procedure block */ if (bp->title != T_Proc) { if (value_tmp.dword == D_Proc) { - bp = (struct b_proc *)BlkLoc(value_tmp); - } + bp = (struct b_proc *)BlkLoc(value_tmp); + } } -#endif /* COMPILER */ - - np = bp->lnames; /* Check the formal parameter names. */ +#endif /* COMPILER */ + + np = bp->lnames; /* Check the formal parameter names. */ for (i = abs((int)bp->nparam); i > 0; i--) { #if COMPILER if (eq(&sdp, np) == 1) { -#else /* COMPILER */ +#else /* COMPILER */ dp++; if (strcmp(s,StrLoc(*np)) == 0) { -#endif /* COMPILER */ +#endif /* COMPILER */ vp->dword = D_Var; VarLoc(*vp) = (dptr)dp; return ParamName; @@ -255,25 +255,25 @@ int getvar(s,vp) np++; #if COMPILER dp++; -#endif /* COMPILER */ +#endif /* COMPILER */ } #if COMPILER dp = &pfp->t.d[0]; -#else /* COMPILER */ +#else /* COMPILER */ dp = &fp->pf_locals[0]; -#endif /* COMPILER */ +#endif /* COMPILER */ for (i = (int)bp->ndynam; i > 0; i--) { /* Check the local dynamic names. */ #if COMPILER if (eq(&sdp, np)) { -#else /* COMPILER */ - if (strcmp(s,StrLoc(*np)) == 0) { -#endif /* COMPILER */ +#else /* COMPILER */ + if (strcmp(s,StrLoc(*np)) == 0) { +#endif /* COMPILER */ vp->dword = D_Var; VarLoc(*vp) = (dptr)dp; return LocalName; - } + } np++; dp++; } @@ -282,13 +282,13 @@ int getvar(s,vp) for (i = (int)bp->nstatic; i > 0; i--) { #if COMPILER if (eq(&sdp, np)) { -#else /* COMPILER */ +#else /* COMPILER */ if (strcmp(s,StrLoc(*np)) == 0) { -#endif /* COMPILER */ +#endif /* COMPILER */ vp->dword = D_Var; VarLoc(*vp) = (dptr)dp; return StaticName; - } + } np++; dp++; } @@ -301,9 +301,9 @@ int getvar(s,vp) return GlobalName; } } -#else /* COMPILER */ +#else /* COMPILER */ glbvars: - dp = globals; /* Check the global variable names. */ + dp = globals; /* Check the global variable names. */ np = gnames; while (dp < eglobals) { if (strcmp(s,StrLoc(*np)) == 0) { @@ -314,10 +314,10 @@ glbvars: np++; dp++; } -#endif /* COMPILER */ +#endif /* COMPILER */ return Failed; } - + /* * hash - compute hash value of arbitrary object for table and set accessing. */ @@ -366,30 +366,30 @@ dptr dp; case 0: break; default: - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - - s += n - 20; - - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - i ^= (i << 7)^(*s++)^(i >> 3); - i ^= ~(i << 11)^(*s++)^(i >> 5); - } + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + + s += n - 20; + + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + i ^= (i << 7)^(*s++)^(i >> 3); + i ^= ~(i << 11)^(*s++)^(i >> 5); + } i += n; } @@ -398,9 +398,9 @@ dptr dp; switch (Type(*dp)) { /* * The hash value of an integer is itself times eight times the golden - * ratio. We do this calculation in fixed point. We don't just use - * the integer itself, for that would give bad results with sets - * having entries that are multiples of a power of two. + * ratio. We do this calculation in fixed point. We don't just use + * the integer itself, for that would give bad results with sets + * having entries that are multiples of a power of two. */ case T_Integer: i = (13255 * (uword)IntVal(*dp)) >> 10; @@ -411,23 +411,23 @@ dptr dp; * The hash value of a bignum is based on its length and its * most and least significant digits. */ - case T_Lrgint: - { - struct b_bignum *b = BlkD(*dp, Lrgint); + case T_Lrgint: + { + struct b_bignum *b = BlkD(*dp, Lrgint); - i = ((b->lsd - b->msd) << 16) ^ - (b->digits[b->msd] << 8) ^ b->digits[b->lsd]; - } - break; -#endif /* LargeInts */ + i = ((b->lsd - b->msd) << 16) ^ + (b->digits[b->msd] << 8) ^ b->digits[b->lsd]; + } + break; +#endif /* LargeInts */ /* * The hash value of a real number is itself times a constant, * converted to an unsigned integer. The intent is to scramble - * the bits well, in the case of integral values, and to scale up - * fractional values so they don't all land in the same bin. - * The constant below is 32749 / 29, the quotient of two primes, - * and was observed to work well in empirical testing. + * the bits well, in the case of integral values, and to scale up + * fractional values so they don't all land in the same bin. + * The constant below is 32749 / 29, the quotient of two primes, + * and was observed to work well in empirical testing. */ case T_Real: GetReal(dp,r); @@ -443,9 +443,9 @@ dptr dp; bitarr = BlkD(*dp,Cset)->bits + CsetSize - 1; for (j = 0; j < CsetSize; j++) { i += *bitarr--; - i *= 37; /* better distribution */ + i *= 37; /* better distribution */ } - i %= 1048583; /* scramble the bits */ + i %= 1048583; /* scramble the bits */ break; /* @@ -467,10 +467,10 @@ dptr dp; case T_Record: i = (13255 * BlkD(*dp,Record)->id) >> 10; break; - - case T_Proc: - dp = &(BlkD(*dp,Proc)->pname); - goto hashstring; + + case T_Proc: + dp = &(BlkD(*dp,Proc)->pname); + goto hashstring; default: /* @@ -485,9 +485,9 @@ dptr dp; return i; } - -#define StringLimit 16 /* limit on length of imaged string */ -#define ListLimit 6 /* limit on list items in image */ + +#define StringLimit 16 /* limit on length of imaged string */ +#define ListLimit 6 /* limit on list items in image */ /* * outimage - print image of *dp on file f. If noimage is nonzero, @@ -535,12 +535,12 @@ int noimage; if (Type(*dp) == T_Lrgint) bigprint(f, dp); else -#endif /* LargeInts */ +#endif /* LargeInts */ #ifdef LongLongWord fprintf(f, "%lld", (word)IntVal(*dp)); -#else /* LongLongWord */ +#else /* LongLongWord */ fprintf(f, "%ld", (long)IntVal(*dp)); -#endif /* LongLongWord */ +#endif /* LongLongWord */ real: { char s[30]; @@ -553,12 +553,12 @@ int noimage; cset: { /* - * Check for a predefined cset; use keyword name if found. - */ - if ((csn = csname(dp)) != NULL) { - fprintf(f, "%s", csn); - return; - } + * Check for a predefined cset; use keyword name if found. + */ + if ((csn = csname(dp)) != NULL) { + fprintf(f, "%s", csn); + return; + } /* * Use printimage to print each character in the cset. Follow * with "..." if the cset contains more than StringLimit @@ -593,55 +593,55 @@ int noimage; /* * The file isn't a special one, just print "file(name)". */ - i = StrLen(BlkD(*dp,File)->fname); - s = StrLoc(BlkLoc(*dp)->File.fname); + i = StrLen(BlkD(*dp,File)->fname); + s = StrLoc(BlkLoc(*dp)->File.fname); #ifdef PosixFns - if (BlkLoc(*dp)->File.status & Fs_Socket) { - fprintf(f, "inet("); + if (BlkLoc(*dp)->File.status & Fs_Socket) { + fprintf(f, "inet("); } else - if (BlkLoc(*dp)->File.status & Fs_Directory) { - fprintf(f, "directory("); + if (BlkLoc(*dp)->File.status & Fs_Directory) { + fprintf(f, "directory("); } - else + else #endif #ifdef Dbm - if(BlkLoc(*dp)->File.status & Fs_Dbm) { - fprintf(f, "dbmfile("); + if(BlkLoc(*dp)->File.status & Fs_Dbm) { + fprintf(f, "dbmfile("); } - else + else #endif #ifdef Graphics - if (BlkLoc(*dp)->File.status & Fs_Window) { - if ((BlkLoc(*dp)->File.status != Fs_Window) && /* window open?*/ - (s = BlkLoc(*dp)->File.fd.wb->window->windowlabel)) { - i = strlen(s); - fprintf(f, "window_%d:%d(", - BlkLoc(*dp)->File.fd.wb->window->serial, - BlkLoc(*dp)->File.fd.wb->context->serial - ); - } - else { - i = 0; - fprintf(f, "window_-1:-1("); - } - } - else -#endif /* Graphics */ + if (BlkLoc(*dp)->File.status & Fs_Window) { + if ((BlkLoc(*dp)->File.status != Fs_Window) && /* window open?*/ + (s = BlkLoc(*dp)->File.fd.wb->window->windowlabel)) { + i = strlen(s); + fprintf(f, "window_%d:%d(", + BlkLoc(*dp)->File.fd.wb->window->serial, + BlkLoc(*dp)->File.fd.wb->context->serial + ); + } + else { + i = 0; + fprintf(f, "window_-1:-1("); + } + } + else +#endif /* Graphics */ #ifdef Messaging if (BlkD(*dp,File)->status & Fs_Messaging) { - struct MFile *mf = BlkLoc(*dp)->File.fd.mf; - fprintf(f, "message("); - if (mf && mf->resp && mf->resp->msg != NULL) { - fprintf(f, "[%d:%s]", mf->resp->sc, mf->resp->msg); - } - } - else + struct MFile *mf = BlkLoc(*dp)->File.fd.mf; + fprintf(f, "message("); + if (mf && mf->resp && mf->resp->msg != NULL) { + fprintf(f, "[%d:%s]", mf->resp->sc, mf->resp->msg); + } + } + else #endif /* Messaging */ - fprintf(f, "file("); - while (i-- > 0) - printimage(f, *s++, '\0'); - putc(')', f); + fprintf(f, "file("); + while (i-- > 0) + printimage(f, *s++, '\0'); + putc(')', f); } } @@ -662,7 +662,7 @@ int noimage; default: type = "procedure"; break; case -1: type = "function"; break; case -2: type = "record constructor"; break; - case -3: type = "class constructor"; break; + case -3: type = "class constructor"; break; } fprintf(f, "%s ", type); while (i-- > 0) @@ -685,15 +685,15 @@ int noimage; } set: { - /* + /* * print "set_m(n)" where n is the cardinality of the set */ - fprintf(f,"set_%ld(%ld)",(long)BlkD(*dp,Set)->id, + fprintf(f,"set_%ld(%ld)",(long)BlkD(*dp,Set)->id, (long)BlkLoc(*dp)->Set.size); } record: { - int is_obj = 0; + int is_obj = 0; /* * If noimage is nonzero, print "record(n)" where n is the * number of fields in the record. If noimage is zero, print @@ -704,56 +704,56 @@ int noimage; s = StrLoc(bp->Record.recdesc->Proc.recname); j = Blk(Blk(bp,Record)->recdesc,Proc)->nfields; - if((j>0) && (bp == (Blk(bp,Record)->fields[0]).vword.bptr) && - !strcmp(StrLoc(Blk(Blk(bp,Record)->recdesc,Proc)->lnames[0]), - "__s")) { - char *__stateloc; - is_obj = 1; - if ((__stateloc = strstr(s, "__state")) != NULL) { - while (s != __stateloc) { - printimage(f, *s++, '\0'); i--; } - s += 7; i -= 7; - } - while (i-- > 0) - printimage(f, *s++, '\0'); - } - else { - fprintf(f, "record "); + if((j>0) && (bp == (Blk(bp,Record)->fields[0]).vword.bptr) && + !strcmp(StrLoc(Blk(Blk(bp,Record)->recdesc,Proc)->lnames[0]), + "__s")) { + char *__stateloc; + is_obj = 1; + if ((__stateloc = strstr(s, "__state")) != NULL) { + while (s != __stateloc) { + printimage(f, *s++, '\0'); i--; } + s += 7; i -= 7; + } + while (i-- > 0) + printimage(f, *s++, '\0'); + } + else { + fprintf(f, "record "); while (i-- > 0) printimage(f, *s++, '\0'); - } + } fprintf(f, "_%ld", (long)Blk(bp,Record)->id); - if (f != stderr) { - if (j <= 0) - fprintf(f, "()"); - else if (noimage > 0) - fprintf(f, "(%ld)", (long)j); - else { - putc('(', f); - if (is_obj) i = 2; else - i = 0; - /* if we have any fields at all... */ - if (i < j) { - for (;;) { - outimage(f, &Blk(bp,Record)->fields[i], noimage + 1); - if (++i >= j) - break; - putc(',', f); - } - } - putc(')', f); - } - } - } + if (f != stderr) { + if (j <= 0) + fprintf(f, "()"); + else if (noimage > 0) + fprintf(f, "(%ld)", (long)j); + else { + putc('(', f); + if (is_obj) i = 2; else + i = 0; + /* if we have any fields at all... */ + if (i < j) { + for (;;) { + outimage(f, &Blk(bp,Record)->fields[i], noimage + 1); + if (++i >= j) + break; + putc(',', f); + } + } + putc(')', f); + } + } + } coexpr: { struct b_coexpr *cp = BlkD(*dp, Coexpr); #ifdef Concurrent if (IS_TS_THREAD(cp->status)) fprintf(f, "thread_%ld(%ld)", (long) cp->id, (long) cp->size); - else -#endif /* Concurrent */ + else +#endif /* Concurrent */ fprintf(f, "co-expression_%ld(%ld)", (long) cp->id, (long) cp->size); } @@ -761,11 +761,11 @@ int noimage; /* * Produce "v[i+:j] = value" where v is the image of the variable * containing the substring, i is starting position of the substring - * j is the length, and value is the string v[i+:j]. If the length + * j is the length, and value is the string v[i+:j]. If the length * (j) is one, just produce "v[i] = value". */ bp = BlkLoc(*dp); - dp = VarLoc(Blk(bp,Tvsubs)->ssvar); + dp = VarLoc(Blk(bp,Tvsubs)->ssvar); if (is:kywdsubj(bp->Tvsubs.ssvar)) { fprintf(f, "&subject"); fflush(f); @@ -779,19 +779,19 @@ int noimage; #if EBCDIC != 1 fprintf(f, "[%ld]", (long)Blk(bp,Tvsubs)->sspos); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ fprintf(f, "$<%ld$>", (long)Blk(bp,Tvsubs)->sspos); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ else #if EBCDIC != 1 fprintf(f, "[%ld+:%ld]", (long)Blk(bp,Tvsubs)->sspos, -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ fprintf(f, "$<%ld+:%ld$>", (long)Blk(bp,Tvsubs)->sspos, -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ (long)Blk(bp,Tvsubs)->sslen); @@ -812,29 +812,29 @@ int noimage; */ bp = BlkLoc(*dp); #ifdef Dbm - if (BlkType(bp) == T_File) - tdp.dword = D_File; - else -#endif /* Dbm */ - tdp.dword = D_Table; - BlkLoc(tdp) = Blk(bp,Tvtbl)->clink; - outimage(f, &tdp, noimage); + if (BlkType(bp) == T_File) + tdp.dword = D_File; + else +#endif /* Dbm */ + tdp.dword = D_Table; + BlkLoc(tdp) = Blk(bp,Tvtbl)->clink; + outimage(f, &tdp, noimage); #if EBCDIC != 1 putc('[', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('<', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ outimage(f, &(bp->Tvtbl.tref), noimage); #if EBCDIC != 1 putc(']', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('>', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ } kywdint: { @@ -846,7 +846,7 @@ int noimage; #ifdef FncTrace else if (VarLoc(*dp) == &kywd_ftrc) fprintf(f, "&ftrace = "); -#endif /* FncTrace */ +#endif /* FncTrace */ else if (VarLoc(*dp) == &kywd_dmp) fprintf(f, "&dump = "); @@ -863,7 +863,7 @@ int noimage; fprintf(f, "&eventcode = "); else if (VarLoc(*dp) == &curpstate->eventval) fprintf(f, "&eventval = "); -#endif /* MultiProgram */ +#endif /* MultiProgram */ outimage(f, VarLoc(*dp), noimage); } @@ -885,33 +885,33 @@ int noimage; outimage(f, VarLoc(*dp), noimage); } - default: { + default: { if (is:variable(*dp)) { /* - * *d is a variable. Print "variable =", dereference it, and + * *d is a variable. Print "variable =", dereference it, and * call outimage to handle the value. */ fprintf(f, "(variable = "); fflush(f); - /* weird special cases for arrays, which are the only "variable" - * descriptors that do not point at a variable descriptor. - */ - if (Offset(*dp) && - (((struct b_intarray *)VarLoc(*dp))->title == T_Intarray)) { - fprintf(f, "%ld",(long) - ((struct b_intarray *)VarLoc(*dp))->a[Offset(*dp)-4]); - } - else if (Offset(*dp) && - (((struct b_realarray *)VarLoc(*dp))->title==T_Realarray)){ - char s[30]; - struct descrip rd; - rtos(((struct b_realarray *)VarLoc(*dp))->a[Offset(*dp)-4], &rd, s); - fprintf(f, "%s", StrLoc(rd)); - } - else { - dp = (dptr)((word *)VarLoc(*dp) + Offset(*dp)); - outimage(f, dp, noimage); - } + /* weird special cases for arrays, which are the only "variable" + * descriptors that do not point at a variable descriptor. + */ + if (Offset(*dp) && + (((struct b_intarray *)VarLoc(*dp))->title == T_Intarray)) { + fprintf(f, "%ld",(long) + ((struct b_intarray *)VarLoc(*dp))->a[Offset(*dp)-4]); + } + else if (Offset(*dp) && + (((struct b_realarray *)VarLoc(*dp))->title==T_Realarray)){ + char s[30]; + struct descrip rd; + rtos(((struct b_realarray *)VarLoc(*dp))->a[Offset(*dp)-4], &rd, s); + fprintf(f, "%s", StrLoc(rd)); + } + else { + dp = (dptr)((word *)VarLoc(*dp) + Offset(*dp)); + outimage(f, dp, noimage); + } putc(')', f); } else if (Type(*dp) == T_External) @@ -923,7 +923,7 @@ int noimage; } } } - + /* * printimage - print character c on file f using escape conventions * if c is unprintable, '\', or equal to q. @@ -957,34 +957,34 @@ int c, q; } /* - * c is some sort of unprintable character. If it one of the common + * c is some sort of unprintable character. If it one of the common * ones, produce a special representation for it, otherwise, produce * its hex value. */ switch (c) { - case '\b': /* backspace */ + case '\b': /* backspace */ fprintf(f, "\\b"); return; #if !EBCDIC - case '\177': /* delete */ -#else /* !EBCDIC */ + case '\177': /* delete */ +#else /* !EBCDIC */ case '\x07': -#endif /* !EBCDIC */ +#endif /* !EBCDIC */ fprintf(f, "\\d"); return; #if !EBCDIC - case '\33': /* escape */ -#else /* !EBCDIC */ + case '\33': /* escape */ +#else /* !EBCDIC */ case '\x27': -#endif /* !EBCDIC */ +#endif /* !EBCDIC */ fprintf(f, "\\e"); return; - case '\f': /* form feed */ + case '\f': /* form feed */ fprintf(f, "\\f"); return; - case LineFeed: /* new line */ + case LineFeed: /* new line */ fprintf(f, "\\n"); return; @@ -992,23 +992,23 @@ int c, q; case '\x25': /* EBCDIC line feed */ fprintf(f, "\\l"); return; -#endif /* EBCDIC == 1 */ +#endif /* EBCDIC == 1 */ - case CarriageReturn: /* carriage return */ + case CarriageReturn: /* carriage return */ fprintf(f, "\\r"); return; - case '\t': /* horizontal tab */ + case '\t': /* horizontal tab */ fprintf(f, "\\t"); return; - case '\13': /* vertical tab */ + case '\13': /* vertical tab */ fprintf(f, "\\v"); return; - default: /* hex escape sequence */ + default: /* hex escape sequence */ fprintf(f, "\\x%02x", ToAscii(c & 0xff)); return; } } - + /* * listimage - print an image of a list. */ @@ -1020,7 +1020,7 @@ int noimage; { register word i, j; word size, count; - + size = lp->size; if (noimage > 0 && size > 0) { @@ -1039,94 +1039,94 @@ int noimage; #if EBCDIC != 1 fprintf(f, "list_%ld = [", (long)lp->id); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ fprintf(f, "list_%ld = $<", (long)lp->id); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ - if (lp->listtail!=NULL){ - register struct b_lelem *bp = (struct b_lelem *) lp->listhead; + if (lp->listtail!=NULL){ + register struct b_lelem *bp = (struct b_lelem *) lp->listhead; count = 1; i = 0; if (size > 0) { - for (;;) { - if (++i > bp->nused) { - i = 1; - bp = (struct b_lelem *) bp->listnext; - } - if (count <= ListLimit/2 || count > size - ListLimit/2) { - j = bp->first + i - 1; - if (j >= bp->nslots) - j -= bp->nslots; - outimage(f, &bp->lslots[j], noimage+1); - if (count >= size) - break; - putc(',', f); - } - else if (count == ListLimit/2 + 1) - fprintf(f, "...,"); - count++; - } - } + for (;;) { + if (++i > bp->nused) { + i = 1; + bp = (struct b_lelem *) bp->listnext; + } + if (count <= ListLimit/2 || count > size - ListLimit/2) { + j = bp->first + i - 1; + if (j >= bp->nslots) + j -= bp->nslots; + outimage(f, &bp->lslots[j], noimage+1); + if (count >= size) + break; + putc(',', f); + } + else if (count == ListLimit/2 + 1) + fprintf(f, "...,"); + count++; + } + } } -#ifdef Arrays +#ifdef Arrays else if (BlkType(lp->listhead) ==T_Realarray){ tended struct descrip d; #ifndef DescriptorDouble tended struct b_real *rblk = alcreal(0.0); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ /* probably need to worry about the following pointer*/ register struct b_realarray *ap = (struct b_realarray *) lp->listhead; - + #ifdef DescriptorDouble d.vword.realval = 0.0; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ d.vword.bptr = (union block *) rblk; -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ d.dword = D_Real; - + for (i=0;i= size - ListLimit/2) { + if (i < ListLimit/2 || i >= size - ListLimit/2) { #ifdef DescriptorDouble - d.vword.realval = ap->a[i]; -#else /* DescriptorDouble */ - rblk->realval = ap->a[i]; -#endif /* DescriptorDouble */ - outimage(f, &d , noimage+1); - if (i < size-1) - putc(',', f); - } - else if (i == ListLimit/2){ - fprintf(f, "...,"); - i=size-ListLimit/2-1; - } - } /* for*/ + d.vword.realval = ap->a[i]; +#else /* DescriptorDouble */ + rblk->realval = ap->a[i]; +#endif /* DescriptorDouble */ + outimage(f, &d , noimage+1); + if (i < size-1) + putc(',', f); + } + else if (i == ListLimit/2){ + fprintf(f, "...,"); + i=size-ListLimit/2-1; + } + } /* for*/ } else if (BlkType(lp->listhead) ==T_Intarray){ register struct b_intarray *ap = (struct b_intarray *) lp->listhead; for (i=0;i= size - ListLimit/2) { - fprintf(f, "%ld" , (long int) (ap->a[i])); - if (i < size-1) - putc(',', f); - } - else if (i == ListLimit/2){ - fprintf(f, "...,"); - i=size-ListLimit/2-1; - } - } /* for */ + if (i < ListLimit/2 || i >= size - ListLimit/2) { + fprintf(f, "%ld" , (long int) (ap->a[i])); + if (i < size-1) + putc(',', f); + } + else if (i == ListLimit/2){ + fprintf(f, "...,"); + i=size-ListLimit/2-1; + } + } /* for */ } -#endif /* Arrays */ +#endif /* Arrays */ #if EBCDIC != 1 putc(']', f); -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ putc('$', f); putc('>', f); -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ } - + /* * qsearch(key,base,nel,width,compar) - binary search * @@ -1147,19 +1147,19 @@ int (*compar)(); l = 0; u = nel - 1; while (l <= u) { - m = (l + u) / 2; - a = (char *) ((char *) base + width * m); - r = compar (a, key); - if (r < 0) - l = m + 1; - else if (r > 0) - u = m - 1; - else - return a; + m = (l + u) / 2; + a = (char *) ((char *) base + width * m); + r = compar (a, key); + if (r < 0) + l = m + 1; + else if (r > 0) + u = m - 1; + else + return a; } return 0; } - + #if !COMPILER /* * qtos - convert a qualified string named by *dp to a C-style string. @@ -1196,8 +1196,8 @@ char *sbuf; } return Succeeded; } -#endif /* !COMPILER */ - +#endif /* !COMPILER */ + #ifdef CoExpr /* * pushact - push actvtr on the activator stack of ce @@ -1209,7 +1209,7 @@ int pushact(struct b_coexpr *ce, struct b_coexpr *actvtr) #ifdef MultiProgram if (ce->program != actvtr->program) return Succeeded; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * If the last activator is the same as this one, just increment * its count. @@ -1238,8 +1238,8 @@ int pushact(struct b_coexpr *ce, struct b_coexpr *actvtr) return Succeeded; } -#endif /* CoExpr */ - +#endif /* CoExpr */ + /* * popact - pop the most recent activator from the activator stack of ce * and return it. @@ -1270,11 +1270,11 @@ struct b_coexpr *popact(struct b_coexpr *ce) if ((abp->nactivators == 0) #if !COMPILER && (abp->astk_nxt -#ifdef MultiProgram - || !(curpstate->parent) -#endif /* MultiProgram */ - ) -#endif /* COMPILER */ +#ifdef MultiProgram + || !(curpstate->parent) +#endif /* MultiProgram */ + ) +#endif /* COMPILER */ ) { oabp = abp; ce->es_actstk = abp = abp->astk_nxt; @@ -1284,24 +1284,24 @@ struct b_coexpr *popact(struct b_coexpr *ce) if (abp == NULL || abp->nactivators == 0) { #ifdef MultiProgram if (curpstate->parent) { - return BlkD(curpstate->parent->K_main, Coexpr); - } + return BlkD(curpstate->parent->K_main, Coexpr); + } else -#endif /* MultiProgram */ +#endif /* MultiProgram */ { #ifdef Concurrent /* * if this is a thread it should exist * coclean calls pthread_exit() in this case. - */ - if (IS_TS_THREAD(ce->status)){ - #ifdef CoClean - coclean(ce); - #endif /* CoClean */ + */ + if (IS_TS_THREAD(ce->status)){ + #ifdef CoClean + coclean(ce); + #endif /* CoClean */ } -#endif /* Concurrent */ - syserr("empty activator stack\n"); +#endif /* Concurrent */ + syserr("empty activator stack\n"); } } @@ -1323,12 +1323,12 @@ struct b_coexpr *popact(struct b_coexpr *ce) return actvtr; -#else /* CoExpr */ +#else /* CoExpr */ syserr("popact() called, but co-expressions not implemented"); -#endif /* CoExpr */ +#endif /* CoExpr */ } - + #ifdef CoExpr /* * topact - return the most recent activator of ce. @@ -1339,9 +1339,9 @@ struct b_coexpr *ce; struct astkblk *abp = ce->es_actstk; CURTSTATE(); -#ifdef MultiProgram +#ifdef MultiProgram if (ce->program == curtstate->c->program){ -#endif /* MultiProgram */ +#endif /* MultiProgram */ if (abp->nactivators == 0) abp = abp->astk_nxt; return abp->arec[abp->nactivators-1].activator; @@ -1349,9 +1349,9 @@ struct b_coexpr *ce; } else return abp->arec[0].activator; -#endif /* MultiProgram */ +#endif /* MultiProgram */ } - + #ifdef DeBugIconx /* * dumpact - dump an activator stack @@ -1375,17 +1375,17 @@ struct b_coexpr *ce; if (IS_TS_THREAD(arp->activator->status)) fprintf(stderr, "thread_%ld(%d)\n", (long)(arp->activator->id), arp->acount); - else -#endif /* Concurrent */ + else +#endif /* Concurrent */ fprintf(stderr, "co-expression_%ld(%d)\n", (long)(arp->activator->id), arp->acount); } abp = abp->astk_nxt; } } -#endif /* DeBugIconx */ -#endif /* CoExpr */ - +#endif /* DeBugIconx */ +#endif /* CoExpr */ + #if !COMPILER /* @@ -1414,8 +1414,8 @@ int findloc(word *ipc_in) uword size; struct ipc_line *base; - static int two = 2; /* some compilers generate bad code for division - by a constant that is a power of two ... */ + static int two = 2; /* some compilers generate bad code for division + by a constant that is a power of two ... */ if (!InRange(code,ipc_in,endcode)) return 0; @@ -1471,7 +1471,7 @@ int findline_p(word *ipc_in, struct progstate *p) { return findloc_p(ipc_in, p) & 65535; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * findipc - find the first ipc associated with a source-code line number. @@ -1481,8 +1481,8 @@ int findipc(int line) uword size; struct ipc_line *base; - static int two = 2; /* some compilers generate bad code for division - by a constant that is a power of two ... */ + static int two = 2; /* some compilers generate bad code for division + by a constant that is a power of two ... */ base = ilines; size = DiffPtrs((char *)elines,(char *)ilines) / sizeof(struct ipc_line *); @@ -1497,7 +1497,7 @@ int findipc(int line) return base->ipc_saved; } - + /* * findoldipc - find the first ipc associated with a procedure frame level. */ @@ -1516,9 +1516,9 @@ int level; fp = pfp; i = ce->program->tstate->K_level; - if (iindex == pe_index) - index_image = 1; + index_image = 1; switch (Blk(ep,Pelem)->pcode) { case PC_Alt: { int common_index = -1; arg = Blk(ep,Pelem)->parameter; r = (union block *)(BlkLoc(arg)); - + /* Find the common index of the two sides (if there is something * that follow the left hand alternation) - */ + */ if(Blk(ep, Pelem)->pthen != NULL) - common_index = find_cindex(Blk(ep, Pelem)->pthen, r); - + common_index = find_cindex(Blk(ep, Pelem)->pthen, r); + /* Traverse through the two sides until you get to the most * recent common indexed element (if it exists) - */ + */ if ((pattern_image(Blk(ep,Pelem)->pthen, prev_index, &left, - peCount, pe_index, common_index)) == RunError) - return RunError; + peCount, pe_index, common_index)) == RunError) + return RunError; - if ((pattern_image(r, prev_index, &right, peCount, pe_index, + if ((pattern_image(r, prev_index, &right, peCount, pe_index, common_index)) == RunError) - return RunError; - - if(construct_image(&left, bi_pat(PI_ALT), &right, result) + return RunError; + + if(construct_image(&left, bi_pat(PI_ALT), &right, result) == RunError) - return RunError; + return RunError; - construct_image(bi_pat(PI_FPAREN), result, + construct_image(bi_pat(PI_FPAREN), result, bi_pat(PI_BPAREN), result); /* if the most recent common element existed traverse to that * on the left so we can include it in our print - */ + */ if(common_index != -1){ while(Blk(Blk(ep, Pelem)->pthen, Pelem)->index != common_index) ep = Blk(ep,Pelem)->pthen; - } + } break; - } + } case PC_Any_MF : case PC_Break_MF : case PC_NotAny_MF: case PC_NSpan_MF : - case PC_Span_MF : + case PC_Span_MF : case PC_Len_NMF : case PC_Pos_NMF : case PC_RPos_NMF : case PC_Tab_NMF : case PC_RTab_NMF : { - if ((construct_funcimage(ep, PT_MF, Blk(ep, Pelem)->pcode, + if ((construct_funcimage(ep, PT_MF, Blk(ep, Pelem)->pcode, result, index_image)) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } case PC_Any_VF : case PC_Break_VF : case PC_NotAny_VF: case PC_NSpan_VF : case PC_Span_VF : - case PC_Len_NF : + case PC_Len_NF : case PC_Pos_NF : case PC_RPos_NF : case PC_Tab_NF : case PC_RTab_NF : { - if ((construct_funcimage(ep, PT_VF, Blk(ep, Pelem)->pcode, + if ((construct_funcimage(ep, PT_VF, Blk(ep, Pelem)->pcode, result, index_image)) == RunError) return RunError; - peCount++; - break; - } + peCount++; + break; + } case PC_Any_VP : case PC_Break_VP : case PC_NotAny_VP: @@ -1815,31 +1815,31 @@ int pattern_image(union block *pe, int prev_index, dptr result, case PC_RPos_NP : case PC_Tab_NP : case PC_RTab_NP : { - if ((construct_funcimage(ep, PT_VP, Blk(ep, Pelem)->pcode, + if ((construct_funcimage(ep, PT_VP, Blk(ep, Pelem)->pcode, result, index_image)) == RunError) return RunError; - peCount++; - break; - } - case PC_Any_CS : + peCount++; + break; + } + case PC_Any_CS : case PC_Break_CS : case PC_NotAny_CS: - case PC_NSpan_CS : + case PC_NSpan_CS : case PC_Span_CS : case PC_Len_Nat : case PC_Pos_Nat : case PC_RPos_Nat : case PC_Tab_Nat : case PC_RTab_Nat : { - if ((construct_funcimage(ep, PT_EVAL, Blk(ep, Pelem)->pcode, + if ((construct_funcimage(ep, PT_EVAL, Blk(ep, Pelem)->pcode, result, index_image)) == RunError) return RunError; - peCount++; - break; - } + peCount++; + break; + } case PC_BreakX_VF: case PC_BreakX_VP: case PC_BreakX_MF: case PC_BreakX_CS: { - int image_case; + int image_case; if (Blk(ep, Pelem)->pcode == PC_BreakX_VF) image_case = PT_VF; @@ -1848,99 +1848,99 @@ int pattern_image(union block *pe, int prev_index, dptr result, else if(Blk(ep, Pelem)->pcode == PC_BreakX_MF) image_case = PT_MF; else /* if(Blk(ep, Pelem)->pcode == PC_BreakX_CS) <-- must always be true */ - image_case = PT_EVAL; + image_case = PT_EVAL; - if (construct_funcimage(ep, image_case, Blk(ep, Pelem)->pcode, + if (construct_funcimage(ep, image_case, Blk(ep, Pelem)->pcode, result, index_image) == RunError) return RunError; - peCount++; - ep = Blk(ep,Pelem)->pthen; - if(Blk(ep, Pelem)->index + 1 == pe_index) - construct_image(bi_pat(PI_FBRACE), result, + peCount++; + ep = Blk(ep,Pelem)->pthen; + if(Blk(ep, Pelem)->index + 1 == pe_index) + construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE), result); - break; + break; } case PC_Arbno_S: { union block *arb; - int last_index = Blk(ep, Pelem)->index; + int last_index = Blk(ep, Pelem)->index; if (Blk(ep, Pelem)->index == prev_index) { - *result = *bi_pat(PI_EMPTY); + *result = *bi_pat(PI_EMPTY); return Succeeded; - } + } arb = (union block *) BlkLoc(Blk(ep,Pelem)->parameter); - if (pattern_image((union block *)arb, last_index, result, 0, pe_index, + if (pattern_image((union block *)arb, last_index, result, 0, pe_index, stop_index) == RunError) return RunError; - if (construct_image(bi_pat(PF_Arbno), result, bi_pat(PI_BPAREN), + if (construct_image(bi_pat(PF_Arbno), result, bi_pat(PI_BPAREN), result) == RunError) return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; - } + peCount++; + break; + } case PC_Arbno_X: { union block *arb; - struct b_pelem *arbParam; + struct b_pelem *arbParam; arbParam = (struct b_pelem *)BlkLoc(Blk(ep,Pelem)->parameter); if (arbParam->pcode == PC_R_Enter) { arb = arbParam->pthen; - if (pattern_image(arb, prev_index, result, 0, pe_index, stop_index) + if (pattern_image(arb, prev_index, result, 0, pe_index, stop_index) == RunError) return RunError; if (construct_image(bi_pat(PF_Arbno), result, - bi_pat(PI_BPAREN), result) == RunError) - return RunError; + bi_pat(PI_BPAREN), result) == RunError) + return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, - bi_pat(PI_BBRACE), result) == RunError) + bi_pat(PI_BBRACE), result) == RunError) return RunError; } else { syserr("PC_Arbno_X whose param is not a PC_R_Enter"); - } - peCount++; - break; - } + } + peCount++; + break; + } case PC_String_VF: case PC_Pred_Func: { - int pcode = Blk(ep, Pelem)->pcode; + int pcode = Blk(ep, Pelem)->pcode; arg = Blk(ep,Pelem)->parameter; if ((arg_image(arg, pcode, PT_VF, result)) == RunError) { - return RunError; - } + return RunError; + } if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE), result) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } case PC_String_MF: case PC_Pred_MF: { - int pcode = Blk(ep, Pelem)->pcode; + int pcode = Blk(ep, Pelem)->pcode; arg = Blk(ep,Pelem)->parameter; - if ((arg_image(arg, pcode, PT_MF, result)) == RunError) + if ((arg_image(arg, pcode, PT_MF, result)) == RunError) return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } case PC_Arb_X: { struct b_pelem * arbY; AsgnCStr(*result, "Arb()"); arbY = BlkD(Blk(ep, Pelem)->parameter, Pelem); - if(arbY->index == pe_index) index_image = 1; + if(arbY->index == pe_index) index_image = 1; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; - } - case PC_Assign_Imm: + peCount++; + break; + } + case PC_Assign_Imm: case PC_Assign_OnM: { - /* - * consider Resolved patterns. do we need to check - * if parameter is a string, or a variable? - */ + /* + * consider Resolved patterns. do we need to check + * if parameter is a string, or a variable? + */ tended struct descrip op; if (index_image == 1){ @@ -1949,38 +1949,38 @@ int pattern_image(union block *pe, int prev_index, dptr result, else AsgnCStr(op, ") [=> "); - if ((construct_image(bi_pat(PI_EMPTY), &op, - &(Blk(ep,Pelem)->parameter), result)) == RunError) + if ((construct_image(bi_pat(PI_EMPTY), &op, + &(Blk(ep,Pelem)->parameter), result)) == RunError) return RunError; - if ((construct_image(result, bi_pat(PI_BBRACE), - bi_pat(PI_EMPTY), result)) == RunError) + if ((construct_image(result, bi_pat(PI_BBRACE), + bi_pat(PI_EMPTY), result)) == RunError) return RunError; } else{ if(Blk(ep, Pelem)->pcode == PC_Assign_OnM) AsgnCStr(op, ") -> "); - else - AsgnCStr(op, ") => "); - - if ((construct_image(&op, &(Blk(ep,Pelem)->parameter), + else + AsgnCStr(op, ") => "); + + if ((construct_image(&op, &(Blk(ep,Pelem)->parameter), bi_pat(PI_EMPTY), result)) == - RunError) return RunError; - } - peCount++; - break; + RunError) return RunError; + } + peCount++; + break; } case PC_Setcur: { AsgnCStr(image, " .> "); if ((construct_image(bi_pat(PI_EMPTY), &image, - &(Blk(ep,Pelem)->parameter), result)) == - RunError) return RunError; + &(Blk(ep,Pelem)->parameter), result)) == + RunError) return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; - } + peCount++; + break; + } case PC_Bal : case PC_Abort : case PC_Fail : @@ -1994,61 +1994,61 @@ int pattern_image(union block *pe, int prev_index, dptr result, else if(Blk(ep, Pelem)->pcode == PC_Fence) AsgnCStr(*result, "Fence()"); else if(Blk(ep, Pelem)->pcode == PC_Fail) - AsgnCStr(*result, "Fail()"); + AsgnCStr(*result, "Fail()"); else if(Blk(ep, Pelem)->pcode == PC_Abort) AsgnCStr(*result, "Abort()"); else if(Blk(ep, Pelem)->pcode == PC_Bal) - AsgnCStr(*result, "Bal()"); + AsgnCStr(*result, "Bal()"); if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } case PC_Rpat: { arg = Blk(ep,Pelem)->parameter; - if ((arg_image(arg, -1, PT_VP, result)) == RunError) + if ((arg_image(arg, -1, PT_VP, result)) == RunError) return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } case PC_String: { arg = Blk(ep,Pelem)->parameter; if ((construct_image(bi_pat(PI_QUOTE), &arg, - bi_pat(PI_QUOTE), result)) == RunError) - return RunError; + bi_pat(PI_QUOTE), result)) == RunError) + return RunError; if (index_image == 1) if (construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE) ,result) == RunError) return RunError; - peCount++; - break; + peCount++; + break; } - case PC_BreakX_X: { + case PC_BreakX_X: { *result = *bi_pat(PI_EMPTY); - break; + break; } case PC_R_Enter: { *result = *bi_pat(PI_FPAREN); - break; + break; } case PC_EOP: { - *result = emptystr; - break; + *result = emptystr; + break; } default: { - char buf[128]; - if (Blk(ep,Pelem)->title != T_Pelem) - sprintf(buf, "pattern_image: bad pattern element, title %" LINTFRMT "d\n", - Blk(ep,Pelem)->title); - else - sprintf(buf, "pattern_image: bad pattern element code %" LINTFRMT "d\n", - Blk(ep,Pelem)->pcode); - syserr(buf); - } + char buf[128]; + if (Blk(ep,Pelem)->title != T_Pelem) + sprintf(buf, "pattern_image: bad pattern element, title %" LINTFRMT "d\n", + Blk(ep,Pelem)->title); + else + sprintf(buf, "pattern_image: bad pattern element code %" LINTFRMT "d\n", + Blk(ep,Pelem)->pcode); + syserr(buf); + } } } else { @@ -2059,74 +2059,74 @@ int pattern_image(union block *pe, int prev_index, dptr result, /* This serves to add the implied concatenation. This checks * for ->, =>, .>, PC_EOP, Arbno_S's, Arbno_Y's because all of those * don't have implied concatenation here. Also peCount checks to see - * if we are at the beginning of the pattern and if we are then it - * also ignores the implied concatenation. - */ + * if we are at the beginning of the pattern and if we are then it + * also ignores the implied concatenation. + */ if ((ep = Blk(ep,Pelem)->pthen) != NULL) { - if(Blk(ep, Pelem)->pcode == PC_Arbno_Y || + if(Blk(ep, Pelem)->pcode == PC_Arbno_Y || Blk(ep, Pelem)->pcode == PC_EOP || Blk(ep, Pelem)->index == prev_index || Blk(ep, Pelem)->index == stop_index) - return Succeeded; + return Succeeded; if ((Blk(ep,Pelem)->pcode != PC_Assign_Imm && - Blk(ep,Pelem)->pcode != PC_Assign_OnM && + Blk(ep,Pelem)->pcode != PC_Assign_OnM && Blk(ep,Pelem)->pcode != PC_Setcur) || - ((Blk(ep,Pelem)->pcode == PC_R_Enter) && peCount != 0)) { - if ((StrLen(*result)>0) || - ((Blk(ep,Pelem)->pcode == PC_R_Enter) && peCount != 0)){ - if ((pattern_image(ep, prev_index, &image, peCount, pe_index, + ((Blk(ep,Pelem)->pcode == PC_R_Enter) && peCount != 0)) { + if ((StrLen(*result)>0) || + ((Blk(ep,Pelem)->pcode == PC_R_Enter) && peCount != 0)){ + if ((pattern_image(ep, prev_index, &image, peCount, pe_index, stop_index)) == RunError) return RunError; - if(strcmp(StrLoc(*result), "(") != 0) - return construct_image(result, bi_pat(PI_CONCAT), &image, result); + if(strcmp(StrLoc(*result), "(") != 0) + return construct_image(result, bi_pat(PI_CONCAT), &image, result); else - return construct_image(result, bi_pat(PI_EMPTY), &image, result); - } - else return pattern_image(ep,prev_index,result,peCount,pe_index, + return construct_image(result, bi_pat(PI_EMPTY), &image, result); + } + else return pattern_image(ep,prev_index,result,peCount,pe_index, stop_index); } else { - if ((pattern_image(ep, prev_index, &image, peCount, pe_index, + if ((pattern_image(ep, prev_index, &image, peCount, pe_index, stop_index)) == RunError) return RunError; return construct_image(bi_pat(PI_EMPTY), result, &image, result); } } return Succeeded; } - -/* Construct image for Pattern Function Parameters */ + +/* Construct image for Pattern Function Parameters */ int arg_image(struct descrip arg, int pcode, int type, dptr result) { - tended struct descrip param = arg; - + tended struct descrip param = arg; + if(!is:list(param)) { - if(type == PT_EVAL) { /*Parameter is a string, cset, int */ - type_case param of { /* or unevaluated variable */ + if(type == PT_EVAL) { /*Parameter is a string, cset, int */ + type_case param of { /* or unevaluated variable */ string: { return construct_image(bi_pat(PI_QUOTE), ¶m, - bi_pat(PI_QUOTE), result); + bi_pat(PI_QUOTE), result); } cset: { - getimage(¶m, result); - return construct_image(bi_pat(PI_EMPTY), result, - bi_pat(PI_EMPTY), result); + getimage(¶m, result); + return construct_image(bi_pat(PI_EMPTY), result, + bi_pat(PI_EMPTY), result); } integer: { - getimage(¶m, result); + getimage(¶m, result); return Succeeded; } default: { - syserr("unexpected type in a PT_EVAL"); + syserr("unexpected type in a PT_EVAL"); } } - } + } else { return construct_image(bi_pat(PI_BQUOTE), ¶m, /*uneval var */ - bi_pat(PI_BQUOTE), result); + bi_pat(PI_BQUOTE), result); } } else { @@ -2136,120 +2136,120 @@ int arg_image(struct descrip arg, int pcode, int type, dptr result) if(!is:string(le->lslots[le->first])) get_name(&le->lslots[le->first], result); - else - AsgnCStr(*result, StrLoc(le->lslots[le->first])); + else + AsgnCStr(*result, StrLoc(le->lslots[le->first])); switch(type) { - case PT_VP: { /*Parameter image is unevaluated class member */ + case PT_VP: { /*Parameter image is unevaluated class member */ do { if (construct_image(result, bi_pat(PI_PERIOD), - &(le->lslots[leCurrent]), result) == - RunError) return RunError; + &(le->lslots[leCurrent]), result) == + RunError) return RunError; leCurrent++; - } - while (leCurrent != le->nslots); - return construct_image(bi_pat(PI_BQUOTE), result, + } + while (leCurrent != le->nslots); + return construct_image(bi_pat(PI_BQUOTE), result, bi_pat(PI_BQUOTE), result); - } - case PT_MF: { /*Parameter image is unevaluated method function */ + } + case PT_MF: { /*Parameter image is unevaluated method function */ if (construct_image(result, bi_pat(PI_PERIOD), - &(le->lslots[leCurrent]), result) == RunError) - return RunError; + &(le->lslots[leCurrent]), result) == RunError) + return RunError; leCurrent++; break; } case PT_VF: { - /* Parameter image is unevaluated variable function */ + /* Parameter image is unevaluated variable function */ break; } default: { - syserr("unknown pcode in arg_image()"); + syserr("unknown pcode in arg_image()"); break; } } - /* There are no parameters for this function/method */ + /* There are no parameters for this function/method */ - if((type != PT_MF && (le->nslots == 1)) || + if((type != PT_MF && (le->nslots == 1)) || ((type == PT_MF) && (le->nslots == 2))) { - if (construct_image(result, bi_pat(PI_FPAREN), + if (construct_image(result, bi_pat(PI_FPAREN), bi_pat(PI_BPAREN), result) == RunError) - return RunError; + return RunError; - /* if double back quote */ + /* if double back quote */ - if (pcode == PC_String_VF || pcode == PC_String_MF) + if (pcode == PC_String_VF || pcode == PC_String_MF) construct_image(bi_pat(PI_BQUOTE), result, - bi_pat(PI_BQUOTE), result); + bi_pat(PI_BQUOTE), result); return construct_image(bi_pat(PI_BQUOTE), result, - bi_pat(PI_BQUOTE), result); - } + bi_pat(PI_BQUOTE), result); + } - /* Attach front paren and first argument */ - /* If string then we are working with resolved copy */ + /* Attach front paren and first argument */ + /* If string then we are working with resolved copy */ if (cnv:string(le->lslots[leCurrent], arg)) - AsgnCStr(arg, StrLoc(le->lslots[leCurrent])); + AsgnCStr(arg, StrLoc(le->lslots[leCurrent])); else if (is:variable(le->lslots[leCurrent])) get_name(&le->lslots[leCurrent], &arg); - else return RunError; + else return RunError; if (construct_image(result, bi_pat(PI_FPAREN), &arg, result) == RunError) return RunError; /*if (!is:string(le->lslots[leCurrent])) { get_name(&le->lslots[leCurrent], &arg); - if (construct_image(result, bi_pat(PI_FPAREN), &arg, result) == - RunError) - return RunError; - } + if (construct_image(result, bi_pat(PI_FPAREN), &arg, result) == + RunError) + return RunError; + } else { - if (construct_image(result, bi_pat(PI_FPAREN), - &(le->lslots[leCurrent]), result) == RunError) - return RunError; - }*/ + if (construct_image(result, bi_pat(PI_FPAREN), + &(le->lslots[leCurrent]), result) == RunError) + return RunError; + }*/ - /* attach rest of parameters for uneval method/function */ + /* attach rest of parameters for uneval method/function */ leCurrent++; - if (((type != PT_MF) && (le->nslots != 2)) || + if (((type != PT_MF) && (le->nslots != 2)) || ((type == PT_MF) && (le->nslots != 3))) { do { - if(is:string(le->lslots[leCurrent])) + if(is:string(le->lslots[leCurrent])) AsgnCStr(arg, StrLoc(le->lslots[leCurrent])); else if(is:variable(le->lslots[leCurrent])) - get_name(&le->lslots[leCurrent], &arg); - if((construct_image(result, bi_pat(PI_COMMA), &arg, - result)) == RunError) return RunError; + get_name(&le->lslots[leCurrent], &arg); + if((construct_image(result, bi_pat(PI_COMMA), &arg, + result)) == RunError) return RunError; /*else { - if (construct_image(result, bi_pat(PI_COMMA), - &(le->lslots[leCurrent]), result) == RunError) - return RunError; - }*/ - leCurrent++; - } - while (leCurrent != le->nslots); + if (construct_image(result, bi_pat(PI_COMMA), + &(le->lslots[leCurrent]), result) == RunError) + return RunError; + }*/ + leCurrent++; + } + while (leCurrent != le->nslots); } if (construct_image(bi_pat(PI_EMPTY), result, - bi_pat(PI_BPAREN), result) == RunError) - return RunError; + bi_pat(PI_BPAREN), result) == RunError) + return RunError; - /* if double back quote */ + /* if double back quote */ - if (pcode == PC_String_VF || pcode == PC_String_MF) + if (pcode == PC_String_VF || pcode == PC_String_MF) construct_image(bi_pat(PI_BQUOTE), result, - bi_pat(PI_BQUOTE), result); + bi_pat(PI_BQUOTE), result); if (construct_image(bi_pat(PI_BQUOTE), result, - bi_pat(PI_BQUOTE), result) == RunError) + bi_pat(PI_BQUOTE), result) == RunError) return RunError; return Succeeded; } } - + /* * bi_pat() - returns a pointer to a string descriptor pattern image for * built-in pattern functions and operators. This subsumes get_patimage() @@ -2261,34 +2261,34 @@ dptr bi_pat(int what) if (!StrLen(patimag[0])) { MUTEX_LOCKID(MTX_PATIMG_FUNCARR); if (!StrLen(patimag[0])) { - AsgnCStr(patimag[PF_Any], "Any("); - AsgnCStr(patimag[PF_Break], "Break("); - AsgnCStr(patimag[PF_BreakX], "Breakx("); - AsgnCStr(patimag[PF_NotAny], "NotAny("); - AsgnCStr(patimag[PF_NSpan], "NSpan("); - AsgnCStr(patimag[PF_Span], "Span("); - AsgnCStr(patimag[PF_Len], "Len("); - AsgnCStr(patimag[PF_Pos], "Pos("); - AsgnCStr(patimag[PF_RPos], "Rpos("); - AsgnCStr(patimag[PF_Tab], "Tab("); - AsgnCStr(patimag[PF_RTab], "Rtab("); - AsgnCStr(patimag[PF_Arbno], "Arbno("); - AsgnCStr(patimag[PI_EMPTY], ""); - AsgnCStr(patimag[PI_FPAREN], "("); - AsgnCStr(patimag[PI_BPAREN], ")"); + AsgnCStr(patimag[PF_Any], "Any("); + AsgnCStr(patimag[PF_Break], "Break("); + AsgnCStr(patimag[PF_BreakX], "Breakx("); + AsgnCStr(patimag[PF_NotAny], "NotAny("); + AsgnCStr(patimag[PF_NSpan], "NSpan("); + AsgnCStr(patimag[PF_Span], "Span("); + AsgnCStr(patimag[PF_Len], "Len("); + AsgnCStr(patimag[PF_Pos], "Pos("); + AsgnCStr(patimag[PF_RPos], "Rpos("); + AsgnCStr(patimag[PF_Tab], "Tab("); + AsgnCStr(patimag[PF_RTab], "Rtab("); + AsgnCStr(patimag[PF_Arbno], "Arbno("); + AsgnCStr(patimag[PI_EMPTY], ""); + AsgnCStr(patimag[PI_FPAREN], "("); + AsgnCStr(patimag[PI_BPAREN], ")"); AsgnCStr(patimag[PI_FBRACE], "["); - AsgnCStr(patimag[PI_BBRACE], "]"); - AsgnCStr(patimag[PI_BQUOTE], "`"); - AsgnCStr(patimag[PI_QUOTE], "\""); - AsgnCStr(patimag[PI_SQUOTE], "'"); - AsgnCStr(patimag[PI_COMMA], ", "); - AsgnCStr(patimag[PI_PERIOD], "."); - AsgnCStr(patimag[PI_CONCAT], " || "); - AsgnCStr(patimag[PI_ALT], " .| "); - AsgnCStr(patimag[PI_ONM], " -> "); - AsgnCStr(patimag[PI_IMM], " => "); - AsgnCStr(patimag[PI_SETCUR], " .> "); - } + AsgnCStr(patimag[PI_BBRACE], "]"); + AsgnCStr(patimag[PI_BQUOTE], "`"); + AsgnCStr(patimag[PI_QUOTE], "\""); + AsgnCStr(patimag[PI_SQUOTE], "'"); + AsgnCStr(patimag[PI_COMMA], ", "); + AsgnCStr(patimag[PI_PERIOD], "."); + AsgnCStr(patimag[PI_CONCAT], " || "); + AsgnCStr(patimag[PI_ALT], " .| "); + AsgnCStr(patimag[PI_ONM], " -> "); + AsgnCStr(patimag[PI_IMM], " => "); + AsgnCStr(patimag[PI_SETCUR], " .> "); + } MUTEX_UNLOCKID(MTX_PATIMG_FUNCARR); } @@ -2297,8 +2297,8 @@ dptr bi_pat(int what) return NULL; } return patimag + what; - } - + } + /* * Construct a concatenation of three strings. Return Succeeded if OK. * Arguments MUST point at tended or static string data. @@ -2314,14 +2314,14 @@ int construct_image(dptr l, dptr s, dptr r, dptr result) for(i=0;iparameter, -1, aicode, result) != Succeeded) return RunError; @@ -2330,109 +2330,109 @@ static int construct_funcimage(union block *pe, int aicode, case PC_Any_MF: case PC_Any_VF: case PC_Any_VP: - case PC_Any_CS: { + case PC_Any_CS: { bpcode = PF_Any; - break; - } + break; + } case PC_Break_MF: case PC_Break_VF: case PC_Break_VP: - case PC_Break_CS: { + case PC_Break_CS: { bpcode = PF_Break; - break; - } + break; + } case PC_NotAny_MF: case PC_NotAny_VF: case PC_NotAny_VP: - case PC_NotAny_CS: { + case PC_NotAny_CS: { bpcode = PF_NotAny; - break; - } + break; + } case PC_BreakX_MF: case PC_BreakX_VF: case PC_BreakX_VP: - case PC_BreakX_CS: { + case PC_BreakX_CS: { bpcode = PF_BreakX; - break; - } + break; + } case PC_Span_MF: case PC_Span_VF: case PC_Span_VP: - case PC_Span_CS: { + case PC_Span_CS: { bpcode = PF_Span; - break; - } + break; + } case PC_NSpan_MF: case PC_NSpan_VF: case PC_NSpan_VP: - case PC_NSpan_CS: { + case PC_NSpan_CS: { bpcode = PF_NSpan; - break; - } + break; + } case PC_Len_NF: case PC_Len_NP: case PC_Len_NMF: - case PC_Len_Nat: { + case PC_Len_Nat: { bpcode = PF_Len; - break; - } + break; + } case PC_Pos_NF: case PC_Pos_NP: case PC_Pos_NMF: - case PC_Pos_Nat: { + case PC_Pos_Nat: { bpcode = PF_Pos; - break; - } + break; + } case PC_RPos_NF: case PC_RPos_NP: case PC_RPos_NMF: - case PC_RPos_Nat: { + case PC_RPos_Nat: { bpcode = PF_RPos; - break; - } + break; + } case PC_Tab_NF: case PC_Tab_NP: case PC_Tab_NMF: - case PC_Tab_Nat: { + case PC_Tab_Nat: { bpcode = PF_Tab; - break; - } + break; + } case PC_RTab_NF: case PC_RTab_NP: case PC_RTab_NMF: - case PC_RTab_Nat: { + case PC_RTab_Nat: { bpcode = PF_RTab; - break; + break; } default: { return RunError; } } - - if (construct_image(bi_pat(bpcode), result, bi_pat(PI_BPAREN), + + if (construct_image(bi_pat(bpcode), result, bi_pat(PI_BPAREN), result) == RunError) return RunError; if (index == 1) return construct_image(bi_pat(PI_FBRACE), result, bi_pat(PI_BBRACE), result); else - return Succeeded; + return Succeeded; } /* Alternations need to find the most recent index that is common * to determine where to cut off the image. The function below fills - * an array with 1's if the index exists in the right pattern. If - * the same index exists in the left side then that is the first + * an array with 1's if the index exists in the right pattern. If + * the same index exists in the left side then that is the first * most common element - */ + */ int find_cindex(union block *l, union block *r) -{ +{ int pat_size = -1; - int * pat_array; - int i; - union block * tmp; - - tmp = r; + int * pat_array; + int i; + union block * tmp; + + tmp = r; while(Blk(tmp, Pelem) != NULL){ if(pat_size < Blk(tmp, Pelem)->index) pat_size = Blk(tmp, Pelem)->index; @@ -2443,7 +2443,7 @@ int find_cindex(union block *l, union block *r) while(Blk(tmp, Pelem) != NULL){ if(pat_size < Blk(tmp, Pelem)->index) pat_size = Blk(tmp, Pelem)->index; - tmp = Blk(tmp, Pelem)->pthen; + tmp = Blk(tmp, Pelem)->pthen; } pat_array = (int *) malloc((pat_size + 1) * sizeof(int)); @@ -2451,29 +2451,29 @@ int find_cindex(union block *l, union block *r) for(i = 0; i < pat_size + 1; i++) pat_array[i] = 0; - while(1){ + while(1){ pat_array[Blk(r, Pelem)->index] = 1; - if((r = Blk(r,Pelem)->pthen) == NULL) - break; - } + if((r = Blk(r,Pelem)->pthen) == NULL) + break; + } while(1){ if(pat_array[Blk(l, Pelem)->index] == 1){ - free(pat_array); + free(pat_array); return Blk(l, Pelem)->index; } if(Blk(l, Pelem)->pthen) - l = Blk(l, Pelem)->pthen; - else break; + l = Blk(l, Pelem)->pthen; + else break; } - free(pat_array); - return -1; + free(pat_array); + return -1; } -#endif /* PatternType */ +#endif /* PatternType */ + - /* * getimage(dp1,dp2) - return string image of object dp1 in dp2. */ @@ -2497,11 +2497,11 @@ dptr dp1, dp2; * doimage with each character in the string, and then putting * a quote at then end. Note that doimage directly "writes" * (allocates) into the string region. (Hence the indentation.) - * This technique is used several times in this routine. + * This technique is used several times in this routine. */ s = StrLoc(source); len = StrLen(source); - Protect (reserve(Strings, (len << 2) + 2), return RunError); + Protect (reserve(Strings, (len << 2) + 2), return RunError); Protect(t = alcstr("\"", (word)(1)), return RunError); StrLoc(*dp2) = t; StrLen(*dp2) = 1; @@ -2525,25 +2525,25 @@ dptr dp1, dp2; struct b_bignum *blk = BlkD(source, Lrgint); slen = blk->lsd - blk->msd; - dlen = slen * NB * 0.3010299956639812 /* 1 / log2(10) */ + dlen = slen * NB * 0.3010299956639812 /* 1 / log2(10) */ + log((double)blk->digits[blk->msd]) * 0.4342944819032518 + 0.5; - /* 1 / ln(10) */ + /* 1 / ln(10) */ if (dlen >= MaxDigits) { sprintf(sbuf,"integer(~10^%ld)",(long)dlen); - len = strlen(sbuf); + len = strlen(sbuf); Protect(StrLoc(*dp2) = alcstr(sbuf,len), return RunError); StrLen(*dp2) = len; } - else bigtos(&source,dp2); - } + else bigtos(&source,dp2); + } else cnv: string(source, *dp2); -#else /* LargeInts */ +#else /* LargeInts */ cnv:string(source, *dp2); -#endif /* LargeInts */ - } +#endif /* LargeInts */ + } real: { cnv:string(source, *dp2); @@ -2551,23 +2551,23 @@ dptr dp1, dp2; cset: { /* - * Check for the value of a predefined cset; use keyword name if found. - */ - if ((csn = csname(dp1)) != NULL) { - StrLoc(*dp2) = csn; - StrLen(*dp2) = strlen(csn); - return Succeeded; - } - /* - * Otherwise, describe it in terms of the character membership. - */ - - i = BlkD(source,Cset)->size; - if (i < 0) - i = cssize(&source); - i = (i << 2) + 2; - if (i > 730) i = 730; - Protect (reserve(Strings, i), return RunError); + * Check for the value of a predefined cset; use keyword name if found. + */ + if ((csn = csname(dp1)) != NULL) { + StrLoc(*dp2) = csn; + StrLen(*dp2) = strlen(csn); + return Succeeded; + } + /* + * Otherwise, describe it in terms of the character membership. + */ + + i = BlkD(source,Cset)->size; + if (i < 0) + i = cssize(&source); + i = (i << 2) + 2; + if (i > 730) i = 730; + Protect (reserve(Strings, i), return RunError); Protect(t = alcstr("'", (word)(1)), return RunError); StrLoc(*dp2) = t; @@ -2600,31 +2600,31 @@ dptr dp1, dp2; else { /* * The file is not a standard one; form a string of the form - * file(nm) where nm is the argument originally given to open. + * file(nm) where nm is the argument originally given to open. */ - char namebuf[100]; /* scratch space */ + char namebuf[100]; /* scratch space */ #ifdef Graphics - if (BlkD(source,File)->status & Fs_Window) { - if ((BlkLoc(source)->File.status != Fs_Window) && - (s = BlkLoc(source)->File.fd.wb->window->windowlabel)){ - len = strlen(s); + if (BlkD(source,File)->status & Fs_Window) { + if ((BlkLoc(source)->File.status != Fs_Window) && + (s = BlkLoc(source)->File.fd.wb->window->windowlabel)){ + len = strlen(s); Protect (reserve(Strings, (len << 2) + 16), return RunError); - sprintf(sbuf, "window_%d:%d(", - BlkLoc(source)->File.fd.wb->window->serial, - BlkLoc(source)->File.fd.wb->context->serial - ); - } - else { + sprintf(sbuf, "window_%d:%d(", + BlkLoc(source)->File.fd.wb->window->serial, + BlkLoc(source)->File.fd.wb->context->serial + ); + } + else { len = 0; Protect (reserve(Strings, (len << 2) + 16), return RunError); - sprintf(sbuf, "window_-1:-1("); + sprintf(sbuf, "window_-1:-1("); } - Protect(t = alcstr(sbuf, (word)(strlen(sbuf))), return RunError); - StrLoc(*dp2) = t; - StrLen(*dp2) = strlen(sbuf); - } - else { -#endif /* Graphics */ + Protect(t = alcstr(sbuf, (word)(strlen(sbuf))), return RunError); + StrLoc(*dp2) = t; + StrLen(*dp2) = strlen(sbuf); + } + else { +#endif /* Graphics */ #ifdef PosixFns if (BlkD(source,File)->status & Fs_Socket) { s = namebuf; @@ -2633,19 +2633,19 @@ dptr dp1, dp2; namebuf, sizeof(namebuf)); } else { -#endif /* PosixFns */ +#endif /* PosixFns */ s = StrLoc(BlkD(source,File)->fname); len = StrLen(BlkD(source,File)->fname); #ifdef PosixFns } -#endif /* PosixFns */ +#endif /* PosixFns */ Protect (reserve(Strings, (len << 2) + 12), return RunError); - Protect(t = alcstr("file(", (word)(5)), return RunError); - StrLoc(*dp2) = t; - StrLen(*dp2) = 5; + Protect(t = alcstr("file(", (word)(5)), return RunError); + StrLoc(*dp2) = t; + StrLen(*dp2) = 5; #ifdef Graphics - } -#endif /* Graphics */ + } +#endif /* Graphics */ while (len-- > 0) StrLen(*dp2) += doimage(*s++, '\0'); Protect(alcstr(")", (word)(1)), return RunError); @@ -2659,19 +2659,19 @@ dptr dp1, dp2; * "procedure name" * "function name" * "record constructor name" - * "class constructor name" + * "class constructor name" * * Note that the number of dynamic locals is used to determine * what type of "procedure" is at hand. */ len = StrLen(BlkD(source,Proc)->pname); s = StrLoc(BlkLoc(source)->Proc.pname); - Protect (reserve(Strings, len + 22), return RunError); + Protect (reserve(Strings, len + 22), return RunError); switch ((int)BlkLoc(source)->Proc.ndynam) { default: type = "procedure "; outlen = 10; break; case -1: type = "function "; outlen = 9; break; case -2: type = "record constructor "; outlen = 19; break; - case -3: type = "class constructor "; outlen = 18; break; + case -3: type = "class constructor "; outlen = 18; break; } Protect(t = alcstr(type, outlen), return RunError); StrLoc(*dp2) = t; @@ -2687,7 +2687,7 @@ dptr dp1, dp2; */ bp = BlkLoc(*dp1); sprintf(sbuf, "list_%ld(%ld)", (long)Blk(bp,List)->id, - (long)Blk(bp,List)->size); + (long)Blk(bp,List)->size); len = strlen(sbuf); Protect(t = alcstr(sbuf, len), return RunError); StrLoc(*dp2) = t; @@ -2715,7 +2715,7 @@ dptr dp1, dp2; */ bp = BlkLoc(*dp1); sprintf(sbuf, "set_%ld(%ld)", (long)Blk(bp,Set)->id, - (long)Blk(bp,Set)->size); + (long)Blk(bp,Set)->size); len = strlen(sbuf); Protect(t = alcstr(sbuf,len), return RunError); StrLoc(*dp2) = t; @@ -2723,40 +2723,40 @@ dptr dp1, dp2; } record: { - long size; + long size; /* * Produce: - * "record name_m(n)" -- under construction + * "record name_m(n)" -- under construction * where n is the number of fields. */ bp = BlkLoc(*dp1); - size = (long)bp->Record.recdesc->Proc.nfields; - rnlen = StrLen(Blk(Blk(bp,Record)->recdesc,Proc)->recname); - sprintf(sbuf, "_%ld(%ld)", (long)bp->Record.id, size); - len = strlen(sbuf); - Protect (reserve(Strings, 7 + len + rnlen), return RunError); - bp = BlkLoc(*dp1); /* refresh pointer */ - /* - * If we have an object, its size is -2 for __s and __m fields. - * Also, drop the tedious "__state" portion of its recname. - */ - if (Blk(Blk(bp,Record)->recdesc, Proc)->ndynam == -3) { - char *los; /* location of "__state" in recname */ - sprintf(sbuf, "_%ld(%ld)", (long)bp->Record.id, size-2); - len= strlen(sbuf); - los= strstr(StrLoc(Blk(bp,Record)->recdesc->Proc.recname),"__state"); - if (los == NULL) - syserr("no __state in object's classname"); - rnlen = los - StrLoc(Blk(bp,Record)->recdesc->Proc.recname); - Protect(t = alcstr("object ", (word)(7)), return RunError); - } - else { - Protect(t = alcstr("record ", (word)(7)), return RunError); - } - StrLoc(*dp2) = t; - StrLen(*dp2) = 7; + size = (long)bp->Record.recdesc->Proc.nfields; + rnlen = StrLen(Blk(Blk(bp,Record)->recdesc,Proc)->recname); + sprintf(sbuf, "_%ld(%ld)", (long)bp->Record.id, size); + len = strlen(sbuf); + Protect (reserve(Strings, 7 + len + rnlen), return RunError); + bp = BlkLoc(*dp1); /* refresh pointer */ + /* + * If we have an object, its size is -2 for __s and __m fields. + * Also, drop the tedious "__state" portion of its recname. + */ + if (Blk(Blk(bp,Record)->recdesc, Proc)->ndynam == -3) { + char *los; /* location of "__state" in recname */ + sprintf(sbuf, "_%ld(%ld)", (long)bp->Record.id, size-2); + len= strlen(sbuf); + los= strstr(StrLoc(Blk(bp,Record)->recdesc->Proc.recname),"__state"); + if (los == NULL) + syserr("no __state in object's classname"); + rnlen = los - StrLoc(Blk(bp,Record)->recdesc->Proc.recname); + Protect(t = alcstr("object ", (word)(7)), return RunError); + } + else { + Protect(t = alcstr("record ", (word)(7)), return RunError); + } + StrLoc(*dp2) = t; + StrLen(*dp2) = 7; Protect(alcstr(StrLoc(Blk(bp,Record)->recdesc->Proc.recname),rnlen), - return RunError); + return RunError); StrLen(*dp2) += rnlen; Protect(alcstr(sbuf, len), return RunError); StrLen(*dp2) += len; @@ -2769,24 +2769,24 @@ dptr dp1, dp2; * where m is the number of the co-expressions and n is the * number of results that have been produced. */ - word numchar; + word numchar; sprintf(sbuf, "_%ld(%ld)", (long)BlkD(source,Coexpr)->id, (long)BlkLoc(source)->Coexpr.size); len = strlen(sbuf); #ifdef Concurrent if (IS_TS_THREAD(BlkLoc(source)->Coexpr.status)){ - numchar = 6; - Protect (reserve(Strings, len + numchar), return RunError); + numchar = 6; + Protect (reserve(Strings, len + numchar), return RunError); Protect(t = alcstr("thread", numchar), return RunError); - } - else -#endif /* Concurrent */ + } + else +#endif /* Concurrent */ { - numchar = 13; - Protect (reserve(Strings, len + numchar), return RunError); + numchar = 13; + Protect (reserve(Strings, len + numchar), return RunError); Protect(t = alcstr("co-expression", numchar), return RunError); - } + } StrLoc(*dp2) = t; Protect(alcstr(sbuf, len), return RunError); @@ -2794,55 +2794,55 @@ dptr dp1, dp2; } tvmonitored:{ - /* - * foreign monitored tapped variable + /* + * foreign monitored tapped variable */ Protect(t = alcstr("Trapped_monitored", (word)(17)), return RunError); StrLoc(*dp2) = t; StrLen(*dp2) = 17; - } + } -#ifdef PatternType +#ifdef PatternType pattern: { /* * Produce: * "pattern_m(n)" * where n is the current size of the pattern. */ - register union block *ep; - tended struct descrip pimage; + register union block *ep; + tended struct descrip pimage; bp = BlkLoc(*dp1); - ep = Blk(bp,Pattern)->pe; - + ep = Blk(bp,Pattern)->pe; + if (pattern_image(ep, -1, &pimage, 0, -1, -1) == RunError) - ReturnErrVal(166, *dp1, RunError); + ReturnErrVal(166, *dp1, RunError); t = alcstr(NULL, StrLen(pimage) + 29); - sprintf(t, "pattern_%ld(%ld) = ", (long)(Blk(bp,Pattern)->id), - (long)(Blk(ep,Pelem)->index)); - len = strlen(t); - { int i; - for(i=0;iblksize); len = strlen(sbuf); @@ -2851,12 +2851,12 @@ dptr dp1, dp2; StrLen(*dp2) = len; } else { - ReturnErrVal(123, source, RunError); + ReturnErrVal(123, source, RunError); } } return Succeeded; } - + /* * csname(dp) -- return the name of a predefined cset matching dp. */ @@ -2866,7 +2866,7 @@ dptr dp; register int n; n = BlkD(*dp,Cset)->size; - if (n < 0) + if (n < 0) n = cssize(dp); #if EBCDIC != 1 @@ -2876,27 +2876,27 @@ dptr dp; */ if (n == 52) { if ((Cset32('a',*dp) & Cset32('A',*dp)) == (0377777777l << CsetOff('a'))) - return ("&letters"); + return ("&letters"); } else if (n < 52) { if (n == 26) { - if (Cset32('a',*dp) == (0377777777l << CsetOff('a'))) - return ("&lcase"); - else if (Cset32('A',*dp) == (0377777777l << CsetOff('A'))) - return ("&ucase"); - } + if (Cset32('a',*dp) == (0377777777l << CsetOff('a'))) + return ("&lcase"); + else if (Cset32('A',*dp) == (0377777777l << CsetOff('A'))) + return ("&ucase"); + } else if (n == 10 && *CsetPtr('0',*dp) == (01777 << CsetOff('0'))) - return ("&digits"); + return ("&digits"); } else /* n > 52 */ { if (n == 256) - return "&cset"; + return "&cset"; else if (n == 128 && ~0 == - (Cset32(0,*dp) & Cset32(32,*dp) & Cset32(64,*dp) & Cset32(96,*dp))) - return "&ascii"; + (Cset32(0,*dp) & Cset32(32,*dp) & Cset32(64,*dp) & Cset32(96,*dp))) + return "&ascii"; } return NULL; -#else /* EBCDIC != 1 */ +#else /* EBCDIC != 1 */ /* * Check for a cset we recognize using a hardwired decision tree. * In EBCDIC, the neither &lcase nor &ucase is contiguous. @@ -2905,21 +2905,21 @@ dptr dp; if (n == 52) { if ((Cset32(0x80,*dp) & Cset32(0xC0,*dp)) == 0x03FE03FE && Cset32(0xA0,*dp) & Cset32(0xE0,*dp)) == 0x03FC) - return ("&letters"); + return ("&letters"); } else if (n < 52) { if (n == 26) { - if (Cset32(0x80,*dp) == 0x03FE03FE && Cset32(0xA0,*dp) == 0x03FC) - return ("&lcase"); - else if (Cset32(0xC0,*dp) == 0x03FE03FE && Cset32(0xE0,*dp) == 0x03FC) - return ("&ucase"); - } + if (Cset32(0x80,*dp) == 0x03FE03FE && Cset32(0xA0,*dp) == 0x03FC) + return ("&lcase"); + else if (Cset32(0xC0,*dp) == 0x03FE03FE && Cset32(0xE0,*dp) == 0x03FC) + return ("&ucase"); + } else if (n == 10 && *CsetPtr('0',*dp) == (01777 << CsetOff('0'))) return ("&digits"); } else /* n > 52 */ { if (n == 256) - return "&cset"; + return "&cset"; else if (n == 128) { int i; for (i = 0; i < CsetSize; i++) @@ -2929,9 +2929,9 @@ dptr dp; } } return NULL; -#endif /* EBCDIC != 1 */ +#endif /* EBCDIC != 1 */ } - + /* * cssize(dp) - calculate cset size, store it, and return it */ @@ -2947,11 +2947,11 @@ dptr dp; n = 0; for (i = CsetSize; --i >= 0; ) for (w = *wp++; w != 0; w >>= 1) - n += (w & 1); + n += (w & 1); cs->size = n; return n; } - + /* * printable(c) -- is c a "printable" character? */ @@ -2968,11 +2968,11 @@ int c; #if PORT return isprint(c); Deliberate Syntax Error -#endif /* PORT */ +#endif /* PORT */ #if MSDOS || UNIX || VMS return (isascii(c) && isprint(c)); -#endif /* MSDOS ... */ +#endif /* MSDOS ... */ #if MVS || VM return isprint(c); @@ -2982,7 +2982,7 @@ Deliberate Syntax Error * End of operating-system specific code. */ } - + #ifndef AsmOver /* * add, sub, mul, neg with overflow check @@ -3026,14 +3026,14 @@ word mul(word a, word b, int *over_flowp) { if (b != 0) { if ((a ^ b) >= 0) { - if (a >= 0 ? a > MaxLong / b : a < MaxLong / b) { + if (a >= 0 ? a > MaxLong / b : a < MaxLong / b) { *over_flowp = 1; - return 0; + return 0; } - } + } else if (b != -1 && (a >= 0 ? a > MinLong / b : a < MinLong / b)) { *over_flowp = 1; - return 0; + return 0; } } @@ -3050,23 +3050,23 @@ word mod3(word a, word b, int *over_flowp) switch ( b ) { case 0: - *over_flowp = 1; /* Not really an overflow, but definitely an error */ - return 0; + *over_flowp = 1; /* Not really an overflow, but definitely an error */ + return 0; case MinLong: - /* Handle this separately, since -MinLong can overflow */ - retval = ( a > MinLong ) ? a : 0; - break; + /* Handle this separately, since -MinLong can overflow */ + retval = ( a > MinLong ) ? a : 0; + break; default: - /* First, we make b positive */ - if ( b < 0 ) b = -b; - - /* Make sure retval should have the same sign as 'a' */ - retval = a % b; - if ( ( a < 0 ) && ( retval > 0 ) ) - retval -= b; - break; + /* First, we make b positive */ + if ( b < 0 ) b = -b; + + /* Make sure retval should have the same sign as 'a' */ + retval = a % b; + if ( ( a < 0 ) && ( retval > 0 ) ) + retval -= b; + break; } *over_flowp = 0; @@ -3075,7 +3075,7 @@ word mod3(word a, word b, int *over_flowp) word div3(word a, word b, int *over_flowp) { - if ( ( b == 0 ) || /* Not really an overflow, but definitely an error */ + if ( ( b == 0 ) || /* Not really an overflow, but definitely an error */ ( b == -1 && a == MinLong ) ) { *over_flowp = 1; return 0; @@ -3096,8 +3096,8 @@ word neg(word a, int *over_flowp) *over_flowp = 0; return -a; } -#endif /* AsmOver */ - +#endif /* AsmOver */ + #if COMPILER /* * sig_rsm - standard success continuation that just signals resumption. @@ -3107,7 +3107,7 @@ int sig_rsm() { return A_Resume; } - + /* * cmd_line - convert command line arguments into a list of strings. */ @@ -3143,7 +3143,7 @@ dptr rslt; rslt->dword = D_List; rslt->vword.bptr = (union block *) hp; } - + /* * varargs - construct list for use in procedures with variable length * argument list. @@ -3172,8 +3172,8 @@ dptr rslt; rslt->dword = D_List; rslt->vword.bptr = (union block *) hp; } -#endif /* COMPILER */ - +#endif /* COMPILER */ + /* * retderef - Dereference local variables and substrings of local * string-valued variables. This is used for return, suspend, and @@ -3219,5 +3219,5 @@ int strncasecmp(char *s1, char *s2, int n) } return 0; } -#endif /* NTGCC */ -#endif /* MSDOS */ +#endif /* NTGCC */ +#endif /* MSDOS */ diff --git a/src/runtime/rmsg.r b/src/runtime/rmsg.r index 2025acc68..8ef189dee 100644 --- a/src/runtime/rmsg.r +++ b/src/runtime/rmsg.r @@ -25,7 +25,7 @@ int M_open_timeout; #if NT extern int StartupWinSocket(void); -#endif /* NT */ +#endif /* NT */ const char* DEFAULT_USER_AGENT = "User-Agent: Unicon Messaging/13.0"; @@ -67,7 +67,7 @@ int Mexcept(int e, void* obj, Tpdisc_t* disc) } struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, - int status) + int status) { Tp_t* tp; Tpdisc_t* disc; @@ -83,7 +83,7 @@ struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, _tpssl_setparam(disc, status & Fs_Verify); } else -#endif /* HAVE_LIBSSL */ +#endif /* HAVE_LIBSSL */ disc = tp_newdisc(TpdUnix); #else @@ -92,7 +92,7 @@ struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, #if NT if (!StartupWinSocket()) return NULL; -#endif /*NT*/ +#endif /*NT*/ tpexcept = disc->exceptf; disc->exceptf = Mexcept; @@ -130,7 +130,7 @@ struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, mfile->tp = tp; mfile->resp = NULL; MFSTATE(mfile, CONNECTING); - + if (meth == TpmHTTP) { Mhttp(mfile, attr, nattr); } @@ -154,7 +154,7 @@ struct MFile* Mopen(URI* puri, dptr attr, int nattr, int shortreq, void Mhttp(struct MFile* mf, dptr attr, int nattr) { int i, l; - tended char *s; + tended char *s; char *end, *colon; char buf[4096]; char header[8192]; @@ -177,56 +177,56 @@ void Mhttp(struct MFile* mf, dptr attr, int nattr) header[0] = '\0'; for (i=0; itp->uri.host, strlen(mf->tp->uri.host), &hleft); /* if the user set the port explicitly then add it to the header */ if (mf->tp->uri.is_explicit_port != 0 ){ - Maddtoheader(header, ":", 1, &hleft); - l = sprintf(buf, "%d", mf->tp->uri.port); - Maddtoheader(header, buf, l, &hleft); - } + Maddtoheader(header, ":", 1, &hleft); + l = sprintf(buf, "%d", mf->tp->uri.port); + Maddtoheader(header, buf, l, &hleft); + } Maddtoheader(header, "\r\n", 2, &hleft); } @@ -265,7 +265,7 @@ void Mpop(struct MFile* mf, dptr attr, int nattr) { Tprequest_t req = {0}; unsigned int nmsg; - + req.type = STAT; mf->resp = tp_sendreq(mf->tp, &req); if (mf->resp->sc != 200) { @@ -303,8 +303,8 @@ int Mpop_delete(struct MFile* mf, unsigned int msgnum) for (i=0; inext; if (mplCurrent->msgnum == 0) { - return -1; - } + return -1; + } } svrnum = mplCurrent->msgnum; req.args = (char *)buf; @@ -356,7 +356,7 @@ int Mpop_newlist(struct MFile* mf, unsigned n) if (n <= 0) { return -1; } - + /* Initialize the list */ mf->data = (void *)disc->memf(sizeof(struct Mpoplist), disc); mplHead = (struct Mpoplist *)(mf->data); @@ -399,21 +399,21 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) else { #ifdef HAVE_GETHOSTNAME if (gethostname(smtpserver, sizeof(smtpserver)) >= 0) { - if (getdomainname(buf, sizeof(buf)) >= 0) { - strncat(smtpserver, ".", 1); - strncat(smtpserver, buf, sizeof(smtpserver)-strlen(smtpserver)-1); - goto got_smtpserver; - } - } + if (getdomainname(buf, sizeof(buf)) >= 0) { + strncat(smtpserver, ".", 1); + strncat(smtpserver, buf, sizeof(smtpserver)-strlen(smtpserver)-1); + goto got_smtpserver; + } + } #endif /* HAVE_GETHOSTNAME */ Mexcept(1209, NULL, NULL); return; } - + #ifdef HAVE_GETHOSTNAME got_smtpserver: #endif /* HAVE_GETHOSTNAME */ - + if(getenv_r("UNICON_USERADDRESS", tmpbuf, 255)==0) { tmpbuf[255] = '\0'; strncat(useraddr, tmpbuf, sizeof(useraddr)-1); @@ -421,22 +421,22 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) } else { #if defined(HAVE_GETUID) && defined(HAVE_GETPWUID) - struct passwd* pw, pwbuf; + struct passwd* pw, pwbuf; char buf[1024]; if(getpwuid_r(getuid(), &pwbuf, buf, 1024, &pw)==0){ - snprintf(useraddr, sizeof(useraddr), "%s@%s", - pw->pw_name, smtpserver); - goto got_useraddr; - } + snprintf(useraddr, sizeof(useraddr), "%s@%s", + pw->pw_name, smtpserver); + goto got_useraddr; + } #endif Mexcept(1210, NULL, NULL); return; } - + #if defined(HAVE_GETUID) && defined(HAVE_GETPWUID) got_useraddr: #endif - + mf->tp->uri.host = _tpastrcpy(smtpserver, mf->tp->disc); mf->tp->uri.port = 25; @@ -452,23 +452,23 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) resp = tp_sendreq(mf->tp, &req); switch (resp->sc) { case 250: /* OK */ - break; - + break; + case 501: /* Argument syntax error */ case 502: /* Command not implemented */ case 504: /* Command parameter not implemented */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; case 421: /* Service not available, closing transmission channel */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; default: - fprintf(stderr, "Msmtp: unrecognized response to HELO: %d\n", - resp->sc); + fprintf(stderr, "Msmtp: unrecognized response to HELO: %d\n", + resp->sc); } tp_freeresp(mf->tp, resp); @@ -477,29 +477,29 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) resp = tp_sendreq(mf->tp, &req); switch (resp->sc) { case 250: /* success */ - break; + break; case 451: /* Requested action aborted: local error in processing */ case 452: /* Requested action not taken: insufficient system storage */ case 552: /* Requested mail action aborted: exceeded storage allocation */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; case 500: /* Syntax error, command unrecognized */ case 501: /* Syntax error in parameters or arguments */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; case 421: - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; default: - fprintf(stderr, "Msmtp: unrecognized response to MAIL: %d\n", - resp->sc); + fprintf(stderr, "Msmtp: unrecognized response to MAIL: %d\n", + resp->sc); } tp_freeresp(mf->tp, resp); @@ -509,7 +509,7 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) switch (resp->sc) { case 250: /* OK */ case 251: /* User not local; will forward to */ - break; + break; case 450: /* Requested mail action not taken: mailbox unavailable */ case 451: /* Requested action aborted: local error in processing */ @@ -518,25 +518,25 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) case 551: /* User not local; please try */ case 552: /* Requested mail action aborted: exceeded storage allocation */ case 553: /* Requested action not taken: mailbox name not allowed */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; case 500: /* Syntax error, command unrecognized */ case 501: /* Syntax error in parameters or arguments */ case 503: /* Bad sequence of commands */ - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; case 421: - Mclose(mf); - Mexcept(1212, NULL, NULL); - return; + Mclose(mf); + Mexcept(1212, NULL, NULL); + return; default: - fprintf(stderr, "Msmtp: unrecognized response to MAIL: %d\n", - resp->sc); + fprintf(stderr, "Msmtp: unrecognized response to MAIL: %d\n", + resp->sc); } tp_freeresp(mf->tp, resp); @@ -548,33 +548,33 @@ void Msmtp(struct MFile* mf, dptr attr, int nattr) hleft = sizeof(header); for (i=0; itp, &req); - MFSTATE(mf, CONNECTED | WRITING); + MFSTATE(mf, CONNECTED | WRITING); } void Mstartreading(struct MFile* mf) @@ -611,7 +611,7 @@ void Mstartreading(struct MFile* mf) Mexceptjmp = 0; return; } - + mf->resp = tp_end(mf->tp); MFLEAVE(mf, WRITING); MFENTER(mf, READING); @@ -648,8 +648,8 @@ char *Mwashs(char* dest, char* s, size_t n) for (i=0; ii; return -1; } -#else /* Messaging */ -static int nomessaging; /* avoid empty module */ -#endif /* Messaging */ +#else /* Messaging */ +static int nomessaging; /* avoid empty module */ +#endif /* Messaging */ diff --git a/src/runtime/rmswin.ri b/src/runtime/rmswin.ri index eb5a9debc..fa271046a 100644 --- a/src/runtime/rmswin.ri +++ b/src/runtime/rmswin.ri @@ -25,7 +25,7 @@ wdp wdsplys; #ifdef ConsoleWindow extern void closelog(); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ void wfreersc(); void SetDCPixelFormat(HDC h); int alc_rgb(wbp w, SysColor rgb); @@ -57,7 +57,7 @@ HPALETTE palette; int numColors = 0; char szAppName[] = "Icon"; - + /* * pattern symbols */ @@ -116,7 +116,7 @@ stringint siLineTypes[] = { {"solid", PS_SOLID}, {"striped", PS_DOT} }; - + HINSTANCE mswinInstance; int ncmdShow; @@ -261,7 +261,7 @@ int mswinsystem(char *s) */ argc = CmdParamToArgv(s, &argv, 0); if (argv[0][0] == '\"') strcpy(cmd, argv[0]+1); - else strcpy(cmd, argv[0]); + else strcpy(cmd, argv[0]); if (cmd[strlen(cmd)-1] == '\"') cmd[strlen(cmd)-1] = '\0'; rv = _spawnvp(_P_WAIT, cmd, (const char* const*) argv); @@ -289,7 +289,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i tended struct descrip attrrslt; HDC hdc, hdc2, hdc3; DWORD winstyles = 0; - TEXTMETRIC metrics; + TEXTMETRIC metrics; LOGPALETTE logpal[4]; /* really 1 + space for an extra palette entry */ HBRUSH brush; HBITMAP oldpix, oldpix2; @@ -315,7 +315,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i *err_idx = -2; return NULL; } - + ws->listp.dword = D_List; BlkLoc(ws->listp) = (union block *) tlp; ws->width = ws->height = 0; @@ -325,27 +325,27 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i if (is_3d) { /* create an empty list for list of function calls */ if (create_display_list(w, 40000) == Failed) { - *err_idx = -2; - return NULL; - } + *err_idx = -2; + return NULL; + } } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * process the passed in attributes - by calling wattrib */ for(i = 0; i < n; i++) switch (wattrib(w, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt, - answer)) { + answer)) { case Failed: - wclose(w); /* suspicious; didn't get it opened OK */ - set_errortext(145); - *err_idx = -1; - return NULL; + wclose(w); /* suspicious; didn't get it opened OK */ + set_errortext(145); + *err_idx = -1; + return NULL; case RunError: - *err_idx = i; - return NULL; - } + *err_idx = i; + return NULL; + } /* * set the title, defaulting to the "filename" supplied to open() @@ -369,11 +369,11 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i winstyles |= WS_VISIBLE; */ ws->iconwin = CreateWindow( UNICONX, ws->windowlabel, - winstyles, - ws->posx, ws->posy, - ws->width == 0 ? 400 : ws->width + BORDWIDTH, - ws->height == 0 ? 400: ws->height + BORDHEIGHT + 1, - NULL, NULL, mswinInstance, NULL); + winstyles, + ws->posx, ws->posy, + ws->width == 0 ? 400 : ws->width + BORDWIDTH, + ws->height == 0 ? 400: ws->height + BORDHEIGHT + 1, + NULL, NULL, mswinInstance, NULL); hdc = GetDC(ws->iconwin); if ((GetDeviceCaps(hdc, RASTERCAPS) & RC_PALETTE) && (numColors == 0)){ /* This window is on a device that supports palettes */ @@ -418,10 +418,10 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i if (!ws->width) ws->width = FWIDTH(w) * 80; if (!ws->height) ws->height = FHEIGHT(w) * 12; SetWindowPos(ws->iconwin, ws->iconwin, - ws->posx, - ws->posy, - ws->width + BORDWIDTH, ws->height + BORDHEIGHT + 1, - SWP_NOZORDER); + ws->posx, + ws->posy, + ws->width + BORDWIDTH, ws->height + BORDHEIGHT + 1, + SWP_NOZORDER); } if (!ws->pix) { hdc = GetDC(ws->iconwin); @@ -447,7 +447,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i create3Dcontext(w); ReleaseDC(ws->iconwin, hdc); } -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (!ISTOBEHIDDEN(ws)) { ws->win = ws->iconwin; @@ -486,9 +486,9 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i if (palette) { SelectPalette(hdc, palette, FALSE); SelectPalette(hdc2, palette, FALSE); - RealizePalette(hdc); - RealizePalette(hdc2); - } + RealizePalette(hdc); + RealizePalette(hdc2); + } brush = CreateBrushIndirect(&(wc->bgbrush)); if (ws->win) FillRect(hdc, &rec, brush); @@ -500,17 +500,17 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx, int i imd = &ws->initimage; if (imd->width) { - r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, - imd->data, (word)imd->width * (word)imd->height, 0); - if (imd->paltbl) - free((pointer)imd->paltbl); - free((pointer)imd->data); - imd->width = 0; - if (r < 0) { - *err_idx = -1; /* review. when does strimage fail? */ - return 0; - } - } + r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, + imd->data, (word)imd->width * (word)imd->height, 0); + if (imd->paltbl) + free((pointer)imd->paltbl); + free((pointer)imd->data); + imd->width = 0; + if (r < 0) { + *err_idx = -1; /* review. when does strimage fail? */ + return 0; + } + } } if (ws->win) UpdateWindow(ws->win); @@ -528,7 +528,7 @@ int handle_config(wbp w, UINT msg, WPARAM wp, LPARAM lp) if (ws->win) { SetWindowText(ws->win, ws->iconlabel); ws->win = NULL; - } + } return 1; } @@ -558,13 +558,13 @@ int handle_config(wbp w, UINT msg, WPARAM wp, LPARAM lp) if(ws->is_3D) { HDC tmpdc = GetDC(ws->iconwin); double tb = 0.125 * ws->height / ws->width; -#ifdef GraphicsGL +#ifdef GraphicsGL wglMakeCurrent(tmpdc, w->window->ctx); SetWindowSize(w); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ReleaseDC(ws->iconwin, tmpdc); } -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (! resizePixmap(w, ws->width, ws->height)) return 0; if (!ISEXPOSED(w)) { SETEXPOSED(w); @@ -606,8 +606,8 @@ void handle_child(wbp wb, UINT msg, WPARAM wp, LPARAM lp) } case EN_SETFOCUS: case EN_KILLFOCUS: case EN_CHANGE: case EN_UPDATE: case EN_ERRSPACE: case EN_MAXTEXT: case EN_HSCROLL: case EN_VSCROLL: { - return; - } + return; + } default: { /* scrollbar */ x = y = msg; } @@ -692,11 +692,11 @@ void handle_mouse(wbp wb, UINT msg, WPARAM wp, LPARAM lp) switch(msg) { case WM_MOUSEMOVE: /* only called if one of these three cases is true */ if (MK_LBUTTON & wp) - eventcode = MOUSELEFTDRAG; + eventcode = MOUSELEFTDRAG; else if (MK_RBUTTON & wp) - eventcode = MOUSERIGHTDRAG; + eventcode = MOUSERIGHTDRAG; else if (MK_MBUTTON & wp) - eventcode = MOUSEMIDDRAG; + eventcode = MOUSEMIDDRAG; else eventcode = MOUSEMOVED; break; case WM_LBUTTONDOWN: { @@ -704,8 +704,8 @@ void handle_mouse(wbp wb, UINT msg, WPARAM wp, LPARAM lp) pt.y = y; win = ChildWindowFromPoint(ws->win,pt); if ((win!=NULL) && (win != GetFocus())) { - SetFocus(win); - } + SetFocus(win); + } } eventcode = MOUSELEFT; break; @@ -759,10 +759,10 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) wfreersc(); #ifdef ConsoleWindow closelog(); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ } else if (!wb) { - /* + /* * doesn't look like its for one of our windows, pass it to * DefWindowProc and hope for the best. */ @@ -783,46 +783,46 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) ReleaseDC(hwnd, hdc); } else { -#endif /* Graphics3D */ +#endif /* Graphics3D */ hdc = BeginPaint(hwnd, &ps); GetClientRect(hwnd, &rect); if (IsIconic(hwnd)) { HBRUSH hb = CreateBrushIndirect(&(wb->context->brush)); - FrameRect(hdc, &rect, hb); - DeleteObject(hb); - DrawText(hdc, "Iconx", 5, &rect, DT_WORDBREAK); - } + FrameRect(hdc, &rect, hb); + DeleteObject(hb); + DrawText(hdc, "Iconx", 5, &rect, DT_WORDBREAK); + } else { HBITMAP oldpix; - hdc2 = CreateCompatibleDC(hdc); - oldpix = SelectObject(hdc2, ws->pix); - BitBlt(hdc, rect.left, rect.top, - rect.right - rect.left + 1, rect.bottom - rect.top + 1, - hdc2, rect.left, rect.top, SRCCOPY); + hdc2 = CreateCompatibleDC(hdc); + oldpix = SelectObject(hdc2, ws->pix); + BitBlt(hdc, rect.left, rect.top, + rect.right - rect.left + 1, rect.bottom - rect.top + 1, + hdc2, rect.left, rect.top, SRCCOPY); SelectObject(hdc2, oldpix); - DeleteDC(hdc2); - } + DeleteDC(hdc2); + } EndPaint(hwnd, &ps); #ifdef Graphics3D } -#endif /* Graphics3D */ +#endif /* Graphics3D */ return 0; case WM_MOUSEMOVE: if (ws->curcursor) SetCursor(ws->curcursor); if ((ws->inputmask & PointerMotionMask) || - ((MK_LBUTTON | MK_RBUTTON | MK_MBUTTON) & wp)) - handle_mouse(wb,msg,wp,lp); + ((MK_LBUTTON | MK_RBUTTON | MK_MBUTTON) & wp)) + handle_mouse(wb,msg,wp,lp); return 0; case WM_LBUTTONDOWN: case WM_RBUTTONDOWN: case WM_MBUTTONDOWN: handle_mouse(wb,msg,wp,lp); #ifdef Graphics3D if (wb->context->rendermode == UGL3D && wb->context->app_use_selection3D){ - wb->context->selectionrendermode = 1; - redraw3D(wb); - wb->context->selectionrendermode = 0; - } -#endif /* Graphics3D */ + wb->context->selectionrendermode = 1; + redraw3D(wb); + wb->context->selectionrendermode = 0; + } +#endif /* Graphics3D */ return 0; case WM_LBUTTONUP: case WM_RBUTTONUP: case WM_MBUTTONUP: handle_mouse(wb,msg,wp,lp); @@ -830,43 +830,43 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) #ifndef NoMouseWheel case WM_MOUSEWHEEL: if (1 /* ws->inputmask & MouseWheelMask */) { - /* generate a SCROLLUP or SCROLLDOWN */ - short wp1 = LOWORD(wp), wp2 = HIWORD(wp); + /* generate a SCROLLUP or SCROLLDOWN */ + short wp1 = LOWORD(wp), wp2 = HIWORD(wp); if (wp2 > 0) { /* page ups */ - do { - handle_mouse(wb, WM_MOUSEWHEEL, wp, lp); - wp2 -= 120; + do { + handle_mouse(wb, WM_MOUSEWHEEL, wp, lp); + wp2 -= 120; } while (wp2 > 0); } else { /* page downs */ - do { - handle_mouse(wb, WM_MOUSEWHEEL, wp, lp); - wp2 += 120; + do { + handle_mouse(wb, WM_MOUSEWHEEL, wp, lp); + wp2 += 120; } while (wp2 < 0); } } else { - /* convert this into a pgup or pgdn */ - short wp1 = LOWORD(wp), wp2 = HIWORD(wp); + /* convert this into a pgup or pgdn */ + short wp1 = LOWORD(wp), wp2 = HIWORD(wp); if (wp2 > 0) { /* page ups */ - while (wp2 > 0) { - handle_keypress(wb, WM_KEYDOWN, VK_PRIOR, lp, 0); - handle_keypress(wb, WM_KEYUP, VK_PRIOR, lp, 0); - wp2 -= 120; + while (wp2 > 0) { + handle_keypress(wb, WM_KEYDOWN, VK_PRIOR, lp, 0); + handle_keypress(wb, WM_KEYUP, VK_PRIOR, lp, 0); + wp2 -= 120; } } else { /* page downs */ - while (wp2 < 0) { - handle_keypress(wb, WM_KEYDOWN/*msg*/, VK_NEXT, lp, 0); - handle_keypress(wb, WM_KEYUP/*msg*/, VK_NEXT, lp, 0); - wp2 += 120; + while (wp2 < 0) { + handle_keypress(wb, WM_KEYDOWN/*msg*/, VK_NEXT, lp, 0); + handle_keypress(wb, WM_KEYUP/*msg*/, VK_NEXT, lp, 0); + wp2 += 120; } } } return 0; -#endif /* WM_MOUSEWHEEL */ +#endif /* WM_MOUSEWHEEL */ case WM_KEYUP: if (ws->inputmask & KeyReleaseMask) handle_keypress(wb, msg, wp, lp, 0); return 0; @@ -880,11 +880,11 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) case VK_INSERT: case VK_SELECT: case VK_PRINT: case VK_EXECUTE: case VK_SNAPSHOT: case VK_HELP: case VK_SEPARATOR: case VK_CLEAR: case VK_PAUSE: case VK_SCROLL: - handle_keypress(wb, msg, wp, lp, 0); - return 0; + handle_keypress(wb, msg, wp, lp, 0); + return 0; case VK_DELETE: - handle_keypress(wb, WM_CHAR, '\177', lp, 0); - return 0; + handle_keypress(wb, WM_CHAR, '\177', lp, 0); + return 0; default: if (ws->inputmask & KeyReleaseMask) { handle_keypress(wb, msg, wp, lp, 0); @@ -902,14 +902,14 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) case VK_INSERT: case VK_DELETE: case VK_SELECT: case VK_PRINT: case VK_EXECUTE: case VK_SNAPSHOT: case VK_HELP: case VK_SEPARATOR: case VK_CLEAR: case VK_PAUSE: - handle_keypress(wb, msg, wp, lp, 1); - return 0; + handle_keypress(wb, msg, wp, lp, 1); + return 0; default: if (ws->inputmask & KeyReleaseMask) { handle_keypress(wb, msg, wp, lp, 0); return 0; } - } + } break; case WM_CHAR: handle_keypress(wb, msg, wp, lp, 0); @@ -928,7 +928,7 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) for(n=0; n < ws->nChildren && ws->child[n].win != (HWND)(word)(short)LOWORD (lp); n++){ } if (n == ws->nChildren) break; - i = GetScrollPos(ws->child[n].win, SB_CTL); + i = GetScrollPos(ws->child[n].win, SB_CTL); GetScrollRange(ws->child[n].win, SB_CTL, &imin, &imax); switch (LOWORD(wp)) { case SB_PAGEDOWN : @@ -936,16 +936,16 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) case SB_LINEDOWN : if (i < imax) { SetScrollPos(ws->child[n].win, SB_CTL, - GetScrollPos(ws->child[n].win, SB_CTL) + 1, TRUE); - } + GetScrollPos(ws->child[n].win, SB_CTL) + 1, TRUE); + } break; case SB_PAGEUP : break; case SB_LINEUP : if (i > imin) { SetScrollPos(ws->child[n].win, SB_CTL, - GetScrollPos(ws->child[n].win, SB_CTL) - 1, TRUE); - } + GetScrollPos(ws->child[n].win, SB_CTL) - 1, TRUE); + } break; case SB_TOP : SetScrollPos(ws->child[n].win, SB_CTL, imin, TRUE); @@ -964,7 +964,7 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) default : /* potentially a problem here */ break; } - i = GetScrollPos(ws->child[n].win, SB_CTL); + i = GetScrollPos(ws->child[n].win, SB_CTL); handle_child(wb, i, n+1, -1); break; case WM_COMMAND: @@ -994,22 +994,22 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) ws->savedcursor = SetCursor(ws->curcursor); else (void) SetCursor(ws->curcursor); if (ISCURSORON(wb)) { - CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb)); - SetCaretPos(ws->x, ws->y - ASCENT(wb)); - SetCaretBlinkTime(500); - ShowCaret(ws->iconwin); - ws->hasCaret = 1; + CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb)); + SetCaretPos(ws->x, ws->y - ASCENT(wb)); + SetCaretBlinkTime(500); + ShowCaret(ws->iconwin); + ws->hasCaret = 1; } - } + } break; case WM_GETMINMAXINFO: { MINMAXINFO *mmi = (MINMAXINFO *)lp; if (! ISRESIZABLE(wb)) { - mmi->ptMinTrackSize.x = mmi->ptMaxTrackSize.x = - ws->width + BORDWIDTH; - mmi->ptMinTrackSize.y = mmi->ptMaxTrackSize.y = - ws->height + BORDHEIGHT + 1; - } + mmi->ptMinTrackSize.x = mmi->ptMaxTrackSize.x = + ws->width + BORDWIDTH; + mmi->ptMinTrackSize.y = mmi->ptMaxTrackSize.y = + ws->height + BORDHEIGHT + 1; + } return 0; } case WM_KILLFOCUS: @@ -1023,22 +1023,22 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) if (ws->focusChild) SetFocus(ws->focusChild); else if (ISCURSORON(wb)) { - CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb)); - SetCaretPos(ws->x, ws->y - ASCENT(wb)); - SetCaretBlinkTime(500); - ShowCaret(ws->iconwin); - ws->hasCaret = 1; + CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb)); + SetCaretPos(ws->x, ws->y - ASCENT(wb)); + SetCaretBlinkTime(500); + ShowCaret(ws->iconwin); + ws->hasCaret = 1; } break; case WM_CLOSE: { if (ws->inputmask & WindowClosureMask) { - struct descrip d; - MakeInt(WINDOWCLOSED, &d); - qevent(ws, &d, 0, 0, 0, 0); - return 0; - } - break; - } + struct descrip d; + MakeInt(WINDOWCLOSED, &d); + qevent(ws, &d, 0, 0, 0, 0); + return 0; + } + break; + } /* case WM_QUIT is handled prior to the switch*/ case WM_DESTROY: { @@ -1047,30 +1047,30 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) struct wbind_list *wbl, *t, *b; if (ws->win == hwnd) - ws->win = NULL; + ws->win = NULL; if (ws->iconwin == hwnd) - ws->iconwin = NULL; + ws->iconwin = NULL; SETCLOSED((wbp)wb); while (w->window->children) { - tmp_wb = w->window->children->child; - wbl = w->window->children; - w->window->children = w->window->children->next; - tmp_wb->refcount--; - tmp_wb->window->parent=NULL; - w->refcount--; - tmp_wb->window->win = (HWND) 0; - /* added next line */ - SETCLOSED(tmp_wb); - wbl->next=NULL; - free(wbl); - } + tmp_wb = w->window->children->child; + wbl = w->window->children; + w->window->children = w->window->children->next; + tmp_wb->refcount--; + tmp_wb->window->parent=NULL; + w->refcount--; + tmp_wb->window->win = (HWND) 0; + /* added next line */ + SETCLOSED(tmp_wb); + wbl->next=NULL; + free(wbl); + } p = w->window->parent; if (p) { t = p->window->children; b = NULL; while (t) { - if (t->child->window==w->window) { + if (t->child->window==w->window) { if (b==NULL) p->window->children = t->next; else b->next = t->next; @@ -1091,30 +1091,30 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) * if the application can handle window closure events, do 1 */ if (ws->inputmask & WindowClosureMask) { - struct descrip d; + struct descrip d; MakeInt(WINDOWCLOSED, &d); - qevent(ws ,&d, 0, 0, 0, 0); + qevent(ws ,&d, 0, 0, 0, 0); } else { /* terminate on unhandled unexpected window closure */ #ifdef ConsoleWindow closelog(); -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef Graphics3D if(ws->is_3D) { -#ifdef GraphicsGL +#ifdef GraphicsGL wglMakeCurrent(0, NULL); wglDeleteContext(wb->window->ctx); wb->window->ctx = NULL; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ } -#endif /* Graphics3D */ - PostQuitMessage(0); - return 0; - } +#endif /* Graphics3D */ + PostQuitMessage(0); + return 0; + } } else if (ws->refcount < 0) { /* window was closed by program */ ws->refcount = -ws->refcount; - } + } if (BlkLoc(lastEventWin)) BlkD(lastEventWin,File)->status &= ~(Fs_Write); @@ -1122,7 +1122,7 @@ LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp) if (ConsoleBinding && (ws == ((wbp)ConsoleBinding)->window)) { ConsoleBinding = 0; } -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ } break; case MM_MCINOTIFY: @@ -1143,15 +1143,15 @@ int wclose(wbp w) wcp wc = w->context; struct wbind_list *wbl, *t, *b; int i; - + if (pollevent() == -1) return -1; while (w->window->children) { tmp_wb = w->window->children->child; wbl = w->window->children; #ifdef Graphics3D if(tmp_wb->window->is_3D) - release_3d_resources(tmp_wb); -#endif /* Graphics3D */ + release_3d_resources(tmp_wb); +#endif /* Graphics3D */ w->window->children = w->window->children->next; tmp_wb->refcount--; tmp_wb->window->parent=NULL; @@ -1167,7 +1167,7 @@ int wclose(wbp w) t = p->window->children; b = NULL; while (t) { - if (t->child->window==w->window) { + if (t->child->window==w->window) { if (b==NULL) p->window->children = t->next; else b->next = t->next; @@ -1179,16 +1179,16 @@ int wclose(wbp w) } b=t; t = t->next; - } + } w->window->parent=NULL; p->refcount--; } - + #ifdef Graphics3D if (w->window->is_3D) release_3d_resources(w); -#endif /* Graphics3D */ - +#endif /* Graphics3D */ + ws->inputmask &= ~WindowClosureMask; if (ws->win && ws->refcount > 1) { @@ -1200,14 +1200,14 @@ int wclose(wbp w) ws->refcount = -ws->refcount; DestroyWindow(ws->win); while (ws->win) - if (pollevent() == -1) return -1; + if (pollevent() == -1) return -1; } else { free_binding(w); } return 1; } - + int pollevent() { @@ -1218,7 +1218,7 @@ int pollevent() int isbusy; MUTEX_TRYLOCKID(MTX_POLLEVENT, isbusy); if (isbusy) return POLL_INTERVAL; -#endif /* Concurrent */ +#endif /* Concurrent */ /* some while PeekMessage loops here, maybe one per window ? */ while (PeekMessage(&m, NULL, 0, 0, PM_NOREMOVE)) { @@ -1226,10 +1226,10 @@ int pollevent() TranslateMessage(&m); DispatchMessage(&m); } - MUTEX_UNLOCKID(MTX_POLLEVENT); + MUTEX_UNLOCKID(MTX_POLLEVENT); return POLL_INTERVAL; } - + /* * write some text to both the window and the pixmap */ @@ -1295,7 +1295,7 @@ int wputc(int ci, wbp w) if ((FILE *)w == stdout || (FILE *)w == stderr || (FILE *)w == ConsoleBinding) { if (flog) fputc(ci, flog); } -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ #ifdef ScrollingConsoleWin char c2[3], *catenation; @@ -1305,49 +1305,49 @@ int wputc(int ci, wbp w) geteditregion(ws->child, &result); while (StrLen(result) + 2 > 32700) { - /* remove a line from the beginning of the buffer */ - - while((StrLen(result) > 0) && (StrLoc(result)[0] != '\n')) { - StrLoc(result) ++; - StrLen(result) --; - } - if (StrLen(result) > 0) { - StrLoc(result)++; StrLen(result)--; - } - } - reserve(Strings, StrLen(result) + 3); - catenation = alcstr(StrLoc(result), StrLen(result)); - if (c == '\n') { c2[0] = '\r'; c2[1] = '\n'; c2[2] = '\0'; } - else { c2[0] = c; c2[1] = '\0'; } + /* remove a line from the beginning of the buffer */ + + while((StrLen(result) > 0) && (StrLoc(result)[0] != '\n')) { + StrLoc(result) ++; + StrLen(result) --; + } + if (StrLen(result) > 0) { + StrLoc(result)++; StrLen(result)--; + } + } + reserve(Strings, StrLen(result) + 3); + catenation = alcstr(StrLoc(result), StrLen(result)); + if (c == '\n') { c2[0] = '\r'; c2[1] = '\n'; c2[2] = '\0'; } + else { c2[0] = c; c2[1] = '\0'; } alcstr(c2, strlen(c2)+1); - seteditregion(w->window->child, catenation); - setchildselection(w->window, w->window->child, - StrLen(result), StrLen(result)+strlen(c2)); - return 0; + seteditregion(w->window->child, catenation); + setchildselection(w->window, w->window->child, + StrLen(result), StrLen(result)+strlen(c2)); + return 0; } -#endif /* ScrollingConsoleWin */ +#endif /* ScrollingConsoleWin */ switch (c) { case '\n': ws->y += LEADING(w); if (ws->y + DESCENT(w) > ws->height) { - RECT r; - STDLOCALS(w); - ws->y -= LEADING(w); - y_plus_descent = ws->y + DESCENT(w); - BitBlt(pixdc, 0, 0, ws->width, y_plus_descent, - pixdc, 0, LEADING(w), SRCCOPY); - r.left = 0; - r.top = y_plus_descent - FHEIGHT(w); - r.right = ws->width; - r.bottom = ws->height; + RECT r; + STDLOCALS(w); + ws->y -= LEADING(w); + y_plus_descent = ws->y + DESCENT(w); + BitBlt(pixdc, 0, 0, ws->width, y_plus_descent, + pixdc, 0, LEADING(w), SRCCOPY); + r.left = 0; + r.top = y_plus_descent - FHEIGHT(w); + r.right = ws->width; + r.bottom = ws->height; hb = CreateBrushIndirect(&(wc->bgbrush)); - FillRect(pixdc, &r, hb); - DeleteObject(hb); - if (stdwin) - BitBlt(stddc, 0, 0, ws->width, ws->height, pixdc, 0, 0, SRCCOPY); - FREE_STDLOCALS(w); - } + FillRect(pixdc, &r, hb); + DeleteObject(hb); + if (stdwin) + BitBlt(stddc, 0, 0, ws->width, ws->height, pixdc, 0, 0, SRCCOPY); + FREE_STDLOCALS(w); + } /* intended fall-through */ case '\r': /* @@ -1364,7 +1364,7 @@ int wputc(int ci, wbp w) case '\177': case '\010': { int i = 0, pre_x; - + /* * Start with the last character queued up. */ @@ -1373,8 +1373,8 @@ int wputc(int ci, wbp w) * Trot back to the control-H itself. */ while ((i>-EQUEUELEN) && (EVQUESUB(w,i) != c)) { - i--; - } + i--; + } if (i == -EQUEUELEN) break; /* * Go past the control-H. @@ -1384,8 +1384,8 @@ int wputc(int ci, wbp w) * Go back through any number of control-H's from prior lifetimes. */ while((i > -EQUEUELEN) && !isprint(EVQUESUB(w,i))) { - i--; - } + i--; + } if (i == -EQUEUELEN) break; /* @@ -1404,8 +1404,8 @@ int wputc(int ci, wbp w) */ i = ws->x; while(ws->x < pre_x) { - xdis(w, " ",1); - } + xdis(w, " ",1); + } ws->x = i; break; } @@ -1423,7 +1423,7 @@ int wputc(int ci, wbp w) UpdateCursorPos(ws,wc); return 0; } - + /* * wgetq - get event from pending queue */ @@ -1443,23 +1443,23 @@ int wgetq(wbp w, dptr res, int t) * grab the built up queue */ if (!EVQUEEMPTY(ws)) { - EVQUEGET(ws, *res); - if (ws->hasCaret && ws->iconwin) { + EVQUEGET(ws, *res); + if (ws->hasCaret && ws->iconwin) { HideCaret(ws->iconwin); DestroyCaret(); ws->hasCaret = 0; } - return 1; - } + return 1; + } if (!(ws->iconwin)) { return -1; } if (ISCURSORON(w) && ws->hasCaret == 0) { - CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w)); - SetCaretPos(ws->x, ws->y - ASCENT(w)); - SetCaretBlinkTime(500); + CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w)); + SetCaretPos(ws->x, ws->y - ASCENT(w)); + SetCaretBlinkTime(500); ShowCaret(ws->iconwin); - ws->hasCaret = 1; + ws->hasCaret = 1; } i++; if (GetMessage(&m, NULL, 0, 0) == 0) longjmp(mark_sj, -1); @@ -1467,7 +1467,7 @@ int wgetq(wbp w, dptr res, int t) DispatchMessage(&m); } } - + /* * determine the new size of the client */ @@ -1511,7 +1511,7 @@ char *geo; } return Succeeded; } - + int setcanvas(w,s) wbp w; char *s; @@ -1554,7 +1554,7 @@ char *val; int height; return Failed; } - + int seticonlabel(w, val) wbp w; char *val; @@ -1658,8 +1658,8 @@ HFONT findfont(char *family, int size, int flags, int ansi) else spacing = DEFAULT_PITCH; return CreateFont(size, 0, 0, 0, weight, slant, 0, 0, charset, - OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, - spacing, family); + OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, + spacing, family); } HFONT mkfont(char *s, char is_3D) @@ -1675,94 +1675,94 @@ HFONT mkfont(char *s, char is_3D) * Check first for special "standard" family names. */ if (!strcmp(family, "mono")) { - stdfam = "Lucida Console"; - flags |= FONTFLAG_MONO + FONTFLAG_SANS; - } + stdfam = "Lucida Console"; + flags |= FONTFLAG_MONO + FONTFLAG_SANS; + } else if ( !strcmp(family, "fixed")) { - stdfam = "Lucida Sans"; - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; - } + stdfam = "Lucida Sans"; + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; + } else if (!strcmp(family, "typewriter")) { - stdfam = "Courier New"; /* was "courier" */ - flags |= FONTFLAG_MONO + FONTFLAG_SERIF; - } + stdfam = "Courier New"; /* was "courier" */ + flags |= FONTFLAG_MONO + FONTFLAG_SERIF; + } else if (!strcmp(family, "sans")) { - stdfam = "Arial"; /* was "swiss" */ - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; - } + stdfam = "Arial"; /* was "swiss" */ + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; + } else if (!strcmp(family, "serif")) { - stdfam = "Times New Roman"; - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF; - } + stdfam = "Times New Roman"; + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF; + } else stdfam = NULL; if (is_3D) { - if (stdfam) { - if (strcmp(stdfam, "Lucida Sans")==0) { - strcpy(fn, "lsans"); - if (flags & FONTFLAG_BOLD) strcat(fn,"d"); - if (flags & FONTFLAG_ITALIC) strcat(fn,"i"); - } - else if (strcmp(stdfam, "Arial")==0) { - strcpy(fn,"arial"); - if (flags & FONTFLAG_NORMAL) strcat(fn,"N"); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "b"); - else if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_NORMAL))) - strcat(fn,"b"); - else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); - if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); - } - else if (strcmp(stdfam, "Times New Roman")==0) { - strcpy(fn,"times"); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "b"); - else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); - if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); + if (stdfam) { + if (strcmp(stdfam, "Lucida Sans")==0) { + strcpy(fn, "lsans"); + if (flags & FONTFLAG_BOLD) strcat(fn,"d"); + if (flags & FONTFLAG_ITALIC) strcat(fn,"i"); + } + else if (strcmp(stdfam, "Arial")==0) { + strcpy(fn,"arial"); + if (flags & FONTFLAG_NORMAL) strcat(fn,"N"); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "b"); + else if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_NORMAL))) + strcat(fn,"b"); + else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); + if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); + } + else if (strcmp(stdfam, "Times New Roman")==0) { + strcpy(fn,"times"); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "b"); + else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); + if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); } - else if (strcmp(stdfam, "Courier New")==0) { - strcpy(fn,"cour"); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "b"); - else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); - if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); + else if (strcmp(stdfam, "Courier New")==0) { + strcpy(fn,"cour"); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "b"); + else if (flags & FONTFLAG_BOLD) strcat(fn, "bd"); + if (flags & FONTFLAG_ITALIC) strcat(fn, "i"); } - strcat(fn, ".ttf"); - } - else { - strcpy(fn,family); - if (flags & (FONTFLAG_BOLD+FONTFLAG_ITALIC)) strcat(fn, "BI"); - else if (flags & FONTFLAG_BOLD) strcat(fn, "BD"); - else if (flags & FONTFLAG_ITALIC) strcat(fn, "I"); - strcat(fn, ".ttf"); + strcat(fn, ".ttf"); + } + else { + strcpy(fn,family); + if (flags & (FONTFLAG_BOLD+FONTFLAG_ITALIC)) strcat(fn, "BI"); + else if (flags & FONTFLAG_BOLD) strcat(fn, "BD"); + else if (flags & FONTFLAG_ITALIC) strcat(fn, "I"); + strcat(fn, ".ttf"); } #if 0 curr_font = srch_3dfont(fn, size, tp); - if (!curr_font) { - add_3dfont(fn, size, tp); - curr_font = end_font; + if (!curr_font) { + add_3dfont(fn, size, tp); + curr_font = end_font; } #endif } if (stdfam) { - /* - * Standard name: first try preferred family, then generalize. - * ICONFONT can be NULL, in which case Windows chooses. - */ - char *icnfnt, fnt[256]; - icnfnt = fnt; - hf = findfont(stdfam, size, flags, 1); - if (hf == NULL){ - if (getenv_r("ICONFONT", icnfnt, 255 )!=0) - icnfnt=NULL; - hf = findfont(icnfnt, size, flags, 1); - } - } + /* + * Standard name: first try preferred family, then generalize. + * ICONFONT can be NULL, in which case Windows chooses. + */ + char *icnfnt, fnt[256]; + icnfnt = fnt; + hf = findfont(stdfam, size, flags, 1); + if (hf == NULL){ + if (getenv_r("ICONFONT", icnfnt, 255 )!=0) + icnfnt=NULL; + hf = findfont(icnfnt, size, flags, 1); + } + } else { - /* - * Any other name: must match as specified. - */ - hf = findfont(family, size, flags, 0); - } + /* + * Any other name: must match as specified. + */ + hf = findfont(family, size, flags, 0); + } } return hf; } @@ -1777,13 +1777,13 @@ char **s; wsp ws = w->window; wcp wc = w->context; HFONT hf, oldfont; - TEXTMETRIC metrics; + TEXTMETRIC metrics; HDC tmpdc; hf = mkfont(*s, 0); if (hf != NULL) { if (wc->font->font) - DeleteObject(wc->font->font); + DeleteObject(wc->font->font); wc->font->font = hf; if (wc->font->name) free(wc->font->name); @@ -1818,7 +1818,7 @@ wbp w, w2; w->context = w2->context; return Succeeded; } - + void setclip(w) wbp w; { @@ -1827,8 +1827,8 @@ wbp w; DeleteObject(wc->cliprgn); if (wc->clipw >= 0) wc->cliprgn = CreateRectRgn(wc->clipx, wc->clipy, - wc->clipx + wc->clipw, - wc->clipy + wc->cliph); + wc->clipx + wc->clipw, + wc->clipy + wc->cliph); else wc->cliprgn = NULL; } @@ -1857,7 +1857,7 @@ int raiseWindow(wbp w) SetWindowPos(ws->win, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE); return Succeeded; } - + int nativecolor(w, s, r, g, b) wbp w; char *s; @@ -1879,7 +1879,7 @@ SysColor mscolor(wbp w, long r, long g, long b) blue = 65535L * pow(b / 65535.0, invgamma); return RGB(red >> 8, green >> 8, blue >> 8); } - + /* * Set the context's fill style by name. */ @@ -1896,25 +1896,25 @@ char *s; else { if (!strcmp(s, "masked") || !strcmp(s, "stippled") || !strcmp(s, "patterned")) { - wc->brush.lbStyle = wc->fillstyle = BS_PATTERN; - wc->brush.lbColor = PALCLR(wc->fg); - wc->brush.lbHatch = (word)wc->pattern; + wc->brush.lbStyle = wc->fillstyle = BS_PATTERN; + wc->brush.lbColor = PALCLR(wc->fg); + wc->brush.lbHatch = (word)wc->pattern; wc->bkmode = TRANSPARENT; - } + } else if (!strcmp(s, "textured") || !strcmp(s, "opaquestippled") || !strcmp(s, "opaquepatterned")) { - wc->brush.lbStyle = wc->fillstyle = BS_PATTERN; - wc->brush.lbColor = PALCLR(wc->fg); - wc->brush.lbHatch = (word)wc->pattern; + wc->brush.lbStyle = wc->fillstyle = BS_PATTERN; + wc->brush.lbColor = PALCLR(wc->fg); + wc->brush.lbHatch = (word)wc->pattern; wc->bkmode = OPAQUE; - } + } else { - return RunError; - } + return RunError; + } } return Succeeded; } - + /* * Set the context's line style by name. */ @@ -1944,7 +1944,7 @@ int setlinewidth(wbp w, LONG linewid) wc->bgpen.lopnWidth.x = wc->bgpen.lopnWidth.y = linewid; return Succeeded; } - + /* * Set the foreground to draw in a mutable color @@ -1984,7 +1984,7 @@ int i; return ISXORREVERSE(w) ? resetfg(w) : Succeeded; } - + int getdepthDC(HDC dc) { return GetDeviceCaps(dc, BITSPIXEL) * GetDeviceCaps(dc, PLANES); @@ -2028,35 +2028,35 @@ int alc_rgb(wbp w, SysColor rgb) if (palette) { for (i=0; i < numColors; i++) { if (rgb == scp[i].c && scp[i].type == CLR_SHARED) break; - } + } if (i == numColors) { SUSPEND_THREADS(); if (i == numColors) { numColors++; - if (ResizePalette(palette, numColors) == 0) { - numColors--; - return Failed; + if (ResizePalette(palette, numColors) == 0) { + numColors--; + return Failed; } scp = realloc(scp, numColors * sizeof(struct wcolor)); if (scp == NULL) { numColors--; return Failed; } - scp[numColors - 1].c = rgb; - scp[numColors - 1].type = CLR_SHARED; - sprintf(scp[numColors - 1].name, "%d,%d,%d", + scp[numColors - 1].c = rgb; + scp[numColors - 1].type = CLR_SHARED; + sprintf(scp[numColors - 1].name, "%d,%d,%d", RED(rgb), GREEN(rgb), BLUE(rgb)); lp.palNumEntries = 1; - lp.palVersion = 0x300; - lp.palPalEntry[0].peFlags = 0; - lp.palPalEntry[0].peRed = RED(rgb); - lp.palPalEntry[0].peGreen = GREEN(rgb); - lp.palPalEntry[0].peBlue = BLUE(rgb); + lp.palVersion = 0x300; + lp.palPalEntry[0].peFlags = 0; + lp.palPalEntry[0].peRed = RED(rgb); + lp.palPalEntry[0].peGreen = GREEN(rgb); + lp.palPalEntry[0].peBlue = BLUE(rgb); SetPaletteEntries(palette, numColors - 1, 1, lp.palPalEntry); - hdc = GetDC(ws->iconwin); - SelectPalette(hdc, palette, FALSE); - RealizePalette(hdc); - ReleaseDC(ws->iconwin, hdc); - } + hdc = GetDC(ws->iconwin); + SelectPalette(hdc, palette, FALSE); + RealizePalette(hdc); + ReleaseDC(ws->iconwin, hdc); + } RESUME_THREADS(); - } + } } return Succeeded; } @@ -2075,13 +2075,13 @@ int setfg(wbp w, char *val) else if (strcmp(wc->fgname, val)) { free(wc->fgname); wc->fgname = salloc(val); - } + } wc->brush.lbColor = - PALCLR(ISXORREVERSE(w) ? ((wc->fg ^ wc->bg) & 0x00FFFFFF) : wc->fg); + PALCLR(ISXORREVERSE(w) ? ((wc->fg ^ wc->bg) & 0x00FFFFFF) : wc->fg); wc->pen.lopnColor = wc->brush.lbColor; wc->brush.lbStyle = wc->fillstyle; if (wc->fillstyle == BS_PATTERN) - wc->brush.lbHatch = (word)wc->pattern; + wc->brush.lbHatch = (word)wc->pattern; return Succeeded; } return Failed; @@ -2101,7 +2101,7 @@ int setbg(wbp w, char *val) else if (strcmp(wc->bgname, val)) { free(wc->bgname); wc->bgname = salloc(val); - } + } wc->bgpen.lopnColor = PALCLR(wc->bg); wc->bgbrush.lbStyle = BS_SOLID; wc->bgbrush.lbColor = PALCLR(wc->bg); @@ -2162,7 +2162,7 @@ char *val; /* should restore savedcursor when pointer moves outside our window */ return Succeeded; } - + /* * setdrawop() - set the drawing operation */ @@ -2173,16 +2173,16 @@ char *val; wcp wc = w->context; if (!strcmp(val,"reverse")) { if (!ISXORREVERSE(w)) { - SETXORREVERSE(w); + SETXORREVERSE(w); wc->drawop = R2_XORPEN; resetfg(w); - } + } } else { if (ISXORREVERSE(w)) { - CLRXORREVERSE(w); + CLRXORREVERSE(w); resetfg(w); - } + } wc->drawop = si_s2i(drawops,val); if (wc->drawop == -1) { wc->drawop = R2_COPYPEN; return RunError; } } @@ -2201,7 +2201,7 @@ int setimage(wbp w, char *val) wsp ws = w->window; int status; ws->initialPix = loadimage(w, val, &(ws->width), &(ws->height), - 0, &status); + 0, &status); if (ws->initialPix == (HBITMAP) NULL) return Failed; return Succeeded; } @@ -2214,7 +2214,7 @@ int i; wc->leading = i; return Succeeded; } - + void toggle_fgbg(w) wbp w; { @@ -2232,7 +2232,7 @@ wbp w; wc->brush = wc->bgbrush; wc->bgbrush = tbrush; } - + int getvisual(w, answer) wbp w; char *answer; @@ -2274,7 +2274,7 @@ char *answer; } else strcpy(answer, "unknown"); } - + void getfntnam(w, answer) wbp w; char *answer; @@ -2306,7 +2306,7 @@ char *answer; if (s) sprintf(answer, "%s", s); else strcpy(answer, "unknown"); } - + void geticonic(w, answer) wbp w; char *answer; @@ -2327,7 +2327,7 @@ char *answer; } else sprintf(answer,"hidden"); } - + int geticonpos(w, val) wbp w; char *val; @@ -2403,13 +2403,13 @@ int x, y, width, height, x2, y2; FillRect(pixdc, &r, hb); } else { - /* - * Check for source partially offscreen, but copy first and - * fill later in case the source and destination overlap. - */ - lpad = rpad = tpad = bpad = 0; - if (x < 0) { /* source extends past left edge */ - lpad = -x; + /* + * Check for source partially offscreen, but copy first and + * fill later in case the source and destination overlap. + */ + lpad = rpad = tpad = bpad = 0; + if (x < 0) { /* source extends past left edge */ + lpad = -x; width -= lpad; x2 += lpad; x = 0; @@ -2418,8 +2418,8 @@ int x, y, width, height, x2, y2; rpad = x + width - ws1->pixwidth; width -= rpad; } - if (y < 0) { /* source extends above top edge */ - tpad = -y; + if (y < 0) { /* source extends above top edge */ + tpad = -y; height -= tpad; y2 += tpad; y = 0; @@ -2432,42 +2432,42 @@ int x, y, width, height, x2, y2; BitBlt(stddc, x2, y2, width, height, srcpixdc, x, y, SRCCOPY); BitBlt(pixdc, x2, y2, width, height, srcpixdc, x, y, SRCCOPY); - if (lpad > 0) { + if (lpad > 0) { r.left = x2-lpad; - r.top = y2-tpad; - r.right = r.left + lpad; - r.bottom = r.top + tpad+height+bpad; + r.top = y2-tpad; + r.right = r.left + lpad; + r.bottom = r.top + tpad+height+bpad; if (stdwin) FillRect(stddc, &r, hb); FillRect(pixdc, &r, hb); } - if (rpad > 0) { + if (rpad > 0) { r.left = x2+width; - r.top = y2-tpad; - r.right = r.left + rpad; - r.bottom = r.top + tpad+height+bpad; + r.top = y2-tpad; + r.right = r.left + rpad; + r.bottom = r.top + tpad+height+bpad; if (stdwin) FillRect(stddc, &r, hb); FillRect(pixdc, &r, hb); - } - if (tpad > 0) { - r.left = x2; - r.top = y2-tpad; - r.right = r.left + width; - r.bottom = r.top + tpad; + } + if (tpad > 0) { + r.left = x2; + r.top = y2-tpad; + r.right = r.left + width; + r.bottom = r.top + tpad; if (stdwin) FillRect(stddc, &r, hb); FillRect(pixdc, &r, hb); - } - if (bpad > 0) { - r.left = x2; - r.top = y2+height; - r.right = r.left + width; - r.bottom = r.top + bpad; + } + if (bpad > 0) { + r.left = x2; + r.top = y2+height; + r.right = r.left + width; + r.bottom = r.top + bpad; if (stdwin) FillRect(stddc, &r, hb); FillRect(pixdc, &r, hb); - } + } } /* @@ -2482,7 +2482,7 @@ int x, y, width, height, x2, y2; FREE_STDLOCALS(w2); return Succeeded; } - + int getdefault(w, prog, opt, answer) wbp w; char *prog, *opt, *answer; @@ -2522,30 +2522,30 @@ word len; m = msk1; while (len--) { if (isxdigit(c = *s++)) { /* if hexadecimal character */ - if (!isdigit(c)) /* fix bottom 4 bits if necessary */ - c += 9; - while (m > 0) { /* set (usually) 4 pixel values */ - --ix; - if (c & m) { - SetPixel(pixdc, ix, iy, palfg); - } - else if (ch != TCH1) { /* if zeroes aren't transparent */ - SetPixel(pixdc, ix, iy, palbg); - } - m >>= 1; - } - if (ix == 0) { /* if end of row */ - ix = width; - iy++; - m = msk1; - } - else - m = 8; - } + if (!isdigit(c)) /* fix bottom 4 bits if necessary */ + c += 9; + while (m > 0) { /* set (usually) 4 pixel values */ + --ix; + if (c & m) { + SetPixel(pixdc, ix, iy, palfg); + } + else if (ch != TCH1) { /* if zeroes aren't transparent */ + SetPixel(pixdc, ix, iy, palbg); + } + m >>= 1; + } + if (ix == 0) { /* if end of row */ + ix = width; + iy++; + m = msk1; + } + else + m = 8; + } } if (ix > 0) /* pad final row if incomplete */ while (ix < width) - SetPixel(pixdc, ix++, iy, palbg); + SetPixel(pixdc, ix++, iy, palbg); /* * Put it on the screen. @@ -2585,7 +2585,7 @@ int on_icon; FREE_STDLOCALS(w); return -1; } - + bmih = &(bmi->bmiHeader); palbg = PALCLR(wc->bg); if (on_icon) { @@ -2605,21 +2605,21 @@ int on_icon; if (e[c].transpt) anytransparent++; if (e[c].used && e[c].valid) { bmih->biClrImportant++; - clrlist[c] = mscolor(w, e[c].clr.red, e[c].clr.green, e[c].clr.blue); - bmi->bmiColors[c].rgbBlue = BLUE(clrlist[c]); - bmi->bmiColors[c].rgbRed = RED(clrlist[c]); - bmi->bmiColors[c].rgbGreen = GREEN(clrlist[c]); + clrlist[c] = mscolor(w, e[c].clr.red, e[c].clr.green, e[c].clr.blue); + bmi->bmiColors[c].rgbBlue = BLUE(clrlist[c]); + bmi->bmiColors[c].rgbRed = RED(clrlist[c]); + bmi->bmiColors[c].rgbGreen = GREEN(clrlist[c]); if (alc_rgb(w, clrlist[c]) == Failed) { free(bmi); FREE_STDLOCALS(w); return -1; } - clrlist[c] = PALCLR(clrlist[c]); - } + clrlist[c] = PALCLR(clrlist[c]); + } else { - bmi->bmiColors[c].rgbBlue = BLUE(wc->bg); - bmi->bmiColors[c].rgbRed = RED(wc->bg); - bmi->bmiColors[c].rgbGreen = GREEN(wc->bg); + bmi->bmiColors[c].rgbBlue = BLUE(wc->bg); + bmi->bmiColors[c].rgbRed = RED(wc->bg); + bmi->bmiColors[c].rgbGreen = GREEN(wc->bg); } } @@ -2656,35 +2656,35 @@ int on_icon; free(buf2); } else { - buf2 = s; + buf2 = s; bmih->biClrUsed = 0; bmih->biHeight = -height; bmih->biBitCount = 24; #if 0 /* - * Microsoft expcects BGR format by default but we store images in RGB. - * the default behavior can be changed by using the user-defined bit mask - * for each of the color components as shown below when - * bmih->biCompression = BI_BITFIELDS; //instead of (BI_RGB) - * but that works only with 32 bit colors (belowbmih->biBitCount = 32) - * not 24. For now, we are storing images in BGR before feeding - * them to MS API! + * Microsoft expcects BGR format by default but we store images in RGB. + * the default behavior can be changed by using the user-defined bit mask + * for each of the color components as shown below when + * bmih->biCompression = BI_BITFIELDS; //instead of (BI_RGB) + * but that works only with 32 bit colors (belowbmih->biBitCount = 32) + * not 24. For now, we are storing images in BGR before feeding + * them to MS API! */ - bmi->bmiColors[0].rgbBlue = 0xFF; - bmi->bmiColors[0].rgbGreen = 0x00; - bmi->bmiColors[0].rgbRed = 0x00; - bmi->bmiColors[0].rgbReserved = 0x00; - - bmi->bmiColors[1].rgbBlue = 0x00; - bmi->bmiColors[1].rgbGreen = 0xFF; - bmi->bmiColors[1].rgbRed = 0x00; - bmi->bmiColors[1].rgbReserved = 0x00; - - bmi->bmiColors[2].rgbBlue = 0x00; - bmi->bmiColors[2].rgbGreen = 0x00; - bmi->bmiColors[2].rgbRed = 0xFF; - bmi->bmiColors[2].rgbReserved = 0x00; + bmi->bmiColors[0].rgbBlue = 0xFF; + bmi->bmiColors[0].rgbGreen = 0x00; + bmi->bmiColors[0].rgbRed = 0x00; + bmi->bmiColors[0].rgbReserved = 0x00; + + bmi->bmiColors[1].rgbBlue = 0x00; + bmi->bmiColors[1].rgbGreen = 0xFF; + bmi->bmiColors[1].rgbRed = 0x00; + bmi->bmiColors[1].rgbReserved = 0x00; + + bmi->bmiColors[2].rgbBlue = 0x00; + bmi->bmiColors[2].rgbGreen = 0x00; + bmi->bmiColors[2].rgbRed = 0xFF; + bmi->bmiColors[2].rgbReserved = 0x00; #endif temppix=CreateDIBitmap(pixdc, bmih, CBM_INIT, buf2, bmi, DIB_RGB_COLORS); } @@ -2709,18 +2709,18 @@ int on_icon; c = *s++; v = e[c].valid; if (v) { /* put char if valid */ - xc = SetPixel(pixdc, ix, iy, clrlist[c]); - } + xc = SetPixel(pixdc, ix, iy, clrlist[c]); + } if (v || e[c].transpt) { /* advance if valid or transparent */ - if (++ix >= tmpw) { - ix = x; /* reset for new row */ - iy++; - } - } + if (++ix >= tmpw) { + ix = x; /* reset for new row */ + iy++; + } + } } if (ix > 0) /* pad final row if incomplete */ while (ix < width) - SetPixel(pixdc, x+ix++, y+iy, palbg); + SetPixel(pixdc, x+ix++, y+iy, palbg); } free(bmi); @@ -2733,12 +2733,12 @@ int on_icon; } else { if (ws->win) - BitBlt(stddc, x, y, width, height, pixdc, x, y, SRCCOPY); + BitBlt(stddc, x, y, width, height, pixdc, x, y, SRCCOPY); } FREE_STDLOCALS(w); return 0; } - + /* * imqsearch(key,base,nel) - binary search hardwired for images * @@ -2801,30 +2801,30 @@ unsigned char *data; #if 0 /* want to do pollevent here, but can't inside a STDLOCALS declaration */ if (y & 1) { /* how often to process window events? */ - pollevent(); - } + pollevent(); + } #endif for (x = xx; x < wd; x++) { - px = GetPixel(pixdc, x, y); - if (px != lastpx) { - lastpx = px; - lp = imqsearch(px, clist, ncolors); - if (*lp != px) { - i = ncolors++; + px = GetPixel(pixdc, x, y); + if (px != lastpx) { + lastpx = px; + lp = imqsearch(px, clist, ncolors); + if (*lp != px) { + i = ncolors++; if (ncolors >= nclist) { - nclist = nclist * 1.5; - clist = realloc(clist, nclist * sizeof (SysColor)); - if (!clist) return 0; - lp = imqsearch(px, clist, ncolors); - } - while (clist + i != lp) { - clist[i] = clist[i-1]; - i--; - } - clist[i] = px; - } - } - } + nclist = nclist * 1.5; + clist = realloc(clist, nclist * sizeof (SysColor)); + if (!clist) return 0; + lp = imqsearch(px, clist, ncolors); + } + while (clist + i != lp) { + clist[i] = clist[i-1]; + i--; + } + clist[i] = px; + } + } + } } /* @@ -2842,31 +2842,31 @@ unsigned char *data; #if 0 /* want to do pollevent here, but can't inside a STDLOCALS declaration */ if (y & 1 == 0) { - pollevent(); - } + pollevent(); + } #endif for (x = xx; x < width; x++) { - px = GetPixel(pixdc, x, y); - if (px != lastpx) { - lastpx = px; - lp = imqsearch(px, clist, ncolors); - if (*lp == px) - i = lp - clist; - else { - FREE_STDLOCALS(w); - free(clist); - return 0; - } - } - *data++ = i; - if (!paltbl[i].used) { - paltbl[i].used = 1; - paltbl[i].clr.red = RED(px) * 257; - paltbl[i].clr.green = GREEN(px) * 257; - paltbl[i].clr.blue = BLUE(px) * 257; - paltbl[i].valid = 1; - } - } + px = GetPixel(pixdc, x, y); + if (px != lastpx) { + lastpx = px; + lp = imqsearch(px, clist, ncolors); + if (*lp == px) + i = lp - clist; + else { + FREE_STDLOCALS(w); + free(clist); + return 0; + } + } + *data++ = i; + if (!paltbl[i].used) { + paltbl[i].used = 1; + paltbl[i].clr.red = RED(px) * 257; + paltbl[i].clr.green = GREEN(px) * 257; + paltbl[i].clr.blue = BLUE(px) * 257; + paltbl[i].valid = 1; + } + } } free(clist); FREE_STDLOCALS(w); @@ -2890,20 +2890,20 @@ unsigned char *data; #if 0 /* want to do pollevent here, but can't inside a STDLOCALS declaration */ if (y & 1 == 0) { - pollevent(); - } + pollevent(); + } #endif for (x = xx; x < wd; x++) { - px = GetPixel(pixdc, x, y); - *data++ = RED(px); - *data++ = GREEN(px); - *data++ = BLUE(px); - } + px = GetPixel(pixdc, x, y); + *data++ = RED(px); + *data++ = GREEN(px); + *data++ = BLUE(px); + } } FREE_STDLOCALS(w); return 1; } - + int readimage(w, filename, x, y, status) wbp w; char *filename; @@ -2944,7 +2944,7 @@ int x, y, *status; } } - + /* * Initialize client for producing pixels from a window, or in this case, @@ -2972,7 +2972,7 @@ struct imgmem *imem; for(i = imem->y; i < y2; i++) for(j = imem->x; j < x2; j++) { if ((*p++ = GetPixel(pixdc, j, i)) == (COLORREF)-1L) { - free(imem->crp); + free(imem->crp); SelectObject(pixdc, oldpix); FREE_STDLOCALS(w); return Failed; @@ -2999,10 +2999,10 @@ int getpixel(wbp w, int x, int y, long *rv, char *s, struct imgmem *imem) COLORREF cr = imem->crp[(y-imem->y) * imem->width + (x-imem->x)]; *rv = 1; sprintf(s, "%ld,%ld,%ld", - (long)RED(cr)*257L, (long)GREEN(cr)*257L, (long)BLUE(cr)*257L); + (long)RED(cr)*257L, (long)GREEN(cr)*257L, (long)BLUE(cr)*257L); return Succeeded; } - + int query_pointer(w, pp) wbp w; XPoint *pp; @@ -3033,13 +3033,13 @@ dptr dp; wsp ws = w->window; return Succeeded; } - + /* * dumpimage -- write an image to a disk file. * At present, there are no MS Windows-specific image file formats. */ int dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, - unsigned int width, unsigned int height) + unsigned int width, unsigned int height) { return NoCvt; } @@ -3049,17 +3049,17 @@ int dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, * loadimage. At present, there are no MS Windows-specific image formats. */ HBITMAP loadimage(wbp w, char *filename, unsigned int *width, - unsigned int *height, int atorigin, int *status) + unsigned int *height, int atorigin, int *status) { return NULL; } - + char *get_mutable_name(wbp w, int mute_index) { char *tmp; PALETTEENTRY pe; - + if (-mute_index > numColors || scp[-mute_index].type != CLR_MUTABLE) { return NULL; } @@ -3091,7 +3091,7 @@ int set_mutable(wbp w, int i, char *s) pe.peGreen = g >> 8; pe.peBlue = b >> 8; pe.peFlags = PC_RESERVED; - raiseWindow(w); /* mutable won't mutate if window isn't active */ + raiseWindow(w); /* mutable won't mutate if window isn't active */ #if 1 AnimatePalette(palette, -i, 1, &pe); rv = SetPaletteEntries(palette, -i, 1, &pe); @@ -3148,33 +3148,33 @@ int mutable_color(wbp w, dptr argv, int argc, int *retval) * old-style check for C integer */ else if (argv[0].dword == D_Integer) {/* check for color cell */ - if (IntVal(argv[0]) >= 0) { + if (IntVal(argv[0]) >= 0) { FREE_STDLOCALS(w); - return Failed; /* must be negative */ + return Failed; /* must be negative */ } - if (GetPaletteEntries(palette, -IntVal(argv[0]), - 1, lp.palPalEntry) == 0) { + if (GetPaletteEntries(palette, -IntVal(argv[0]), + 1, lp.palPalEntry) == 0) { FREE_STDLOCALS(w); return RunError; } - /* convert to linear color? */ - } + /* convert to linear color? */ + } else { - if (!cnv:C_string(argv[0],str)) { + if (!cnv:C_string(argv[0],str)) { FREE_STDLOCALS(w); - ReturnErrVal(103,argv[0], RunError); - } - if (parsecolor(w, str, &r, &g, &b, &a) != Succeeded) { - /* reduce logical palette size and count */ + ReturnErrVal(103,argv[0], RunError); + } + if (parsecolor(w, str, &r, &g, &b, &a) != Succeeded) { + /* reduce logical palette size and count */ FREE_STDLOCALS(w); - numColors--; + numColors--; ResizePalette(palette, numColors); - return Failed; /* invalid color specification */ - } - lp.palPalEntry[0].peRed = r >> 8; - lp.palPalEntry[0].peGreen = g >> 8; - lp.palPalEntry[0].peBlue = b >> 8; - } + return Failed; /* invalid color specification */ + } + lp.palPalEntry[0].peRed = r >> 8; + lp.palPalEntry[0].peGreen = g >> 8; + lp.palPalEntry[0].peBlue = b >> 8; + } lp.palNumEntries = 1; lp.palVersion = 0x300; lp.palPalEntry[0].peFlags = PC_RESERVED; @@ -3218,7 +3218,7 @@ void drawarcs(wbp wb, XArc *arcs, int narcs) right = arc->x + arc->width + 1; bottom = arc->y + arc->height + 1; if (ws->win) - Arc(stddc, arc->x, arc->y, right, bottom, x1, y1, x2, y2); + Arc(stddc, arc->x, arc->y, right, bottom, x1, y1, x2, y2); Arc(pixdc, arc->x, arc->y, right, bottom, x1, y1, x2, y2); } if (stdwin) SelectObject(stddc, oldpen); @@ -3227,7 +3227,7 @@ void drawarcs(wbp wb, XArc *arcs, int narcs) FREE_STDLOCALS(wb); return; } - + /* * drawlines - Support routine for DrawLine @@ -3252,10 +3252,10 @@ void drawlines(wbinding *wb, XPoint *points, int npoints) FREE_STDLOCALS(wb); return; } - + /* - * drawpoints() - + * drawpoints() - * Parameters - the window binding for output, an array of points (assumed * to be fixed up for bitmap) and the number of points */ @@ -3297,8 +3297,8 @@ void drawsegments(wbinding *wb, XSegment *segs, int nsegs) if (stdwin) { SetBkMode(stddc, wc->bkmode); for (i = 0; i < nsegs; i++) { - Polyline(stddc, (POINT *)(segs+i), 2); - } + Polyline(stddc, (POINT *)(segs+i), 2); + } } SetBkMode(pixdc, wc->bkmode); for (i = 0; i < nsegs; i++) { @@ -3310,7 +3310,7 @@ void drawsegments(wbinding *wb, XSegment *segs, int nsegs) FREE_STDLOCALS(wb); return; } - + int allowresize(w, on) wbp w; @@ -3354,7 +3354,7 @@ char *getselection(wbp w, char *buf) } } FREE_STDLOCALS(w); - + return rv; } @@ -3385,13 +3385,13 @@ int setselection(wbp w, dptr val) SetClipboardData(CF_TEXT, hGlobalMemory); CloseClipboard(); FREE_STDLOCALS(w); - return Succeeded; + return Succeeded; } } FREE_STDLOCALS(w); return Failed; } - + /* * drawstrng() */ @@ -3417,12 +3417,12 @@ void drawstrng(wbinding *wb, int x, int y, char *s, int slen) FREE_STDLOCALS(wb); return; } - + /* * fillarcs */ -void fillarcs(wbp wb, XArc *arcs, int narcs) +void fillarcs(wbp wb, XArc *arcs, int narcs) { register XArc *arc = arcs; int i, diff, bheight; @@ -3448,38 +3448,38 @@ void fillarcs(wbp wb, XArc *arcs, int narcs) * from SDK reference: Ellipse() draws up to but not including * the right and bottom coordinates. Add +1 to compensate. */ - if (stdwin) - Ellipse(stddc, arc->x, arc->y, - arc->x + arc->width + 1, arc->y + arc->height + 1); - Ellipse(pixdc, arc->x, arc->y, - arc->x + arc->width + 1, arc->y + arc->height + 1); - } + if (stdwin) + Ellipse(stddc, arc->x, arc->y, + arc->x + arc->width + 1, arc->y + arc->height + 1); + Ellipse(pixdc, arc->x, arc->y, + arc->x + arc->width + 1, arc->y + arc->height + 1); + } else { - arc->angle1 = -arc->angle1 - arc->angle2; - pts[0].x = arc->x + (arc->width>>1); - pts[0].y = arc->y + (arc->height>>1); - pts[1].x = arc->x + (arc->width>>1) + + arc->angle1 = -arc->angle1 - arc->angle2; + pts[0].x = arc->x + (arc->width>>1); + pts[0].y = arc->y + (arc->height>>1); + pts[1].x = arc->x + (arc->width>>1) + (int)(((arc->width + 1)>>1) * cos(arc->angle1)); - pts[1].y = arc->y + (arc->height>>1) - + pts[1].y = arc->y + (arc->height>>1) - (int)(((arc->height )>>1) * sin(arc->angle1)); - pts[2].x = arc->x + (arc->width>> 1) + + pts[2].x = arc->x + (arc->width>> 1) + (int)(((arc->width + 1)>>1) * cos(arc->angle1+arc->angle2)); - pts[2].y = arc->y + (arc->height>>1) - + pts[2].y = arc->y + (arc->height>>1) - (int)(((arc->height )>>1) * sin(arc->angle1+arc->angle2)); - if ((pts[1].x == pts[2].x) && (pts[1].y == pts[2].y)) { - /* extent of 0 will be misinterpreted by windows as 2pi */ - } - else { - if (stdwin) { - Pie(stddc, arc->x, arc->y, - arc->x + arc->width + 1, arc->y + arc->height + 1, - pts[1].x, pts[1].y, pts[2].x, pts[2].y); - } - Pie(pixdc, arc->x, arc->y, - arc->x + arc->width + 1, arc->y + arc->height + 1, - pts[1].x, pts[1].y, pts[2].x, pts[2].y); - } - } + if ((pts[1].x == pts[2].x) && (pts[1].y == pts[2].y)) { + /* extent of 0 will be misinterpreted by windows as 2pi */ + } + else { + if (stdwin) { + Pie(stddc, arc->x, arc->y, + arc->x + arc->width + 1, arc->y + arc->height + 1, + pts[1].x, pts[1].y, pts[2].x, pts[2].y); + } + Pie(pixdc, arc->x, arc->y, + arc->x + arc->width + 1, arc->y + arc->height + 1, + pts[1].x, pts[1].y, pts[2].x, pts[2].y); + } + } } if (stdwin) SelectObject(stddc, oldpen); SelectObject(pixdc, oldpen2); @@ -3631,7 +3631,7 @@ void fillpolygon(wbp w, XPoint *pts, int npts) LONG NumWindows = 0; - + /* * Allocate a display on machine s. A "display" originated on X Windows as * a structure to remember a network connection to an X server, and handles @@ -3651,7 +3651,7 @@ wdp alc_display(char *s) for(wd = wdsplys; wd; wd = wd->next) if (!strcmp(wd->name,s)) { wd->refcount++; - return wd; + return wd; } GRFX_ALLOC(wd, _wdisplay); @@ -3667,7 +3667,7 @@ wdp alc_display(char *s) strcpy(wd->name,s); #ifdef Graphics3D wd->stex = NULL; -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* gradually move common/shared resources into "display". e.g. fonts? */ @@ -3686,10 +3686,10 @@ wbp w; CURTSTATE(); GRFX_ALLOC(wc, _wcontext); - + if (getenv_r("ICONFONT", icnfnt, 255 ) == 0) icnfnt = fnt; - + wc->serial = ++context_serial; wc->display = w->window->display; wc->bkmode = OPAQUE; /* at present, only used in line drawing */ @@ -3714,10 +3714,10 @@ wbp w; wc->font = (wfp)alloc(sizeof (struct _wfont)); wc->font->name = salloc("fixed"); wc->font->font = CreateFont(16,0,0,0,FW_NORMAL,0,0,0, - ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET), - OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS, - DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, - icnfnt); + ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET), + OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS, + DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, + icnfnt); wc->font->charwidth = 8; /* looks like a bug */ wc->leading = 16; @@ -3725,7 +3725,7 @@ wbp w; GRFX_LINK(wc, wcntxts); return wc; } - + /* * allocate a context, cloning attributes from an existing context */ @@ -3740,10 +3740,10 @@ wbp w; CURTSTATE(); GRFX_ALLOC(wc, _wcontext); - + if (getenv_r("ICONFONT", fnt, 255 ) == 0) icnfnt=fnt; - + wc->serial = ++context_serial; tmp.window = ws; @@ -3757,8 +3757,8 @@ wbp w; wc->cliph = wc2->cliph; if (wc2->cliprgn) wc->cliprgn = CreateRectRgn(wc->clipx,wc->clipy, - wc->clipx+wc->clipw, - wc->clipy+wc->cliph); + wc->clipx+wc->clipw, + wc->clipy+wc->cliph); wc->dx = wc2->dx; wc->dy = wc2->dy; wc->bits = wc2->bits; @@ -3793,10 +3793,10 @@ wbp w; wc->font = (wfp)alloc(sizeof (struct _wfont)); wc->font->name = salloc("fixed"); wc->font->font = CreateFont(13,0,0,0,FW_NORMAL,0,0,0, - ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET), - OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS, - DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, - icnfnt); + ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET), + OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS, + DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, + icnfnt); wc->leading = wc2->leading; setfont(&tmp, &(wc2->font->name)); @@ -3821,12 +3821,12 @@ wbp w; ReleaseDC(ws->iconwin, hdc); #endif } -#endif /* Graphics3D */ +#endif /* Graphics3D */ GRFX_LINK(wc, wcntxts); return wc; } - + /* * allocate a window state structure */ @@ -3835,7 +3835,7 @@ wsp alc_winstate() int i; wsp ws; CURTSTATE(); - + GRFX_ALLOC(ws, _wstate); ws->serial = ++canvas_serial; ws->bits = 1024; /* echo ON; others OFF */ @@ -3847,7 +3847,7 @@ wsp alc_winstate() #ifdef Graphics3D ws->type = REAL_WSTATE; ws->texindex = -1; -#endif /* Graphics3D */ +#endif /* Graphics3D */ GRFX_LINK(ws, wstates); return ws; } @@ -3862,42 +3862,42 @@ wsp ws; ws->refcount--; if(ws->refcount == 0) { if (ws->win) /* && IsWindowVisible(ws->win))*/ - DestroyWindow(ws->win); + DestroyWindow(ws->win); /* ws->win = 0;*/ if (ws->iconwin && ws->iconwin != ws->win) { if (IsWindowVisible(ws->iconwin)) - DestroyWindow(ws->iconwin); + DestroyWindow(ws->iconwin); else DestroyWindow(ws->iconwin); - } + } /* ws->iconwin = 0;*/ /* while (ws->win) - if (pollevent() == -1) return -1; + if (pollevent() == -1) return -1; */ if (ws->windowlabel) { free(ws->windowlabel); ws->windowlabel=0;} if (ws->iconlabel) {free(ws->iconlabel); ws->iconlabel=0;} if (ws->pix) - DeleteObject(ws->pix); + DeleteObject(ws->pix); ws->pix = 0; if (ws->iconpix) - DeleteObject(ws->iconpix); + DeleteObject(ws->iconpix); ws->iconpix = 0; if (ws->initialPix) - DeleteObject(ws->initialPix); + DeleteObject(ws->initialPix); ws->initialPix = 0; /* need to enumerate and specifically free each string */ if (ws->menuMap) { - for(i=0;inmMapElems;i++) free(ws->menuMap[i]); + for(i=0;inmMapElems;i++) free(ws->menuMap[i]); free(ws->menuMap); ws->menuMap = 0; - } + } free(ws->cursorname); if (ws->child) { for(i=0;inChildren;i++) { free(ws->child[i].id); if (ws->child[i].font) DeleteObject(ws->child[i].font); - } + } free(ws->child); - } + } ws->child = 0; GRFX_UNLINK(ws, wstates); } @@ -3913,27 +3913,27 @@ wcp wc; wc->refcount--; if(wc->refcount == 0) { if (wc->cliprgn) - DeleteObject(wc->cliprgn); + DeleteObject(wc->cliprgn); wc->cliprgn = 0; if (wc->pattern) - DeleteObject(wc->pattern); + DeleteObject(wc->pattern); wc->pattern = 0; if (wc->patternname) - free(wc->patternname); + free(wc->patternname); wc->patternname = 0; if (wc->fgname) free(wc->fgname); wc->fgname = 0; if (wc->bgname) free(wc->bgname); wc->bgname = 0; if (wc->font) { - if (wc->font->font) - DeleteObject(wc->font->font); - wc->font->font = 0; - if (wc->font->name) - free(wc->font->name); - wc->font->name = 0; - free(wc->font); - } + if (wc->font->font) + DeleteObject(wc->font->font); + wc->font->font = 0; + if (wc->font->name) + free(wc->font->name); + wc->font->name = 0; + free(wc->font); + } wc->font = 0; GRFX_UNLINK(wc, wcntxts); } @@ -3989,7 +3989,7 @@ int len; wc->patternname = malloc(len+1); strncpy(wc->patternname, name, len); wc->patternname[len] = '\0'; - + /* * If the pattern starts with a number it is a width , bits encoding */ @@ -3997,10 +3997,10 @@ int len; nbits = MAXXOBJS; switch (parsepattern(name, len, &width, &nbits, bits)) { case Failed: - return Failed; + return Failed; case RunError: - ReturnErrNum(145, RunError); - } + ReturnErrNum(145, RunError); + } if (w->window->iconwin == NULL) return Succeeded; return SetPatternBits(w, width, bits, nbits); } @@ -4011,18 +4011,18 @@ int len; if ((symbol = si_s2i(siPatternSyms, wc->patternname)) >= 0) { if (w->window->iconwin == NULL) return Succeeded; for(i = 0; i < 8; i++) { - v = reversebits(~(patbits[symbol * 8 + i])); - *buf++ = v; - } + v = reversebits(~(patbits[symbol * 8 + i])); + *buf++ = v; + } p = CreateBitmapFromData(data); if (wc->pattern) - DeleteObject(wc->pattern); + DeleteObject(wc->pattern); wc->pattern = p; if (wc->fillstyle == BS_PATTERN) { - wc->brush.lbStyle = BS_PATTERN; - wc->brush.lbColor = PALCLR(wc->fg); - wc->brush.lbHatch = (word)p; - } + wc->brush.lbStyle = BS_PATTERN; + wc->brush.lbColor = PALCLR(wc->fg); + wc->brush.lbHatch = (word)p; + } return Succeeded; } ReturnErrNum(145, RunError); @@ -4065,15 +4065,15 @@ int nbits; if (width == 8) { for(i = 0; i < nbits; i++) { v = bits[i]; - *buf++ = reversebits(~v); - } + *buf++ = reversebits(~v); + } } else if (width == 4) { for(k=0; k < 2; k++) /* do twice to get 8 rows */ for(i = 0; i < nbits; i++) { v = widenbits(bits[i]); - *buf++ = reversebits(~v); - } + *buf++ = reversebits(~v); + } } else return Failed; @@ -4085,7 +4085,7 @@ int nbits; wc->brush.lbStyle = BS_PATTERN; wc->brush.lbColor = PALCLR(wc->fg); wc->brush.lbHatch = (word)p; - } + } return Succeeded; } @@ -4120,7 +4120,7 @@ wbp w; resizePixmap(w, ws->width, ws->height); return Succeeded; } - + int do_config(w, status) wbp w; @@ -4138,61 +4138,61 @@ int status; if (ws->win) { pollevent(); if (status == 3) { - if (ws->parent) - SetWindowPos(ws->win, ws->win, posx, posy, wid, ht, - SWP_NOZORDER|SWP_NOACTIVATE); - else - SetWindowPos(ws->win, ws->win, posx, posy, - wid + BORDWIDTH, ht + BORDHEIGHT + 1, - SWP_NOZORDER|SWP_NOACTIVATE); - } + if (ws->parent) + SetWindowPos(ws->win, ws->win, posx, posy, wid, ht, + SWP_NOZORDER|SWP_NOACTIVATE); + else + SetWindowPos(ws->win, ws->win, posx, posy, + wid + BORDWIDTH, ht + BORDHEIGHT + 1, + SWP_NOZORDER|SWP_NOACTIVATE); + } else if (status == 2) { - if (ws->parent) - SetWindowPos(ws->win, ws->win, 0, 0, wid, ht, - SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); - else - SetWindowPos(ws->win, ws->win, 0, 0, - wid + BORDWIDTH, ht + BORDHEIGHT + 1, - SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); + if (ws->parent) + SetWindowPos(ws->win, ws->win, 0, 0, wid, ht, + SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); + else + SetWindowPos(ws->win, ws->win, 0, 0, + wid + BORDWIDTH, ht + BORDHEIGHT + 1, + SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); } else if (status == 1) - if (ws->parent) - SetWindowPos(ws->win, ws->win, posx, posy, 0, 0, - SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); + if (ws->parent) + SetWindowPos(ws->win, ws->win, posx, posy, 0, 0, + SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); else - SetWindowPos(ws->win, ws->win, - posx, - posy, - 0, 0, SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); + SetWindowPos(ws->win, ws->win, + posx, + posy, + 0, 0, SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); } else if (ws->iconwin) { if (status == 3) { - if (ws->parent) - SetWindowPos(ws->iconwin, ws->iconwin, posx, posy, wid, ht, - SWP_NOZORDER|SWP_NOACTIVATE); - else - SetWindowPos(ws->iconwin, ws->iconwin, - posx, - posy, - wid, ht, SWP_NOZORDER|SWP_NOACTIVATE); - } + if (ws->parent) + SetWindowPos(ws->iconwin, ws->iconwin, posx, posy, wid, ht, + SWP_NOZORDER|SWP_NOACTIVATE); + else + SetWindowPos(ws->iconwin, ws->iconwin, + posx, + posy, + wid, ht, SWP_NOZORDER|SWP_NOACTIVATE); + } else if (status == 2) { - if (ws->parent) - SetWindowPos(ws->iconwin, ws->iconwin, 0, 0, wid, ht, - SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); - else - SetWindowPos(ws->iconwin, ws->iconwin, 0, 0, - wid, ht, SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); + if (ws->parent) + SetWindowPos(ws->iconwin, ws->iconwin, 0, 0, wid, ht, + SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); + else + SetWindowPos(ws->iconwin, ws->iconwin, 0, 0, + wid, ht, SWP_NOMOVE|SWP_NOZORDER|SWP_NOACTIVATE); } else if (status == 1) - if (ws->parent) - SetWindowPos(ws->iconwin, ws->iconwin, posx, posy, 0, 0, - SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); - else - SetWindowPos(ws->iconwin, ws->iconwin, - posx, - posy, - 0, 0, SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); + if (ws->parent) + SetWindowPos(ws->iconwin, ws->iconwin, posx, posy, 0, 0, + SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); + else + SetWindowPos(ws->iconwin, ws->iconwin, + posx, + posy, + 0, 0, SWP_NOSIZE|SWP_NOZORDER|SWP_NOACTIVATE); } #ifdef Graphics3D if (ws->is_3D) { @@ -4201,7 +4201,7 @@ int status; #endif return Succeeded; } - + DWORD playMIDIfile(HWND hWndNotify, LPSTR s) { uword wDeviceID; @@ -4214,8 +4214,8 @@ DWORD playMIDIfile(HWND hWndNotify, LPSTR s) mciOpenParms.lpstrDeviceType = "sequencer"; mciOpenParms.lpstrElementName = s; if (dwReturn = mciSendCommand((uword)NULL, MCI_OPEN, - MCI_OPEN_TYPE | MCI_OPEN_ELEMENT, - (uword)(LPVOID) &mciOpenParms)) { + MCI_OPEN_TYPE | MCI_OPEN_ELEMENT, + (uword)(LPVOID) &mciOpenParms)) { return dwReturn; } wDeviceID = mciOpenParms.wDeviceID; @@ -4223,13 +4223,13 @@ DWORD playMIDIfile(HWND hWndNotify, LPSTR s) /* attempt to select the MIDI mapper */ mciSeqSetParms.dwPort = MIDI_MAPPER; if (dwReturn = mciSendCommand(wDeviceID, MCI_SET, MCI_SEQ_SET_PORT, - (uword)(LPVOID) &mciSeqSetParms)) { + (uword)(LPVOID) &mciSeqSetParms)) { /* could not select the MIDI mapper; play anyway */ } mciPlayParms.dwCallback = (uword) hWndNotify; if (dwReturn = mciSendCommand(wDeviceID, MCI_PLAY, MCI_NOTIFY, - (uword)(LPVOID) &mciPlayParms)) { + (uword)(LPVOID) &mciPlayParms)) { mciSendCommand(wDeviceID, MCI_CLOSE, 0, (uword)NULL); return dwReturn; } @@ -4258,7 +4258,7 @@ int playmedia(wbp w, char *s) } return Failed; } - + /* * UpdateCursorPos */ @@ -4328,11 +4328,11 @@ int resizePixmap(wbp w, int width, int height) FillRect(hdc, &rect, hb); } - if (ws->pix) + if (ws->pix) if (ws->parent) - BitBlt(hdc3, 0, 0, x, y, hdc2, 0, 0, SRCCOPY); - else - BitBlt(hdc3, 0, 0, x - 2, y - 1, hdc2, 0, 0, SRCCOPY); + BitBlt(hdc3, 0, 0, x, y, hdc2, 0, 0, SRCCOPY); + else + BitBlt(hdc3, 0, 0, x - 2, y - 1, hdc2, 0, 0, SRCCOPY); if (ws->win) BitBlt(hdc, 0, 0, ws->pixwidth, ws->pixheight, hdc3, 0, 0, SRCCOPY); SelectObject(hdc3, oldpix2); @@ -4366,7 +4366,7 @@ void SetDCPixelFormat(HDC h) iFormat = ChoosePixelFormat( h, &pfd ); SetPixelFormat( h, iFormat, &pfd ); } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * CreateWinDC - create a device context for drawing on the window @@ -4396,9 +4396,9 @@ HDC CreateWinDC(wbp w) if (w->context->rendermode == UGL3D) { #ifdef GraphicsGL wglMakeCurrent (hdc, w->window->ctx); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ } -#endif /* Graphics3D */ +#endif /* Graphics3D */ return hdc; } @@ -4444,8 +4444,8 @@ int setinputmask(wbp w, char *val) } if (strchr(val,'t')) { if (!(ws->inputmask | TouchInputMask)) { - ws->inputmask |= TouchInputMask; - } + ws->inputmask |= TouchInputMask; + } } else { ws->inputmask &= ~TouchInputMask; @@ -4522,7 +4522,7 @@ int textWidth(wbp w, char *s, int n) ReleaseDC(ws->iconwin, stddc); return rv; } - + void warpPointer(w, x, y) wbp w; int x, y; @@ -4578,9 +4578,9 @@ void makebutton(wsp ws, childcontrol *cc, char *s) cc->font = 0; cc->id = salloc(s); cc->win = CreateWindow("button", cc->id, - WS_CHILD | WS_VISIBLE | BS_PUSHBUTTON, - 0, 0, 0, 0, ws->iconwin, (HMENU) (uword) ws->nChildren, mswinInstance, - NULL); + WS_CHILD | WS_VISIBLE | BS_PUSHBUTTON, + 0, 0, 0, 0, ws->iconwin, (HMENU) (uword) ws->nChildren, mswinInstance, + NULL); } void makescrollbar(wsp ws, childcontrol *cc, char *s, int i1, int i2) @@ -4590,7 +4590,7 @@ void makescrollbar(wsp ws, childcontrol *cc, char *s, int i1, int i2) cc->font = 0; cc->win = CreateWindow("scrollbar", cc->id, WS_CHILD | WS_VISIBLE | SBS_VERT, 0, 0, 0, 0, - ws->iconwin, (HMENU)(uword)ws->nChildren, mswinInstance, NULL); + ws->iconwin, (HMENU)(uword)ws->nChildren, mswinInstance, NULL); SetScrollRange(cc->win, SB_CTL, i1, i2, FALSE); } @@ -4653,11 +4653,11 @@ void makeeditregion(wbp w, childcontrol *cc, char *s) cc->type = CHILD_EDIT; cc->id = salloc(s); cc->win = CreateWindow("edit", NULL, - WS_CHILD | WS_VISIBLE | WS_HSCROLL | WS_VSCROLL | - WS_BORDER | ES_LEFT | ES_MULTILINE | - ES_AUTOHSCROLL | ES_AUTOVSCROLL, - 0, 0, 0, 0, ws->iconwin, - (HMENU) (uword) ws->nChildren, mswinInstance, NULL); + WS_CHILD | WS_VISIBLE | WS_HSCROLL | WS_VSCROLL | + WS_BORDER | ES_LEFT | ES_MULTILINE | + ES_AUTOHSCROLL | ES_AUTOVSCROLL, + 0, 0, 0, 0, ws->iconwin, + (HMENU) (uword) ws->nChildren, mswinInstance, NULL); setchildfont(cc, w->context->font->name); } @@ -4715,7 +4715,7 @@ void seteditregion(childcontrol *cc, char *s2) void movechild(childcontrol *cc, - C_integer x, C_integer y, C_integer width, C_integer height) + C_integer x, C_integer y, C_integer width, C_integer height) { MoveWindow(cc->win, x, y, width, height, TRUE); } @@ -4790,12 +4790,12 @@ int nativefontdialog(wbp w, char *buf, int flags, int fheight, char *colr) } if (flags & FONTFLAG_BOLD) lf.lfWeight = FW_BOLD; - else + else lf.lfWeight = FW_DONTCARE; if (flags & FONTFLAG_ITALIC) lf.lfItalic = 1; lf.lfUnderline = lf.lfStrikeOut = 0; - lf.lfCharSet = - ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET); + lf.lfCharSet = + ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET); lf.lfOutPrecision = OUT_DEFAULT_PRECIS; lf.lfClipPrecision = CLIP_DEFAULT_PRECIS; lf.lfQuality = DEFAULT_QUALITY; @@ -4822,9 +4822,9 @@ int nativefontdialog(wbp w, char *buf, int flags, int fheight, char *colr) sprintf(buf, "%s,%d%s%s", lf.lfFaceName, ((lf.lfHeight > 0) ? lf.lfHeight : -lf.lfHeight), (lf.lfItalic ? ",italic" : ""), - ((lf.lfWeight > 500) ? ",bold" : "")); + ((lf.lfWeight > 500) ? ",bold" : "")); sprintf(colr,"%d,%d,%d", - RED(cf.rgbColors),GREEN(cf.rgbColors),BLUE(cf.rgbColors)); + RED(cf.rgbColors),GREEN(cf.rgbColors),BLUE(cf.rgbColors)); return Succeeded; } @@ -4849,7 +4849,7 @@ char *nativecolordialog(wbp w, long r, long g, long b, char *buf) sprintf(buf, "%d,%d,%d", (RED(cc.rgbResult)<<8) | 0xFF, (GREEN(cc.rgbResult) << 8) | 0xFF, (BLUE(cc.rgbResult) << 8) | 0xFF); - return buf; + return buf; } @@ -4907,11 +4907,11 @@ char *nativeselectdialog(wbp w, struct b_list *L, char *s) else if (okflag) okflag = MB_OK; j = MessageBox((ws->focusChild ? ws->focusChild : - (ws->win ? ws->win : ws->iconwin)), + (ws->win ? ws->win : ws->iconwin)), s, " ", okflag | yesnoflag | retryflag - | (strchr(s, '!') ? MB_ICONEXCLAMATION : - (strchr(s, '?') ? MB_ICONQUESTION : MB_ICONASTERISK))); + | (strchr(s, '!') ? MB_ICONEXCLAMATION : + (strchr(s, '?') ? MB_ICONQUESTION : MB_ICONASTERISK))); switch (j) { case IDOK: return "Okay"; @@ -4926,11 +4926,11 @@ char *nativeselectdialog(wbp w, struct b_list *L, char *s) OPENFILENAME ofn; char *nativefiledialog(wbp w, - char *s1, /* title */ - char *s2, /* default/initial file */ - char *s3, /* filter */ - char *s4, /* directory */ - int i, int j, int saveflag) + char *s1, /* title */ + char *s2, /* default/initial file */ + char *s3, /* filter */ + char *s4, /* directory */ + int i, int j, int saveflag) { char buf[256], buf2[256], buf3[256]; char *stmp; @@ -4963,7 +4963,7 @@ char *nativefiledialog(wbp w, while(strchr(s2, '\\')) s2 = strchr(s2, '\\') + 1; if (strchr(s2,'.')){ int len = strlen(ofn.lpstrFile); - return alcstr(ofn.lpstrFile, len+1); + return alcstr(ofn.lpstrFile, len+1); } /* @@ -5006,7 +5006,7 @@ char my_wmap(wbp w) #ifdef MSWindows HDC hdc, hdc2, hdc3; DWORD winstyles = 0; - TEXTMETRIC metrics; + TEXTMETRIC metrics; LOGPALETTE logpal[4]; /* really 1 + space for an extra palette entry */ HBRUSH brush; HBITMAP oldpix, oldpix2; @@ -5043,14 +5043,14 @@ char my_wmap(wbp w) winstyles=WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS; ws->iconwin = CreateWindow( "ChildWClass", NULL, - winstyles, - ws->posx, ws->posy, - ws->width == 0 ? 400 : ws->width, - ws->height == 0 ? 400: ws->height, - /* NULL, NULL, mswinInstance, NULL); */ - ws->parent->window->win, - (HMENU) (uword) ws->no, - mswinInstance, NULL); + winstyles, + ws->posx, ws->posy, + ws->width == 0 ? 400 : ws->width, + ws->height == 0 ? 400: ws->height, + /* NULL, NULL, mswinInstance, NULL); */ + ws->parent->window->win, + (HMENU) (uword) ws->no, + mswinInstance, NULL); hdc = GetDC(ws->iconwin); if ((GetDeviceCaps(hdc, RASTERCAPS) & RC_PALETTE) && (numColors == 0)){ /* This window is on a device that supports palettes */ @@ -5095,10 +5095,10 @@ char my_wmap(wbp w) if (!ws->width) ws->width = FWIDTH(w) * 80; if (!ws->height) ws->height = FHEIGHT(w) * 12; SetWindowPos(ws->iconwin, ws->iconwin, - ws->posx, - ws->posy, - ws->width, ws->height, - SWP_NOZORDER); + ws->posx, + ws->posy, + ws->width, ws->height, + SWP_NOZORDER); } if (!ws->pix) { hdc = GetDC(ws->iconwin); @@ -5121,10 +5121,10 @@ char my_wmap(wbp w) #ifdef GraphicsGL ws->ctx = wglCreateContext (hdc); wglMakeCurrent (hdc, ws->ctx); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ReleaseDC(ws->iconwin, hdc); } -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (!ISTOBEHIDDEN(ws)) { ws->win = ws->iconwin; @@ -5162,9 +5162,9 @@ char my_wmap(wbp w) if (palette) { SelectPalette(hdc, palette, FALSE); SelectPalette(hdc2, palette, FALSE); - RealizePalette(hdc); - RealizePalette(hdc2); - } + RealizePalette(hdc); + RealizePalette(hdc2); + } brush = CreateBrushIndirect(&(wc->bgbrush)); if (ws->win) FillRect(hdc, &rec, brush); @@ -5176,30 +5176,30 @@ char my_wmap(wbp w) imd = &ws->initimage; if (imd->width) { - r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, - imd->data, (word)imd->width * (word)imd->height, 0); - if (imd->paltbl) - free((pointer)imd->paltbl); - free((pointer)imd->data); - imd->width = 0; - if (r < 0) { - return 0; - } - } + r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, + imd->data, (word)imd->width * (word)imd->height, 0); + if (imd->paltbl) + free((pointer)imd->paltbl); + free((pointer)imd->data); + imd->width = 0; + if (r < 0) { + return 0; + } + } } if (ws->win) UpdateWindow(ws->win); #ifdef Graphics3D { int child_window = 0; - if (ws->is_3D) + if (ws->is_3D) child_window = CHILD_WIN3D; else if (ws->type >= CHILD_WIN3D) - child_window = CHILD_WIN3D; + child_window = CHILD_WIN3D; if (child_window == CHILD_WIN3D){ /* set up the appropriate 3D states; initialize canvas */ - if (init_3dcanvas(w) == Failed) + if (init_3dcanvas(w) == Failed) return 0; } } @@ -5214,10 +5214,10 @@ void makecurrent(wbp w) HDC stddc = GetDC(w->window->iconwin); #ifdef GraphicsGL wglMakeCurrent(stddc, w->window->ctx); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ReleaseDC(w->window->iconwin, stddc); } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * sync to the server (noop) @@ -5238,9 +5238,9 @@ void MSStartup(HINSTANCE hInstance, HINSTANCE hPrevInstance) #ifdef Graphics3D wc.style |= CS_OWNDC; #endif -#else /* NT */ +#else /* NT */ wc.style = 0; -#endif /* NT */ +#endif /* NT */ wc.lpfnWndProc = WndProc; wc.cbClsExtra = 0; wc.cbWndExtra = 0; @@ -5256,9 +5256,9 @@ void MSStartup(HINSTANCE hInstance, HINSTANCE hPrevInstance) #ifdef INTMAIN int iconx(int argc, char **argv); -#else /* INTMAIN */ +#else /* INTMAIN */ void iconx(int argc, char **argv); -#endif /* INTMAIN */ +#endif /* INTMAIN */ jmp_buf mark_sj; @@ -5282,11 +5282,11 @@ int_PASCAL WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, xmfree(); #ifdef NTGCC _exit(0); -#endif /* NTGCC */ +#endif /* NTGCC */ return 0; } #define main iconx -#endif /* MSWindows */ +#endif /* MSWindows */ #ifdef PosixFns @@ -5312,38 +5312,38 @@ struct b_list *findactivepty(struct b_list *lps) */ for ( ; BlkType(ep) == T_Lelem; ep = ep->Lelem.listnext) { for (i = 0; i < ep->Lelem.nused; i++) { - union block *bp; - int status; - DWORD tb; - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - + union block *bp; + int status; + DWORD tb; + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + if (!(is:file(ep->Lelem.lslots[j]))) syserr("internal error #1 calling findactivepty()"); if (!(status = BlkLoc(ep->Lelem.lslots[j])->File.status)) syserr("internal error #2 calling findactivepty()"); if (! (status & Fs_Pty)) { syserr("internal error #3 calling findactivepty()"); - } + } if (!(status & Fs_Read)) { /* a closed window was found on the list, ignore it */ - continue; - } - bp = BlkLoc(ep->Lelem.lslots[j]); - pt = bp->File.fd.pt; - if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) - && (tb>0)) { - if (is:null(d)) { - BlkLoc(d) = (union block *)alclist(0, MinListSlots); - d.dword = D_List; - } - c_put(&d, &(ep->Lelem.lslots[j])); - } - } + continue; + } + bp = BlkLoc(ep->Lelem.lslots[j]); + pt = bp->File.fd.pt; + if ((PeekNamedPipe(pt->master_read, NULL, 0, NULL, &tb, NULL) != 0) + && (tb>0)) { + if (is:null(d)) { + BlkLoc(d) = (union block *)alclist(0, MinListSlots); + d.dword = D_List; + } + c_put(&d, &(ep->Lelem.lslots[j])); + } + } } if (is:null(d)) return NULL; return (struct b_list *)BlkLoc(d); } -#endif /* defined(PseudoPty) && defined(MSWindows) */ -#endif PosixFns /* PosixFns */ +#endif /* defined(PseudoPty) && defined(MSWindows) */ +#endif PosixFns /* PosixFns */ diff --git a/src/runtime/ropengl.ri b/src/runtime/ropengl.ri index 8656223cd..ecc71eaae 100644 --- a/src/runtime/ropengl.ri +++ b/src/runtime/ropengl.ri @@ -9,7 +9,7 @@ int lookup_texture_byname(wbp w, char *name, int len, int type, int curtex); int texture(int width, int height, GLubyte *tex, int texmode); int texture_24img(wbp w, struct imgdata im); int textureimg(wbp w, int width, int height, - struct palentry *e, unsigned char *s, word len); + struct palentry *e, unsigned char *s, word len); int init_3dcontext(wcp wc); int traversefunclist(wbp w); @@ -44,9 +44,9 @@ FILE *wopengl(char *name, struct b_list *lp, dptr attr, int n, int *err_index) if (setglXVisual(wd) == 0) return NULL; -#endif /* XWindows */ +#endif /* XWindows */ - /* + /* * Even for 2D opengl mode, make is_3d = 1. That way, there is a good way * to distinguish between opengl 2D mode vs X Windows 2D */ @@ -87,7 +87,7 @@ int init_3dcanvas(wbp w) wc->display->maxstex = INITTEXTURENUM; wc->display->stex = - (struct _wtexture *) malloc(INITTEXTURENUM*sizeof(struct _wtexture)); + (struct _wtexture *) malloc(INITTEXTURENUM*sizeof(struct _wtexture)); if (wc->display->stex == NULL) return Failed; if (init_texnames(w->context) == Failed) return Failed ; @@ -135,7 +135,7 @@ int make_enough_texture_space(wdp wd) if (wd->ntextures >= wd->maxstex) { SUSPEND_THREADS(); - /* + /* * Allocate space and create new opengl texture names */ if (wd->ntextures >= wd->maxstex) { @@ -146,25 +146,25 @@ int make_enough_texture_space(wdp wd) } glGenTextures(wd->maxstex, texName); - newmax = wd->maxstex * 2; + newmax = wd->maxstex * 2; - /* - * Expand the texture storage and copy the new OpenGL names into place - */ - wd->stex = realloc(wd->stex, sizeof(struct _wtexture) * newmax); - if (wd->stex == NULL) { + /* + * Expand the texture storage and copy the new OpenGL names into place + */ + wd->stex = realloc(wd->stex, sizeof(struct _wtexture) * newmax); + if (wd->stex == NULL) { RESUME_THREADS(); - free(texName); - return Failed; - } + free(texName); + return Failed; + } for (i=wd->maxstex; istex[i].texName = texName[i-wd->maxstex]; wd->maxstex = newmax; - RESUME_THREADS(); - free(texName); - } + RESUME_THREADS(); + free(texName); + } } return Succeeded; } @@ -175,11 +175,11 @@ int init_texnames(wcp wc) GLuint texNames[INITTEXTURENUM]; int i; - if (wd->stex == NULL) + if (wd->stex == NULL) return Failed; - + glGenTextures(INITTEXTURENUM, texNames); - + for (i=0; istex[i].texName = texNames[i]; } @@ -231,7 +231,7 @@ void calcNormal( double* v0, double* v1, double *v2, double* n ) } int setnormals(double *norm){ - + return 0; } @@ -252,7 +252,7 @@ int drawpoly(wbp w, double* v, int num, int type, int dim) wcp wc = w->context; MakeCurrent(w); - + /* each vertex has an x-coordinate and a y-coordinate */ if (dim == 2){ /* must reset the current normal vector */ @@ -275,7 +275,7 @@ int drawpoly(wbp w, double* v, int num, int type, int dim) glEnd(); } else { - double *atex=wc->texcoords->a; + double *atex=wc->texcoords->a; /* * There must be at least the same number of texture coordinate * pairs as there are vertices. If not, fail. @@ -299,129 +299,129 @@ int drawpoly(wbp w, double* v, int num, int type, int dim) double *vnorm; /* int vcount; int normcount; -*/ +*/ /*prepare normals for normals auto mode*/ - if(wc->normode==1){ + if(wc->normode==1){ /*vnorm = malloc (num*sizeof(double));* -/* if (type==GL_TRIANGLES || type==GL_TRIANGLE_FAN || type ==GL_TRIANGLE_STRIP) - vcount=3; - else if (type==GL_QUADS || type==GL_QUAD_STRIP) - vcount = 4; - else if (type==GL_POLYGON) - vcount = 3; - normcount = num - num % (vcount); - */ if (num>9){ - calcNormal(&v[0], &v[3], &v[6], n ); - } - glNormal3dv(n); - +/* if (type==GL_TRIANGLES || type==GL_TRIANGLE_FAN || type ==GL_TRIANGLE_STRIP) + vcount=3; + else if (type==GL_QUADS || type==GL_QUAD_STRIP) + vcount = 4; + else if (type==GL_POLYGON) + vcount = 3; + normcount = num - num % (vcount); + */ if (num>9){ + calcNormal(&v[0], &v[3], &v[6], n ); + } + glNormal3dv(n); + /*for (i = 0; i < num; i = i+3){ - vnorm[i] = n[0]; - vnorm[i+1] = n[1]; - vnorm[i+2] = n[2]; - } - */ - } + vnorm[i] = n[0]; + vnorm[i+1] = n[1]; + vnorm[i+2] = n[2]; + } + */ + } else if(wc->normode==2){ /* normals are supplied by the user*/ - if (num > wc->numnormals) return Failed; - vnorm = wc->normals->a; - } + if (num > wc->numnormals) return Failed; + vnorm = wc->normals->a; + } else - /* must reset the current normal vector */ - glNormal3dv(n); - + /* must reset the current normal vector */ + glNormal3dv(n); + if (!wc->texmode) { - if(wc->normode==2){ - glBegin(type); - for (i = 0; i < num; i = i+3){ - glNormal3dv(&vnorm[i]); - glVertex3dv(&v[i]); - } - glEnd(); - } - else{ - glBegin(type); - for (i = 0; i < num; i = i+3) - glVertex3dv(&v[i]); - glEnd(); - } - } + if(wc->normode==2){ + glBegin(type); + for (i = 0; i < num; i = i+3){ + glNormal3dv(&vnorm[i]); + glVertex3dv(&v[i]); + } + glEnd(); + } + else{ + glBegin(type); + for (i = 0; i < num; i = i+3) + glVertex3dv(&v[i]); + glEnd(); + } + } else { - /* opengl should generate the texture coordinate */ + /* opengl should generate the texture coordinate */ if (wc->autogen){ glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR); glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR); - if(wc->normode==2){ - glBegin(type); - for (i = 0; i < num; i = i+3){ - glNormal3dv(&(vnorm[i])); - glVertex3dv(&v[i]); - } - glEnd(); - } - else{ - glBegin(type); - for (i = 0; i < num; i = i+3) - glVertex3dv(&v[i]); - glEnd(); - } + if(wc->normode==2){ + glBegin(type); + for (i = 0; i < num; i = i+3){ + glNormal3dv(&(vnorm[i])); + glVertex3dv(&v[i]); + } + glEnd(); + } + else{ + glBegin(type); + for (i = 0; i < num; i = i+3) + glVertex3dv(&v[i]); + glEnd(); + } } else { /* - * If there are not the same number of texture coordinate pairs - * as there are vertices, fail. - */ + * If there are not the same number of texture coordinate pairs + * as there are vertices, fail. + */ if (num/3 > wc->numtexcoords/2) return Failed; - j = 0; - if(wc->normode==2){ - /* - glEnableClientState(GL_VERTEX_ARRAY); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glEnableClientState(GL_NORMAL_ARRAY); - glVertexPointer(3, GL_DOUBLE, 0, v); - glNormalPointer(GL_DOUBLE, 0, vnorm); - glTexCoordPointer(2, GL_DOUBLE, 0, wc->texcoords->a); - glDrawArrays(type, 0, num); - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - glDisableClientState(GL_NORMAL_ARRAY); - */ - glBegin(type); - for (i = 0; i < num; i = i+3){ - glNormal3dv(&(vnorm[i])); - glTexCoord2f(wc->texcoords->a[j], wc->texcoords->a[j+1]); - j = j + 2; - glVertex3dv(&v[i]); - } - glEnd(); - - } - else { - /* - glEnableClientState(GL_VERTEX_ARRAY); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glVertexPointer(3, GL_DOUBLE, 0, v); - glTexCoordPointer(2, GL_DOUBLE, 0, wc->texcoords->a); - glDrawArrays(type, 0, num); - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - */ - - glBegin(type); - for (i = 0; i < num; i = i+3){ - glTexCoord2f(wc->texcoords->a[j], wc->texcoords->a[j+1]); - j = j + 2; - glVertex3dv(&v[i]); - } - glEnd(); - } + j = 0; + if(wc->normode==2){ + /* + glEnableClientState(GL_VERTEX_ARRAY); + glEnableClientState(GL_TEXTURE_COORD_ARRAY); + glEnableClientState(GL_NORMAL_ARRAY); + glVertexPointer(3, GL_DOUBLE, 0, v); + glNormalPointer(GL_DOUBLE, 0, vnorm); + glTexCoordPointer(2, GL_DOUBLE, 0, wc->texcoords->a); + glDrawArrays(type, 0, num); + glDisableClientState(GL_VERTEX_ARRAY); + glDisableClientState(GL_TEXTURE_COORD_ARRAY); + glDisableClientState(GL_NORMAL_ARRAY); + */ + glBegin(type); + for (i = 0; i < num; i = i+3){ + glNormal3dv(&(vnorm[i])); + glTexCoord2f(wc->texcoords->a[j], wc->texcoords->a[j+1]); + j = j + 2; + glVertex3dv(&v[i]); + } + glEnd(); + + } + else { + /* + glEnableClientState(GL_VERTEX_ARRAY); + glEnableClientState(GL_TEXTURE_COORD_ARRAY); + glVertexPointer(3, GL_DOUBLE, 0, v); + glTexCoordPointer(2, GL_DOUBLE, 0, wc->texcoords->a); + glDrawArrays(type, 0, num); + glDisableClientState(GL_VERTEX_ARRAY); + glDisableClientState(GL_TEXTURE_COORD_ARRAY); + */ + + glBegin(type); + for (i = 0; i < num; i = i+3){ + glTexCoord2f(wc->texcoords->a[j], wc->texcoords->a[j+1]); + j = j + 2; + glVertex3dv(&v[i]); + } + glEnd(); + } } } - + } /* each vertex is of the form (x, y, z, w) */ if (dim == 4){ @@ -441,11 +441,11 @@ int drawpoly(wbp w, double* v, int num, int type, int dim) glVertex4d(v[i], v[i+1], v[i+2], v[i+3]); glEnd(); } - else { - /* - * fail if the number of vertices is more than - * the number of texture coordinate pairs - */ + else { + /* + * fail if the number of vertices is more than + * the number of texture coordinate pairs + */ if (num/4 > wc->numtexcoords/2) return Failed; glBegin(type); @@ -464,7 +464,7 @@ int drawpoly(wbp w, double* v, int num, int type, int dim) /* helper function to draw a torus */ void torus(double radius1, double radius2, double x,double y, double z, - int slices, int rings, int gen) + int slices, int rings, int gen) { int i, j; GLfloat theta, phi, theta1; @@ -484,7 +484,7 @@ void torus(double radius1, double radius2, double x,double y, double z, #ifndef M_PI #define M_PI 3.14159265358979323846264338327950288419716939937511 -#endif /* M_PI */ +#endif /* M_PI */ /* rotate to make the torus look nicer */ glRotatef(130.0, 1.0, 0.0, 0.0); @@ -542,11 +542,11 @@ void cube(double length, double x, double y, double z, int gen) glTranslatef(x, y, z); /* static GLfloat v[8][3] = { - {-1.0, -1.0, 1.0}, + {-1.0, -1.0, 1.0}, { 1.0, -1.0, 1.0}, { 1.0, 1.0, 1.0}, {-1.0, 1.0, 1.0}, - { 1.0, -1.0, -1.0}, + { 1.0, -1.0, -1.0}, {-1.0, -1.0, -1.0}, {-1.0, 1.0, -1.0}, { 1.0, 1.0, -1.0}, @@ -564,31 +564,31 @@ void cube(double length, double x, double y, double z, int gen) glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); for (i = 0; i <=5 ; i++) { - glBegin(GL_QUADS); - glNormal3fv(&n[i][0]); - glTexCoord2f(0.0, 0.0); - glVertex3fv(&v[faces[i][0]][0]); - glTexCoord2f(1.0, 0.0); - glVertex3fv(&v[faces[i][1]][0]); - glTexCoord2f(1.0, 1.0); - glVertex3fv(&v[faces[i][2]][0]); - glTexCoord2f(0.0, 1.0); - glVertex3fv(&v[faces[i][3]][0]); - glEnd(); - } + glBegin(GL_QUADS); + glNormal3fv(&n[i][0]); + glTexCoord2f(0.0, 0.0); + glVertex3fv(&v[faces[i][0]][0]); + glTexCoord2f(1.0, 0.0); + glVertex3fv(&v[faces[i][1]][0]); + glTexCoord2f(1.0, 1.0); + glVertex3fv(&v[faces[i][2]][0]); + glTexCoord2f(0.0, 1.0); + glVertex3fv(&v[faces[i][3]][0]); + glEnd(); + } glEnable(GL_TEXTURE_GEN_S); glEnable(GL_TEXTURE_GEN_T); } else { for (i = 5; i >= 0; i--) { - glBegin(GL_QUADS); - glNormal3fv(&n[i][0]); - glVertex3fv(&v[faces[i][0]][0]); - glVertex3fv(&v[faces[i][1]][0]); - glVertex3fv(&v[faces[i][2]][0]); - glVertex3fv(&v[faces[i][3]][0]); - glEnd(); - } + glBegin(GL_QUADS); + glNormal3fv(&n[i][0]); + glVertex3fv(&v[faces[i][0]][0]); + glVertex3fv(&v[faces[i][1]][0]); + glVertex3fv(&v[faces[i][2]][0]); + glVertex3fv(&v[faces[i][3]][0]); + glEnd(); + } } glPopMatrix(); } @@ -716,8 +716,8 @@ int popmatrix() if (params2 > 1) glPopMatrix(); else{ - /*printf(" PROJECTION MODE ... POP is failing...!! %d \n", params2 );*/ - return Failed; + /*printf(" PROJECTION MODE ... POP is failing...!! %d \n", params2 );*/ + return Failed; } } @@ -728,11 +728,11 @@ int popmatrix() * matrix on the stack. if not return Failed */ glGetIntegerv(GL_MODELVIEW_STACK_DEPTH, ¶ms2); - if (params2 > 1) - glPopMatrix(); - else { - /*printf(" MODELVIEW------- MODE ... POP is failing...!! %d \n", params2 );*/ - return Failed; + if (params2 > 1) + glPopMatrix(); + else { + /*printf(" MODELVIEW------- MODE ... POP is failing...!! %d \n", params2 );*/ + return Failed; } } return Succeeded; @@ -757,8 +757,8 @@ int pushmatrix() glPushMatrix(); } else{ - /*printf(" PROJECTION MODE ... PUUUUUUUUUUUUSH is failing...!! %d \n", params2 );*/ - return Failed; + /*printf(" PROJECTION MODE ... PUUUUUUUUUUUUSH is failing...!! %d \n", params2 );*/ + return Failed; } } @@ -768,10 +768,10 @@ int pushmatrix() */ glGetIntegerv(GL_MODELVIEW_STACK_DEPTH, ¶ms2); if (params2 < 32) - glPushMatrix(); + glPushMatrix(); else{ - /*printf(" MODELVIEW------- MODE ... PUUUUUUUUUUUUSH is failing...!! %d \n", params2 );*/ - return Failed; + /*printf(" MODELVIEW------- MODE ... PUUUUUUUUUUUUSH is failing...!! %d \n", params2 );*/ + return Failed; } } return Succeeded; @@ -816,7 +816,7 @@ int redraw3D(wbp w) #ifdef GraphicsGL copy_2dcontext(&(ws->wcrender), &(ws->wcdef)); init_2dcanvas(w); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (ws->is_3D) wc->dim = 3; @@ -832,7 +832,7 @@ int redraw3D(wbp w) glLoadIdentity(); glPushMatrix(); gluLookAt(ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, ws->eyediry, - ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); + ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); if (ws->is_3D) { glMaterialfv(GL_FRONT, GL_AMBIENT, deflt_ambient); glMaterialfv(GL_FRONT, GL_DIFFUSE, deflt_diffuse); @@ -840,26 +840,26 @@ int redraw3D(wbp w) glMaterialfv(GL_FRONT, GL_EMISSION, deflt_emission); glMaterialf(GL_FRONT, GL_SHININESS, 50.0); if (!wc->autogen) { - glEnable(GL_TEXTURE_GEN_S); - glEnable(GL_TEXTURE_GEN_T); - wc->autogen = 1; - } - } + glEnable(GL_TEXTURE_GEN_S); + glEnable(GL_TEXTURE_GEN_T); + wc->autogen = 1; + } + } /* if (wc->texmode) { - glDisable(GL_TEXTURE_2D); - wc->texmode = 0; - } + glDisable(GL_TEXTURE_2D); + wc->texmode = 0; + } */ if (traversefunctionlist(w) == Failed) { ws->busy_flag = 0; - return Failed; - } + return Failed; + } glPopMatrix(); } - else { /* GL_SELECT mode */ + else { /* GL_SELECT mode */ GLint viewport[4]; GLuint selectionbuf[1024]; /* selection buffer */ GLint selectionhits=0; /* number of hits */ @@ -883,7 +883,7 @@ int redraw3D(wbp w) glPushMatrix(); glLoadIdentity(); gluLookAt(ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, ws->eyediry, - ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); + ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); /* switch to GL_SELECT render mode */ @@ -891,7 +891,7 @@ int redraw3D(wbp w) glRenderMode(GL_SELECT); glInitNames(); - /* render the scene in GL_SELECT render mode */ + /* render the scene in GL_SELECT render mode */ if (traversefunctionlist(w) == Failed) { ws->busy_flag = 0; return Failed; @@ -902,13 +902,13 @@ int redraw3D(wbp w) if (selectionhits < 0) { ws->busy_flag = 0; - return Failed; + return Failed; } else if (selectionhits > 256) { /* too many hits? maybe nonsense then. */ ws->busy_flag = 0; - return Failed; - } - else if (selectionhits != 0) { /* > 0, hits were found */ + return Failed; + } + else if (selectionhits != 0) { /* > 0, hits were found */ GLuint name, numnames, z1, z_buf[256]; tended struct b_list *namelist; tended struct descrip selectednameslist; @@ -917,81 +917,81 @@ int redraw3D(wbp w) if ((namelist = alclist(0, MinListSlots)) == NULL) { ws->busy_flag = 0; - return Failed; - } + return Failed; + } selectednameslist.dword = D_List; selectednameslist.vword.bptr = (union block*) namelist; - /* - * First pass over the selection buffer to collect and sort z values. - */ + /* + * First pass over the selection buffer to collect and sort z values. + */ bufp = selectionbuf; for(j = 0; j < selectionhits; j++){ - if (bufp - selectionbuf > 1024 - 4) { - /* Reading this would go past the end of the selection buffer. */ - selectionhits = j; - break; - } - numnames = *bufp++; - z_buf[j] = *bufp++; - bufp++; /* skip z2 */ - bufp+=numnames; /* skip names */ + if (bufp - selectionbuf > 1024 - 4) { + /* Reading this would go past the end of the selection buffer. */ + selectionhits = j; + break; + } + numnames = *bufp++; + z_buf[j] = *bufp++; + bufp++; /* skip z2 */ + bufp+=numnames; /* skip names */ } - qsort(z_buf,selectionhits, sizeof(GLuint), compare_GLuint); + qsort(z_buf,selectionhits, sizeof(GLuint), compare_GLuint); /* second pass : get the data */ savedhits=0; while (savedhitsz_buf[savedhits]) { - bufp+=numnames; /* skip names */ - continue; - } - else { - tended char *tmpname; - tended struct descrip the_newselectedname; - int numnam=numnames, memsize=0; - GLuint *bufp2 = bufp; - /* - * z is 2 locations back. set it to 1 so that - * it will be skipped next time - */ - *(bufp-2)=1; - savedhits++; - while (numnam--) { - int i = *bufp2++; - if ((0 <= i) && (i < wc->selectionnamecount)) - memsize += strlen(wc->selectionnamelist[i])+1; - } - - Protect(tmpname = alcstr(NULL, memsize), return RunError); - tmpname[0] = '\0'; - - while (numnames) { - name = *bufp++; - --numnames; - /* - * Name being unsigned, it will never be negative, - * but it may be out of range. - */ - if (name < wc->selectionnamecount) { - strcat(tmpname, wc->selectionnamelist[name]); - if (numnames)strcat(tmpname, "-"); - } + numnames = *bufp++; + z1 = *bufp++; + bufp++; /* skip z2 */ + + if (z1 == 1 || z1>z_buf[savedhits]) { + bufp+=numnames; /* skip names */ + continue; + } + else { + tended char *tmpname; + tended struct descrip the_newselectedname; + int numnam=numnames, memsize=0; + GLuint *bufp2 = bufp; + /* + * z is 2 locations back. set it to 1 so that + * it will be skipped next time + */ + *(bufp-2)=1; + savedhits++; + while (numnam--) { + int i = *bufp2++; + if ((0 <= i) && (i < wc->selectionnamecount)) + memsize += strlen(wc->selectionnamelist[i])+1; + } + + Protect(tmpname = alcstr(NULL, memsize), return RunError); + tmpname[0] = '\0'; + + while (numnames) { + name = *bufp++; + --numnames; + /* + * Name being unsigned, it will never be negative, + * but it may be out of range. + */ + if (name < wc->selectionnamecount) { + strcat(tmpname, wc->selectionnamelist[name]); + if (numnames)strcat(tmpname, "-"); + } } /* while */ if ( strlen(tmpname) > 0 ){ - newnameadded=1; + newnameadded=1; MakeStr(tmpname, strlen(tmpname), &the_newselectedname); - c_put(&selectednameslist, &the_newselectedname); - } - }/* else*/ + c_put(&selectednameslist, &the_newselectedname); + } + }/* else*/ } /* for j */ } /* savedhits */ @@ -1045,23 +1045,23 @@ int c_realarray(struct b_list *hp, int m, int n, double *a) used = bp->nused; for (j=0; j < n; j++){ if (j >= (m-1)) { - d = bp->lslots[i]; + d = bp->lslots[i]; if (!cnv:real(d, d)) return 0; - bp->lslots[i] = d; + bp->lslots[i] = d; #ifdef DescriptorDouble - a[j-(m-1)] = d.vword.realval; -#else /* DescriptorDouble */ - a[j-(m-1)] = BlkD(d, Real)->realval; -#endif /* DescriptorDouble */ - } + a[j-(m-1)] = d.vword.realval; +#else /* DescriptorDouble */ + a[j-(m-1)] = BlkD(d, Real)->realval; +#endif /* DescriptorDouble */ + } if (used <= 1){ - bp = (struct b_lelem *) bp->listnext; + bp = (struct b_lelem *) bp->listnext; used = bp->nused; i = bp->first; } else { - if (i++ >= bp->nslots) i = 0; - used--; + if (i++ >= bp->nslots) i = 0; + used--; } } return 1; @@ -1070,8 +1070,8 @@ int c_realarray(struct b_list *hp, int m, int n, double *a) /* * Traverse the 2d and 3d display lists to redraw the scene. * Optimizations should be added to determine whether a display list is - * empty and should be skipped. - * + * empty and should be skipped. + * * The order of operations on matrix transfomations seems to be reversed, * hence why glLoadIdentity() is called before drawing the 2d scene. * The HUD should be drawn from the modelview matrix resulting from @@ -1083,7 +1083,7 @@ int c_realarray(struct b_list *hp, int m, int n, double *a) * Draw 3d first and 2d last to preserve the back-to-front rendering for * transparency. */ -int traversefunctionlist(wbp w) +int traversefunctionlist(wbp w) { wsp ws = w->window; int rendermode = ws->rendermode; @@ -1094,7 +1094,7 @@ int traversefunctionlist(wbp w) if (traversefunclist(w) == Failed) { /* 3d */ ApplyRendermode(w, rendermode); - return Failed; + return Failed; } } @@ -1107,7 +1107,7 @@ int traversefunctionlist(wbp w) if (traversefunclist2d(w) == Failed) { /* 2d */ ApplyRendermode(w, rendermode); - return Failed; + return Failed; } glPopMatrix(); glEnable(GL_LIGHTING); @@ -1120,7 +1120,7 @@ int traversefunctionlist(wbp w) /* update screen */ FlushWindow(w); - return Succeeded; + return Succeeded; } /* @@ -1167,155 +1167,155 @@ int traversefunclist(wbp w) for (i=0; i< elements; i++) { if (count>2) { /* skip forward as much as possible */ - int asmuchaspossible = count-1; - if (used <= asmuchaspossible) asmuchaspossible = used-1; - if (asmuchaspossible >1) { - used -= asmuchaspossible; - k = (k+asmuchaspossible) % (bp->nslots); - count -= asmuchaspossible; - i += asmuchaspossible; - } - } + int asmuchaspossible = count-1; + if (used <= asmuchaspossible) asmuchaspossible = used-1; + if (asmuchaspossible >1) { + used -= asmuchaspossible; + k = (k+asmuchaspossible) % (bp->nslots); + count -= asmuchaspossible; + i += asmuchaspossible; + } + } flist = bp->lslots[k]; k++; used--; if (k>=bp->nslots) k=0; if (used<=0) { - bp = (struct b_lelem *) bp->listnext; - used = bp->nused; + bp = (struct b_lelem *) bp->listnext; + used = bp->nused; k = bp->first; } if (count) { count--; continue; - } + } if (v != v2) free(v); v = v2; vsize = 256; if (is:record(flist)) { - rp = BlkD(flist, Record); - fname = rp->fields[0]; + rp = BlkD(flist, Record); + fname = rp->fields[0]; tmp = IntVal(rp->fields[1]); - if (tmp == -1) { - return Failed; /* probably should runerr on this */ - } - for (j=0; j < (tmp&15); j++) { - var1 = rp->fields[j+2]; - if (!cnv:C_double(var1, v[j])) goto free_v_and_fail; - } - - switch(tmp & ~0xf) { - case REDRAW_TORUS: - torus(v[3], v[4], v[0], v[1], v[2], - wc->slices, /* slices */ - wc->rings, /* rings */ - (wc->texmode?wc->autogen:0)); - break; - case REDRAW_CUBE: - cube(v[3], v[0], v[1], v[2], (wc->texmode?wc->autogen:0)); - break; - case REDRAW_SPHERE: - sphere(v[3], v[0], v[1], v[2], - wc->slices, /* slices */ - wc->rings, /* rings */ - (wc->texmode?wc->autogen:0)); - break; - case REDRAW_CYLINDER: - cylinder(v[4], v[5], v[3], v[0], v[1], v[2], - wc->slices, /* slices */ - wc->rings, /* rings */ - (wc->texmode?wc->autogen:0)); - break; - case REDRAW_DISK: - disk(v[3], v[4], v[5], v[6], v[0], v[1], v[2], - wc->slices, /* slices */ - wc->rings, /* rings */ - (wc->texmode?wc->autogen:0)); - break; - case REDRAW_ROTATE: - glRotated(v[3], v[0], v[1], v[2]); - break; - case REDRAW_TRANSLATE: - glTranslated(v[0], v[1], v[2]); - break; - case REDRAW_SCALE: - glScaled(v[0], v[1], v[2]); - break; - case REDRAW_POPMATRIX: - if (popmatrix() != Succeeded) goto free_v_and_fail; - break; - case REDRAW_PUSHMATRIX: - if (pushmatrix() != Succeeded) goto free_v_and_fail; - break; - case REDRAW_IDENTITY: - glLoadIdentity(); - break; - case REDRAW_MATRIXMODE: - if (!cnv:C_string(rp->fields[2], temp)) goto free_v_and_fail; - if (!strcmp("modelview", temp)) glMatrixMode(GL_MODELVIEW); - else if (!strcmp("projection", temp)) glMatrixMode(GL_PROJECTION); - break; - case REDRAW_TEXTURE: - /* - * lookup the name of the texture and bind it + if (tmp == -1) { + return Failed; /* probably should runerr on this */ + } + for (j=0; j < (tmp&15); j++) { + var1 = rp->fields[j+2]; + if (!cnv:C_double(var1, v[j])) goto free_v_and_fail; + } + + switch(tmp & ~0xf) { + case REDRAW_TORUS: + torus(v[3], v[4], v[0], v[1], v[2], + wc->slices, /* slices */ + wc->rings, /* rings */ + (wc->texmode?wc->autogen:0)); + break; + case REDRAW_CUBE: + cube(v[3], v[0], v[1], v[2], (wc->texmode?wc->autogen:0)); + break; + case REDRAW_SPHERE: + sphere(v[3], v[0], v[1], v[2], + wc->slices, /* slices */ + wc->rings, /* rings */ + (wc->texmode?wc->autogen:0)); + break; + case REDRAW_CYLINDER: + cylinder(v[4], v[5], v[3], v[0], v[1], v[2], + wc->slices, /* slices */ + wc->rings, /* rings */ + (wc->texmode?wc->autogen:0)); + break; + case REDRAW_DISK: + disk(v[3], v[4], v[5], v[6], v[0], v[1], v[2], + wc->slices, /* slices */ + wc->rings, /* rings */ + (wc->texmode?wc->autogen:0)); + break; + case REDRAW_ROTATE: + glRotated(v[3], v[0], v[1], v[2]); + break; + case REDRAW_TRANSLATE: + glTranslated(v[0], v[1], v[2]); + break; + case REDRAW_SCALE: + glScaled(v[0], v[1], v[2]); + break; + case REDRAW_POPMATRIX: + if (popmatrix() != Succeeded) goto free_v_and_fail; + break; + case REDRAW_PUSHMATRIX: + if (pushmatrix() != Succeeded) goto free_v_and_fail; + break; + case REDRAW_IDENTITY: + glLoadIdentity(); + break; + case REDRAW_MATRIXMODE: + if (!cnv:C_string(rp->fields[2], temp)) goto free_v_and_fail; + if (!strcmp("modelview", temp)) glMatrixMode(GL_MODELVIEW); + else if (!strcmp("projection", temp)) glMatrixMode(GL_PROJECTION); + break; + case REDRAW_TEXTURE: + /* + * lookup the name of the texture and bind it * the objects using glBindTexture() - */ - if (!cnv:C_integer(rp->fields[2], num)) { - goto free_v_and_fail; - } - glBindTexture(GL_TEXTURE_2D, wc->display->stex[num].texName); - if (wc->texmode) - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, wc->texmode); - break; + */ + if (!cnv:C_integer(rp->fields[2], num)) { + goto free_v_and_fail; + } + glBindTexture(GL_TEXTURE_2D, wc->display->stex[num].texName); + if (wc->texmode) + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, wc->texmode); + break; case REDRAW_FONT3D: #if HAVE_LIBFTGL - curr_font = (wfont *) IntVal(rp->fields[2]); -#endif /* HAVE_LIBFTGL */ - break; + curr_font = (wfont *) IntVal(rp->fields[2]); +#endif /* HAVE_LIBFTGL */ + break; case REDRAW_DRAWSTRING3D: #if HAVE_LIBFTGL - if (!cnv:C_double(rp->fields[2], v[0])) goto free_v_and_fail; - if (!cnv:C_double(rp->fields[3], v[1])) goto free_v_and_fail; - if (!cnv:C_double(rp->fields[4], v[2])) goto free_v_and_fail; - if (!cnv:C_string(rp->fields[5], s)) goto free_v_and_fail; - drawstrng3d(w,v[0],v[1],v[2],s); -#endif /* HAVE_LIBFTGL */ + if (!cnv:C_double(rp->fields[2], v[0])) goto free_v_and_fail; + if (!cnv:C_double(rp->fields[3], v[1])) goto free_v_and_fail; + if (!cnv:C_double(rp->fields[4], v[2])) goto free_v_and_fail; + if (!cnv:C_string(rp->fields[5], s)) goto free_v_and_fail; + drawstrng3d(w,v[0],v[1],v[2],s); +#endif /* HAVE_LIBFTGL */ break; case REDRAW_MARK: { - struct descrip d = BlkLoc(flist)->Record.fields[3]; + struct descrip d = BlkLoc(flist)->Record.fields[3]; if (is:integer(d) && IntVal(d)==1) { - count = IntVal(BlkLoc(flist)->Record.fields[4]); + count = IntVal(BlkLoc(flist)->Record.fields[4]); } else count=0; - if (!count && wc->selectionenabled && wc->selectionrendermode ){ - GLuint int_code = IntVal(BlkLoc(flist)->Record.fields[5]); + if (!count && wc->selectionenabled && wc->selectionrendermode ){ + GLuint int_code = IntVal(BlkLoc(flist)->Record.fields[5]); glPushName(int_code); } - } - break; - case REDRAW_ENDMARK: - if (wc->selectionenabled && wc->selectionrendermode) - glPopName(); - break; - case REDRAW_MESHMODE: + } + break; + case REDRAW_ENDMARK: + if (wc->selectionenabled && wc->selectionrendermode) + glPopName(); + break; + case REDRAW_MESHMODE: if (!cnv:C_integer(rp->fields[2], num)) goto free_v_and_fail; w->context->meshmode = num; break; - default: - fprintf(stderr,"invalid displaylist entry '%s'\n", - (is:string(fname) ? StrLoc(fname) : "(corrupted)")); + default: + fprintf(stderr,"invalid displaylist entry '%s'\n", + (is:string(fname) ? StrLoc(fname) : "(corrupted)")); goto free_v_and_fail; - } - continue; - } + } + continue; + } else if (is:list(flist)) { - funclist = (struct b_list*)flist.vword.bptr; + funclist = (struct b_list*)flist.vword.bptr; if (funclist->size<=1) continue; bp1 = (struct b_lelem *) funclist->listhead; if (bp1->nused<=0) { @@ -1330,30 +1330,30 @@ int traversefunclist(wbp w) used1 = bp1->nused-1; if (used1<=0) { bp1 = (struct b_lelem *) bp1->listnext; - k1 = bp1->first; + k1 = bp1->first; funclist->listhead = (union block *) bp1; bp1->listprev = (union block *) funclist; } - if (! is:integer(bp1->lslots[k1])) { /* should check for large int! */ - return RunError; - } + if (! is:integer(bp1->lslots[k1])) { /* should check for large int! */ + return RunError; + } tmp = IntVal(bp1->lslots[k1]); /* OK, at this point, k1 has been preset to refer to the int code */ - if (funclist->size-1 > vsize) { - if (v == v2) - v = calloc(funclist->size, sizeof (double)); - else { - v = realloc(v, funclist->size * sizeof (double)); - } - vsize = funclist->size-1; - if (v == NULL) return RunError; - } + if (funclist->size-1 > vsize) { + if (v == v2) + v = calloc(funclist->size, sizeof (double)); + else { + v = realloc(v, funclist->size * sizeof (double)); + } + vsize = funclist->size-1; + if (v == NULL) return RunError; + } switch(tmp & ~0xf) { case REDRAW_FG: - /* Fg() or WAttrib("fg=...") */ + /* Fg() or WAttrib("fg=...") */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; @@ -1366,7 +1366,7 @@ int traversefunclist(wbp w) d = bp1->lslots[k1]; if (!cnv:C_string(d, temp)) - return Failed; + return Failed; if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1380,7 +1380,7 @@ int traversefunclist(wbp w) d = bp1->lslots[k1]; if (!cnv:C_integer(d, r)) - return Failed; + return Failed; if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1394,7 +1394,7 @@ int traversefunclist(wbp w) d = bp1->lslots[k1]; if (!cnv:C_integer(d, g)) - return Failed; + return Failed; if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1408,7 +1408,7 @@ int traversefunclist(wbp w) d = bp1->lslots[k1]; if (!cnv:C_integer(d, b)) - return Failed; + return Failed; if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1422,19 +1422,19 @@ int traversefunclist(wbp w) d = bp1->lslots[k1]; if (!cnv:C_integer(d, a)) - return Failed; + return Failed; - if(!determinematerial(temp, r, g, b, a)) { - /* - if(!determinematerial(funclist)) { - */ + if(!determinematerial(temp, r, g, b, a)) { + /* + if(!determinematerial(funclist)) { + */ free_v_and_fail: - if (v != v2) free(v); - return Failed; - } - break; + if (v != v2) free(v); + return Failed; + } + break; case REDRAW_DIM: - /* WAttrib("dim=...") */ + /* WAttrib("dim=...") */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; @@ -1446,12 +1446,12 @@ int traversefunclist(wbp w) } var1 = bp1->lslots[k1]; - if ((!cnv:C_integer(var1, dim))||(dim<1)||(dim>3)) - goto free_v_and_fail; + if ((!cnv:C_integer(var1, dim))||(dim<1)||(dim>3)) + goto free_v_and_fail; wc->dim = dim; - break; + break; case REDRAW_LINEWIDTH: - /* WAttrib("linewidth=...") */ + /* WAttrib("linewidth=...") */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; @@ -1464,16 +1464,16 @@ int traversefunclist(wbp w) var1 = bp1->lslots[k1]; if (!cnv:C_integer(var1, num)) goto free_v_and_fail; - setlinewidth(w, num); + setlinewidth(w, num); glLineWidth(num); - break; + break; case REDRAW_PICK: - /* WAttrib("pick=...") */ + /* WAttrib("pick=...") */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; k1 = bp1->first; - } + } else { if (k1++>=bp1->nslots) k1=0; used1--; @@ -1482,10 +1482,10 @@ int traversefunclist(wbp w) if (!cnv:C_integer(var1, num)) goto free_v_and_fail; - wc->selectionenabled = num; - break; + wc->selectionenabled = num; + break; case REDRAW_TEXMODE: - /* WAttrib("texmode=...") */ + /* WAttrib("texmode=...") */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; @@ -1502,7 +1502,7 @@ int traversefunclist(wbp w) /* texturing is on */ if (num) { if (wc->texmode == 0) - glEnable(GL_TEXTURE_2D); + glEnable(GL_TEXTURE_2D); wc->texmode = num; } @@ -1511,75 +1511,75 @@ int traversefunclist(wbp w) if (wc->texmode != 0) glDisable(GL_TEXTURE_2D); wc->texmode = 0; - } - break; - case REDRAW_SLICES: - /* WAttrib("slices=...") */ + } + break; + case REDRAW_SLICES: + /* WAttrib("slices=...") */ if (used1<=1) { - bp1=(struct b_lelem *) bp1->listnext; - used1 = bp1->nused; - k1 = bp1->first; - } - else { - if (k1++>=bp1->nslots) k1=0; - used1--; - } - var1 = bp1->lslots[k1]; - - if (!cnv:C_integer(var1, num)) goto free_v_and_fail; - - /* make sure slice is more than 0, otherwise just ignore */ + bp1=(struct b_lelem *) bp1->listnext; + used1 = bp1->nused; + k1 = bp1->first; + } + else { + if (k1++>=bp1->nslots) k1=0; + used1--; + } + var1 = bp1->lslots[k1]; + + if (!cnv:C_integer(var1, num)) goto free_v_and_fail; + + /* make sure slice is more than 0, otherwise just ignore */ if (num>0) - wc->slices = num; - break; - case REDRAW_RINGS: - /* WAttrib("rings=...") */ + wc->slices = num; + break; + case REDRAW_RINGS: + /* WAttrib("rings=...") */ if (used1<=1) { - bp1=(struct b_lelem *) bp1->listnext; - used1 = bp1->nused; - k1 = bp1->first; - } - else { - if (k1++>=bp1->nslots) k1=0; - used1--; - } - var1 = bp1->lslots[k1]; - - if (!cnv:C_integer(var1, num)) goto free_v_and_fail; - - /* make sure rings is more than 0, otherwise just ignore */ + bp1=(struct b_lelem *) bp1->listnext; + used1 = bp1->nused; + k1 = bp1->first; + } + else { + if (k1++>=bp1->nslots) k1=0; + used1--; + } + var1 = bp1->lslots[k1]; + + if (!cnv:C_integer(var1, num)) goto free_v_and_fail; + + /* make sure rings is more than 0, otherwise just ignore */ if (num>0) - wc->rings = num; - break; - case REDRAW_NORMODE: - /* WAttrib("normode=...") */ + wc->rings = num; + break; + case REDRAW_NORMODE: + /* WAttrib("normode=...") */ if (used1<=1) { - bp1=(struct b_lelem *) bp1->listnext; - used1 = bp1->nused; - k1 = bp1->first; - } - else { - if (k1++>=bp1->nslots) k1=0; - used1--; - } - var1 = bp1->lslots[k1]; - - if (!cnv:C_integer(var1, num)) goto free_v_and_fail; - - /* normals is off */ + bp1=(struct b_lelem *) bp1->listnext; + used1 = bp1->nused; + k1 = bp1->first; + } + else { + if (k1++>=bp1->nslots) k1=0; + used1--; + } + var1 = bp1->lslots[k1]; + + if (!cnv:C_integer(var1, num)) goto free_v_and_fail; + + /* normals is off */ if (num==0) - wc->normode = 0; - /* normals is on */ + wc->normode = 0; + /* normals is on */ else if (num==2) - wc->normode = 2; - /* default is auto*/ + wc->normode = 2; + /* default is auto*/ else - wc->normode = 1; - break; + wc->normode = 1; + break; case REDRAW_TEXCOORD: /* Texcoord() or WAttrib("texcoord=...") */ /* - * first element tells us if opengl generates texture coordinates - */ + * first element tells us if opengl generates texture coordinates + */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; used1 = bp1->nused; @@ -1601,83 +1601,83 @@ int traversefunclist(wbp w) /* there is a list of texture coordinates to use */ else { - struct b_realarray *ap; + struct b_realarray *ap; glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); wc->autogen = 0; - + if (used1 <= 1){ - bp1 = (struct b_lelem *) bp1->listnext; + bp1 = (struct b_lelem *) bp1->listnext; used1 = bp1->nused; k1 = bp1->first; } else { - if (k1++ >= bp1->nslots) k1 = 0; - used1--; + if (k1++ >= bp1->nslots) k1 = 0; + used1--; } if (used1>0) { - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title != T_Realarray) { - fprintf(stderr,"traversefunctionlist/Texcoord: " - "real array expected\n"); - return Failed; - } - wc->numtexcoords = BlkD(d, List)->size; - wc->texcoords = ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title != T_Realarray) { + fprintf(stderr,"traversefunctionlist/Texcoord: " + "real array expected\n"); + return Failed; + } + wc->numtexcoords = BlkD(d, List)->size; + wc->texcoords = ap; } } - break; + break; case REDRAW_NORMALS: /* Normals() */ /* there is a list of normal coordinates to use */ if (used1 <= 1){ - bp1 = (struct b_lelem *) bp1->listnext; + bp1 = (struct b_lelem *) bp1->listnext; used1 = bp1->nused; k1 = bp1->first; } else { - if (k1++ >= bp1->nslots) k1 = 0; - used1--; + if (k1++ >= bp1->nslots) k1 = 0; + used1--; } if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_NORMALS: NOT a real Array!!..\n"); - return Failed; - } - wc->numnormals = BlkD(d, List)->size; - wc->normals = ap; + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_NORMALS: NOT a real Array!!..\n"); + return Failed; + } + wc->numnormals = BlkD(d, List)->size; + wc->normals = ap; } - break; + break; case REDRAW_MULTMATRIX: /* MultMatrix() */ /* check if we have a list of size 16 */ if (used1 <= 1){ - bp1 = (struct b_lelem *) bp1->listnext; + bp1 = (struct b_lelem *) bp1->listnext; used1 = bp1->nused; k1 = bp1->first; } else { - if (k1++ >= bp1->nslots) k1 = 0; - used1--; + if (k1++ >= bp1->nslots) k1 = 0; + used1--; } if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_MULTMATRIX: NOT a real Array!!..\n"); - return Failed; - } + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_MULTMATRIX: NOT a real Array!!..\n"); + return Failed; + } #if HAVE_LIBGL - glMultMatrixd((GLdouble *)ap->a); -#endif /* HAVE_LIBGL */ + glMultMatrixd((GLdouble *)ap->a); +#endif /* HAVE_LIBGL */ } /*used1>0 */ - break; + break; case REDRAW_POLYGON: /* DrawPolygon() */ /* element in position 1 is the dim attribute */ if (used1<=1) { @@ -1691,17 +1691,17 @@ int traversefunclist(wbp w) } if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_POLYGON: NOT a real Array!!..\n"); - return Failed; - } - /* call drawpoly with meshmode to get something polygonish */ - drawpoly(w, ap->a, BlkD(d, List)->size , w->context->meshmode, wc->dim); - } /*used1>0 */ - break; + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_POLYGON: NOT a real Array!!..\n"); + return Failed; + } + /* call drawpoly with meshmode to get something polygonish */ + drawpoly(w, ap->a, BlkD(d, List)->size , w->context->meshmode, wc->dim); + } /*used1>0 */ + break; case REDRAW_FILLPOLYGON: /* FillPolygon() */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1712,19 +1712,19 @@ int traversefunclist(wbp w) if (k1++>=bp1->nslots) k1=0; used1--; } - + if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_FILLPOLYGON: NOT a real Array!!..\n"); - return Failed; - } - /* call drawpoly with meshmode to get something polygonish */ - drawpoly(w, ap->a, BlkD(d, List)->size , w->context->meshmode, wc->dim); - } /*used1>0 */ - break; + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_FILLPOLYGON: NOT a real Array!!..\n"); + return Failed; + } + /* call drawpoly with meshmode to get something polygonish */ + drawpoly(w, ap->a, BlkD(d, List)->size , w->context->meshmode, wc->dim); + } /*used1>0 */ + break; case REDRAW_SEGMENT: /* DrawSegment() */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1735,19 +1735,19 @@ int traversefunclist(wbp w) if (k1++>=bp1->nslots) k1=0; used1--; } - + if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_SEGMENT: NOT a real Array!!..\n"); - return Failed; - } - /* call drawpoly with GL_LINES to get segments */ - drawpoly(w, ap->a, BlkD(d, List)->size , GL_LINES, wc->dim); - } /*used1>0 */ - break; + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_SEGMENT: NOT a real Array!!..\n"); + return Failed; + } + /* call drawpoly with GL_LINES to get segments */ + drawpoly(w, ap->a, BlkD(d, List)->size , GL_LINES, wc->dim); + } /*used1>0 */ + break; case REDRAW_LINE: /* DrawLine() */ if (used1<=0) { bp1=(struct b_lelem *) bp1->listnext; @@ -1759,18 +1759,18 @@ int traversefunclist(wbp w) used1--; } - if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_LINE: NOT a real Array!!..\n"); - return Failed; - } - /* call drawpoly with GL_LINE_STRIP to get lines */ - drawpoly(w, ap->a, BlkD(d, List)->size , GL_LINE_STRIP, wc->dim); - } /*used1>0 */ - break; + if (used1>0) { + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_LINE: NOT a real Array!!..\n"); + return Failed; + } + /* call drawpoly with GL_LINE_STRIP to get lines */ + drawpoly(w, ap->a, BlkD(d, List)->size , GL_LINE_STRIP, wc->dim); + } /*used1>0 */ + break; case REDRAW_POINT: /* DrawPoint() */ if (used1<=1) { bp1=(struct b_lelem *) bp1->listnext; @@ -1781,27 +1781,27 @@ int traversefunclist(wbp w) if (k1++>=bp1->nslots) k1=0; used1--; } - if (used1>0) { - struct b_realarray *ap; - d = bp1->lslots[k1]; - ap = (struct b_realarray *) BlkD(d, List)->listhead; - if (ap->title!=T_Realarray){ - printf("REDRAW_POINT: NOT a real Array!!..\n"); - return Failed; - } - /* call drawpoly with GL_POINTS to get points */ - drawpoly(w, ap->a, BlkD(d, List)->size , GL_POINTS, wc->dim); - } /*used1>0 */ - break; + if (used1>0) { + struct b_realarray *ap; + d = bp1->lslots[k1]; + ap = (struct b_realarray *) BlkD(d, List)->listhead; + if (ap->title!=T_Realarray){ + printf("REDRAW_POINT: NOT a real Array!!..\n"); + return Failed; + } + /* call drawpoly with GL_POINTS to get points */ + drawpoly(w, ap->a, BlkD(d, List)->size , GL_POINTS, wc->dim); + } /*used1>0 */ + break; default: - fprintf(stderr,"invalid displaylist entry '%s'\n", - (is:string(fname) ? StrLoc(fname) : "(corrupted)")); - goto free_v_and_fail; - } /* switch tmp */ + fprintf(stderr,"invalid displaylist entry '%s'\n", + (is:string(fname) ? StrLoc(fname) : "(corrupted)")); + goto free_v_and_fail; + } /* switch tmp */ } /* else if is:list */ else { - return Failed; - } + return Failed; + } } if (v!=v2) free(v); @@ -1934,8 +1934,8 @@ int setmaterials(wbp w, char* s) /* create a list element for each material property */ if (create3Dlisthdr(&f, "Fg", 7)!=Succeeded) - return RunError; - + return RunError; + /* * parse the string to determine the material property and its value */ @@ -1943,7 +1943,7 @@ int setmaterials(wbp w, char* s) while(s[i] && isalpha(s[i])) { sbuf1[k] = s[i]; i++; k++; - } + } sbuf1[k] = '\0'; /* ambient */ @@ -1953,7 +1953,7 @@ int setmaterials(wbp w, char* s) while(s[i] != '\0' && s[i] != ';') { sbuf2[j] = s[i]; i++; j++; - } + } sbuf2[j] = '\0'; /* determine the icon color */ if(parsecolor(w,sbuf2, &rd, &gr, &bl, &al)== Failed) @@ -1967,47 +1967,47 @@ int setmaterials(wbp w, char* s) glMaterialfv(GL_FRONT, GL_AMBIENT, color); MakeStr("ambient", 7, &material); c_put(&f, &material); - } + } /* diffuse */ else if(!strcmp(sbuf1, "diffuse")) { - while(isspace(s[i])) i++; - if(s[i] == '\0') return Failed; - while(s[i] != '\0' && s[i] != ';') { - sbuf2[j] = s[i]; - i++; j++; - } - sbuf2[j] = '\0'; + while(isspace(s[i])) i++; + if(s[i] == '\0') return Failed; + while(s[i] != '\0' && s[i] != ';') { + sbuf2[j] = s[i]; + i++; j++; + } + sbuf2[j] = '\0'; /* determine the appropriate icon color */ - if(parsecolor(w,sbuf2, &rd, &gr, &bl, &al)==Failed) + if(parsecolor(w,sbuf2, &rd, &gr, &bl, &al)==Failed) return Failed; /* convert values to floats between 0.0 and 1.0 */ - color[0] = rd/(GLfloat)65535; - color[1] = gr/(GLfloat)65535; - color[2] = bl/(GLfloat)65535; - color[3] = al/(GLfloat)65535; + color[0] = rd/(GLfloat)65535; + color[1] = gr/(GLfloat)65535; + color[2] = bl/(GLfloat)65535; + color[3] = al/(GLfloat)65535; /* set the property */ - glMaterialfv(GL_FRONT, GL_DIFFUSE, color); - MakeStr("diffuse", 7, &material); - c_put(&f, &material); - } + glMaterialfv(GL_FRONT, GL_DIFFUSE, color); + MakeStr("diffuse", 7, &material); + c_put(&f, &material); + } /* specular */ else if (!strcmp(sbuf1, "specular")) { while(isspace(s[i])) i++; if(s[i] == '\0') return Failed; while(s[i] != '\0' && s[i] != ';') { - sbuf2[j] = s[i]; - i++; j++; - } - sbuf2[j] = '\0'; + sbuf2[j] = s[i]; + i++; j++; + } + sbuf2[j] = '\0'; /* - * determine the icon color and convert to a float between 0.0 and 1.0 - */ + * determine the icon color and convert to a float between 0.0 and 1.0 + */ if(parsecolor(w, sbuf2, &rd, &gr,&bl,&al)==Failed) return Failed; color[0] = rd/(GLfloat)65535; @@ -2019,67 +2019,67 @@ int setmaterials(wbp w, char* s) glMaterialfv(GL_FRONT, GL_SPECULAR, color); MakeStr("specular", 8, &material); c_put(&f, &material); - } + } /* shininess */ else if(!strcmp(sbuf1, "shininess")) { - while(isspace(s[i])) i++; - if(s[i] == '\0') return Failed; - while(s[i] != '\0' && s[i] != ';') { - sbuf2[j] = s[i]; - i++; j++; - } - sbuf2[j] = '\0'; - - /* set the shininess */ - shine = atof(sbuf2); - glMaterialf(GL_FRONT, GL_SHININESS, shine); + while(isspace(s[i])) i++; + if(s[i] == '\0') return Failed; + while(s[i] != '\0' && s[i] != ';') { + sbuf2[j] = s[i]; + i++; j++; + } + sbuf2[j] = '\0'; + + /* set the shininess */ + shine = atof(sbuf2); + glMaterialf(GL_FRONT, GL_SHININESS, shine); MakeStr("shininess", 9, &material); - c_put(&f, &material); - rd = shine; - gr = 0; - bl = 0; - } + c_put(&f, &material); + rd = shine; + gr = 0; + bl = 0; + } /* emission */ else if(!strcmp(sbuf1, "emission")) { - while(isspace(s[i])) i++; - if(s[i] == '\0') return Failed; - while(s[i] != '\0' && s[i] != ';') { - sbuf2[j] = s[i]; - i++; j++; - } - sbuf2[j] = '\0'; - - /* - * determine r, g, b and convert them to floats between 0.0 and 1.0 - */ - if(parsecolor(w, sbuf2, &rd, &gr,&bl,&al)==Failed) - return Failed; - color[0] = rd/(GLfloat)65535; - color[1] = gr/(GLfloat)65535; - color[2] = bl/(GLfloat)65535; - color[3] = al/(GLfloat)65535; - - /* set the emission color */ - glMaterialfv(GL_FRONT, GL_EMISSION, color); + while(isspace(s[i])) i++; + if(s[i] == '\0') return Failed; + while(s[i] != '\0' && s[i] != ';') { + sbuf2[j] = s[i]; + i++; j++; + } + sbuf2[j] = '\0'; + + /* + * determine r, g, b and convert them to floats between 0.0 and 1.0 + */ + if(parsecolor(w, sbuf2, &rd, &gr,&bl,&al)==Failed) + return Failed; + color[0] = rd/(GLfloat)65535; + color[1] = gr/(GLfloat)65535; + color[2] = bl/(GLfloat)65535; + color[3] = al/(GLfloat)65535; + + /* set the emission color */ + glMaterialfv(GL_FRONT, GL_EMISSION, color); MakeStr("emission", 8, &material); - c_put(&f, &material); - } + c_put(&f, &material); + } /* otherwise set the current foreground color; treat as diffuse */ else { - if(setfg(w, s) == Failed) return Failed; + if(setfg(w, s) == Failed) return Failed; if(parsecolor(w, s, &rd, &gr, &bl, &al)==Failed) return Failed; - i = strlen(s); - color[0] = rd/(GLfloat)65535; - color[1] = gr/(GLfloat)65535; - color[2] = bl/(GLfloat)65535; - color[3] = al/(GLfloat)65535; - glColor4f(color[0], color[1], color[2], color[3]); - glMaterialfv(GL_FRONT, GL_DIFFUSE, color); + i = strlen(s); + color[0] = rd/(GLfloat)65535; + color[1] = gr/(GLfloat)65535; + color[2] = bl/(GLfloat)65535; + color[3] = al/(GLfloat)65535; + glColor4f(color[0], color[1], color[2], color[3]); + glMaterialfv(GL_FRONT, GL_DIFFUSE, color); MakeStr("diffuse", 7, &material); - c_put(&f, &material); + c_put(&f, &material); } /* put material property values on the list */ @@ -2134,7 +2134,7 @@ int setlight(wbp w, char* s, int light) /* query opengl to make sure the light is not already off */ glGetBooleanv(light, ¶ms); if (params) - glDisable(light); + glDisable(light); s2 = s2 + 3; if(*s2 != ',' && *s2 != '\0') return Failed; if(*s2 == ',') s2++; @@ -2153,11 +2153,11 @@ int setlight(wbp w, char* s, int light) } s3[i] = '\0'; /* - * Determine the r, g, b values. Convert from an integer between - * 0 and 65535 to a float between 0.0 and 1.0 - */ + * Determine the r, g, b values. Convert from an integer between + * 0 and 65535 to a float between 0.0 and 1.0 + */ if(parsecolor(w, s3, &rd, &gr, &bl, &al) ==Failed) - return Failed; + return Failed; color[0] = rd/(GLfloat)65535; color[1] = gr/(GLfloat)65535; @@ -2167,8 +2167,8 @@ int setlight(wbp w, char* s, int light) /* set the ambient light value */ glLightfv(light, GL_AMBIENT, color); s2 = s2 + i; - if(*s2 != ';' && *s2 != '\0') return Failed; - if(*s2 != '\0') s2++; + if(*s2 != ';' && *s2 != '\0') return Failed; + if(*s2 != '\0') s2++; } /* set the diffuse lighting values */ @@ -2184,7 +2184,7 @@ int setlight(wbp w, char* s, int light) /* convert the icon r, g, b values to floats between 0.0 and 1.0 */ if(parsecolor(w, s3, &rd, &gr, &bl,&al) == Failed) - return Failed; + return Failed; color[0] = rd/(GLfloat)65535; color[1] = gr/(GLfloat)65535; color[2] = bl/(GLfloat)65535; @@ -2193,8 +2193,8 @@ int setlight(wbp w, char* s, int light) /* set the diffuse value of the light */ glLightfv(light, GL_DIFFUSE, color); s2 = s2 + i; - if (*s2 != ';' && *s2 != '\0') return Failed; - if (*s2 != '\0') s2++; + if (*s2 != ';' && *s2 != '\0') return Failed; + if (*s2 != '\0') s2++; } /* set the specular lighting values */ if (!strncmp(s2, "specular", 8)) { @@ -2207,7 +2207,7 @@ int setlight(wbp w, char* s, int light) } s3[i] = '\0'; /* convert to appropriate values */ - if (parsecolor(w, s3, &rd, &gr, &bl, &al) == Failed) + if (parsecolor(w, s3, &rd, &gr, &bl, &al) == Failed) return Failed; color[0] = rd/(GLfloat)65535; color[1] = gr/(GLfloat)65535; @@ -2215,29 +2215,29 @@ int setlight(wbp w, char* s, int light) color[3] = al/(GLfloat)65535; glLightfv(light, GL_SPECULAR, color); s2 = s2 + i; - if (*s2 != ';' && *s2 != '\0') return Failed; - if (*s2 != '\0') s2++; + if (*s2 != ';' && *s2 != '\0') return Failed; + if (*s2 != '\0') s2++; } /* set the positon of the light */ - if (!strncmp(s2, "position", 8)) { + if (!strncmp(s2, "position", 8)) { s2 = s2 + 8; - for (j = 0; j < 2; j++) { - while (isspace(*s2)) s2++; + for (j = 0; j < 2; j++) { + while (isspace(*s2)) s2++; i = 0; - if (*s2 == '\0') return Failed; - while (s2[i] != '\0' && s2[i] != ',') { + if (*s2 == '\0') return Failed; + while (s2[i] != '\0' && s2[i] != ',') { s3[i] = s2[i]; i++; } s3[i] = '\0'; color[j] = atof(s3); s2 = s2 + i; - if (*s2 != ',') return Failed; + if (*s2 != ',') return Failed; s2++; } - while (isspace(*s2)) s2++; - if (*s2 == '\0') return Failed; - while (s2[i] != '\0' && s2[i] != ';') { + while (isspace(*s2)) s2++; + if (*s2 == '\0') return Failed; + while (s2[i] != '\0' && s2[i] != ';') { s3[i] = s2[i]; i++; } @@ -2245,8 +2245,8 @@ int setlight(wbp w, char* s, int light) color[2] = atof(s3); color[3] = 0.0; s2 = s2 + i; - if (*s2 != ';' && *s2 != '\0') return Failed; - if (*s2 != '\0') s2++; + if (*s2 != ';' && *s2 != '\0') return Failed; + if (*s2 != '\0') s2++; glLightfv(light, GL_POSITION, color); } } @@ -2285,15 +2285,15 @@ void applyAutomaticTextureCoords(int enable) { if (enable) { if (!glIsEnabled(GL_TEXTURE_GEN_S)) - glEnable(GL_TEXTURE_GEN_S); + glEnable(GL_TEXTURE_GEN_S); if (!glIsEnabled(GL_TEXTURE_GEN_T)) - glEnable(GL_TEXTURE_GEN_T); + glEnable(GL_TEXTURE_GEN_T); } else { if (glIsEnabled(GL_TEXTURE_GEN_S)) - glDisable(GL_TEXTURE_GEN_S); + glDisable(GL_TEXTURE_GEN_S); if (glIsEnabled(GL_TEXTURE_GEN_T)) - glDisable(GL_TEXTURE_GEN_T); + glDisable(GL_TEXTURE_GEN_T); } } @@ -2341,14 +2341,14 @@ int settexcoords(wbp w, char* s) c_put(&f, &mode); j = w->context->numtexcoords = 0; w->context->autogen = 0; - + /* must turn off automatic texture generation */ if (glIsEnabled(GL_TEXTURE_GEN_S)) glDisable(GL_TEXTURE_GEN_S); if (glIsEnabled(GL_TEXTURE_GEN_T)) glDisable(GL_TEXTURE_GEN_T); /* parse string */ - /* The first pass counts the # of texcoords */ + /* The first pass counts the # of texcoords */ while(*s2 != '\0') { while(*s2 != ',' && *s2 != '\0' ) { s3[i] = *s2; @@ -2356,10 +2356,10 @@ int settexcoords(wbp w, char* s) } s3[i]='\0'; j++; - if (*s2 == ',') { - s2++; - i=0; - } + if (*s2 == ',') { + s2++; + i=0; + } else break; } @@ -2382,16 +2382,16 @@ int settexcoords(wbp w, char* s) s3[i]='\0'; ap->a[j] = r = atof(s3); j++; - if (*s2 == ',') { - s2++; - i=0; - } + if (*s2 == ',') { + s2++; + i=0; + } else break; } /* Number of texture coordinates must be even */ if (j % 2) - return RunError; + return RunError; /* save the number of texture coordinates */ w->context->numtexcoords = j; c_put(&(w->window->funclist), &f); @@ -2415,20 +2415,20 @@ int imagestr(wbp w, char* str) /* Extract the Width and skip the following comma.*/ s = (unsigned char *)str; - z = s + strlen(str); /* end+1 of string */ + z = s + strlen(str); /* end+1 of string */ width = 0; - while (s < z && *s == ' ') /* skip blanks */ + while (s < z && *s == ' ') /* skip blanks */ s++; - while (s < z && isdigit(*s)) /* scan number */ + while (s < z && isdigit(*s)) /* scan number */ width = 10 * width + *s++ - '0'; - while (s < z && *s == ' ') /* skip blanks */ + while (s < z && *s == ' ') /* skip blanks */ s++; if (width == 0 || *s++ != ',') /* skip comma */ return Failed; - while (s < z && *s == ' ') /* skip blanks */ + while (s < z && *s == ' ') /* skip blanks */ s++; - if (s >= z) /* if end of string */ - return Failed; + if (s >= z) /* if end of string */ + return Failed; /* Check for a bilevel format */ if ((c = *s) == '#' || c == '~') { @@ -2436,36 +2436,36 @@ int imagestr(wbp w, char* str) nchars = 0; for (t = s; t < z; t++) if (isxdigit(*t)) - nchars++; /* count hex digits */ + nchars++; /* count hex digits */ else if (*t != PCH1 && *t != PCH2) - return Failed; /* illegal punctuation */ + return Failed; /* illegal punctuation */ if (nchars == 0) return Failed; - row = (width + 3) / 4; /* digits per row */ + row = (width + 3) / 4; /* digits per row */ if (nchars % row != 0) return Failed; height = nchars / row; i = bltex(w, width, height, c, (char *)s, (word)(z - s)); if (i == Succeeded) - return Succeeded; + return Succeeded; else - return Failed; + return Failed; } /* Extract the palette name and skip its comma.*/ - c = *s++; /* save initial character */ + c = *s++; /* save initial character */ p = 0; while (s < z && isdigit(*s)) /* scan digits */ p = 10 * p + *s++ - '0'; - while (s < z && *s == ' ') /* skip blanks */ - s++; + while (s < z && *s == ' ') /* skip blanks */ + s++; if (s >= z || p == 0 || *s++ != ',')/* skip comma */ return Failed; - if (c == 'g' && p >= 2 && p <= 256) /* validate grayscale number */ + if (c == 'g' && p >= 2 && p <= 256) /* validate grayscale number */ p = -p; - else if (c != 'c' || p < 1 || p > 6) /* validate color number */ + else if (c != 'c' || p < 1 || p > 6) /* validate color number */ return Failed; /* Scan the image to see which colors are needed. */ @@ -2479,14 +2479,14 @@ int imagestr(wbp w, char* str) c = *t; e[c].used = 1; if (e[c].valid || e[c].transpt) - nchars++; /* valid color, or transparent */ + nchars++; /* valid color, or transparent */ else if (c != PCH1 && c != PCH2) return Failed; } if (nchars == 0) - return Failed; /* empty image */ + return Failed; /* empty image */ if (nchars % width != 0){ - return Failed; /* not rectangular */ + return Failed; /* not rectangular */ } /* Create the texture */ @@ -2546,7 +2546,7 @@ int fileimage(wbp w, char* filename) } if (i == Succeeded) - return Succeeded; + return Succeeded; else return Failed; } @@ -2565,7 +2565,7 @@ int textureimg(wbp w, int width, int height, GLubyte *tex = (GLubyte *)malloc(height * width * 4 + 1); if (tex == NULL) return Failed; - + MakeCurrent(w); /* @@ -2578,32 +2578,32 @@ int textureimg(wbp w, int width, int height, v = e[c].valid; if (v) { /* r,g,b component must be between 0 and 256 */ - tex[(iy*width+ix)*3+0] = e[c].clr.red/256; - tex[(iy*width+ix)*3+1] = e[c].clr.green/256; - tex[(iy*width+ix)*3+2] = e[c].clr.blue/256; + tex[(iy*width+ix)*3+0] = e[c].clr.red/256; + tex[(iy*width+ix)*3+1] = e[c].clr.green/256; + tex[(iy*width+ix)*3+2] = e[c].clr.blue/256; } - if (v || e[c].transpt) { /* advance if valid or transparent */ - if (e[c].transpt) { /* if transparent use background color */ + if (v || e[c].transpt) { /* advance if valid or transparent */ + if (e[c].transpt) { /* if transparent use background color */ tex[(iy*width+ix)*3+0] = (GLint)RED(w->context->bg); tex[(iy*width+ix)*3+1] = (GLint)GREEN(w->context->bg); - + tex[(iy*width+ix)*3+2] = (GLint)BLUE(w->context->bg); } if (++ix >= width) { ix = 0; - /* reset for new row */ + /* reset for new row */ iy--; } } } - if (ix > 0) { /* pad final row if incomplete */ + if (ix > 0) { /* pad final row if incomplete */ while (ix < width) { tex[(iy*width+ix)*3+0] = (GLint)RED(w->context->bg); tex[(iy*width+ix)*3+1] = (GLint)GREEN(w->context->bg); tex[(iy*width+ix)*3+2] = (GLint)BLUE(w->context->bg); ix++; } - } + } /* set the texture */ i = texture(width, height, (GLubyte *)tex, w->context->texmode); @@ -2645,28 +2645,28 @@ int bltex(wbp w, int width, int height, int ch, char *s, word len) if (!isdigit(c)) c += 9; while (m > 0) { - --ix; - if (c & m){ - r = (GLint)RED(w->context->fg); - g = (GLint)GREEN(w->context->fg); - b = (GLint)BLUE(w->context->fg); + --ix; + if (c & m){ + r = (GLint)RED(w->context->fg); + g = (GLint)GREEN(w->context->fg); + b = (GLint)BLUE(w->context->fg); l = (iy*width+ix)*3; - tex[l] = r; /* [ix][iy][0] */ - tex[l+1] = g; /* [ix][iy][1] */ - tex[l+2] = b; /* [ix][iy][2] */ + tex[l] = r; /* [ix][iy][0] */ + tex[l+1] = g; /* [ix][iy][1] */ + tex[l+2] = b; /* [ix][iy][2] */ } - else if (ch != TCH1) { - r = (GLint)RED(w->context->bg); - g = (GLint)GREEN(w->context->bg); - b = (GLint)BLUE(w->context->bg); + else if (ch != TCH1) { + r = (GLint)RED(w->context->bg); + g = (GLint)GREEN(w->context->bg); + b = (GLint)BLUE(w->context->bg); l = (iy*width+ix)*3; - tex[l] = r; /* [iy][ix][0] */ - tex[l+1] = g; /* [iy][ix][1] */ - tex[l+2] = b; /* [iy][ix][2] */ + tex[l] = r; /* [iy][ix][0] */ + tex[l+1] = g; /* [iy][ix][1] */ + tex[l+2] = b; /* [iy][ix][2] */ } m >>= 1; } - if (ix == 0) { /* if end of row */ + if (ix == 0) { /* if end of row */ ix = width; iy--; m = msk1; @@ -2675,15 +2675,15 @@ int bltex(wbp w, int width, int height, int ch, char *s, word len) m = 8; } } - if (ix > 0) /* pad final row if incomplete */ + if (ix > 0) /* pad final row if incomplete */ while (ix < width){ r = (GLint)RED(w->context->bg); g = (GLint)GREEN(w->context->bg); b = (GLint)BLUE(w->context->bg); l = (iy*width+ix)*3; - tex[l] = r; /* [iy][ix][0] */ - tex[l+1] = g; /* [iy][ix][1] */ - tex[l+2] = b; /* [iy][ix][2] */ + tex[l] = r; /* [iy][ix][0] */ + tex[l+1] = g; /* [iy][ix][1] */ + tex[l+2] = b; /* [iy][ix][2] */ ix++; } @@ -2712,7 +2712,7 @@ int texture(int width, int height, GLubyte *tex, int texmode) tex2 = (GLubyte *) malloc(neww * newh * 3); if (tex2 == NULL) return Failed; rv = gluScaleImage(GL_RGB, width, height, GL_UNSIGNED_BYTE, tex, - neww, newh, GL_UNSIGNED_BYTE, tex2); + neww, newh, GL_UNSIGNED_BYTE, tex2); if (rv) { free(tex2); return Failed; } width = neww; height = newh; @@ -2720,7 +2720,7 @@ int texture(int width, int height, GLubyte *tex, int texmode) else tex2 = tex; glTexImage2D(GL_TEXTURE_2D, 0, 3, width, height, 0, GL_RGB, - GL_UNSIGNED_BYTE, tex2); + GL_UNSIGNED_BYTE, tex2); if (tex2 != tex) free(tex2); @@ -2744,7 +2744,7 @@ int texture1(int width, int height, GLubyte *tex, int texmode) tex2 = (GLubyte *) malloc(neww * newh * 3); if (tex2 == NULL) return Failed; rv = gluScaleImage(GL_RGB, width, height, GL_UNSIGNED_BYTE, tex, - neww, newh, GL_UNSIGNED_BYTE, tex2); + neww, newh, GL_UNSIGNED_BYTE, tex2); if (rv) { free(tex2); return Failed; } width = neww; height = newh; @@ -2777,7 +2777,7 @@ int translate(wbp w, dptr argv, int i, dptr f) if (!constr) if (!(constr = rec_structor3d(GL3D_TRANSLATE))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; /* @@ -2821,7 +2821,7 @@ int rotate(wbp w, dptr argv, int i, dptr f) if (!constr) if (!(constr = rec_structor3d(GL3D_ROTATE))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; /* convert parameters and perform the rotation */ @@ -2865,7 +2865,7 @@ int scale(wbp w, dptr argv, int i, dptr f) if (!constr) if (!(constr = rec_structor3d(GL3D_SCALE))) - syserr("failed to create opengl record constructor"); + syserr("failed to create opengl record constructor"); nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; /* @@ -2918,19 +2918,19 @@ int lookup_texture_byname(wbp w, char *name, int len, int ttype, int curtex) while (intextures) { wt = &(wd->stex[i]); if (wt->textype == ttype) { - switch (ttype) { - case 1: /* file */ - if ((StrLen(wt->d) == len) && strncmp(StrLoc(wt->d),name,len)==0) { - wc->curtexture = i; - return i; - } - break; - case 2: /* window */ - break; - case 3: /* string */ - break; - } - } + switch (ttype) { + case 1: /* file */ + if ((StrLen(wt->d) == len) && strncmp(StrLoc(wt->d),name,len)==0) { + wc->curtexture = i; + return i; + } + break; + case 2: /* window */ + break; + case 3: /* string */ + break; + } + } i++; } @@ -2993,20 +2993,20 @@ int texture_24img(wbp w, struct imgdata im) #ifdef XWindows l = (height-1) * width * 3; for(j=0; j < height; j++){ - for(i=0; i < width; i++) { + for(i=0; i < width; i++) { tex[l] = t[0]; tex[l+1] = t[1]; tex[l+2] = t[2]; - l = l + 3; t += 3; - } - l -= wd3x2; - } -#else /* XWindows */ + l = l + 3; t += 3; + } + l -= wd3x2; + } +#else /* XWindows */ { word l, wd3x2=width*3*2, wh3=width*height*3; for(l=0; l < wh3; l+=3, t+=3) { tex[l] = t[0]; tex[l+1] = t[1]; tex[l+2] = t[2]; } } -#endif /* XWindows */ +#endif /* XWindows */ /* set the texture */ i = texture(width, height, (GLubyte *)tex, w->context->texmode); @@ -3035,9 +3035,9 @@ int drawstrng3d(wbp w, double x, double y, double z, char *s) static char *full_name = NULL; #if NT struct _stat sb; -#else /* NT */ +#else /* NT */ struct stat sb; -#endif /* NT */ +#endif /* NT */ int len_full_name=0, len_path=0, len_font; @@ -3052,7 +3052,7 @@ int drawstrng3d(wbp w, double x, double y, double z, char *s) findonpath("unicon", full_name, 255); q = full_name + strlen(full_name); while (q > full_name && q[-1] != '/') - q--; + q--; *q = '\0'; } len_path = strlen(path); @@ -3071,7 +3071,7 @@ int drawstrng3d(wbp w, double x, double y, double z, char *s) } xx=cpp_drawstring3d(x*64,y*64,z*64,s,p,curr_font->type, curr_font->size, - &(curr_font->fonts)); + &(curr_font->fonts)); switch (xx) { case 1: fprintf(stderr, "Error:file does not support point size\n"); break; @@ -3081,9 +3081,9 @@ int drawstrng3d(wbp w, double x, double y, double z, char *s) free(p); return ((xx==0)?Succeeded:Failed); -#else /* HAVE_LIBFTGL */ +#else /* HAVE_LIBFTGL */ return Failed; -#endif /* HAVE_LIBFTGL */ +#endif /* HAVE_LIBFTGL */ } int add_3dfont(char *fname, int fsize, char ftype) @@ -3101,12 +3101,12 @@ int add_3dfont(char *fname, int fsize, char ftype) } end_font->name = (char *) strdup(fname); if (!end_font->name) - return 0; + return 0; end_font->size = fsize; end_font->type = ftype; end_font->fonts = 0; end_font->next = 0; -#endif /* HAVE_LIBFTGL */ +#endif /* HAVE_LIBFTGL */ return 1; } @@ -3117,11 +3117,11 @@ srch_3dfont(char *fname, int fsize, char ftype) wfp g = start_font; while (g) { if (!strcmp(g->name, fname) && g->size==fsize && g->type==ftype) { - return g; - } + return g; + } g = g->next; } -#endif /* HAVE_LIBFTGL */ +#endif /* HAVE_LIBFTGL */ return 0; } @@ -3188,11 +3188,11 @@ int setselectionmode(wbp w, char* s) return RunError; if (!strcmp("on", s)) - wc->selectionenabled = 1; + wc->selectionenabled = 1; else if (!strcmp("off", s)) - wc->selectionenabled = 0; + wc->selectionenabled = 0; else - return RunError; + return RunError; wc->app_use_selection3D = 1; @@ -3212,32 +3212,32 @@ int setselectionmode(wbp w, char* s) #define SWAPINT(x, y) do{ int t=x; x=y; y=t; }while(0) #define CLIPENDS(a, b, start, finish) do {\ - if (afinish) b=finish; } while(0) + if (afinish) b=finish; } while(0) #define FCLIPENDS(a, b, start, finish, flag1, flag2) do {\ - if (afinish){ b=finish; flag2=1;} else flag2=0;} while (0) + if (afinish){ b=finish; flag2=1;} else flag2=0;} while (0) #ifdef XWindows #define MKCURRENT3D(w3d) \ glXMakeCurrent(w3d->window->display->display, w3d->window->win, w3d->window->ctx); -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows #define MKCURRENT3D(w3d){ \ HDC stddc = CreateWinDC(w3d); \ wglMakeCurrent(stddc, w3d->window->ctx); \ ReleaseDC(w3d->window->iconwin, stddc);} -#endif /* MSWindows */ +#endif /* MSWindows */ #define TEXUPDATE(win, wc, texhand, tex, wd, ht) \ if (wc->buffermode) { \ - wc->curtexture = texhand; \ - MakeCurrent(wc->display->stex[texhand].w); \ - glBindTexture(GL_TEXTURE_2D, wc->display->stex[texhand].texName); \ - texture1(wd, ht, tex, \ - wc->display->stex[texhand].w->context->texmode); } + wc->curtexture = texhand; \ + MakeCurrent(wc->display->stex[texhand].w); \ + glBindTexture(GL_TEXTURE_2D, wc->display->stex[texhand].texName); \ + texture1(wd, ht, tex, \ + wc->display->stex[texhand].w->context->texmode); } int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2) @@ -3248,7 +3248,7 @@ int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2) int cred, cgreen, cblue; int wd3, wd, ht, yy, xx, l, yb, yt, xl, xr, dx, dy, ee, tx, clip1, clip2, y0, x0, - top, rit, pixelshift; + top, rit, pixelshift; GLubyte *tex; cred = (GLint) RED(wc->fg); @@ -3269,9 +3269,9 @@ int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2) wd3 = wd * 3; l = wd3 * (ht-y1-1) + x1 * 3; for (yy = y1; yy <= y2; yy++) { - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - l -= wd3; - } + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + l -= wd3; + } } else if (y2==y1){ if (y2 < 0 || y2 >= wd) return Failed; @@ -3282,106 +3282,106 @@ int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2) wd3 = wd * 3; l = wd3 * (ht-y1-1) + x1 * 3; for (xx = x1; xx <= x2; xx++) { - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - l += 3; - } + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + l += 3; + } } else { /* All other lines */ steep = abs(y2 - y1) > abs(x2 - x1); if (steep) { SWAPINT(x1, y1); - SWAPINT(x2, y2); - top = wd - 1; rit = ht -1; + SWAPINT(x2, y2); + top = wd - 1; rit = ht -1; } else{ top = ht-1; rit = wd-1; } - if (x1 > x2) { SWAPINT(x1, x2); SWAPINT(y1, y2);} + if (x1 > x2) { SWAPINT(x1, x2); SWAPINT(y1, y2);} dx = x2 - x1; ee = 0; y0 = y1; x0 = x1; if (y1 < y2){ - ystep = 1; - if (steep) - { wd3 = wd * -3; tx=3;} - else - { wd3 = wd * -3; tx=3;} - dy = y2 - y1; - FCLIPENDS(y1, y2, 0, top, yb, yt); - if INVISIBLE(y1, y2, 0, top) return Failed; - if (yb){ - clip1 = (0-y0)* dx/(ystep*dy) + x0; - if (clip1<0) clip1=0; + ystep = 1; + if (steep) + { wd3 = wd * -3; tx=3;} + else + { wd3 = wd * -3; tx=3;} + dy = y2 - y1; + FCLIPENDS(y1, y2, 0, top, yb, yt); + if INVISIBLE(y1, y2, 0, top) return Failed; + if (yb){ + clip1 = (0-y0)* dx/(ystep*dy) + x0; + if (clip1<0) clip1=0; } - else clip1=0; + else clip1=0; - if (yt){ + if (yt){ clip2 = (top-y0)* dx/(ystep*dy) + x0; if(clip2>rit) clip2=rit; } - else clip2=rit; + else clip2=rit; - if (y2==y1) return Failed; - FCLIPENDS(x1, x2, clip1, clip2, xl, xr); - if INVISIBLE(x1, x2, 0, rit) return Failed; + if (y2==y1) return Failed; + FCLIPENDS(x1, x2, clip1, clip2, xl, xr); + if INVISIBLE(x1, x2, 0, rit) return Failed; - if (xl){ - clip1 = (0-x0)* (ystep*dy)/dx + y0; - if(clip1<0 || clip1>top) clip1=0; + if (xl){ + clip1 = (0-x0)* (ystep*dy)/dx + y0; + if(clip1<0 || clip1>top) clip1=0; } - else clip1=0; + else clip1=0; - if (xr){ - clip2 = (rit-x0)* (ystep*dy)/dx + y0; - if(clip2<0 || clip2>top) clip2=top; + if (xr){ + clip2 = (rit-x0)* (ystep*dy)/dx + y0; + if(clip2<0 || clip2>top) clip2=top; } - else clip2=top; + else clip2=top; - CLIPENDS(y1, y2, clip1, clip2); - if INVISIBLE(y1, y2, 0, top) return Failed; + CLIPENDS(y1, y2, clip1, clip2); + if INVISIBLE(y1, y2, 0, top) return Failed; } else{ /* y1 > y2 */ ystep = -1; - if (steep) - { wd3 = wd * -3; tx=-3;} - else - { wd3 = wd * 3; tx=3;} - dy = y1 - y2; - FCLIPENDS(y2, y1, 0, top, yb, yt); - if INVISIBLE(y2, y1, 0, top) return Failed; - if (yb){ - clip2 = (0-y0)* dx/(ystep*dy) + x0; - if(clip2>rit) clip2=rit; + if (steep) + { wd3 = wd * -3; tx=-3;} + else + { wd3 = wd * 3; tx=3;} + dy = y1 - y2; + FCLIPENDS(y2, y1, 0, top, yb, yt); + if INVISIBLE(y2, y1, 0, top) return Failed; + if (yb){ + clip2 = (0-y0)* dx/(ystep*dy) + x0; + if(clip2>rit) clip2=rit; } - else clip2=rit; + else clip2=rit; - if (yt){ + if (yt){ clip1 = (top-y0)* dx/(ystep*dy) + x0; if(clip1<0)clip1=0; } - else clip1=0; + else clip1=0; - if (y2==y1) return Failed; - FCLIPENDS(x1, x2, clip1, clip2, xl, xr); - if INVISIBLE(x1, x2, 0, rit) return Failed; + if (y2==y1) return Failed; + FCLIPENDS(x1, x2, clip1, clip2, xl, xr); + if INVISIBLE(x1, x2, 0, rit) return Failed; - if (xl){ - clip1 = (0-x0)* (ystep*dy)/dx + y0; - if(clip1<0 || clip1>top) clip1=top; + if (xl){ + clip1 = (0-x0)* (ystep*dy)/dx + y0; + if(clip1<0 || clip1>top) clip1=top; } - else clip1=top; + else clip1=top; - if (xr){ - clip2 = (rit-x0)* (ystep*dy)/dx + y0; - if(clip2<0 || clip2>top) clip2=0; + if (xr){ + clip2 = (rit-x0)* (ystep*dy)/dx + y0; + if(clip2<0 || clip2>top) clip2=0; } - else clip2=0; + else clip2=0; + + CLIPENDS(y2, y1, clip2, clip1); + if INVISIBLE(y2, y1, 0, top) return Failed; - CLIPENDS(y2, y1, clip2, clip1); - if INVISIBLE(y2, y1, 0, top) return Failed; - } dx = x2 - x1; @@ -3398,9 +3398,9 @@ int TexDrawLine(wbp w, int texhandle, int x1, int y1, int x2, int y2) for (xx=x1; xx<=x2; xx++) { tex[l] = cred; tex[l+1] = cgreen; tex[l+2] = cblue; - ee += dy; - if (2 * ee >= dx) { l+=wd3+tx; ee -= dx; } - else l += pixelshift; + ee += dy; + if (2 * ee >= dx) { l+=wd3+tx; ee -= dx; } + else l += pixelshift; } } @@ -3416,7 +3416,7 @@ int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height) int wd3, wd, ht, yy, xx, l; GLubyte *tex; int skipTop=0, skipBottom=0, skipLeft=0, skipRight=0, - flipx=0, flipy=0; + flipx=0, flipy=0; cred = (GLint) RED(wc->fg); cgreen = (GLint) GREEN(wc->fg); @@ -3432,20 +3432,20 @@ int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height) if (x+width<0 || x>wd || y+height<0 || y>ht) return Failed; - if (x<0){ - width+=x; x=0; + if (x<0){ + width+=x; x=0; if (flipx) skipRight=1; else skipLeft=1; } - if (x+width >= wd ) { - width=wd-x-1; + if (x+width >= wd ) { + width=wd-x-1; if (flipx) skipLeft=1; else skipRight=1; } - if (y<0){ - height+=y; y=0; + if (y<0){ + height+=y; y=0; if (flipy) skipTop=1; else skipBottom=1; } if (y+height >= ht ) { - height=ht-y-1; + height=ht-y-1; if (flipy) skipBottom=1; else skipTop=1; } @@ -3458,9 +3458,9 @@ int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height) if (!skipBottom){ l = wd3 * (ht - y-1) + x * 3; for (xx = x; xx <= x2; xx++) { - l = l + 3; - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - } + l = l + 3; + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + } } /* Horizontal 2 */ @@ -3468,26 +3468,26 @@ int TexDrawRect(wbp w, int texhandle, int x, int y, int width, int height) if (!skipTop){ l = wd3 * (ht - y2-1) + x * 3; for (xx = x; xx <= x2; xx++) { - l = l + 3; - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - } + l = l + 3; + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + } } /* verticals 1 & 2 */ if (!skipLeft){ l = wd3 * (ht-y - 1) + x * 3; for (yy = y; yy <= y2; yy++) { - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - l -= wd3; - } + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + l -= wd3; + } } if (!skipRight){ l = wd3 * (ht-y - 1) + x * 3 + width * 3; for (yy = y; yy <= y2; yy++) { - tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; - l -= wd3; - } + tex[l] = cred; tex[l+1]=cgreen; tex[l+2]=cblue; + l -= wd3; + } } TEXUPDATE(w, wc, texhandle, tex, wd, ht); @@ -3542,12 +3542,12 @@ int TexFillRect(wbp w, int texh, int x, int y, int width, int height, int isfg) for (yy=y; yydisplay->stex[texhandle].width; ht = wc->display->stex[texhandle].height; - if (x<0 || x>=wd || y<0 || y>=ht) + if (x<0 || x>=wd || y<0 || y>=ht) return Failed; l = 3 * (x + wd * (ht-y - 1)); @@ -3604,11 +3604,11 @@ int TexReadImage(wbp w, int texhandle, int x, int y, struct imgdata *imd) for (i=0; iheight; i++) { for (j=0; jwidth; j++) { - tex[l] = (GLubyte) *s++; - tex[l+1] = (GLubyte) *s++; - tex[l+2] = (GLubyte) *s++; - l+=3; - } + tex[l] = (GLubyte) *s++; + tex[l+1] = (GLubyte) *s++; + tex[l+2] = (GLubyte) *s++; + l+=3; + } l += nextLineOffset; } @@ -3617,8 +3617,8 @@ int TexReadImage(wbp w, int texhandle, int x, int y, struct imgdata *imd) } int copyareaTexToTex(wbp w, int texhandle, int dest_texhandle, - int x, int y, int width, int height, /* box to copy */ - int xt, int yt) /* dest loc */ + int x, int y, int width, int height, /* box to copy */ + int xt, int yt) /* dest loc */ { wdp wd = w->window->display; GLubyte *src = wd->stex[texhandle].tex; @@ -3638,28 +3638,28 @@ int copyareaTexToTex(wbp w, int texhandle, int dest_texhandle, srcl = (srcht-y-j-1)*tws3 + x * 3; dstl = (txh-yt-j-1)*twd3 + xt * 3; for(i=0; i < width; i++) { - b = src[srcl]; + b = src[srcl]; dest[dstl] =b; dest[dstl+1] = src[srcl+1]; dest[dstl+2] = src[srcl+2]; - srcl += 3; - dstl += 3; - } - } + srcl += 3; + dstl += 3; + } + } MakeCurrent(w); glBindTexture(GL_TEXTURE_2D, - wd->stex[dest_texhandle].texName); + wd->stex[dest_texhandle].texName); texture(wd->stex[dest_texhandle].width, - wd->stex[dest_texhandle].height, - wd->stex[dest_texhandle].tex, - w->context->texmode - ); + wd->stex[dest_texhandle].height, + wd->stex[dest_texhandle].tex, + w->context->texmode + ); return Succeeded; } /* copy from a 2D window to a texture */ -int copyareaToTex2D(wbp w2d, GLubyte *tex, int x, int y, +int copyareaToTex2D(wbp w2d, GLubyte *tex, int x, int y, int width, int height, int xt, int yt, int txw, int txh) { struct imgmem imem; @@ -3673,7 +3673,7 @@ int copyareaToTex2D(wbp w2d, GLubyte *tex, int x, int y, XColor clrcell; /* wclrp cp, lastcp = wd->colors; */ TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(vis->red_mask, vis->green_mask,vis->blue_mask); -#endif /* XWindows */ +#endif /* XWindows */ imem.x = x; imem.y = y; @@ -3686,75 +3686,75 @@ int copyareaToTex2D(wbp w2d, GLubyte *tex, int x, int y, twd3 = txw * 3; #ifdef XWindows - if(vis->class==TrueColor){ + if(vis->class==TrueColor){ for(j=0; j < height; j++){ - l = (txh-1-yt-j)*twd3 + xt * 3; - for(i=0; i < width; i++) { - c = XGetPixel(imem.im, i, j); + l = (txh-1-yt-j)*twd3 + xt * 3; + for(i=0; i < width; i++) { + c = XGetPixel(imem.im, i, j); tex[l] = TRUECOLOR_GET_RGB_RED(c); tex[l+1] = TRUECOLOR_GET_RGB_GREEN(c); tex[l+2] = TRUECOLOR_GET_RGB_BLUE(c); - l = l + 3; - } - } + l = l + 3; + } + } return Succeeded; } #endif for(j=0; j < height; j++){ - l = (yt+j)*twd3 + xt * 3; - for(i=0; i < width; i++) { + l = (yt+j)*twd3 + xt * 3; + for(i=0; i < width; i++) { #ifdef XWindows - clrcell.pixel = XGetPixel(imem.im, i, j); -/* rv = 0xff000000; - if (lastcp->c == c){ - tex[l] = lastcp ->r>>8; - tex[l+1] = lastcp->g>>8; - tex[l+2] = lastcp->b>>8; - l = l + 3; - continue; - } - else - for (cp = wd->colors ; cp < wd->colors + wd->numColors; cp++) { - if (cp->c == c) { - lastcp = cp; - tex[l] = cp->r>>8; - tex[l+1] = cp->g>>8; - tex[l+2] = cp->b>>8; - l = l + 3; - continue; - } - } - if (rv == 0xff000000) { + clrcell.pixel = XGetPixel(imem.im, i, j); +/* rv = 0xff000000; + if (lastcp->c == c){ + tex[l] = lastcp ->r>>8; + tex[l+1] = lastcp->g>>8; + tex[l+2] = lastcp->b>>8; + l = l + 3; + continue; + } + else + for (cp = wd->colors ; cp < wd->colors + wd->numColors; cp++) { + if (cp->c == c) { + lastcp = cp; + tex[l] = cp->r>>8; + tex[l+1] = cp->g>>8; + tex[l+2] = cp->b>>8; + l = l + 3; + continue; + } + } + if (rv == 0xff000000) { */ - XQueryColor(stddpy, wd->cmap, &clrcell); - clr = lcolor(w2d, clrcell); + XQueryColor(stddpy, wd->cmap, &clrcell); + clr = lcolor(w2d, clrcell); tex[l] = clr.red>>8; tex[l+1] = clr.green>>8; tex[l+2] = clr.blue>>8; - l = l + 3; -/* } */ + l = l + 3; +/* } */ #else - { - char *s2, strout[50]; - long rv; + { + char *s2, strout[50]; + long rv; - if (getpixel(w2d, i, height-j-1, &rv, strout, &imem) == Failed) + if (getpixel(w2d, i, height-j-1, &rv, strout, &imem) == Failed) return Failed; s2 = strout; /* parse string to get pixel values */ - while(isspace(*s2)) s2++; + while(isspace(*s2)) s2++; tex[l] = atoi(s2)/256; - while(isdigit(*s2)) s2++; - s2++; + while(isdigit(*s2)) s2++; + s2++; tex[l+1] = atoi(s2)/256; - while (isdigit(*s2)) s2++; - s2++; + while (isdigit(*s2)) s2++; + s2++; tex[l+2] = atoi(s2)/256; - l = l + 3; - } + l = l + 3; + } #endif } } @@ -3765,7 +3765,7 @@ int copyareaToTex2D(wbp w2d, GLubyte *tex, int x, int y, * Copy from a 3D window to a texture. As written here, it comes out * in four-byte RGBA format, and we copy just the RGB part over. */ -int copyareaToTex3D(wbp w3d, GLubyte *tex, int x, int y, +int copyareaToTex3D(wbp w3d, GLubyte *tex, int x, int y, int width, int height, int xt, int yt, int txw, int txh) { int i, j, twd3, l, m; @@ -3777,31 +3777,31 @@ int copyareaToTex3D(wbp w3d, GLubyte *tex, int x, int y, /* change the current context to w2's context */ #ifdef XWindows glXMakeCurrent(w3d->window->display->display, w3d->window->win, w3d->window->ctx); - glReadPixels( (GLint) x, (GLint)y, (GLint) width, (GLint) height, - GL_RGBA, GL_UNSIGNED_BYTE, tex2); -#endif /* XWindows */ + glReadPixels( (GLint) x, (GLint)y, (GLint) width, (GLint) height, + GL_RGBA, GL_UNSIGNED_BYTE, tex2); +#endif /* XWindows */ #ifdef MSWindows { HDC stddc = CreateWinDC(w3d); wglMakeCurrent(stddc, w3d->window->ctx); - glReadPixels( (GLint) x, (GLint)y, (GLint) width, (GLint) height, - GL_RGBA, GL_UNSIGNED_BYTE, tex2); + glReadPixels( (GLint) x, (GLint)y, (GLint) width, (GLint) height, + GL_RGBA, GL_UNSIGNED_BYTE, tex2); ReleaseDC(w3d->window->iconwin, stddc); } -#endif /* MSWindows */ +#endif /* MSWindows */ twd3 = txw * 3; m=0; for(j=0; j < height; j++){ - l = (yt+j)* twd3 + xt * 3; - for(i=0; i < width; i++) { + l = (yt+j)* twd3 + xt * 3; + for(i=0; i < width; i++) { tex[l] = tex2[m]; tex[l+1] = tex2[m+1]; tex[l+2] = tex2[m+2]; - l = l + 3; - m = m +4; - } - } + l = l + 3; + m = m +4; + } + } free(tex2); return Succeeded; } @@ -3825,8 +3825,8 @@ int texwindow2D(wbp w, wbp w2d) if (tex == NULL) return Failed; - copyareaToTex2D(w2d, tex, 0, 0, ws->width, ws->height, - 0, 0, ws->width, ws->height); + copyareaToTex2D(w2d, tex, 0, 0, ws->width, ws->height, + 0, 0, ws->width, ws->height); /* apply the texture */ @@ -3857,7 +3857,7 @@ int texwindow3D(wbp w1, wbp w2) int i; GLubyte *tex = (GLubyte *)malloc(height * width * 3); if (tex == NULL) - return Failed; + return Failed; /* change the current context to w2's context */ #ifdef XWindows @@ -3866,7 +3866,7 @@ int texwindow3D(wbp w1, wbp w2) glXMakeCurrent(w1s->display->display, w1s->win, w1s->ctx); glBindTexture(GL_TEXTURE_2D, w1c->display->stex[w1c->curtexture].texName); i = texture(width, height, (GLubyte *)tex, w1->context->texmode); -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows { HDC stddc = CreateWinDC(w2); @@ -3876,11 +3876,11 @@ int texwindow3D(wbp w1, wbp w2) stddc = CreateWinDC(w1); wglMakeCurrent(stddc, w1s->ctx); glBindTexture(GL_TEXTURE_2D, - w1c->display->stex[w1c->curtexture].texName); + w1c->display->stex[w1c->curtexture].texName); i = texture(width, height, (GLubyte *)tex, w1c->texmode); ReleaseDC(w1->window->iconwin, stddc); } -#endif /* MSWindows */ +#endif /* MSWindows */ if (i == Succeeded) { /* no need to re-check, the check was made earlier in the code */ /*if (make_enough_texture_space(wc->display)==Failed) return Failed;*/ @@ -3898,12 +3898,12 @@ int texwindow3D(wbp w1, wbp w2) * TexCopyArea copies source image data into a destination texture. */ int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, - int height, int xt, int yt, int width2, int height2) + int height, int xt, int yt, int width2, int height2) { wcp wc=w2->context; int wd, ht, wwd, wht; GLubyte *tex; - + wwd = (int)w->window->width; wht = (int)w->window->height; tex = wc->display->stex[texhandle].tex; @@ -3919,7 +3919,7 @@ int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, if (xt+width<0 || xt>=wd || yt+height<0 || yt>=ht) return Failed; if (x<0){ width+=x; x=0;} - if (xt<0){width+=xt; xt=0;} + if (xt<0){width+=xt; xt=0;} if (y<0){ height+=y; y=0;} if (yt<0){ height+=yt; yt=0;} @@ -3935,14 +3935,14 @@ int TexCopyArea(wbp w, wbp w2, int texhandle, int x, int y, int width, y = wht-y - height; yt = ht-yt - height; if (copyareaToTex3D(w, tex, x, y, width, height, xt, yt, wd, ht)==Failed) - return Failed; + return Failed; } else{ if (copyareaToTex2D(w, tex, x, y, width, height, xt, yt, wd, ht)==Failed) - return Failed; + return Failed; } - TEXUPDATE(w2, wc, texhandle, tex, wd, ht); + TEXUPDATE(w2, wc, texhandle, tex, wd, ht); return Succeeded; } @@ -3964,10 +3964,10 @@ void swapbuffers(wbp w, int flush) /* * Hidden state uses unmapped windows. From experimentation, it * seems that the front buffer in double buffering mode is undefined when - * the window is unmapped. + * the window is unmapped. */ if (ws->win != (Window) NULL && ws->iconic != HiddenState) -#endif /* XWindows */ +#endif /* XWindows */ { MakeCurrent(w); glXSwapBuffers(ws->display->display, ws->win); /* implcit flush */ @@ -3980,8 +3980,8 @@ void swapbuffers(wbp w, int flush) */ void erasetocolor(int r,int g,int b) { - glClearColor(r/(GLfloat)256, g/(GLfloat)256, b/(GLfloat)256, 0.0); - glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); + glClearColor(r/(GLfloat)256, g/(GLfloat)256, b/(GLfloat)256, 0.0); + glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); } /* @@ -4005,12 +4005,12 @@ int create3Dcontext(wbp w) HDC hdc = CreateWinDC(w); ws->ctx = wglCreateContext (hdc); wglMakeCurrent (hdc, ws->ctx); -#endif /* MSWindows */ +#endif /* MSWindows */ #ifdef XWindows ws->ctx = glXCreateContext(wd->display, wd->vis, None, GL_TRUE); - if (ws->ctx == NULL) + if (ws->ctx == NULL) return Failed; glXMakeCurrent(wd->display, w->window->win, ws->ctx); -#endif /* XWindows */ +#endif /* XWindows */ return Succeeded; } diff --git a/src/runtime/ropengl2d.ri b/src/runtime/ropengl2d.ri index 4dd1c853a..9fa5d2e9f 100644 --- a/src/runtime/ropengl2d.ri +++ b/src/runtime/ropengl2d.ri @@ -2,12 +2,12 @@ * ropengl2d.ri - OpenGL-specific runtime file for the 2D graphics facilities. * * For easier searching: - * + * * (1) OpenGL 2D utility functions - * (2) Drawing functions - * (3) Context attribute functions - * (4) Window management functions (platform independent) - * (5) Window management functions (platform specific) + * (2) Drawing functions + * (3) Context attribute functions + * (4) Window management functions (platform independent) + * (5) Window management functions (platform specific) */ /* @@ -18,7 +18,7 @@ /* * Macros */ -/* +/* * Make sure {desc} and {ap} are tended. * Would like to move to rmacros.h, but gets compilation error. Problem * with Protect() macro. @@ -37,32 +37,32 @@ #define DEFAULTFONTNAME "mono" -/* - * debugging prototypes +/* + * debugging prototypes */ void print_arc(struct b_record *rp, const char *s); -void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, +void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, char *s); void print_bitmap(unsigned char *bitmap, int width, int height, char *s); void printlist2d(wsp ws); char *getDLiteminfo2d(struct b_record *rp); -/* - * prototypes +/* + * prototypes */ struct b_record *getlastlistitem(wbp w, int intcode); -void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, +void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, unsigned char *pixmap, int invert, int bitorder); -int traverselist2d(wbp w, struct b_lelem *bp, int start, int end, int used, +int traverselist2d(wbp w, struct b_lelem *bp, int start, int end, int used, word k); -struct b_list *segment_line(wbp w, int num, struct b_realarray * ap2, +struct b_list *segment_line(wbp w, int num, struct b_realarray * ap2, double *v2, word n2); static wfp loadfont(wdp wd, char *s, int len); char *find_fontfile(char *family, int flags); -int write_xbm(char *filename, int width, int height, unsigned char *pixmap, +int write_xbm(char *filename, int width, int height, unsigned char *pixmap, unsigned char bg[4]); int write_xpm(char *filename, int width, int height, unsigned char *pixmap); char *load_xbm(char *filename, unsigned int *width, unsigned int *height); @@ -82,7 +82,7 @@ void print_bitmap(unsigned char *bitmap, int width, int height, char *s) bmwidth = width/8 + 1; for (iy=height-1; iy>=0; iy--) { - for (ix=0; ixfields[0]),rp->id,StrLoc(pp->lnames[2]),v1,\ StrLoc(pp->lnames[3]),v2,StrLoc(pp->lnames[4]),v3,\ StrLoc(pp->lnames[5]),v4,StrLoc(pp->lnames[6]),v5); - break; + break; case GL2D_FILLARC: case GL2D_DRAWARC: GetReal(&(rp->fields[2]),v1); @@ -141,19 +141,19 @@ void print_arc(struct b_record *rp, const char *s) v1,StrLoc(pp->lnames[3]),v2,StrLoc(pp->lnames[4]),v3,\ StrLoc(pp->lnames[5]),v4,StrLoc(pp->lnames[6]),v5,\ StrLoc(pp->lnames[7]),v6); - break; + break; default: glprintf("got code %d\n",tmp); } } -#else /* GL2D_DEBUG */ +#else /* GL2D_DEBUG */ void print_arc(struct b_record *rp, const char *s) { } -#endif /* GL2D_DEBUG */ +#endif /* GL2D_DEBUG */ #ifdef GL2D_DEBUG -void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, +void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, char *s) { int i, j, rwidth; @@ -174,19 +174,19 @@ void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, glprintf("\n"); } } -#else /* GL2D_DEBUG */ -void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, +#else /* GL2D_DEBUG */ +void print_pixmap(unsigned char *pixmap, int nbytes, int width, int height, char *s) { } -#endif /* GL2D_DEBUG */ +#endif /* GL2D_DEBUG */ #ifdef GL2D_DEBUG -void printlist2d(wsp ws) +void printlist2d(wsp ws) { if (is:list(ws->funclist2d)) { - struct b_lelem *bp; - struct b_list *lp; + struct b_lelem *bp; + struct b_list *lp; word i, size, used, k; lp = BlkD(ws->funclist2d, List); @@ -194,7 +194,7 @@ void printlist2d(wsp ws) bp = (struct b_lelem *)BlkD(ws->funclist2d, List)->listhead; - if (bp->nused<=0) { + if (bp->nused<=0) { bp = (struct b_lelem *) bp->listnext; lp->listhead = (union block *) bp; bp->listprev = (union block *) lp; @@ -205,13 +205,13 @@ void printlist2d(wsp ws) for (i = 0; i < size; i++) { struct b_record *rp; struct descrip desc; - + desc = bp->lslots[k++]; used--; if (used <= 0) { bp = (struct b_lelem *) bp->listnext; - k = bp->first; - used = bp->nused; + k = bp->first; + used = bp->nused; } if (!is:record(desc)) { glprintf("item %ld is not a record\n",i); @@ -220,14 +220,14 @@ void printlist2d(wsp ws) rp = BlkD(desc, Record); glprintf("(%ld) %s\n",i,getDLiteminfo2d(rp)); - } + } } } -#else /* GL2D_DEBUG */ -void printlist2d(wsp ws) +#else /* GL2D_DEBUG */ +void printlist2d(wsp ws) { } -#endif /* GL2D_DEBUG */ +#endif /* GL2D_DEBUG */ /* @@ -263,7 +263,7 @@ char *getDLiteminfo2d(struct b_record *rp) int intcode; char *recname; double v1, v2, v3, v4, v5, v6; - + if (!rp->recdesc || Blk(rp->recdesc,Proc)->nfields < 2) return NULL; recname = StrLoc(Blk(rp->recdesc,Proc)->recname); @@ -370,7 +370,7 @@ char *getDLiteminfo2d(struct b_record *rp) case GL2D_FG: case GL2D_BG: - if (is:null(rp->fields[2])) + if (is:null(rp->fields[2])) sprintf(buf,"[%s] r: %ld, g: %ld, b: %ld, a: %ld", recname, IntVal(rp->fields[3]),IntVal(rp->fields[4]), IntVal(rp->fields[5]),IntVal(rp->fields[6])); @@ -428,21 +428,21 @@ char *getDLiteminfo2d(struct b_record *rp) } } return buf; - } -#else /* GL2D_DEBUG */ -char *getDLiteminfo2d(struct b_record *rp) + } +#else /* GL2D_DEBUG */ +char *getDLiteminfo2d(struct b_record *rp) { return NULL; /* Avoid clang: "non-void function does not return a value" */ } -#endif /* GL2D_DEBUG */ +#endif /* GL2D_DEBUG */ + - /*********************************** * (1) OpenGL 2D utility functions * ***********************************/ - + int create_display_list2d(wbp w, int size) { @@ -456,7 +456,7 @@ int create_display_list2d(wbp w, int size) return Succeeded; } - + /* * Returns a record constructor for a 2d graphics primitive. Used to allocate * a new 2d graphics object. @@ -467,7 +467,7 @@ dptr rec_structor2d(int type) /* Graphic primitives */ static struct descrip gl2d_blimage = {D_Null}; - static struct descrip gl2d_readimage = {D_Null}; + static struct descrip gl2d_readimage = {D_Null}; static struct descrip gl2d_strimage = {D_Null}; static struct descrip gl2d_drawstring = {D_Null}; static struct descrip gl2d_wwrite = {D_Null}; @@ -486,7 +486,7 @@ dptr rec_structor2d(int type) static struct descrip gl2d_drawrectangle = {D_Null}; /* - * (Context) Attribute assignment + * (Context) Attribute assignment */ static struct descrip gl2d_fg = {D_Null}; static struct descrip gl2d_bg = {D_Null}; @@ -508,16 +508,16 @@ dptr rec_structor2d(int type) * record field names - the following are fixed: * * field[0] - function name: "name" - * field[1] - function code: "code" + * field[1] - function code: "code" */ static char *gl2d_blimage_fields[] = { "x", "y", "width", "height", "__s", "__ch", "__texid", "__index" }; static char *gl2d_readimage_fields[] = { - "x", "y", "width", "height", "__is_pixmap", "__pixmap", "__texid", + "x", "y", "width", "height", "__is_pixmap", "__pixmap", "__texid", "__index" }; - static char *gl2d_strimage_fields[] = {"x", "y", "width", "height", + static char *gl2d_strimage_fields[] = {"x", "y", "width", "height", "__pixmap", "__texid", "__index" }; static char *gl2d_drawstring_fields[] = {"x", "y", "s"}; @@ -533,23 +533,23 @@ dptr rec_structor2d(int type) static char *gl2d_drawsegment_fields[] = {"__v", "__coords", "__vseg"}; static char *gl2d_drawpoint_fields[] = {"__v", "__coords"}; static char *gl2d_drawcircle_fields[] = { - "__v", "x", "y", "r", "theta", "alpha", "__x", "__y", "__r", "__theta", + "__v", "x", "y", "r", "theta", "alpha", "__x", "__y", "__r", "__theta", "__alpha", "__vseg" }; static char *gl2d_fillcircle_fields[] = { - "__v", "x", "y", "r", "theta", "alpha", "__x", "__y", "__r", "__theta", + "__v", "x", "y", "r", "theta", "alpha", "__x", "__y", "__r", "__theta", "__alpha" }; static char *gl2d_drawarc_fields[] = { - "__v", "x", "y", "width", "height", "theta", "alpha", "__x", "__y", + "__v", "x", "y", "width", "height", "theta", "alpha", "__x", "__y", "__width", "__height", "__theta", "__alpha", "__vseg" }; static char *gl2d_fillarc_fields[] = { - "__v", "x", "y", "width", "height", "theta", "alpha", "__x", "__y", + "__v", "x", "y", "width", "height", "theta", "alpha", "__x", "__y", "__width", "__height", "__theta", "__alpha" }; static char *gl2d_drawrectangle_fields[] = { - "__v", "x", "y", "width", "height", "__x", "__y", "__width", "__height", + "__v", "x", "y", "width", "height", "__x", "__y", "__width", "__height", "__vseg" }; static char *gl2d_fillrectangle_fields[] = { @@ -561,20 +561,20 @@ dptr rec_structor2d(int type) */ static char *gl2d_fg_fields[] = {"index", "r", "g", "b", "a"}; static char *gl2d_bg_fields[] = {"index", "r", "g", "b", "a"}; - static char *gl2d_reverse_fields[] = {NULL}; - static char *gl2d_gamma_fields[] = {"val"}; - static char *gl2d_drawop_fields[] = {"s"}; - static char *gl2d_font_fields[] = {"s"}; - static char *gl2d_leading_fields[] = {"val"}; - static char *gl2d_linewidth_fields[] = {"val"}; - static char *gl2d_linestyle_fields[] = {"s"}; - static char *gl2d_fillstyle_fields[] = {"s"}; + static char *gl2d_reverse_fields[] = {NULL}; + static char *gl2d_gamma_fields[] = {"val"}; + static char *gl2d_drawop_fields[] = {"s"}; + static char *gl2d_font_fields[] = {"s"}; + static char *gl2d_leading_fields[] = {"val"}; + static char *gl2d_linewidth_fields[] = {"val"}; + static char *gl2d_linestyle_fields[] = {"s"}; + static char *gl2d_fillstyle_fields[] = {"s"}; static char *gl2d_pattern_fields[] = { "s", "__s", "__width", "__height", "__texid", "__index" }; - static char *gl2d_clip_fields[] = {"x", "y", "width", "height"}; - static char *gl2d_dx_fields[] = {"val", "__val"}; - static char *gl2d_dy_fields[] = {"val", "__val"}; + static char *gl2d_clip_fields[] = {"x", "y", "width", "height"}; + static char *gl2d_dx_fields[] = {"val", "__val"}; + static char *gl2d_dy_fields[] = {"val", "__val"}; /* * Initialize all constructors @@ -585,37 +585,37 @@ dptr rec_structor2d(int type) /* * Primitives */ - Protect(rec_structor2dinit(&gl2d_blimage, "gl2d_blimage", 10, + Protect(rec_structor2dinit(&gl2d_blimage, "gl2d_blimage", 10, gl2d_blimage_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_readimage, "gl2d_readimage", 10, + Protect(rec_structor2dinit(&gl2d_readimage, "gl2d_readimage", 10, gl2d_readimage_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_strimage, "gl2d_strimage", 9, + Protect(rec_structor2dinit(&gl2d_strimage, "gl2d_strimage", 9, gl2d_strimage_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawstring, "gl2d_drawstring", 5, + Protect(rec_structor2dinit(&gl2d_drawstring, "gl2d_drawstring", 5, gl2d_drawstring_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_wwrite, "gl2d_wwrite", 5, + Protect(rec_structor2dinit(&gl2d_wwrite, "gl2d_wwrite", 5, gl2d_wwrite_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_copyarea, "gl2d_copyarea", 11, + Protect(rec_structor2dinit(&gl2d_copyarea, "gl2d_copyarea", 11, gl2d_copyarea_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_erasearea, "gl2d_erasearea", 6, + Protect(rec_structor2dinit(&gl2d_erasearea, "gl2d_erasearea", 6, gl2d_erasearea_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_fillpolygon, "gl2d_fillpolygon", 5, + Protect(rec_structor2dinit(&gl2d_fillpolygon, "gl2d_fillpolygon", 5, gl2d_fillpolygon_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawpolygon, "gl2d_drawpolygon", 5, + Protect(rec_structor2dinit(&gl2d_drawpolygon, "gl2d_drawpolygon", 5, gl2d_drawpolygon_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawline, "gl2d_drawline", 5, + Protect(rec_structor2dinit(&gl2d_drawline, "gl2d_drawline", 5, gl2d_drawline_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawsegment, "gl2d_drawsegment", 5, + Protect(rec_structor2dinit(&gl2d_drawsegment, "gl2d_drawsegment", 5, gl2d_drawsegment_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawpoint, "gl2d_drawpoint", 4, + Protect(rec_structor2dinit(&gl2d_drawpoint, "gl2d_drawpoint", 4, gl2d_drawpoint_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawcircle, "gl2d_drawcircle", 14, + Protect(rec_structor2dinit(&gl2d_drawcircle, "gl2d_drawcircle", 14, gl2d_drawcircle_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_fillcircle, "gl2d_fillcircle", 13, + Protect(rec_structor2dinit(&gl2d_fillcircle, "gl2d_fillcircle", 13, gl2d_fillcircle_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawarc, "gl2d_drawarc", 16, + Protect(rec_structor2dinit(&gl2d_drawarc, "gl2d_drawarc", 16, gl2d_drawarc_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_fillarc, "gl2d_fillarc", 15, + Protect(rec_structor2dinit(&gl2d_fillarc, "gl2d_fillarc", 15, gl2d_fillarc_fields), return NULL); Protect(rec_structor2dinit(&gl2d_drawrectangle, "gl2d_drawrectangle", 12, gl2d_drawrectangle_fields), return NULL); @@ -623,35 +623,35 @@ dptr rec_structor2d(int type) gl2d_fillrectangle_fields), return NULL); /* - * Attributes + * Attributes */ - Protect(rec_structor2dinit(&gl2d_fg, "gl2d_fg", 7, gl2d_fg_fields), + Protect(rec_structor2dinit(&gl2d_fg, "gl2d_fg", 7, gl2d_fg_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_bg, "gl2d_bg", 7, gl2d_bg_fields), + Protect(rec_structor2dinit(&gl2d_bg, "gl2d_bg", 7, gl2d_bg_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_reverse, "gl2d_reverse", 2, + Protect(rec_structor2dinit(&gl2d_reverse, "gl2d_reverse", 2, gl2d_reverse_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_gamma, "gl2d_gamma", 3, + Protect(rec_structor2dinit(&gl2d_gamma, "gl2d_gamma", 3, gl2d_gamma_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_drawop, "gl2d_drawop", 3, + Protect(rec_structor2dinit(&gl2d_drawop, "gl2d_drawop", 3, gl2d_drawop_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_font, "gl2d_font", 3, gl2d_font_fields), + Protect(rec_structor2dinit(&gl2d_font, "gl2d_font", 3, gl2d_font_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_leading, "gl2d_leading", 3, + Protect(rec_structor2dinit(&gl2d_leading, "gl2d_leading", 3, gl2d_leading_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_linewidth, "gl2d_linewidth", 3, + Protect(rec_structor2dinit(&gl2d_linewidth, "gl2d_linewidth", 3, gl2d_linewidth_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_linestyle, "gl2d_linestyle", 3, + Protect(rec_structor2dinit(&gl2d_linestyle, "gl2d_linestyle", 3, gl2d_linestyle_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_fillstyle, "gl2d_fillstyle", 3, + Protect(rec_structor2dinit(&gl2d_fillstyle, "gl2d_fillstyle", 3, gl2d_fillstyle_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_pattern, "gl2d_pattern", 8, + Protect(rec_structor2dinit(&gl2d_pattern, "gl2d_pattern", 8, gl2d_pattern_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_clip, "gl2d_clip", 6, gl2d_clip_fields), + Protect(rec_structor2dinit(&gl2d_clip, "gl2d_clip", 6, gl2d_clip_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_dx, "gl2d_dx", 4, gl2d_dx_fields), + Protect(rec_structor2dinit(&gl2d_dx, "gl2d_dx", 4, gl2d_dx_fields), return NULL); - Protect(rec_structor2dinit(&gl2d_dy, "gl2d_dy", 4, gl2d_dy_fields), + Protect(rec_structor2dinit(&gl2d_dy, "gl2d_dy", 4, gl2d_dy_fields), return NULL); } @@ -695,7 +695,7 @@ dptr rec_structor2d(int type) return &gl2d_fillrectangle; /* - * Attributes + * Attributes */ case GL2D_FG: /* Fg()/WAttrib() */ return &gl2d_fg; @@ -731,7 +731,7 @@ dptr rec_structor2d(int type) } } - + dptr rec_structor2dinit(dptr dp, char *name, int nfields, char *field_names[]) { @@ -754,13 +754,13 @@ dptr rec_structor2dinit(dptr dp, char *name, int nfields, char *field_names[]) return dp; } - + /* - * Called by traversefunclist2d(). Traverses any contiguous subset of a + * Called by traversefunclist2d(). Traverses any contiguous subset of a * Unicon list. */ -int traverselist2d(wbp w, struct b_lelem *bp, int start, int end, int used, +int traverselist2d(wbp w, struct b_lelem *bp, int start, int end, int used, word k) { tended struct b_lelem *bp_t = bp; @@ -845,10 +845,10 @@ int traverselist2d(wbp w, struct b_lelem *bp, int start, int end, int used, rv = setdrawop2d(w,rp); break; case GL2D_FONT: - rv = setfont2d(w,rp); + rv = setfont2d(w,rp); break; case GL2D_LEADING: - rv = setleading2d(w,rp); + rv = setleading2d(w,rp); break; case GL2D_LINEWIDTH: rv = setlinewidth2d(w,rp); @@ -905,7 +905,7 @@ int traversefunclist2d(wbp w) if (elements <= 0) return Succeeded; bp = (struct b_lelem *) hp->listhead; - if (bp->nused<=0) { + if (bp->nused<=0) { /* get rid of useless lelem block */ bp = (struct b_lelem *) bp->listnext; hp->listhead = (union block *) bp; @@ -918,8 +918,8 @@ int traversefunclist2d(wbp w) * Traverse the list while keeping an eye out for EraseArea */ if (ws->is_3D) { /* integrated 2d/3d mode traversal */ - struct descrip desc; - struct b_record *rp; + struct descrip desc; + struct b_record *rp; wcp wcr = &(ws->wcrender); word last_k = k; int last_used = used, last_i; @@ -948,12 +948,12 @@ int traversefunclist2d(wbp w) if (intcode == GL2D_ERASEAREA) { - /* + /* * Draw area to be erased into stencil buffer */ erasearea2d(w, rp); - /* + /* * Setup stencil buffer and render context to traverse all * contiguous non-erasearea display list records before this */ @@ -964,13 +964,13 @@ int traversefunclist2d(wbp w) rv = traverselist2d(w, last_bp, last_i, i, last_used, last_k); if (rv != Succeeded) return rv; - /* + /* * Set stencil buffer states back to default and save the current * render context state and position in display list */ ws->stencil_mask = 0; DefaultStencilFunc(w); - copy_2dcontext(&last_wc, wcr); + copy_2dcontext(&last_wc, wcr); last_k = k; last_i = i+1; last_used = used; @@ -978,7 +978,7 @@ int traversefunclist2d(wbp w) } else if (i == elements-1 && last_i < i) { - /* + /* * Traverse the remaining non-erasearea elements of the list */ copy_2dcontext(wcr, &last_wc); @@ -1005,10 +1005,10 @@ int traversefunclist2d(wbp w) rv = setdrawop2d(w,rp); break; case GL2D_FONT: - rv = setfont2d(w,rp); + rv = setfont2d(w,rp); break; case GL2D_LEADING: - rv = setleading2d(w,rp); + rv = setleading2d(w,rp); break; case GL2D_LINEWIDTH: rv = setlinewidth2d(w,rp); @@ -1049,7 +1049,7 @@ int traversefunclist2d(wbp w) return Succeeded; } - + /* * Find the last display list item from the 2d display list @@ -1064,38 +1064,38 @@ struct b_record *getlastlistitem(wbp w, int intcode) struct descrip *dptr; struct b_record *rp; word i, first; - - dl = BlkD(w->window->funclist2d,List); + + dl = BlkD(w->window->funclist2d,List); lastlelem = Blk(dl->listtail,Lelem); - first = lastlelem->first; + first = lastlelem->first; i = lastlelem->nused - 1; if (first) i += lastlelem->first; /* check type of last list element */ - dptr = &(lastlelem->lslots[i]); + dptr = &(lastlelem->lslots[i]); if (dptr && is:record(*dptr)) { - rp = BlkD((*dptr), Record); + rp = BlkD((*dptr), Record); if (IntVal(rp->fields[1]) == intcode) return rp; } return NULL; } - + /* * Currently only applied to the 2d facilites. - * Takes a diff of relevent context attributes. If any differ, create a + * Takes a diff of relevent context attributes. If any differ, create a * display list item for each and apply the relevent Unicon and OpenGL * state changes. * * For now, implement a brute-force approach. Create an efficient * algorithm after proof-of-concept * - * The second parameter {intcode} is only for context attribute - * item creation functions (to stop unwanted recursion). + * The second parameter {intcode} is only for context attribute + * item creation functions (to stop unwanted recursion). * Otherwise 0 is passed. */ int updaterendercontext(wbp w, int intcode) @@ -1116,26 +1116,26 @@ int updaterendercontext(wbp w, int intcode) /* apply drawop */ if (intcode != GL2D_DRAWOP && wcr->drawop != wc->drawop) { - if (wc->drawop == GL2D_DRAWOP_REVERSE) + if (wc->drawop == GL2D_DRAWOP_REVERSE) s = "reverse"; - else + else s = "copy"; if (gl_setdrawop(w, s) == RunError) { - return RunError; + return RunError; } } /* apply fg */ if (intcode != GL2D_FG && !ColorEqual(wcr->glfg,wc->glfg)) { if (gl_color(w, GL2D_FG, 0, wc->glfg.name) == RunError) { - return RunError; + return RunError; } } /* apply bg */ if (intcode != GL2D_BG && !ColorEqual(wcr->glbg,wc->glbg)) { if (gl_color(w, GL2D_BG, 0, wc->glbg.name) == RunError) { - return RunError; + return RunError; } } @@ -1154,7 +1154,7 @@ int updaterendercontext(wbp w, int intcode) } /* apply font */ - if (intcode != GL2D_FONT && wc->font != wcr->font) { + if (intcode != GL2D_FONT && wc->font != wcr->font) { if (wc->font) { if (gl_setfont(w, &(wc->font->name)) == RunError) return RunError; @@ -1174,18 +1174,18 @@ int updaterendercontext(wbp w, int intcode) /* apply fillstyle */ if (intcode != GL2D_FILLSTYLE && wcr->fillstyle != wc->fillstyle) { switch (wc->fillstyle) { - case GL2D_FILL_SOLID: - s = "solid"; + case GL2D_FILL_SOLID: + s = "solid"; break; - case GL2D_FILL_MASKED: - s = "masked"; + case GL2D_FILL_MASKED: + s = "masked"; break; - case GL2D_FILL_TEXTURED: - s = "textured"; + case GL2D_FILL_TEXTURED: + s = "textured"; break; default: syserr("invalid fillstyle"); - } + } if (gl_setfillstyle(w, s) == RunError) { return RunError; } @@ -1194,24 +1194,24 @@ int updaterendercontext(wbp w, int intcode) /* apply linestyle */ if (intcode != GL2D_LINESTYLE && wcr->linestyle != wc->linestyle) { switch (wc->linestyle) { - case GL2D_LINE_SOLID: - s = "solid"; + case GL2D_LINE_SOLID: + s = "solid"; break; - case GL2D_LINE_DASHED: - s = "dashed"; + case GL2D_LINE_DASHED: + s = "dashed"; break; - case GL2D_LINE_STRIPED: - s = "striped"; + case GL2D_LINE_STRIPED: + s = "striped"; break; default: syserr("invalid linestyle"); - } + } if (gl_setlinestyle(w, s) == RunError) { return RunError; } } - /* + /* * apply pattern - {patternname} should never be NULL */ if (intcode != GL2D_PATTERN && strcmp(wc->patternname,wcr->patternname)) { @@ -1242,7 +1242,7 @@ int updaterendercontext(wbp w, int intcode) } /* apply clipping - just generalize for all four components */ - if (intcode != GL2D_CLIP && + if (intcode != GL2D_CLIP && (wcr->clipx != wc->clipx || wcr->clipy != wc->clipy || wcr->clipw != wc->clipw || wcr->cliph != wc->cliph)) { if (gl_setclip(w) == RunError) { @@ -1266,23 +1266,23 @@ int updaterendercontext(wbp w, int intcode) } - + /* * Function for setting the OpenGL capabilities needed for the Unicon * 2D facilities */ -int init_2dcanvas(wbp w) +int init_2dcanvas(wbp w) { wsp ws = w->window; wcp wcr = &(ws->wcrender); /* byte alignment for OpenGL bitmaps/pixmaps */ - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - glPixelStorei(GL_PACK_ALIGNMENT, 1); + glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + glPixelStorei(GL_PACK_ALIGNMENT, 1); - glPixelTransferi(GL_INDEX_SHIFT, 0); - glPixelTransferi(GL_INDEX_OFFSET, 0); + glPixelTransferi(GL_INDEX_SHIFT, 0); + glPixelTransferi(GL_INDEX_OFFSET, 0); /* * Fg/Bg colors - gamma/reverse are implicit (see SetDrawopColorState()) @@ -1290,7 +1290,7 @@ int init_2dcanvas(wbp w) setcolor2d(w, NULL, GL2D_FG); setcolor2d(w, NULL, GL2D_BG); - /* + /* * Drawops */ glLogicOp(GL2D_DRAWOP_REVERSE); @@ -1300,7 +1300,7 @@ int init_2dcanvas(wbp w) * Linewidth - linestyle/fillstyle are implicit (see drawgeometry2d()) */ ApplyLinewidth(wcr->linewidth); - + /* * Patterns */ @@ -1323,12 +1323,12 @@ int init_2dcanvas(wbp w) return Succeeded; } - + /* * Remember to call MakeCurrent() before calling this function */ -int init_canvas(wbp w) +int init_canvas(wbp w) { wsp ws = w->window; wcp wc = w->context; @@ -1336,7 +1336,7 @@ int init_canvas(wbp w) /* * Copy default context state to render context and default - * context state + * context state */ ws->lastwcserial = wc->serial; ws->wcdef.display = ws->wcrender.display = wd; @@ -1347,14 +1347,14 @@ int init_canvas(wbp w) ws->busy_flag = 0; /* - * Init specific mode states + * Init specific mode states * * Need to check to make sure changes made to init_3dcanvas() did not * change behavior */ init_2dcanvas(w); if (ws->is_3D) - init_3dcanvas(w); + init_3dcanvas(w); /* Init all-encompassing mode states */ glClearDepth(1.0); @@ -1386,12 +1386,12 @@ int init_canvas(wbp w) } - -/* + +/* * Can make this a macro */ -int init_2dcontext(wcp wc) +int init_2dcontext(wcp wc) { wdp wd = wc->display; wfp *wfptr = &(wd->glfonts); @@ -1405,7 +1405,7 @@ int init_2dcontext(wcp wc) #ifdef XWindows wc->glfg.c = wd->colors[0].c; wd->colors[0].refcount++; -#endif /* XWindows */ +#endif /* XWindows */ /* default bg is white */ SetColor(wc->glbg, 65535, 65535, 65535, 65535, 0); @@ -1413,7 +1413,7 @@ int init_2dcontext(wcp wc) #ifdef XWindows wc->glbg.c = wd->colors[1].c; wd->colors[1].refcount++; -#endif /* XWindows */ +#endif /* XWindows */ wc->rgbmode = 2; wc->gamma = wd->gamma; @@ -1460,9 +1460,9 @@ int init_2dcontext(wcp wc) } - -int copy_2dcontext(wcp wcdest, wcp wcsrc) + +int copy_2dcontext(wcp wcdest, wcp wcsrc) { wcdest->rendermode = wcsrc->rendermode; wcdest->alpha = wcsrc->alpha; @@ -1472,20 +1472,20 @@ int copy_2dcontext(wcp wcdest, wcp wcsrc) #ifdef XWindows wcdest->glfg.c = wcsrc->glfg.c; wcdest->glbg.c = wcsrc->glbg.c; -#endif /* XWindows */ +#endif /* XWindows */ wcdest->drawop = wcsrc->drawop; wcdest->gamma = wcsrc->gamma; wcdest->reverse = wcsrc->reverse; if (wcsrc->font) { - if (wcdest->font) + if (wcdest->font) wcdest->font->refcount--; wcdest->font = wcsrc->font; wcdest->font->refcount++; wcdest->leading = wcsrc->leading; } - + if (wcdest->patternname) { if (strcmp(wcdest->patternname,wcsrc->patternname)) { free(wcdest->patternname); @@ -1510,13 +1510,13 @@ int copy_2dcontext(wcp wcdest, wcp wcsrc) return Succeeded; } - + /* * Allocates {ntex} OpenGL textures. If more than one are requested, the * index returned is the first of the requested array. */ -int get_tex_index(wdp wd, unsigned int ntex) +int get_tex_index(wdp wd, unsigned int ntex) { int rv; /* Max # is dependent on GLuint (65536), but reserve a fraction */ @@ -1562,22 +1562,22 @@ int delete_first_tex(wdp wd, unsigned int ndel) a = wd->texIds; j = ntex - ndel; - glDeleteTextures(ndel, a); + glDeleteTextures(ndel, a); wd->numTexIds = j; for (i = 0; i < ndel; i++) { if (j < ntex) { - a[i] = a[j]; + a[i] = a[j]; a[j++] = 0; } else - a[i] = 0; + a[i] = 0; } return Succeeded; } /* - * Frees the last {ntex} (OpenGL) resources in the texture array + * Frees the last {ntex} (OpenGL) resources in the texture array */ int delete_last_tex(wdp wd, unsigned int ndel) { @@ -1590,22 +1590,22 @@ int delete_last_tex(wdp wd, unsigned int ndel) a = wd->texIds; j = ntex - ndel; - glDeleteTextures(ndel, &(a[j])); + glDeleteTextures(ndel, &(a[j])); wd->numTexIds = j; - + for (i = ntex; i > j; i--) a[i-1] = 0; return Succeeded; } - + /* * Convert bitmap to a pixmap (RGBA). This is a helper function for using * an alpha-based pixmap for texture alpha testing. * - * {n} dictates the number of bytes per bit in the conversion. + * {n} dictates the number of bytes per bit in the conversion. * {invert} dictates whether the bitmap is inverted across the y-axis. If * {bitmap} is OpenGL formatted, then no inversion is necessary. * {bitorder} specifies whether to read bits from {bitmap} as high-to-low @@ -1617,7 +1617,7 @@ int delete_last_tex(wdp wd, unsigned int ndel) #define INVERT 1 #define LOW_TO_HIGH 0 #define HIGH_TO_LOW 1 -void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, +void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, unsigned char *pixmap, int invert, int bitorder) { int i, ix, iy, bmwidth; @@ -1634,7 +1634,7 @@ void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, unsigned char byte, c; unsigned int m; int index; - if (invert) + if (invert) index = n*((height-(iy+1))*width); else index = n*(iy*width); @@ -1658,9 +1658,9 @@ void bitmap_to_pixmap(unsigned char *bitmap, int width, int height, } } - -struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, + +struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, double *v2, word n2) { wsp ws = (w)->window; @@ -1676,7 +1676,7 @@ struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, return NULL; } - if (ap2_t) v2 = ap2_t->a; + if (ap2_t) v2 = ap2_t->a; dx = wcr->dx; dy = wcr->dy; @@ -1694,14 +1694,14 @@ struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, /* last vertex, add it to the segmented array */ nseg += 2; } - } + } /* Alloc segmented array */ nseg++; /* +1 for drawcode */ AlcRealarrayList(desc, apseg, nseg, NULL); vseg = apseg->a; vseg[0] = GL_LINES; - if (ap2_t) v2 = ap2_t->a; + if (ap2_t) v2 = ap2_t->a; /* Calculate points and place them on real array */ for (i = 0, j = 1; i < n2; i+=num) { @@ -1711,7 +1711,7 @@ struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, double deltax, deltay, theta; deltax = v2[i+2]-v2[i]; deltay = v2[i+3]-v2[i+1]; - theta = atan2(deltay, deltax); + theta = atan2(deltay, deltax); /* maybe use macros to make this faster */ len = sqrt(deltax*deltax + deltay*deltay); @@ -1732,13 +1732,13 @@ struct b_list *segment_line(wbp w, int num, struct b_realarray *ap2, vseg[j+1] = GLWORLDCOORD_RENDER_Y(w, v2[i+1]+dy); j+=2; } - } + } return (struct b_list *)BlkLoc(desc); - } + } /* - * Allocates and calculates coordinates for all geometric + * Allocates and calculates coordinates for all geometric * primitives (polygons, circles, arcs, rectangles, lines, points, * line segments). Incorporates fillstyle for the primitives which * are filled. @@ -1808,7 +1808,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) /* * These primitives are not allowed to be updated by the * user because they would incur N comparisons each time - * they are rendered. + * they are rendered. */ case GL2D_DRAWPOLYGON: case GL2D_DRAWLINE: @@ -1825,7 +1825,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) /* * Recalculate coordinates if necessary */ - if (!is:list(rp->fields[2]) || recalc || ws->resize || RecalcTranslation(w)) + if (!is:list(rp->fields[2]) || recalc || ws->resize || RecalcTranslation(w)) { switch (intcode) { case GL2D_FILLCIRCLE: @@ -1890,19 +1890,19 @@ int drawgeometry2d(wbp w, struct b_record *rp) is_complete = 0; drawcode = GL_LINE_STRIP; } - if (fill) drawcode = GL_POLYGON; - - /* calculate values */ + if (fill) drawcode = GL_POLYGON; + + /* calculate values */ dtheta = 2*Pi/(RINGS*r); n = 2*ceil(alpha/dtheta) + 1; /* +1 for drawcode */ - if (!is_complete && fill) /* for partial filled circled */ + if (!is_complete && fill) /* for partial filled circled */ n += 2; start = theta; end = theta + alpha; if (!is:list(rp->fields[2]) || n != BlkD(rp->fields[2], List)->size) AlcRealarrayList(rp_t->fields[2], ap, n, RunError); - else + else ap = (struct b_realarray *)BlkD(rp->fields[2],List)->listhead; /* @@ -1912,7 +1912,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) nseg = 2*ceil(((n-1)/2)/SKIP) + 1; /* +1 for drawcode */ switch (intcode) { case GL2D_DRAWCIRCLE: - if (!is:list(rp_t->fields[13]) || + if (!is:list(rp_t->fields[13]) || nseg != BlkD(rp_t->fields[13], List)->size) { AlcRealarrayList(rp_t->fields[13], apseg, nseg, RunError); @@ -1923,7 +1923,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) } break; case GL2D_DRAWARC: - if (!is:list(rp_t->fields[15]) || + if (!is:list(rp_t->fields[15]) || nseg != BlkD(rp_t->fields[15], List)->size) { AlcRealarrayList(rp_t->fields[15],apseg,nseg,RunError); @@ -1934,16 +1934,16 @@ int drawgeometry2d(wbp w, struct b_record *rp) } break; } - vseg = apseg->a; + vseg = apseg->a; vseg[0] = GL_LINES; } i = 0; v = ap->a; /* assign here to avoid tending issues */ v[i++] = drawcode; - if (!is_complete && fill) { /* for partial filled circled */ + if (!is_complete && fill) { /* for partial filled circled */ v[i++] = wx; - v[i++] = wy; + v[i++] = wy; } /* calculate points */ @@ -1962,7 +1962,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) /* calculate endpoint specifically */ v[n-2] = wx + rx*cos(end); v[n-1] = wy + ry*sin(-end); /* to imitate X11 rotation */ - if (!fill) { + if (!fill) { vseg[nseg-2] = v[n-2]; vseg[nseg-1] = v[n-1]; } @@ -1980,13 +1980,13 @@ int drawgeometry2d(wbp w, struct b_record *rp) GetDouble(rp->fields[6], height); /* alloc cooked array */ - if (!is:list(rp->fields[2])) { - if (intcode == GL2D_DRAWRECTANGLE) + if (!is:list(rp->fields[2])) { + if (intcode == GL2D_DRAWRECTANGLE) AlcRealarrayList(rp_t->fields[2],ap,8+1,RunError); /* for line loop */ - else + else AlcRealarrayList(rp_t->fields[2],ap,12+1,RunError); /* for triangles */ } - else + else ap = (struct b_realarray *)BlkD(rp_t->fields[2],List)->listhead; v = ap->a; n = BlkD(rp_t->fields[2], List)->size; @@ -2014,7 +2014,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) vtmp[3] = vtmp[5] = y+height; /* y2 */ if ((lp = segment_line(w,2,NULL,vtmp,SIZE)) == NULL) { - return RunError; + return RunError; } BlkLoc(rp_t->fields[11]) = (union block *)lp; rp_t->fields[11].dword = D_List; @@ -2026,13 +2026,13 @@ int drawgeometry2d(wbp w, struct b_record *rp) else { /* fill */ /* (x1,y1)->(x1,y2)->(x2,y1) (x2,y1)->(x1,y2)->(x2,y2) */ v[0] = GL_TRIANGLES; - v[j] = v[j+2] = v[j+8] = GLWORLDCOORD_RENDER_X(w, x); - v[j+1] = v[j+5] = v[j+7] = GLWORLDCOORD_RENDER_Y(w, y); - v[j+4] = v[j+6] = v[j+10] = GLWORLDCOORD_RENDER_X(w, x+width); - v[j+3] = v[j+9] = v[j+11] = GLWORLDCOORD_RENDER_Y(w, y+height); + v[j] = v[j+2] = v[j+8] = GLWORLDCOORD_RENDER_X(w, x); + v[j+1] = v[j+5] = v[j+7] = GLWORLDCOORD_RENDER_Y(w, y); + v[j+4] = v[j+6] = v[j+10] = GLWORLDCOORD_RENDER_X(w, x+width); + v[j+3] = v[j+9] = v[j+11] = GLWORLDCOORD_RENDER_Y(w, y+height); } break; - } + } case GL2D_FILLPOLYGON: case GL2D_DRAWPOINT: @@ -2057,11 +2057,11 @@ int drawgeometry2d(wbp w, struct b_record *rp) switch (intcode) { case GL2D_FILLPOLYGON: switch (polytype) { - case POLY_NONCONVEX: - case POLY_COMPLEX: + case POLY_NONCONVEX: + case POLY_COMPLEX: drawcode = GL_TRIANGLE_FAN; break; - case POLY_CONVEX: + case POLY_CONVEX: drawcode = GL_POLYGON; break; } @@ -2084,17 +2084,17 @@ int drawgeometry2d(wbp w, struct b_record *rp) for (i = 1; i < n; i+=2) { v[i] = GLWORLDCOORD_RENDER_X(w, v2[i-1]+dx); v[i+1] = GLWORLDCOORD_RENDER_Y(w, v2[i]+dy); - } + } if (!fill && intcode != GL2D_DRAWPOINT) { /* segment lines */ - if (intcode == GL2D_DRAWSEGMENT) + if (intcode == GL2D_DRAWSEGMENT) num = 4; - else + else num = 2; /* pass {ap2->a} instead of {v2} because its tended */ if ((lp = segment_line(w,num,ap2,NULL,n2)) == NULL) { - return RunError; + return RunError; } BlkLoc(rp_t->fields[4]) = (union block *)lp; rp_t->fields[4].dword = D_List; @@ -2104,7 +2104,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) v = ap->a; /* in case of GC */ } break; - } + } default: glprintf("Invalid record type\n"); return Failed; @@ -2138,7 +2138,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) break; case GL2D_DRAWPOLYGON: case GL2D_DRAWLINE: - case GL2D_DRAWSEGMENT: + case GL2D_DRAWSEGMENT: apseg = (struct b_realarray *)BlkD(rp->fields[4],List)->listhead; nseg = BlkD(rp->fields[4], List)->size; vseg = apseg->a; @@ -2155,10 +2155,10 @@ int drawgeometry2d(wbp w, struct b_record *rp) * Render primitive * * Linestyle and fillstyle are accounted for during this time for line - * and filled primitives respectively. Points are the only primitive + * and filled primitives respectively. Points are the only primitive * that are rendered as is. * - * NOTE: Transparency won't work when drawop="xor"/"reverse". + * NOTE: Transparency won't work when drawop="xor"/"reverse". */ glPushMatrix(); glTranslated(0,0,-CNEAR); @@ -2173,9 +2173,9 @@ int drawgeometry2d(wbp w, struct b_record *rp) case GL2D_FILLRECTANGLE: /* * For complex and nonconvex polygons: - * Use a 2-pass stencil algorithm where writing to the color buffer is - * disabled on the first pass to only draw to the stencil buffer. - * Only regions drawn to an odd number of times (1st pass) will have a + * Use a 2-pass stencil algorithm where writing to the color buffer is + * disabled on the first pass to only draw to the stencil buffer. + * Only regions drawn to an odd number of times (1st pass) will have a * '1' will be drawn to on the second pass. * * http://www.glprogramming.com/red/chapter14.html#name13 @@ -2191,7 +2191,7 @@ int drawgeometry2d(wbp w, struct b_record *rp) DisableStencilWrite(); /* - * Second pass + * Second pass */ RenderRealarrayFillstyle(w, v, n, GL2D_DRAW_BIT); } @@ -2214,12 +2214,12 @@ int drawgeometry2d(wbp w, struct b_record *rp) return Succeeded; } - + /* * Draws a bi-level image using bitmaps. */ -int drawblimage2d(wbp w, struct b_record *rp) +int drawblimage2d(wbp w, struct b_record *rp) { wsp ws = w->window; wdp wd = ws->display; @@ -2239,16 +2239,16 @@ int drawblimage2d(wbp w, struct b_record *rp) ch = (char)IntVal(rp->fields[7]); if (is:integer(rp->fields[8]) && is:integer(rp->fields[9])) { - texid = IntVal(rp->fields[8]); - index = IntVal(rp->fields[9]); + texid = IntVal(rp->fields[8]); + index = IntVal(rp->fields[9]); - if (wd->texIds[index] != texid) + if (wd->texIds[index] != texid) update = 1; - else + else UGLBindTexture(GL_TEXTURE_2D, texid); } else - update = 1; + update = 1; if (update) { tended struct b_record *rp_t = rp; @@ -2261,7 +2261,7 @@ int drawblimage2d(wbp w, struct b_record *rp) bmwidth++; bytes = bmwidth*height; - bitmap = (unsigned char *)malloc(bytes); + bitmap = (unsigned char *)malloc(bytes); if (!bitmap) return RunError; /* @@ -2279,28 +2279,28 @@ int drawblimage2d(wbp w, struct b_record *rp) m = msk1; while (len--) { if (isxdigit(c = *s++)) { /* if hexadecimal character */ - if (!isdigit(c)) /* fix bottom 4 bits if necessary */ - c += 9; - while (m > 0) { /* set (usually) 4 pixel values */ - --ix; + if (!isdigit(c)) /* fix bottom 4 bits if necessary */ + c += 9; + while (m > 0) { /* set (usually) 4 pixel values */ + --ix; index = ix/8 + bmwidth*(height-(iy+1)); shift = 7 - ix % 8; - if (c & m) { + if (c & m) { bitmap[index] |= 1 << shift; /* set */ - } - else { + } + else { bitmap[index] &= ~(1 << shift); /* clear */ - } - m >>= 1; - } - if (ix == 0) { /* if end of row */ - ix = width; - iy++; - m = msk1; - } - else - m = 8; - } + } + m >>= 1; + } + if (ix == 0) { /* if end of row */ + ix = width; + iy++; + m = msk1; + } + else + m = 8; + } } if (ix > 0) { /* pad final row if incomplete */ while (ix < width) { @@ -2316,13 +2316,13 @@ int drawblimage2d(wbp w, struct b_record *rp) index = get_tex_index(wd, 1); texptr = &(wd->texIds[index]); InitTexture2d(texptr); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, - GL_UNSIGNED_BYTE, tmp, RunError); + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, + GL_UNSIGNED_BYTE, tmp, RunError); free(tmp); free(bitmap); - MakeInt(*texptr, &(rp->fields[8])); - MakeInt(index, &(rp->fields[9])); + MakeInt(*texptr, &(rp->fields[8])); + MakeInt(index, &(rp->fields[9])); } AddDxDy(w, x, y, width, height); @@ -2330,19 +2330,19 @@ int drawblimage2d(wbp w, struct b_record *rp) if (ch == TCH1) /* transparent background */ RenderTexturedBitmapRect(w,x,y,width,height,width,height,-CNEAR, TRANSP_BG); - else + else RenderTexturedBitmapRect(w,x,y,width,height,width,height,-CNEAR,FILL_BG); UGLBindTexture(GL_TEXTURE_2D, 0); /* unbind */ return Succeeded; } - + /* * Draw an image loaded from a file */ -int drawreadimage2d(wbp w, struct b_record *rp) +int drawreadimage2d(wbp w, struct b_record *rp) { wsp ws = w->window; wdp wd = ws->display; @@ -2360,8 +2360,8 @@ int drawreadimage2d(wbp w, struct b_record *rp) is_pixmap = IntVal(rp->fields[6]); if (is:integer(rp->fields[8]) && is:integer(rp->fields[9])) { - texid = IntVal(rp->fields[8]); - index = IntVal(rp->fields[9]); + texid = IntVal(rp->fields[8]); + index = IntVal(rp->fields[9]); if (wd->texIds[index] != texid) update = 1; @@ -2369,8 +2369,8 @@ int drawreadimage2d(wbp w, struct b_record *rp) UGLBindTexture(GL_TEXTURE_2D, texid); } else - update = 1; - + update = 1; + if (update) { unsigned int *texptr; @@ -2381,7 +2381,7 @@ int drawreadimage2d(wbp w, struct b_record *rp) if (is_pixmap) { UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGB8, width, height, 0, GL_RGB, - GL_UNSIGNED_BYTE, img, RunError); + GL_UNSIGNED_BYTE, img, RunError); } else { unsigned char *tmp; @@ -2389,14 +2389,14 @@ int drawreadimage2d(wbp w, struct b_record *rp) tmp = malloc(4*width*height); if (!tmp) return RunError; bitmap_to_pixmap(img, width, height, tmp, DONT_INVERT, HIGH_TO_LOW); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmp, RunError); free(tmp); } - MakeInt(texid = *texptr, &(rp->fields[8])); - MakeInt(index, &(rp->fields[9])); - } + MakeInt(texid = *texptr, &(rp->fields[8])); + MakeInt(index, &(rp->fields[9])); + } AddDxDy(w, x, y, width, height); @@ -2404,7 +2404,7 @@ int drawreadimage2d(wbp w, struct b_record *rp) RenderTexturedRect(w, x, y, width, height, width, height, -CNEAR); } else { /* bitmap */ - RenderTexturedBitmapRect(w, x, y, width, height, width, height, -CNEAR, + RenderTexturedBitmapRect(w, x, y, width, height, width, height, -CNEAR, TRANSP_BG); } @@ -2412,9 +2412,9 @@ int drawreadimage2d(wbp w, struct b_record *rp) return Succeeded; } - -int drawstrimage2d(wbp w, struct b_record *rp) + +int drawstrimage2d(wbp w, struct b_record *rp) { wsp ws = w->window; wdp wd = ws->display; @@ -2433,7 +2433,7 @@ int drawstrimage2d(wbp w, struct b_record *rp) if (is:integer(rp->fields[7]) && is:integer(rp->fields[8])) { texid = IntVal(rp->fields[7]); index = IntVal(rp->fields[8]); - if (wd->texIds[index] != texid) + if (wd->texIds[index] != texid) update = 1; else UGLBindTexture(GL_TEXTURE_2D, texid); @@ -2441,20 +2441,20 @@ int drawstrimage2d(wbp w, struct b_record *rp) else { update = 1; } - + /* (re)allocate texture */ if (update) { unsigned int *texptr; - pixmap = (unsigned char *)StrLoc(rp->fields[6]); + pixmap = (unsigned char *)StrLoc(rp->fields[6]); index = get_tex_index(wd, 1); texptr = &(wd->texIds[index]); InitTexture2d(texptr); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, - GL_UNSIGNED_BYTE, pixmap, RunError); + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, + GL_UNSIGNED_BYTE, pixmap, RunError); - MakeInt(texid = *texptr, &(rp->fields[7])); - MakeInt(index, &(rp->fields[8])); + MakeInt(texid = *texptr, &(rp->fields[7])); + MakeInt(index, &(rp->fields[8])); } AddDxDy(w, x, y, width, height); @@ -2463,16 +2463,16 @@ int drawstrimage2d(wbp w, struct b_record *rp) return Succeeded; } - -int drawstring2d(wbp w, struct b_record *rp) + +int drawstring2d(wbp w, struct b_record *rp) { wsp ws = w->window; wcp wcr = &(ws->wcrender); int len, fill, rv; double x, y; char *s; - + if (!rp) return Failed; switch (IntVal(rp->fields[1])) { @@ -2504,11 +2504,11 @@ int drawstring2d(wbp w, struct b_record *rp) } } - + /* * Uses FreeType to create the text pixmap. Creates the display list - * entry and calls drawstring2d() to render the text pixmap. + * entry and calls drawstring2d() to render the text pixmap. * * It appears that the RC or XY position specifies the bottom left corner * of the text block to be drawn. @@ -2524,7 +2524,7 @@ int drawstring2d(wbp w, struct b_record *rp) /* * (x,y) specifies the lower-left hand corner of the string. */ -int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, +int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, int fill, int draw) { wsp ws = w->window; @@ -2536,9 +2536,9 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, char *ptr = s; FT_Face face = wf->face; - fheight = FT_FHEIGHT(face); + fheight = FT_FHEIGHT(face); fdescent = FT_DESCENT(face); - penx = startx = x; + penx = startx = x; peny = y + fdescent; /* center vertically around global font baseline */ textwidth = 0; @@ -2570,14 +2570,14 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, } /* get glyph bitmap dimensions */ - glyph = wf->face->glyph; + glyph = wf->face->glyph; ftbitmap = glyph->bitmap; bitmap = ftbitmap.buffer; bmwidth = ftbitmap.pitch; /* # of bytes per row (incl. padding) */ if (bmwidth < 0) bmwidth = -bmwidth; - sym->height = ftbitmap.rows; - sym->width = 8*bmwidth; + sym->height = ftbitmap.rows; + sym->width = 8*bmwidth; sym->advance = glyph->advance.x >> 6; sym->top_bearing = glyph->bitmap_top; sym->left_bearing = glyph->bitmap_left; @@ -2589,7 +2589,7 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, bitmap_to_pixmap(bitmap, sym->width, sym->height, sym->pixmap, INVERT, HIGH_TO_LOW); } - + if (draw) { double x1, y1; @@ -2600,8 +2600,8 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, sym->index = get_tex_index(wd, 1); texptr = &(wd->texIds[sym->index]); InitTexture2d(texptr); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, sym->width, - sym->height, 0, GL_RGBA, GL_UNSIGNED_BYTE, + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, sym->width, + sym->height, 0, GL_RGBA, GL_UNSIGNED_BYTE, sym->pixmap, RunError); sym->texid = *texptr; } @@ -2610,9 +2610,9 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, } /* - * Draw to stencil buffer - * - * Position character (low left corner) by using the left and top + * Draw to stencil buffer + * + * Position character (low left corner) by using the left and top * bearing values. See FreeType glyph metrics. */ x1 = penx + sym->left_bearing; @@ -2646,19 +2646,19 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, return textwidth; } -#else /* HAVE_LIBFREETYPE */ +#else /* HAVE_LIBFREETYPE */ -int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, +int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, int fill, int draw) { return Failed; } -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ + - -/* +/* * 2d CopyArea() semantics (!ws->is_3D) * Copies all pixels (same as legacy semantics) * @@ -2668,7 +2668,7 @@ int drawstringhelper(wbp w, double x, double y, double z, char *s, int len, #define OffscreenPixel(ws, x, y, ix, iy) \ ((real_iy+y < 0 || real_iy+y > (ws)->height || ix+x < 0 ||\ ix+x > (ws)->width)) -int copyarea2d(wbp w2, struct b_record *rp) +int copyarea2d(wbp w2, struct b_record *rp) { wbp w, tmp1, tmp2; wsp ws2 = w2->window, ws; @@ -2720,23 +2720,23 @@ int copyarea2d(wbp w2, struct b_record *rp) index = (unsigned int)IntVal(rp->fields[10]); if (w) { - wd = w->window->display; + wd = w->window->display; } else { /* Since window is closed, the binding has been freed */ rp->fields[2] = nulldesc; /* - * if window is closed, assume same display + * if window is closed, assume same display * TODO: expand to encompass different displays - */ - wd = ws2->display; + */ + wd = ws2->display; } /* check if texture is still alive */ - if (wd->texIds[index] == texid) - UGLBindTexture(GL_TEXTURE_2D, texid); - else + if (wd->texIds[index] == texid) + UGLBindTexture(GL_TEXTURE_2D, texid); + else update = 1; } else if (w) { @@ -2761,7 +2761,7 @@ int copyarea2d(wbp w2, struct b_record *rp) ws = w->window; - /* + /* * Get area from source window */ MakeCurrent(w); @@ -2769,14 +2769,14 @@ int copyarea2d(wbp w2, struct b_record *rp) /* check for out-of-bounds rectangle */ if ((x+width > ws->width || x < 0) || (y+height > ws->height || y < 0)) { - outofbounds = 1; + outofbounds = 1; } - px = x; + px = x; py = ws->height - (y + height); /* correct for OpenGL conventions */ /* get color buffer */ - size = width*height; + size = width*height; pixmap = (unsigned char *)malloc(4*size); if (!pixmap) return RunError; glReadPixels(px,py,width,height,GL_RGBA,GL_UNSIGNED_BYTE,pixmap); @@ -2792,11 +2792,11 @@ int copyarea2d(wbp w2, struct b_record *rp) for (ix = 0; ix < width; ix++) { /* make off-screen pixels transparent */ if (outofbounds && OffscreenPixel(ws,x,y,ix,real_iy)) { - pixmap[4*(iy*width+ix)+3] = 0; + pixmap[4*(iy*width+ix)+3] = 0; } /* make 3D pixels transparent */ else if (depth[iy*width+ix] != 0) { - pixmap[4*(iy*width+ix)+3] = 0; + pixmap[4*(iy*width+ix)+3] = 0; } } } @@ -2824,8 +2824,8 @@ int copyarea2d(wbp w2, struct b_record *rp) index = get_tex_index(wd, 1); texptr = &(wd->texIds[index]); InitTexture2d(texptr); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, - GL_UNSIGNED_BYTE, pixmap, RunError); + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, height, 0, GL_RGBA, + GL_UNSIGNED_BYTE, pixmap, RunError); free(pixmap); /* Update field values */ @@ -2840,20 +2840,20 @@ int copyarea2d(wbp w2, struct b_record *rp) return Succeeded; } - + /* * 2D semantics (!ws->is_3D): * Erases everything in the specified area - * 2D/3D semantics (ws->is_3D): + * 2D/3D semantics (ws->is_3D): * Erases only 2D/HUD pixels in the specified area. This is done with - * a unique traversal algorithm in traversefunclist2d(). + * a unique traversal algorithm in traversefunclist2d(). */ -int erasearea2d(wbp w, struct b_record *rp) +int erasearea2d(wbp w, struct b_record *rp) { wsp ws = w->window; double x, y, width, height; - + if (!rp) return Failed; GetDouble(rp->fields[2], x); @@ -2867,7 +2867,7 @@ int erasearea2d(wbp w, struct b_record *rp) /* this should only run during a 3d's windows traversal redraw */ glColorMask(GL_FALSE, GL_FALSE, GL_FALSE, GL_FALSE); glDepthMask(GL_FALSE); - EnableStencilWrite(GL2D_ERASE_BIT,0xFF,GL_ZERO); + EnableStencilWrite(GL2D_ERASE_BIT,0xFF,GL_ZERO); RenderFilledRect(x, y, width, height, -CNEAR); DisableStencilWrite(); glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); @@ -2876,7 +2876,7 @@ int erasearea2d(wbp w, struct b_record *rp) else { /* * Draw bg color to the far plane of the viewing volumes. This - * erases all primitives in the rectangular area. 3d primitives + * erases all primitives in the rectangular area. 3d primitives * are drawn after 2d primitives to make this work */ SetDrawopColorState(w, wcr->drawop, BG); @@ -2890,18 +2890,18 @@ int erasearea2d(wbp w, struct b_record *rp) return Succeeded; } - + /* * Attributes */ - + /* * Sets the render context's fg/bg to the appropriate values using * display list items. - * SetDrawopColorState() actually sets the OpenGL color states. + * SetDrawopColorState() actually sets the OpenGL color states. */ int setcolor2d(wbp w, struct b_record *rp, int type) { @@ -2909,22 +2909,22 @@ int setcolor2d(wbp w, struct b_record *rp, int type) wcp wcr = &(ws->wcrender); int index, intcode; unsigned int r, g, b, a; - + /* * No display list entry, so use the current render context color - * specified by type. + * specified by type. */ if (!rp) { switch (intcode = type) { - case GL2D_FG: + case GL2D_FG: GetColorUS(w, wcr->glfg, r, g, b, a); index = wcr->glfg.id; break; - case GL2D_BG: + case GL2D_BG: GetColorUS(w, wcr->glbg, r, g, b, a); index = wcr->glbg.id; break; - default: + default: glprintf("incorrect record type\n"); return Failed; } @@ -2937,13 +2937,13 @@ int setcolor2d(wbp w, struct b_record *rp, int type) GetInt(rp->fields[2], index); if (find_mutable(w, index) == NULL) { glprintf("Mutable color not found\n"); - return Failed; + return Failed; } r = g = b = a = 0; } /* non-mutable color */ else { - index = 0; + index = 0; GetInt(rp->fields[3], r); GetInt(rp->fields[4], g); GetInt(rp->fields[5], b); @@ -2952,11 +2952,11 @@ int setcolor2d(wbp w, struct b_record *rp, int type) } if (intcode == GL2D_FG) { - SetColor(wcr->glfg, r, g, b, a, index); - SetDrawopColorState(w, wcr->drawop, FG); + SetColor(wcr->glfg, r, g, b, a, index); + SetDrawopColorState(w, wcr->drawop, FG); } else if (intcode == GL2D_BG) { - SetColor(wcr->glbg, r, g, b, a, index); + SetColor(wcr->glbg, r, g, b, a, index); if (wcr->reverse || wcr->drawop == GL2D_DRAWOP_REVERSE) SetDrawopColorState(w, wcr->drawop, FG); } @@ -2964,11 +2964,11 @@ int setcolor2d(wbp w, struct b_record *rp, int type) return Succeeded; } - + /* * Sets the current fg color to the fg color xor'd with the bg color - * if drawop="reverse". + * if drawop="reverse". * * Need to take into consideration mutable colors and the implications * for updating the fg color when in drawop="reverse" @@ -2991,14 +2991,14 @@ int setdrawop2d(wbp w, struct b_record *rp) } } else { - wcr->drawop = wc->drawop; + wcr->drawop = wc->drawop; } ApplyDrawop(w, wcr->drawop); return Succeeded; } -int setgamma2d(wbp w, struct b_record *rp) +int setgamma2d(wbp w, struct b_record *rp) { if (!rp) return Failed; GetReal(&(rp->fields[2]), w->window->wcrender.gamma); @@ -3009,10 +3009,10 @@ int setgamma2d(wbp w, struct b_record *rp) /* * Toggles "reverse" attribute */ -int togglefgbg2d(wbp w) +int togglefgbg2d(wbp w) { wcp wcr = &(w->window->wcrender); - + wcr->reverse = !(wcr->reverse); /* set OpenGL color state using render context */ @@ -3020,7 +3020,7 @@ int togglefgbg2d(wbp w) return Succeeded; } -int setfont2d(wbp w, struct b_record *rp) +int setfont2d(wbp w, struct b_record *rp) { wsp ws = w->window; wcp wcr = &(ws->wcrender); @@ -3037,19 +3037,19 @@ int setfont2d(wbp w, struct b_record *rp) if (!wf) return Failed; - /* update render context */ - if (wcr->font) - wcr->font->refcount--; + /* update render context */ + if (wcr->font) + wcr->font->refcount--; wcr->font = wf; wcr->leading = FT_FHEIGHT(wf->face); - wcr->font->refcount--; + wcr->font->refcount--; - return Succeeded; + return Succeeded; } - -int setleading2d(wbp w, struct b_record *rp) + +int setleading2d(wbp w, struct b_record *rp) { wsp ws = w->window; wcp wcr = &(ws->wcrender); @@ -3059,7 +3059,7 @@ int setleading2d(wbp w, struct b_record *rp) return Succeeded; } - + int setlinewidth2d(wbp w, struct b_record *rp) { @@ -3071,7 +3071,7 @@ int setlinewidth2d(wbp w, struct b_record *rp) return Succeeded; } - + int setlinestyle2d(wbp w, struct b_record *rp) { @@ -3096,7 +3096,7 @@ int setlinestyle2d(wbp w, struct b_record *rp) return Succeeded; } - + int setfillstyle2d(wbp w, struct b_record *rp) { @@ -3106,7 +3106,7 @@ int setfillstyle2d(wbp w, struct b_record *rp) int len; if (!rp) return Failed; - + GetStr(rp->fields[2], s, len); if (!strncmp(s, "solid", len)) { wcr->fillstyle = GL2D_FILL_SOLID; @@ -3121,9 +3121,9 @@ int setfillstyle2d(wbp w, struct b_record *rp) return Succeeded; } - -int setpattern2d(wbp w, struct b_record *rp) + +int setpattern2d(wbp w, struct b_record *rp) { wsp ws = w->window; wcp wcr = &(ws->wcrender); @@ -3141,18 +3141,18 @@ int setpattern2d(wbp w, struct b_record *rp) update = (slen <= s1len) ? strncmp(s, s1, slen) : strncmp(s, s1, s1len); if (update) { /* - * TODO: If a texture id is already active (and is not a std pattern), + * TODO: If a texture id is already active (and is not a std pattern), * load a new texture into it */ - MakeStr(s, slen, &(rp->fields[3])); + MakeStr(s, slen, &(rp->fields[3])); } - else { + else { if (is:integer(rp->fields[6]) && is:integer(rp->fields[7])) { texid = (unsigned int) IntVal(rp->fields[6]); index = (unsigned int) IntVal(rp->fields[7]); /* Check if non-std pattern needs to be reallocated */ - if (index && texid != wd->texIds[index]) { + if (index && texid != wd->texIds[index]) { update = 1; } else { @@ -3174,7 +3174,7 @@ int setpattern2d(wbp w, struct b_record *rp) if (update) { /* - * Allocate texture + * Allocate texture */ int size; int i, j; @@ -3192,7 +3192,7 @@ int setpattern2d(wbp w, struct b_record *rp) nbits = MAXXOBJS; switch (parsepattern(s, slen, &width, &nbits, bits)) { case Failed: - return Failed; + return Failed; case RunError: return RunError; } @@ -3216,7 +3216,7 @@ int setpattern2d(wbp w, struct b_record *rp) */ nbits = width = 8; if (wd->stdPatTexIds[symbol] > 0) { - texid = wd->stdPatTexIds[symbol]; + texid = wd->stdPatTexIds[symbol]; } else { for(i = 0; i < 8; i++) { @@ -3228,11 +3228,11 @@ int setpattern2d(wbp w, struct b_record *rp) } if (!texptr) { /* stdpat already allocated */ - UGLBindTexture(GL_TEXTURE_2D, texid); + UGLBindTexture(GL_TEXTURE_2D, texid); } else { /* - * Convert from bits to bytes. + * Convert from bits to bytes. * * Need to invert the pattern across the y-axis since OpenGL reads * from the lower left corner first (bottom to top, left to right) @@ -3247,8 +3247,8 @@ int setpattern2d(wbp w, struct b_record *rp) * Generate a texture based off the pattern (img) */ InitTexture2d(texptr); - UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, nbits, 0, - GL_RGBA, GL_UNSIGNED_BYTE, img, RunError); + UGLTexImage2D(wd, GL_TEXTURE_2D, 0, GL_RGBA8, width, nbits, 0, + GL_RGBA, GL_UNSIGNED_BYTE, img, RunError); free(img); } @@ -3256,16 +3256,16 @@ int setpattern2d(wbp w, struct b_record *rp) * Update record fields */ if (rp) { - MakeInt(width, &(rp->fields[4])); - MakeInt(nbits, &(rp->fields[5])); + MakeInt(width, &(rp->fields[4])); + MakeInt(nbits, &(rp->fields[5])); if (texptr) MakeInt(*texptr, &(rp->fields[6])); else MakeInt(texid, &(rp->fields[6])); /* - * Index of 0 indicates it is a std pattern, otherwise it is the index + * Index of 0 indicates it is a std pattern, otherwise it is the index * into the general texture id array (wd->texIds) - */ + */ MakeInt(index, &(rp->fields[7])); } } @@ -3301,23 +3301,23 @@ int setpattern2d(wbp w, struct b_record *rp) return Succeeded; } - + /* - * Uses scissor test to implement 2D clipping. + * Uses scissor test to implement 2D clipping. */ -int setclip2d(wbp w, struct b_record *rp) +int setclip2d(wbp w, struct b_record *rp) { wsp ws = w->window; wcp wcr = &(ws->wcrender); int clipx, clipy, clipw, cliph; if (rp == NULL) { - clipx = wcr->clipx; - clipy = wcr->clipy; - clipw = wcr->clipw; - cliph = wcr->cliph; - } + clipx = wcr->clipx; + clipy = wcr->clipy; + clipw = wcr->clipw; + cliph = wcr->cliph; + } else { GetInt(rp->fields[2], clipx); GetInt(rp->fields[3], clipy); @@ -3329,14 +3329,14 @@ int setclip2d(wbp w, struct b_record *rp) wcr->clipy = clipy; wcr->clipw = clipw; wcr->cliph = cliph; - } + } /* clipping disabled */ if (clipx == 0 && clipy == 0 && clipw == -1 && cliph == -1) { if (glIsEnabled(GL_SCISSOR_TEST) == GL_TRUE) glDisable(GL_SCISSOR_TEST); } - else { + else { if (glIsEnabled(GL_SCISSOR_TEST) == GL_FALSE) glEnable(GL_SCISSOR_TEST); @@ -3348,7 +3348,7 @@ int setclip2d(wbp w, struct b_record *rp) return Succeeded; } - + int setdx2d(wbp w, struct b_record *rp) { @@ -3357,15 +3357,15 @@ int setdx2d(wbp w, struct b_record *rp) GetInt(rp->fields[2], wcr->dx); if (wcr->dx != IntVal(rp->fields[3])) { - ws->dx_flag = 1; - IntVal(rp->fields[3]) = wcr->dx; + ws->dx_flag = 1; + IntVal(rp->fields[3]) = wcr->dx; } - else + else ws->dx_flag = 0; return Succeeded; } - + int setdy2d(wbp w, struct b_record *rp) { @@ -3374,29 +3374,29 @@ int setdy2d(wbp w, struct b_record *rp) GetInt(rp->fields[2], wcr->dy); if (wcr->dy != IntVal(rp->fields[3])) { - ws->dy_flag = 1; - IntVal(rp->fields[3]) = wcr->dy; + ws->dy_flag = 1; + IntVal(rp->fields[3]) = wcr->dy; } else - ws->dy_flag = 0; + ws->dy_flag = 0; return Succeeded; } - + /****************************************************** * (2) Drawing functions (creates display list entry) * ******************************************************/ -/* - * Draw a bi-level image (1-bit-per-pixel, encoded as a string) image. +/* + * Draw a bi-level image (1-bit-per-pixel, encoded as a string) image. * Used in DrawImage(). Creates and stores bitmap record. The origin (x,y) - * of the bi-level image is in the upper left-hand corner. + * of the bi-level image is in the upper left-hand corner. * * Pixel value of 1 corresponds to fg color, 0 to bg color. */ -int gl_blimage(wbp w, int x, int y, int width, int height, int ch, +int gl_blimage(wbp w, int x, int y, int width, int height, int ch, unsigned char *s, word len) { wsp ws = w->window; @@ -3447,7 +3447,7 @@ int gl_blimage(wbp w, int x, int y, int width, int height, int ch, #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -3455,7 +3455,7 @@ int gl_blimage(wbp w, int x, int y, int width, int height, int ch, } - + /* * Called by ReadImage(). Read an image from file and draw it at (x,y). @@ -3505,13 +3505,13 @@ int gl_readimage(wbp w, char *filename, int x, int y, int *status) glDisable(GL_LIGHTING); rv = drawreadimage2d(w, rp); glEnable(GL_LIGHTING); - if (rv != Succeeded) + if (rv != Succeeded) return rv; c_put(&(ws->funclist2d), &f); #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -3519,7 +3519,7 @@ int gl_readimage(wbp w, char *filename, int x, int y, int *status) return Succeeded; } - + /* * Macro for strimage to use in place of XPutPixel(). (clr) is of type @@ -3582,12 +3582,12 @@ int gl_strimage(wbp w, int x, int y, int width, int height, struct palentry *e, /* encode rgb values for each pixel */ size = width*height; - Protect(pixmap = alcstr(NULL,4*size), return RunError); + Protect(pixmap = alcstr(NULL,4*size), return RunError); /* store pre-cooked image value */ - MakeStr(pixmap, 4*size, &(rp->fields[6])); - rp->fields[7] = nulldesc; - rp->fields[8] = nulldesc; + MakeStr(pixmap, 4*size, &(rp->fields[6])); + rp->fields[7] = nulldesc; + rp->fields[8] = nulldesc; /* * String (s) specifies a color within palette entry (e). The RGB @@ -3604,20 +3604,20 @@ int gl_strimage(wbp w, int x, int y, int width, int height, struct palentry *e, while (len--) { c = *s++; v = e[c].valid; - if (v) { /* put char if valid */ + if (v) { /* put char if valid */ PutPixelPixmapEncodeGamma(w,pixmap,width,height,ix,iy,e[c].clr); } /* keep track of transparent pixels */ if (e[c].transpt) { - pixmap[4*((height-1-iy)*width+ix)+3] = 0; + pixmap[4*((height-1-iy)*width+ix)+3] = 0; } else - pixmap[4*((height-1-iy)*width+ix)+3] = alpha; + pixmap[4*((height-1-iy)*width+ix)+3] = alpha; - if (v || e[c].transpt) { /* advance if valid or transparent */ + if (v || e[c].transpt) { /* advance if valid or transparent */ if (++ix >= width) { - ix = 0; /* reset for new row */ + ix = 0; /* reset for new row */ iy++; } } @@ -3641,7 +3641,7 @@ int gl_strimage(wbp w, int x, int y, int width, int height, struct palentry *e, PutPixelPixmap(w,pixmap,width,height,ix,iy,clr); /* keep track of non-transparent pixels */ - pixmap[4*((height-1-iy)*width+ix)+3] = alpha; + pixmap[4*((height-1-iy)*width+ix)+3] = alpha; ix++; } iy++; @@ -3655,7 +3655,7 @@ int gl_strimage(wbp w, int x, int y, int width, int height, struct palentry *e, #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -3663,13 +3663,13 @@ int gl_strimage(wbp w, int x, int y, int width, int height, struct palentry *e, return 0; /* OpenGL doesn't need to allocate colors... */ } - + /* * Draws text at (x,y) without background fill. Affected by translational * coordinates and not affect by cursor position. */ -int gl_drawstrng(wbp w, int x, int y, char *s, int len) +int gl_drawstrng(wbp w, int x, int y, char *s, int len) { wsp ws = w->window; wcp wcr = &(ws->wcrender); @@ -3695,7 +3695,7 @@ int gl_drawstrng(wbp w, int x, int y, char *s, int len) MakeInt(intcode, &(rp->fields[1])); MakeInt(x - wcr->dx, &(rp->fields[2])); MakeInt(y - wcr->dy, &(rp->fields[3])); - + Protect(str = alcstr(s, len), return RunError); MakeStr(str, len, &(rp->fields[4])); @@ -3711,7 +3711,7 @@ int gl_drawstrng(wbp w, int x, int y, char *s, int len) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -3719,7 +3719,7 @@ int gl_drawstrng(wbp w, int x, int y, char *s, int len) return Succeeded; } - + /* * Draws text at (ws->posx,ws->posy) with background fill around the bounding @@ -3767,7 +3767,7 @@ int gl_xdis(wbp w, char *s, int len) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -3775,14 +3775,14 @@ int gl_xdis(wbp w, char *s, int len) return Succeeded; } - + /* * Need to discuss semantics - if CopyArea() (no args), should it still * be a pixmap image, or should the display list be copied? It seems like * the former would be faster for a large display list. */ -int gl_copyArea(wbp w1, wbp w2, int x, int y, int width, int height, int x2, +int gl_copyArea(wbp w1, wbp w2, int x, int y, int width, int height, int x2, int y2) { wsp ws1 = w1->window, ws2 = w2->window; @@ -3810,19 +3810,19 @@ int gl_copyArea(wbp w1, wbp w2, int x, int y, int width, int height, int x2, } /* - * Now that the display list is gone, make the current render - * context the default context. + * Now that the display list is gone, make the current render + * context the default context. * the window with the new context. */ copy_2dcontext(&(ws2->wcdef), &(ws2->wcrender)); } RemoveDxDy(w1, x, y, width, height); - /* - * Hard to know if (x,y) of (0,0) is a default, or has been dx/dy + /* + * Hard to know if (x,y) of (0,0) is a default, or has been dx/dy * corrected. For now, assume that (0,0) is a default. */ - RemoveDxDy(w2, x2, y2, width, height); + RemoveDxDy(w2, x2, y2, width, height); Get2dRecordConstr(constr, intcode); nfields = (int)BlkD(*constr,Proc)->nfields; @@ -3850,20 +3850,20 @@ int gl_copyArea(wbp w1, wbp w2, int x, int y, int width, int height, int x2, return rv; } - /* put on display list of window to be drawn to */ + /* put on display list of window to be drawn to */ c_put(&(ws2->funclist2d), &f); /* redraw so changes are seen onscreen */ #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w2); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws2->redraw_flag |= 1; ws2->busy_flag = 0; return Succeeded; } - + int gl_eraseArea(wbp w, int x, int y, int width, int height) { @@ -3892,8 +3892,8 @@ int gl_eraseArea(wbp w, int x, int y, int width, int height) } /* - * Now that the display list is gone, make the current render - * context the default context + * Now that the display list is gone, make the current render + * context the default context */ copy_2dcontext(&(ws->wcdef), &(ws->wcrender)); ClearScreenToColor(w, BG); @@ -3938,21 +3938,21 @@ int gl_eraseArea(wbp w, int x, int y, int width, int height) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; return Succeeded; } - -int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) + +int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) { wsp ws = w->window; static struct descrip *fillarc_constr, *drawarc_constr; static struct descrip *fillcirc_constr, *drawcirc_constr; - tended struct descrip f; + tended struct descrip f; tended struct b_record *rp; tended struct b_realarray *ap; int nfillarc, ndrawarc, nfillcirc, ndrawcirc; @@ -3967,15 +3967,15 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) CheckRendermode(w); /* initialize constructors - have same number of fields */ - Get2dRecordConstr(fillarc_constr, GL2D_FILLARC); + Get2dRecordConstr(fillarc_constr, GL2D_FILLARC); nfillarc = (int) BlkD(*fillarc_constr, Proc)->nfields; - Get2dRecordConstr(drawarc_constr, GL2D_DRAWARC); + Get2dRecordConstr(drawarc_constr, GL2D_DRAWARC); ndrawarc = (int) BlkD(*drawarc_constr, Proc)->nfields; - Get2dRecordConstr(fillcirc_constr, GL2D_FILLCIRCLE); + Get2dRecordConstr(fillcirc_constr, GL2D_FILLCIRCLE); nfillcirc = (int) BlkD(*fillcirc_constr, Proc)->nfields; - Get2dRecordConstr(drawcirc_constr, GL2D_DRAWCIRCLE); + Get2dRecordConstr(drawcirc_constr, GL2D_DRAWCIRCLE); ndrawcirc = (int) BlkD(*drawcirc_constr, Proc)->nfields; - + glDisable(GL_LIGHTING); for (i = 0; i < n; i++) { x = arcs[i].x; @@ -3987,7 +3987,7 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) if (circle) { if (fill) { - Protect(rp = alcrecd(nfillcirc, BlkLoc(*fillcirc_constr)), + Protect(rp = alcrecd(nfillcirc, BlkLoc(*fillcirc_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -3996,7 +3996,7 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) MakeInt(GL2D_FILLCIRCLE, &(rp->fields[1])); } else { - Protect(rp = alcrecd(ndrawcirc, BlkLoc(*drawcirc_constr)), + Protect(rp = alcrecd(ndrawcirc, BlkLoc(*drawcirc_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4012,20 +4012,20 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) y += r - w->context->dy; rp->fields[2] = nulldesc; - MakeInt(x, &(rp->fields[3])); + MakeInt(x, &(rp->fields[3])); MakeInt(y, &(rp->fields[4])); - MakeRealAlc(r, &(rp->fields[5])); - MakeRealAlc(theta, &(rp->fields[6])); + MakeRealAlc(r, &(rp->fields[5])); + MakeRealAlc(theta, &(rp->fields[6])); MakeRealAlc(alpha, &(rp->fields[7])); - MakeInt(x, &(rp->fields[8])); + MakeInt(x, &(rp->fields[8])); MakeInt(y, &(rp->fields[9])); - MakeRealAlc(r, &(rp->fields[10])); - MakeRealAlc(theta, &(rp->fields[11])); + MakeRealAlc(r, &(rp->fields[10])); + MakeRealAlc(theta, &(rp->fields[11])); MakeRealAlc(alpha, &(rp->fields[12])); } else { /* arc */ if (fill) { - Protect(rp = alcrecd(nfillarc, BlkLoc(*fillarc_constr)), + Protect(rp = alcrecd(nfillarc, BlkLoc(*fillarc_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4034,7 +4034,7 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) MakeInt(GL2D_FILLARC, &(rp->fields[1])); } else { - Protect(rp = alcrecd(ndrawarc, BlkLoc(*drawarc_constr)), + Protect(rp = alcrecd(ndrawarc, BlkLoc(*drawarc_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4048,18 +4048,18 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) RemoveDxDy(w, x, y, width, height); rp->fields[2] = nulldesc; - MakeInt(x, &(rp->fields[3])); - MakeInt(y, &(rp->fields[4])); - MakeInt(width, &(rp->fields[5])); - MakeInt(height, &(rp->fields[6])); - MakeRealAlc(theta, &(rp->fields[7])); - MakeRealAlc(alpha, &(rp->fields[8])); - MakeInt(x, &(rp->fields[9])); - MakeInt(y, &(rp->fields[10])); - MakeInt(width, &(rp->fields[11])); - MakeInt(height, &(rp->fields[12])); - MakeRealAlc(theta, &(rp->fields[13])); - MakeRealAlc(alpha, &(rp->fields[14])); + MakeInt(x, &(rp->fields[3])); + MakeInt(y, &(rp->fields[4])); + MakeInt(width, &(rp->fields[5])); + MakeInt(height, &(rp->fields[6])); + MakeRealAlc(theta, &(rp->fields[7])); + MakeRealAlc(alpha, &(rp->fields[8])); + MakeInt(x, &(rp->fields[9])); + MakeInt(y, &(rp->fields[10])); + MakeInt(width, &(rp->fields[11])); + MakeInt(height, &(rp->fields[12])); + MakeRealAlc(theta, &(rp->fields[13])); + MakeRealAlc(alpha, &(rp->fields[14])); } drawgeometry2d(w, rp); @@ -4069,28 +4069,28 @@ int gl_arcs(wbp w, XArc *arcs, int n, int circle, int fill) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; return Succeeded; } - + int gl_fillcircles(wbp w, XArc *arcs, int n) { - return gl_arcs(w, arcs, n, 1, 1); - } + return gl_arcs(w, arcs, n, 1, 1); + } + - int gl_drawcircles(wbp w, XArc *arcs, int n) { - return gl_arcs(w, arcs, n, 1, 0); - } + return gl_arcs(w, arcs, n, 1, 0); + } + - /* * Creates a display list item @@ -4100,7 +4100,7 @@ int gl_fillarcs(wbp w, XArc *arcs, int n) return gl_arcs(w, arcs, n, 0, 1); } - + /* * Creates a display list item @@ -4110,7 +4110,7 @@ int gl_drawarcs(wbp w, XArc *arcs, int n) return gl_arcs(w, arcs, n, 0, 0); } - + int gl_rectangles(wbp w, XRectangle *recs, int n, int fill) { @@ -4126,9 +4126,9 @@ int gl_rectangles(wbp w, XRectangle *recs, int n, int fill) UpdateRenderContext(w, 0); CheckRendermode(w); - Get2dRecordConstr(fill_constr, GL2D_FILLRECTANGLE); + Get2dRecordConstr(fill_constr, GL2D_FILLRECTANGLE); nfill = (int) BlkD(*fill_constr, Proc)->nfields; - Get2dRecordConstr(draw_constr, GL2D_DRAWRECTANGLE); + Get2dRecordConstr(draw_constr, GL2D_DRAWRECTANGLE); ndraw = (int) BlkD(*draw_constr, Proc)->nfields; glDisable(GL_LIGHTING); @@ -4150,7 +4150,7 @@ int gl_rectangles(wbp w, XRectangle *recs, int n, int fill) Protect(rp = alcrecd(ndraw,BlkLoc(*draw_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; - + MakeStr("DrawRectangle",13,&(rp->fields[0])); MakeInt(GL2D_DRAWRECTANGLE, &(rp->fields[1])); rp->fields[11] = nulldesc; @@ -4177,37 +4177,37 @@ int gl_rectangles(wbp w, XRectangle *recs, int n, int fill) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; return Succeeded; } - + int gl_fillrectangles(wbp w, XRectangle *recs, int n) { return gl_rectangles(w, recs, n, 1); } - + int gl_drawrectangles(wbp w, XRectangle *recs, int n) { return gl_rectangles(w, recs, n, 0); } - + /* - * + * * For DrawLine() and DrawPolygon() and DrawCurve(). * * NOTE: Calls to DrawCurve() create GL2D_DRAWLINE primitives. It would * be possible to remedy this by changing the internal 2D API (drawlines()) * to be able to determine the primitive type. However, a curve is still a - * line primitive; so let GL2D_DRAWLINE encompasses DrawLine() and + * line primitive; so let GL2D_DRAWLINE encompasses DrawLine() and * DrawCurve(). */ int gl_drawlines(wbp w, XPoint *points, int n) @@ -4233,15 +4233,15 @@ int gl_drawlines(wbp w, XPoint *points, int n) Get2dRecordConstr(line_constr, GL2D_DRAWLINE); Get2dRecordConstr(poly_constr, GL2D_DRAWPOLYGON); nfields = (int)BlkD(*line_constr,Proc)->nfields; /* same # fields for both */ - - /* create primitive */ + + /* create primitive */ if (points[0].x == points[n-1].x && points[0].y == points[n-1].y) { Protect(rp = alcrecd(nfields,BlkLoc(*poly_constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; MakeStr("DrawPolygon",11,&(rp->fields[0])); MakeInt(intcode, &(rp->fields[1])); - } + } else { Protect(rp = alcrecd(nfields,BlkLoc(*line_constr)), return RunError); f.dword = D_Record; @@ -4254,9 +4254,9 @@ int gl_drawlines(wbp w, XPoint *points, int n) /* get coordinates */ for (i=0; ia[2*i] = points[i].x - dx; - ap->a[2*i+1] = points[i].y - dy; - } + ap->a[2*i] = points[i].x - dx; + ap->a[2*i+1] = points[i].y - dy; + } /* add to display list */ glDisable(GL_LIGHTING); @@ -4267,7 +4267,7 @@ int gl_drawlines(wbp w, XPoint *points, int n) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -4275,7 +4275,7 @@ int gl_drawlines(wbp w, XPoint *points, int n) return Succeeded; } - + int gl_drawpoints(wbp w, XPoint *points, int n) { @@ -4299,8 +4299,8 @@ int gl_drawpoints(wbp w, XPoint *points, int n) Get2dRecordConstr(constr, intcode); nfields = (int)BlkD(*constr,Proc)->nfields; - - /* create primitive */ + + /* create primitive */ Protect(rp = alcrecd(nfields,BlkLoc(*constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4309,14 +4309,14 @@ int gl_drawpoints(wbp w, XPoint *points, int n) MakeInt(intcode, &(rp->fields[1])); rp->fields[2] = nulldesc; - /* alloc realarray */ + /* alloc realarray */ AlcRealarrayList(rp->fields[3], ap, size, RunError); /* get coordinates */ for (i=0; ia[2*i] = points[i].x - dx; - ap->a[2*i+1] = points[i].y - dy; - } + ap->a[2*i] = points[i].x - dx; + ap->a[2*i+1] = points[i].y - dy; + } glDisable(GL_LIGHTING); drawgeometry2d(w, rp); @@ -4327,14 +4327,14 @@ int gl_drawpoints(wbp w, XPoint *points, int n) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; return Succeeded; } - + int gl_drawsegments(wbp w, XSegment *segs, int n) { @@ -4358,8 +4358,8 @@ int gl_drawsegments(wbp w, XSegment *segs, int n) Get2dRecordConstr(constr, intcode); nfields = (int)BlkD(*constr,Proc)->nfields; - - /* create primitive */ + + /* create primitive */ Protect(rp = alcrecd(nfields,BlkLoc(*constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4368,17 +4368,17 @@ int gl_drawsegments(wbp w, XSegment *segs, int n) MakeInt(intcode, &(rp->fields[1])); rp->fields[2] = nulldesc; - /* alloc realarray */ + /* alloc realarray */ AlcRealarrayList(rp->fields[3], ap, size, RunError); rp->fields[4] = nulldesc; /* get coordinates */ for (i=0; ia[4*i] = segs[i].x1 - dx; - ap->a[4*i+1] = segs[i].y1 - dy; - ap->a[4*i+2] = segs[i].x2 - dx; - ap->a[4*i+3] = segs[i].y2 - dy; - } + ap->a[4*i] = segs[i].x1 - dx; + ap->a[4*i+1] = segs[i].y1 - dy; + ap->a[4*i+2] = segs[i].x2 - dx; + ap->a[4*i+3] = segs[i].y2 - dy; + } glDisable(GL_LIGHTING); drawgeometry2d(w, rp); @@ -4389,23 +4389,23 @@ int gl_drawsegments(wbp w, XSegment *segs, int n) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; return Succeeded; } - + /* * Based off of algorithm provided by Rory Daulton: * https://stackoverflow.com/questions/471962/how-do-i-efficiently-determine-if-a-polygon-is-convex-non-convex-or-complex/45372025#45372025 * * Takes a set of order points and determines whether a polygon is complex, - * convex, or nonconvex (based on XFillPolygon() conventions). + * convex, or nonconvex (based on XFillPolygon() conventions). * Returns Failed if not a polygon, otherwise returns a status code - * of either complex (self-intersecting), convex, or nonconvex. + * of either complex (self-intersecting), convex, or nonconvex. * #define's can be found in src/h/opengl.h */ int polygon_type(XPoint *points, int n) @@ -4432,7 +4432,7 @@ int polygon_type(XPoint *points, int n) prev_y = curr_y; /* check to see if last point completes the polygon */ - if (i == n && (prev_x != points[0].x || prev_y != points[0].y)) { + if (i == n && (prev_x != points[0].x || prev_y != points[0].y)) { curr_x = points[0].x; curr_y = points[0].y; } @@ -4465,7 +4465,7 @@ int polygon_type(XPoint *points, int n) return POLY_CONVEX; } - + int gl_fillpolygon(wbp w, XPoint *points, int n) { @@ -4493,8 +4493,8 @@ int gl_fillpolygon(wbp w, XPoint *points, int n) Get2dRecordConstr(constr, intcode); nfields = (int)BlkD(*constr,Proc)->nfields; - - /* create primitive */ + + /* create primitive */ Protect(rp = alcrecd(nfields,BlkLoc(*constr)), return RunError); f.dword = D_Record; BlkLoc(f) = (union block *)rp; @@ -4506,15 +4506,15 @@ int gl_fillpolygon(wbp w, XPoint *points, int n) /* * alloc realarray - add an extra pair of vertices so the polygon * is complete - */ + */ AlcRealarrayList(rp->fields[3], ap, size, RunError); MakeInt(polytype, &(rp->fields[4])); /* get coordinates */ for (i=0; ia[2*i] = points[i].x - dx; - ap->a[2*i+1] = points[i].y - dy; - } + ap->a[2*i] = points[i].x - dx; + ap->a[2*i+1] = points[i].y - dy; + } glDisable(GL_LIGHTING); drawgeometry2d(w, rp); @@ -4524,7 +4524,7 @@ int gl_fillpolygon(wbp w, XPoint *points, int n) #ifdef GL2D_IMMEDIATE_RENDER FlushWindow(w); -#endif /* GL2D_IMMEDIATE_RENDER */ +#endif /* GL2D_IMMEDIATE_RENDER */ ws->redraw_flag |= 1; ws->busy_flag = 0; @@ -4532,18 +4532,18 @@ int gl_fillpolygon(wbp w, XPoint *points, int n) return Succeeded; } - + /************************************************* * Image-related functions (not on display list) * *************************************************/ - + /* * Write the RGB array (pixmap) to an XBM file specified by (filename) */ -int write_xbm(char *filename, int width, int height, unsigned char *pixmap, +int write_xbm(char *filename, int width, int height, unsigned char *pixmap, unsigned char bg[4]) { int ix, iy; @@ -4572,14 +4572,14 @@ int write_xbm(char *filename, int width, int height, unsigned char *pixmap, fwrite(buf, strlen(buf), 1, fout); sprintf(buf,"#define %s_height %d\n", name, width); fwrite(buf, strlen(buf), 1, fout); - + /* - * write the static array definition + * write the static array definition */ sprintf(buf,"static unsigned char %s_bits[] = {\n", name); fwrite(buf, strlen(buf), 1, fout); - /* + /* * The upper left pixel in the XBM bitmap is specified by the lowest bit * of the first pixel in the static array */ @@ -4592,7 +4592,7 @@ int write_xbm(char *filename, int width, int height, unsigned char *pixmap, byte = 0; } else m <<= 1; - + /* pixel is bg color, set to '0' */ if (pixmap[index] == bg[0] && pixmap[index+1] == bg[1] && pixmap[index+2] == bg[2]) { @@ -4600,7 +4600,7 @@ int write_xbm(char *filename, int width, int height, unsigned char *pixmap, } /* set bit to '1' */ else { - byte |= m; + byte |= m; } /* got a byte, write to file */ @@ -4621,12 +4621,12 @@ int write_xbm(char *filename, int width, int height, unsigned char *pixmap, buf[1] = ';'; buf[2] = '\0'; fwrite(buf, 2, 1, fout); - fclose(fout); - + fclose(fout); + return Succeeded; } - + /* * Write the image at (x, y) to filename as a XPM file @@ -4644,22 +4644,22 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) /* * Cannot use control characters (0-31 + 127), double quote (34), or - * blackslash (47). So the maximum number of chars supported is currently + * blackslash (47). So the maximum number of chars supported is currently * 128-(33+2) = 93. */ const int chars_avail = 93; const unsigned char chars[] = { - 0x20, 0x21, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C, + 0x20, 0x21, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2E, 0x2F, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, + 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F, - 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, + 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, - 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x5B, + 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D, 0x5E, 0x5F, - 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, + 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, - 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x7B, + 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x7B, 0x7C, 0x7D, 0x7E }; @@ -4694,11 +4694,11 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) for (i = 0; i < ncolors; i++) { if (clist[i].r == pixmap[index] && clist[i].g == pixmap[index+1] && clist[i].b == pixmap[index+2]) { - found = 1; + found = 1; cindex = i; break; } - } + } /* add color if not found */ if (!found) { @@ -4713,7 +4713,7 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) clist[ncolors].b = pixmap[index+2]; cindex = ncolors++; } - codes[iy*width+ix] = cindex; + codes[iy*width+ix] = cindex; } } @@ -4742,21 +4742,21 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) } - /* + /* * write the static array definition */ sprintf(buf, "/* XPM */\nstatic char * %s[] = {\n", name); fwrite(buf, strlen(buf), 1, fout); /* - * encode values + * encode values */ sprintf(buf,"/* width height ncolors chars_per_pixel */\n\"%d %d %d %d\",\n", width, height, ncolors, chars_per_pixel); fwrite(buf, strlen(buf), 1, fout); /* - * encode colors with RGB hex code + * encode colors with RGB hex code */ sprintf(buf,"/* colors */\n"); fwrite(buf, strlen(buf), 1, fout); @@ -4765,16 +4765,16 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) for (j = chars_per_pixel-1; j >= 0; j--) { tmp[j] = chars[charcode % chars_avail]; charcode /= chars_avail; - } + } tmp[chars_per_pixel] = '\0'; - - sprintf(buf, "\"%s c #%02x%02x%02x\",\n", tmp, clist[i].r, clist[i].g, + + sprintf(buf, "\"%s c #%02x%02x%02x\",\n", tmp, clist[i].r, clist[i].g, clist[i].b); fwrite(buf, strlen(buf), 1, fout); } /* - * encode pixels + * encode pixels */ sprintf(buf, "/* pixels */\n\""); fwrite(buf, strlen(buf), 1, fout); @@ -4799,13 +4799,13 @@ int write_xpm(char *filename, int width, int height, unsigned char *pixmap) buf[2] = '\0'; fwrite(buf, 2, 1, fout); - fclose(fout); - free(s); + fclose(fout); + free(s); return Succeeded; } - + /* * Given an XBM file, return a bitmap if valid, NULL if not @@ -4828,23 +4828,23 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) /* * Parse #defines * - * This is assuming it goes in the order: + * This is assuming it goes in the order: * width height [hotspotx hotspoty] */ rv = fscanf(f, "#define %s %d \n", tmp, &wid); if (rv < 2) { fclose(f); - return NULL; + return NULL; } rv = fscanf(f, "#define %s %d \n", tmp, &ht); if (rv < 2) { fclose(f); - return NULL; + return NULL; } if (wid < 0 || ht < 0) { fclose(f); - return NULL; + return NULL; } /* optional hotspot */ @@ -4857,13 +4857,13 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) while ((rv = fgetc(f)) != '{') { if (rv == EOF) { fclose(f); - return NULL; - } + return NULL; + } } } if (rv < 1) { fclose(f); - return NULL; + return NULL; } /* @@ -4883,20 +4883,20 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) int byte, rev_byte; rv = fscanf(f, " 0x%x, ", &byte); - if (rv < 1) + if (rv < 1) rv = fscanf(f, " 0x%x ", &byte); if (rv < 1) { glprintf("failed to scan, only scanned %d items out of 2\n",rv); fclose(f); free(bitmap); - return NULL; + return NULL; } /* * XBM file readers read starting from the top left corner from * low to high bits. OpenGL starts at the bottom left corner and - * reads from high to low bits. + * reads from high to low bits. */ rev_byte = 0; for (i = 1, j = 0x80; i & 0xFF; i <<= 1, j >>= 1) { @@ -4913,7 +4913,7 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) free(bitmap); fclose(f); return NULL; - } + } } while ( (rv = fgetc(f)) != ';' ) { if (rv == EOF) { @@ -4921,7 +4921,7 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) free(bitmap); fclose(f); return NULL; - } + } } fclose(f); @@ -4931,7 +4931,7 @@ char *load_xbm(char *filename, unsigned int *width, unsigned int *height) return bitmap; } - + /* * Given an XPM file, return a pixmap if valid, NULL if not @@ -4958,7 +4958,7 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) } rv = fscanf(f," /* width height ncolors chars_per_pixel */"); - rv = fscanf(f, " \" %d %d %d %d \", \n", &wid, &ht, &ncolors, + rv = fscanf(f, " \" %d %d %d %d \", \n", &wid, &ht, &ncolors, &chars_per_pixel); if (rv < 4 || chars_per_pixel < 1 || wid < 1 || ht < 1 || ncolors < 1) { fclose(f); @@ -4970,7 +4970,7 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) * Allocate structures needed for colors */ size = 3*ht*wid; - Protect(pixmap = alcstr(NULL, size+1), return NULL); + Protect(pixmap = alcstr(NULL, size+1), return NULL); pixmap[size] = 0; clist = (struct color *)malloc(ncolors*sizeof(struct color)); @@ -4997,8 +4997,8 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) for (i = 0; i < ncolors; i++) { chars[i] = (char *)malloc(chars_per_pixel+1); if (!chars[i]) { - for (j = 0; j < i; j++) - free(chars[j]); + for (j = 0; j < i; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5007,7 +5007,7 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) } } - /* + /* * Get colors * * format: "pixel_chars type color_val" @@ -5017,8 +5017,8 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) char *ptr; while ((rv = fgetc(f)) != '\"') { if (rv == EOF) { - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5028,9 +5028,9 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) } /* get the pixel chars */ if (fgets(chars[i], chars_per_pixel+1, f) == NULL) { - /* premature EOF */ - for (j = 0; j < ncolors; j++) - free(chars[j]); + /* premature EOF */ + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5040,9 +5040,9 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) /* get type */ if (fscanf(f, " %s", type) == EOF) { - /* premature EOF */ - for (j = 0; j < ncolors; j++) - free(chars[j]); + /* premature EOF */ + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5053,7 +5053,7 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) case 'c': rv = fscanf(f, " %s\",", spec); if (rv) { /* find terminating double quote */ - ptr = strchr(spec, '\"'); + ptr = strchr(spec, '\"'); if (ptr) *ptr = '\0'; } break; @@ -5064,11 +5064,11 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) rv = 0; break; } - - /* get color value */ + + /* get color value */ if (rv < 1 || parsecolor(w, spec, &r, &g, &b, &a) != Succeeded) { - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5082,15 +5082,15 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) clist[i].a = a; } - /* + /* * Get pixels */ rv = fscanf(f," /* pixels */"); /* optional */ for (iy = 0; iy < ht; iy++) { while ((rv = fgetc(f)) == ' ' || rv == '\n'); if (rv != '\"' || !fgets(buf, wid*chars_per_pixel+1, f)) { - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5105,42 +5105,42 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) int index = 3*((ht-iy-1)*wid + ix); for (i = 0; i < ncolors; i++) { if (!strncmp(chars[i],&buf[ix*chars_per_pixel],chars_per_pixel)) { - AssignRGB(&(pixmap[index]),clist[i].r >> 8,clist[i].g >> 8, + AssignRGB(&(pixmap[index]),clist[i].r >> 8,clist[i].g >> 8, clist[i].b >> 8); break; - } - } + } + } } } while ((rv = fgetc(f)) != '}' ) { if (rv == EOF) { glprintf("missing '}'\n"); - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); fclose(f); return NULL; - } + } } while ((rv = fgetc(f)) != ';' ) { if (rv == EOF) { glprintf("missing '}'\n"); - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); fclose(f); return NULL; - } + } } fclose(f); - for (j = 0; j < ncolors; j++) - free(chars[j]); + for (j = 0; j < ncolors; j++) + free(chars[j]); free(chars); free(clist); free(buf); @@ -5150,17 +5150,17 @@ char *load_xpm(wbp w, char *filename, unsigned int *width, unsigned int *height) return pixmap; } - + /* * dumpimage -- write an image to a disk file in an X format. * * Accepts only .xpm and .xbm file names, returning NoCvt for anything else. - * + * * To make things simpler, read image as RGB format (for write_x*m()) */ -int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, +int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, unsigned int width, unsigned int height) { int slen; @@ -5173,15 +5173,15 @@ int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, tmp = (unsigned char *)malloc(3*height*width); if (!tmp) return RunError; - - /* - * Read pixel data into (tmp) + + /* + * Read pixel data into (tmp) */ px = x; py = ws->height - y - height; MakeCurrent(w); - glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_BYTE,tmp); + glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_BYTE,tmp); /* * Check for bilevel XBM (X BitMap) format. @@ -5189,7 +5189,7 @@ int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, slen = strlen(filename); if ((slen > 4) && (!strcmp(".xbm", filename + slen - 4) || - !strcmp(".XBM", filename + slen - 4))) + !strcmp(".XBM", filename + slen - 4))) { GetContextColorUS(w, BG, bgs[0], bgs[1], bgs[2], bgs[3]); EncodeGammaUSToUC_V4(bg, bgs, wc->gamma); @@ -5200,9 +5200,9 @@ int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, * Check for XPM (color X PixMap) format. */ else if (((slen > 4) && - (!strcmp(".xpm", filename + slen - 4) || - !strcmp(".XPM", filename + slen - 4))) || - ((slen > 6) && !strcmp(".xpm.Z", filename + slen - 6))) + (!strcmp(".xpm", filename + slen - 4) || + !strcmp(".XPM", filename + slen - 4))) || + ((slen > 6) && !strcmp(".xpm.Z", filename + slen - 6))) { rv = write_xpm(filename, width, height, tmp); } @@ -5212,7 +5212,7 @@ int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, } - + /* @@ -5224,17 +5224,17 @@ int gl_dumpimage(wbp w, char *filename, unsigned int x, unsigned int y, */ #passthru #if (DMAXCOLORS > 256) #passthru Deliberate Syntax error -#passthru #endif /* DMAXCOLORS */ +#passthru #endif /* DMAXCOLORS */ /* * getimstr(w, x, y, width, height, ptbl, data) -- get image as a string. * * Stores the specified subimage in data, one pixel per byte, and sets * entries in ptbl corresponding to the pixel values that were used. - * + * * This function is used to write BMP files */ -int gl_getimstr(wbp w, int x, int y, int width, int height, +int gl_getimstr(wbp w, int x, int y, int width, int height, struct palentry *ptbl, unsigned char *data) { wsp ws = w->window; @@ -5244,9 +5244,9 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, tmp = (unsigned short *)malloc(3*height*width*sizeof(unsigned short)); if (!tmp) return RunError; - - /* - * Read pixel data into (tmp). For some reason BMP files reverse + + /* + * Read pixel data into (tmp). For some reason BMP files reverse * the R & B pixels somehow. Anyways, using BGR format and treating it * like RGB works somehow. */ @@ -5254,10 +5254,10 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, py = ws->height - y - height; MakeCurrent(w); - glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_SHORT,tmp); + glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_SHORT,tmp); /* - * Go through each pixel and see how many colors are used. If there are over + * Go through each pixel and see how many colors are used. If there are over * DMAXCOLORS, then fail for now. * * Don't encode gamma for this @@ -5267,18 +5267,18 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, for (ix = 0; ix < width; ix++) { int found, index, cindex; - /* look through palentry to see if we have the color */ + /* look through palentry to see if we have the color */ index = 3*((height-(iy+1))*width+ix); found = 0; for (i = 0; i < ncolors; i++) { - if (ptbl[i].clr.red == tmp[index] && + if (ptbl[i].clr.red == tmp[index] && ptbl[i].clr.green == tmp[index+1] && ptbl[i].clr.blue == tmp[index+2]) { - found = 1; + found = 1; cindex = i; break; - } + } } /* store color if not found */ @@ -5286,13 +5286,13 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, /* too many colors, failure or runerror? */ if (ncolors >= DMAXCOLORS) { free(tmp); - return Failed; + return Failed; } ptbl[ncolors].clr.red = tmp[index]; ptbl[ncolors].clr.green = tmp[index+1]; ptbl[ncolors].clr.blue = tmp[index+2]; cindex = ncolors++; - } + } /* put color in data */ data[iy*width+ix] = cindex; @@ -5302,7 +5302,7 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, return 1; } - + /* * getimstr24 -- get an image as a string of RGB tuples. @@ -5310,7 +5310,7 @@ int gl_getimstr(wbp w, int x, int y, int width, int height, * Stores the specified subimage in data, three bytes per pixel. * Used for writing PNG files */ -int gl_getimstr24(wbp w, int x, int y, int width, int height, +int gl_getimstr24(wbp w, int x, int y, int width, int height, unsigned char *data) { wsp ws = w->window; @@ -5319,16 +5319,16 @@ int gl_getimstr24(wbp w, int x, int y, int width, int height, tmp = (unsigned char *)malloc(3*height*width); if (!tmp) return RunError; - + /* read pixel data into (tmp) */ px = x; py = ws->height - y - height; MakeCurrent(w); - glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_BYTE,tmp); + glReadPixels(px,py,width,height,GL_RGB,GL_UNSIGNED_BYTE,tmp); - /* - * Since Unicon (top left) and OpenGL (bottom left) window origins differ, + /* + * Since Unicon (top left) and OpenGL (bottom left) window origins differ, * flip the rows */ row_size = 3*width; @@ -5337,13 +5337,13 @@ int gl_getimstr24(wbp w, int x, int y, int width, int height, } /* define out of bound pixels as background color */ - if (x < 0 || x + width >= ws->width || + if (x < 0 || x + width >= ws->width || y < 0 || y + height >= ws->height) { unsigned char bg[4]; GetContextColorUC(w, BG, bg[0], bg[1], bg[2], bg[3]); - for (ix=0; ix < width; ix++) { - for (iy=0; iy < height; iy++) { + for (ix=0; ix < width; ix++) { + for (iy=0; iy < height; iy++) { if (x+ix < 0 || x+ix >= ws->width || y+iy < 0 || y+iy >= ws->height) { index = 3*((height-iy-1)*width+ix); @@ -5356,10 +5356,10 @@ int gl_getimstr24(wbp w, int x, int y, int width, int height, return 1; } - + /* - * Grabs a pixmap of a rectangular area from the OpenGL buffer. + * Grabs a pixmap of a rectangular area from the OpenGL buffer. * So far, the getpixel*() class of functions will not be able to * suspend accurate pixel values if there are any additional drawing * operations between suspensions. @@ -5375,7 +5375,7 @@ int gl_getpixel_init(wbp w, struct imgmem *imem) if (imem->width <= 0 || imem->height <= 0) { #ifdef XWindows imem->im = NULL; -#endif /* XWindows */ +#endif /* XWindows */ return Succeeded; } width = imem->width; @@ -5384,7 +5384,7 @@ int gl_getpixel_init(wbp w, struct imgmem *imem) py = w->window->height - imem->y - height; size = width*height*4; imem->pixmap = (unsigned short *)malloc(size*sizeof(unsigned short)); - if (imem->pixmap == NULL) + if (imem->pixmap == NULL) return RunError; MakeCurrent(w); @@ -5400,7 +5400,7 @@ int gl_getpixel_init(wbp w, struct imgmem *imem) return Succeeded; } - + int gl_getpixel_term(wbp w, struct imgmem *imem) { @@ -5409,7 +5409,7 @@ int gl_getpixel_term(wbp w, struct imgmem *imem) return Succeeded; } - + int gl_getpixel(wbp w, int x, int y, long *rv, char *s, struct imgmem *imem) { @@ -5437,57 +5437,57 @@ int gl_getpixel(wbp w, int x, int y, long *rv, char *s, struct imgmem *imem) return Succeeded; } - + /* - * Load an image, currently only looking for XBM/XPM files + * Load an image, currently only looking for XBM/XPM files */ -char *gl_loadimage(wbp w, char *filename, unsigned int *height, +char *gl_loadimage(wbp w, char *filename, unsigned int *height, unsigned int *width, int atorigin, int *is_pixmap) { char *rv; if (!strcmp(".xbm", filename + strlen(filename) - 4)) { *is_pixmap = 0; - rv = load_xbm(filename, width, height); + rv = load_xbm(filename, width, height); } else if (!strcmp(".xpm", filename + strlen(filename) - 4) || - !strcmp(".xpm.Z", filename + strlen(filename) - 6)) { + !strcmp(".xpm.Z", filename + strlen(filename) - 6)) { *is_pixmap = 1; - rv = load_xpm(w, filename, width, height); + rv = load_xpm(w, filename, width, height); } /* try both */ else { *is_pixmap = 0; - rv = load_xbm(filename, width, height); + rv = load_xbm(filename, width, height); if (!rv) { *is_pixmap = 1; - rv = load_xpm(w, filename, width, height); + rv = load_xpm(w, filename, width, height); } } return rv; } - + /*********************************** * (3) Context attribute functions * ***********************************/ - + void gl_getbg(wbp w, char *s) { sprintf(s, "%s", w->context->glbg.name); } - + void gl_getfg(wbp w, char *s) { sprintf(s, "%s", w->context->glfg.name); } - + void gl_getdrawop(wbp w, char *answer) { @@ -5498,24 +5498,24 @@ void gl_getdrawop(wbp w, char *answer) sprintf(answer, "%s", s); } - + void gl_getlinestyle(wbp w, char *s) { wcp wc = w->context; sprintf(s,"%s", - (wc->linestyle==GL2D_LINE_SOLID)?"solid": - ((wc->linestyle==GL2D_LINE_DASHED)?"dashed":"striped")); + (wc->linestyle==GL2D_LINE_SOLID)?"solid": + ((wc->linestyle==GL2D_LINE_DASHED)?"dashed":"striped")); } - + void gl_getfntnam(wbp w, char *s) { sprintf(s,"%s", w->context->font->name); } - + char *gl_get_mutable_name(wbp w, int mute_index) { @@ -5523,13 +5523,13 @@ char *gl_get_mutable_name(wbp w, int mute_index) char *colorname; if (!(mclr = find_mutable(w, mute_index))) - return NULL; + return NULL; colorname = mclr->name; return colorname; } - + int gl_set_mutable(wbp w, int mute_index, char *s) { @@ -5552,7 +5552,7 @@ int gl_set_mutable(wbp w, int mute_index, char *s) return Succeeded; } - + struct color *find_mutable(wbp w, int index) { @@ -5562,19 +5562,19 @@ struct color *find_mutable(wbp w, int index) if (wd->numMclrs > 0 || index < 0) { if (!wd->mclrs) { glprintf("mutable colors linked list improper linking\n"); - return NULL; + return NULL; } for (mclr=wd->mclrs; mclr; mclr = mclr->next) { - if (mclr->id == index) + if (mclr->id == index) return mclr; } } return NULL; } - -struct color *alc_mutable_color(wbp w) + +struct color *alc_mutable_color(wbp w) { wdp wd = w->window->display; struct color **head, *new; @@ -5582,10 +5582,10 @@ struct color *alc_mutable_color(wbp w) new = (struct color *)calloc(1,sizeof(struct color)); if (!new) { glprintf("failed allocating mutable color\n"); - return NULL; + return NULL; } - wd->numMclrs++; + wd->numMclrs++; new->id = -(++(wd->muteIdCount)); /* negative index for mutables */ /* link to the front of list */ @@ -5599,10 +5599,10 @@ struct color *alc_mutable_color(wbp w) *head = new; } - return new; + return new; } - + void gl_free_mutable(wbp w, int mute_index) { @@ -5610,8 +5610,8 @@ void gl_free_mutable(wbp w, int mute_index) struct color *mclr; /* try to find mutable */ - if (!(mclr = find_mutable(w, mute_index))) - return; + if (!(mclr = find_mutable(w, mute_index))) + return; /* unlink */ if (mclr->prev) @@ -5631,17 +5631,17 @@ void gl_free_mutable(wbp w, int mute_index) } } - + void free_mutables(wdp wd) { struct color *mclr, *del; mclr = wd->mclrs; while (mclr) { - del = mclr; + del = mclr; mclr = mclr->next; - - /* unlink */ + + /* unlink */ if (mclr) { mclr->prev = NULL; del->next = NULL; @@ -5652,7 +5652,7 @@ void free_mutables(wdp wd) { wd->muteIdCount = wd->numMclrs = 0; } - + /* * Should a mutable color even have a display list entry? @@ -5674,11 +5674,11 @@ int gl_mutable_color(wbp w, dptr argv, int warg, int *rv) * Check for mutable color id as arg */ else if (is:integer(argv[0])) {/* check for color cell */ - if ((id = IntVal(argv[0])) >= 0) - return Failed; /* must be negative */ + if ((id = IntVal(argv[0])) >= 0) + return Failed; /* must be negative */ /* - * check to see if it's a valid mutable color + * check to see if it's a valid mutable color */ if (!(mclr = find_mutable(w, id))) return Failed; /* not a valid color */ @@ -5688,35 +5688,35 @@ int gl_mutable_color(wbp w, dptr argv, int warg, int *rv) g = mclr->g; b = mclr->b; a = mclr->a; - } + } - /* + /* * String specification */ else { - if (!cnv:C_string(argv[0],str)) { - ReturnErrVal(103,argv[0], RunError); - } + if (!cnv:C_string(argv[0],str)) { + ReturnErrVal(103,argv[0], RunError); + } if (parsecolor(w, str, &r, &g, &b, &a) != Succeeded) { - return Failed; /* invalid color specification */ - } - } + return Failed; /* invalid color specification */ + } + } } else { return Failed; } - /* + /* * Allocate a mutable color */ - if (!(mclr = alc_mutable_color(w))) + if (!(mclr = alc_mutable_color(w))) return Failed; SetColor(*mclr, r, g, b, a, mclr->id); *rv = mclr->id; /* store return value */ return Succeeded; } - + /* * Allocates a display list record for fg/bg color. @@ -5750,7 +5750,7 @@ int gl_color(wbp w, int intcode, int mindex, char *s) /* normal color with color specification */ else if (s != NULL) { if (parsecolor(w, s, &r, &g, &b, &a) != Succeeded) { - /* What to do if unable to parse color spec? */ + /* What to do if unable to parse color spec? */ glprintf("unable to parse color specification '%s'\n",s); return Failed; } @@ -5765,13 +5765,13 @@ int gl_color(wbp w, int intcode, int mindex, char *s) /* Set context color */ if (!ws->updateRC) { switch (intcode) { - case GL2D_FG: + case GL2D_FG: SetColor(wc->glfg, r, g, b, a, index); break; - case GL2D_BG: + case GL2D_BG: SetColor(wc->glbg, r, g, b, a, index); break; - default: + default: glprintf("incorrect color record type\n"); return Failed; } @@ -5811,8 +5811,8 @@ int gl_color(wbp w, int intcode, int mindex, char *s) /* * Store attributes */ - MakeStr(name, 2, &(rp->fields[0])); - MakeInt(intcode, &(rp->fields[1])); + MakeStr(name, 2, &(rp->fields[0])); + MakeInt(intcode, &(rp->fields[1])); if (!is_mutable) { rp->fields[2] = nulldesc; MakeInt(r, &(rp->fields[3])); @@ -5823,10 +5823,10 @@ int gl_color(wbp w, int intcode, int mindex, char *s) else { MakeInt(mindex, &(rp->fields[2])); /* - rp->fields[3] = nulldesc; - rp->fields[4] = nulldesc; - rp->fields[5] = nulldesc; - rp->fields[6] = nulldesc; + rp->fields[3] = nulldesc; + rp->fields[4] = nulldesc; + rp->fields[5] = nulldesc; + rp->fields[6] = nulldesc; */ } @@ -5843,7 +5843,7 @@ int gl_color(wbp w, int intcode, int mindex, char *s) return Succeeded; } - + int gl_setbgrgb(wbp w, int r, int g, int b) { @@ -5852,7 +5852,7 @@ int gl_setbgrgb(wbp w, int r, int g, int b) return gl_setbg(w, sbuf1); } - + int gl_setfgrgb(wbp w, int r, int g, int b) { @@ -5861,7 +5861,7 @@ int gl_setfgrgb(wbp w, int r, int g, int b) return gl_setfg(w, sbuf1); } - + /* * For setting a color to a mutable color using its negative integer @@ -5875,13 +5875,13 @@ int gl_isetbg(wbp w, int mindex) if (!(mclr = find_mutable(w, mindex))) { /* Failed to find a mutable, what to do? */ - return Failed; + return Failed; } return gl_color(w, GL2D_BG, mindex, NULL); } - + /* * For setting a color to a mutable color using its negative integer @@ -5895,13 +5895,13 @@ int gl_isetfg(wbp w, int mindex) if (!(mclr = find_mutable(w, mindex))) { /* Failed to find a mutable, what to do? */ - return Failed; + return Failed; } return gl_color(w, GL2D_FG, mindex, NULL); } - + /* @@ -5912,7 +5912,7 @@ int gl_setbg(wbp w, char *s) return gl_color(w, GL2D_BG, 0, s); /* not mutable */ } - + /* * Creates a display list item @@ -5923,7 +5923,7 @@ int gl_setfg(wbp w, char *s) } - + int gl_toggle_fgbg(wbp w) { @@ -5937,12 +5937,12 @@ int gl_toggle_fgbg(wbp w) if (!ws->updateRC) { ISREVERSE(w) ? CLRREVERSE(w) : SETREVERSE(w); /* for legacy impl. */ - if (wc->reverse) wc->reverse = 0; + if (wc->reverse) wc->reverse = 0; else wc->reverse = 1; } - if (ws->initAttrs) - return Succeeded; + if (ws->initAttrs) + return Succeeded; ws->busy_flag = 1; MakeCurrent(w); @@ -5959,13 +5959,13 @@ int gl_toggle_fgbg(wbp w) MakeInt(intcode, &(rp->fields[1])); togglefgbg2d(w); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + int gl_setgamma(wbp w, double gamma) { @@ -5977,10 +5977,10 @@ int gl_setgamma(wbp w, double gamma) const int intcode = GL2D_GAMMA; int nfields; - if (!ws->updateRC) + if (!ws->updateRC) wc->gamma = gamma; - if (ws->initAttrs) + if (ws->initAttrs) return Succeeded; ws->busy_flag = 1; @@ -5999,19 +5999,19 @@ int gl_setgamma(wbp w, double gamma) MakeRealAlc(gamma, &(rp->fields[2])); setgamma2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + /* * Context attributes set before call to this function */ int gl_setclip(wbp w) -{ +{ wsp ws = w->window; wcp wc = w->context; tended struct descrip f; @@ -6020,7 +6020,7 @@ int gl_setclip(wbp w) const int intcode = GL2D_CLIP; int nfields, rv; int clipx, clipy, clipw, cliph; - + /* context attributes already set in wattrib() */ @@ -6060,20 +6060,20 @@ int gl_setclip(wbp w) ws->busy_flag = 0; return rv; } - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + int gl_unsetclip(wbp w) { return gl_setclip(w); } - + int gl_SetPattern(wbp w, char *name, int len) { @@ -6091,7 +6091,7 @@ int gl_SetPattern(wbp w, char *name, int len) /* * Update pattern name */ - if (!ws->updateRC) { + if (!ws->updateRC) { if (wc->patternname != NULL) free(wc->patternname); wc->patternname = malloc(len+1); @@ -6135,21 +6135,21 @@ int gl_SetPattern(wbp w, char *name, int len) case RunError: ws->busy_flag = 0; ReturnErrNum(145, RunError); - } - - c_put(&(w->window->funclist2d), &f); + } + + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } } - + /* * Context attribute set in rwindow.r before the call to this function */ -int gl_setdx(wbp w) +int gl_setdx(wbp w) { wsp ws = w->window; wcp wc = w->context; @@ -6179,18 +6179,18 @@ int gl_setdx(wbp w) MakeInt(wc->dx, &(rp->fields[3])); setdx2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + /* * Context attribute set in rwindow.r before the call to this function */ -int gl_setdy(wbp w) +int gl_setdy(wbp w) { wsp ws = w->window; wcp wc = w->context; @@ -6220,12 +6220,12 @@ int gl_setdy(wbp w) setdy2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + int gl_setdrawop(wbp w, char *s) { @@ -6241,18 +6241,18 @@ int gl_setdrawop(wbp w, char *s) /* "reverse" */ if (!ws->updateRC) { - if (!strcmp(s,"reverse") || !strcmp(s,"xor")) + if (!strcmp(s,"reverse") || !strcmp(s,"xor")) wc->drawop = GL2D_DRAWOP_REVERSE; - else if (!strcmp(s,"copy")) + else if (!strcmp(s,"copy")) wc->drawop = GL2D_DRAWOP_COPY; /* consider both invalid strings and unsupported drawops as failure */ - else + else return Failed; } MakeCurrent(w); - if (ws->initAttrs) + if (ws->initAttrs) return Succeeded; ws->busy_flag = 1; @@ -6277,7 +6277,7 @@ int gl_setdrawop(wbp w, char *s) return Succeeded; } - + /* * Sets the fillstyle for the current context and render context. @@ -6285,7 +6285,7 @@ int gl_setdrawop(wbp w, char *s) * By default, the OpenGL implementation will use the clipping * plane of the stencil function. Only when the fillstyle is set * to a mode other than "solid" and a drawing operation on applicable - * primitives is about to be performed, is the OpenGL stencil state + * primitives is about to be performed, is the OpenGL stencil state * changed to accommodate it. After the drawing operation is completed, * the stencil state is restored to default (clipping only). */ @@ -6305,11 +6305,11 @@ int gl_setfillstyle(wbp w, char *s) * and "opaquepatterned"? */ if (!ws->updateRC) { - if (!strcmp(s, "solid")) + if (!strcmp(s, "solid")) wc->fillstyle = GL2D_FILL_SOLID; - else if (!strcmp(s, "masked")) + else if (!strcmp(s, "masked")) wc->fillstyle = GL2D_FILL_MASKED; - else if (!strcmp(s, "textured")) + else if (!strcmp(s, "textured")) wc->fillstyle = GL2D_FILL_TEXTURED; else return Failed; } @@ -6334,13 +6334,13 @@ int gl_setfillstyle(wbp w, char *s) MakeStr(s_op, len, &(rp->fields[2])); setfillstyle2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + int gl_setlinestyle(wbp w, char *s) { @@ -6358,11 +6358,11 @@ int gl_setlinestyle(wbp w, char *s) return Failed; if (!ws->updateRC) { - if (!strcmp(s, "solid")) + if (!strcmp(s, "solid")) wc->linestyle = GL2D_LINE_SOLID; - else if (!strcmp(s, "dashed")) + else if (!strcmp(s, "dashed")) wc->linestyle = GL2D_LINE_DASHED; - else if (!strcmp(s, "striped")) + else if (!strcmp(s, "striped")) wc->linestyle = GL2D_LINE_STRIPED; else return Failed; } @@ -6387,13 +6387,13 @@ int gl_setlinestyle(wbp w, char *s) MakeStr(s_op, len, &(rp->fields[2])); setlinestyle2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + /* setlinewidth() in ropengl.ri */ int gl_setlinewidth(wbp w, LONG linewidth) @@ -6406,17 +6406,17 @@ int gl_setlinewidth(wbp w, LONG linewidth) const int intcode = GL2D_LINEWIDTH; int nfields; - if (!ws->updateRC) + if (!ws->updateRC) wc->linewidth = linewidth; - if (ws->initAttrs) - return Succeeded; + if (ws->initAttrs) + return Succeeded; ws->busy_flag = 1; MakeCurrent(w); UpdateRenderContext(w, intcode); - Get2dRecordConstr(constr, intcode); + Get2dRecordConstr(constr, intcode); nfields = (int)BlkD(*constr,Proc)->nfields; Protect(rp = alcrecd(nfields,BlkLoc(*constr)), return RunError); @@ -6428,13 +6428,13 @@ int gl_setlinewidth(wbp w, LONG linewidth) MakeInt(linewidth, &(rp->fields[2])); setlinewidth2d(w,rp); - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + int gl_setfont(wbp w, char **s) { @@ -6456,14 +6456,14 @@ int gl_setfont(wbp w, char **s) return Failed; if (!ws->updateRC) { - if (wc->font) - wc->font->refcount--; - wc->font = wf; + if (wc->font) + wc->font->refcount--; + wc->font = wf; wc->leading = FT_FHEIGHT(wf->face); wc->font->refcount++; } - if (ws->initAttrs) + if (ws->initAttrs) return Succeeded; ws->busy_flag = 1; @@ -6478,25 +6478,25 @@ int gl_setfont(wbp w, char **s) MakeStr("Font", 4, &(rp->fields[0])); MakeInt(intcode, &(rp->fields[1])); - + Protect(name = alcstr(*s,len), return RunError); MakeStr(name, len, &(rp->fields[2])); - /* update render context */ - if (wcr->font) - wcr->font->refcount--; + /* update render context */ + if (wcr->font) + wcr->font->refcount--; wcr->font = wf; wcr->leading = FT_FHEIGHT(wf->face); - wcr->font->refcount--; + wcr->font->refcount--; - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + /* * Allocate font (s) in the display attached to (w). @@ -6511,7 +6511,7 @@ wfp gl_alc_font(wbp w, char **s, int len) wfp rv; /* what to do if empty string? */ - if (*s == NULL) + if (*s == NULL) return NULL; /* @@ -6541,7 +6541,7 @@ wfp gl_alc_font(wbp w, char **s, int len) * link the font into this displays fontlist (but not at the head!) */ if (!(*wfptr)) { - *wfptr = rv; + *wfptr = rv; } else { rv->next = (*wfptr)->next; @@ -6552,7 +6552,7 @@ wfp gl_alc_font(wbp w, char **s, int len) return rv; } - + /* * This function may deal with Unicon strings. As such, use (len) to ensure @@ -6582,13 +6582,13 @@ static wfp loadfont(wdp wd, char *s, int len) if (rv) { glprintf("Error %d occurred during FT library initialization\n",rv); return NULL; - } + } /* * Try to convert (s) to a font spec * * a spec can start with "fc:" to indicate that it's in fontconfig - * format. + * format. */ if (len >= 3 && !strncmp(s, "fc:", 3)) s += 3; @@ -6602,18 +6602,18 @@ static wfp loadfont(wdp wd, char *s, int len) * Use fontconfig or something to find closest available font * file. */ - fname = find_fontfile(family, flags); + fname = find_fontfile(family, flags); if (!fname) { /* failed to find file or approx font file */ free(wf); return NULL; } /* - * Load font - * + * Load font + * * Start by looking at first font (0). The loop will continue * if there are more fonts and the first font didn't match the - * requested font + * requested font * * Maybe should keep track of a "best" font. * @@ -6622,19 +6622,19 @@ static wfp loadfont(wdp wd, char *s, int len) * 'family[,styles],size' */ for (i = 0, num_faces = 1; i < num_faces; i++) { - rv = FT_New_Face(wf->library, fname, i, &(wf->face)); + rv = FT_New_Face(wf->library, fname, i, &(wf->face)); if (rv == FT_Err_Unknown_File_Format) { glprintf("Font file format is not supported\n"); free(wf); if (fname) free(fname); - return NULL; - } + return NULL; + } else if (rv) { glprintf("Error %d occurred loading font file\n",rv); free(wf); if (fname) free(fname); - return NULL; - } + return NULL; + } /* * Bits 0-15 contain the index of the current face. 0 if @@ -6645,15 +6645,15 @@ static wfp loadfont(wdp wd, char *s, int len) /* * Check family name */ - strcpy(buf, wf->face->family_name); + strcpy(buf, wf->face->family_name); s = buf; do { /* make case insensitive */ int c = *s; if (c >= 65 && c <= 90) { - *s -= ((int)'a' - (int)'A'); - } + *s -= ((int)'a' - (int)'A'); + } } while (*s++); - + /* if match, we're done */ if (!strcmp(buf, family)) { break; @@ -6662,23 +6662,23 @@ static wfp loadfont(wdp wd, char *s, int len) /* * Size not specified, pick a size that makes the default font height - * 13 + * 13 */ - if (size == -1) + if (size == -1) size = 10; - rv = FT_Set_Pixel_Sizes(wf->face, - 0, /* char width in pixels */ - size); /* char height in pixels */ + rv = FT_Set_Pixel_Sizes(wf->face, + 0, /* char width in pixels */ + size); /* char height in pixels */ if (rv) { glprintf("Failed to set character size, error code: %d\n",rv); free(wf); if (fname) free(fname); - return NULL; + return NULL; } /* - * Calculate Unicon font attributes + * Calculate Unicon font attributes */ wf->size = size; /* in pixels */ wf->ascent = FT_ASCENT(wf->face); @@ -6690,20 +6690,20 @@ static wfp loadfont(wdp wd, char *s, int len) * If no unicode charmap, get one * NOTE: desired platform id & encoding id are known * - * platform_id - 0 (Apple), 1 (Macintosh), 2 (ISO), 3 (MS), 4 (CUSTOM), + * platform_id - 0 (Apple), 1 (Macintosh), 2 (ISO), 3 (MS), 4 (CUSTOM), * 5 (Adobe) * * For now, use (1,0), i.e., Macintosh platform_id, Apple roman encoding id. - * According to FT documentation, most TrueType fonts support this + * According to FT documentation, most TrueType fonts support this * platform/encoding combination.... I suppose we'll see if it's true. - */ + */ platform_id = 1; /* TT_PLATFORM_MACINTOSH */ encoding_id = 0; /* TT_MAC_ID_ROMAN */ cmap_index = -1; for (i = 0; i < wf->face->num_charmaps; i++) { if (wf->face->charmaps[i]->platform_id == platform_id && - wf->face->charmaps[i]->encoding_id == encoding_id) + wf->face->charmaps[i]->encoding_id == encoding_id) { cmap_index = i; break; @@ -6715,7 +6715,7 @@ static wfp loadfont(wdp wd, char *s, int len) * Check FT headers for the correct encoding type. FT_ENCODING_BIG5 * was the encoding used in the tutorial example. */ - rv = FT_Select_Charmap(wf->face, FT_ENCODING_BIG5); + rv = FT_Select_Charmap(wf->face, FT_ENCODING_BIG5); if (rv) { glprintf("failed to get charmap, error code %d\n", rv); if (fname) free(fname); @@ -6726,7 +6726,7 @@ static wfp loadfont(wdp wd, char *s, int len) else { /* now, select the charmap for the face object */ rv = FT_Set_Charmap(wf->face, wf->face->charmaps[i]); - if (rv) { + if (rv) { glprintf("failed to get charmap, error code %d\n", rv); if (fname) free(fname); free(wf); @@ -6735,26 +6735,26 @@ static wfp loadfont(wdp wd, char *s, int len) } for (i = 0; i < 256; i++) { - wf->chars[i].pixmap = NULL; - wf->chars[i].texid = wf->chars[i].index = 0; + wf->chars[i].pixmap = NULL; + wf->chars[i].texid = wf->chars[i].index = 0; } if (fname) free(fname); return wf; } -#else /* HAVE_LIBFREETYPE */ +#else /* HAVE_LIBFREETYPE */ static wfp loadfont(wdp wd, char *s, int len) { return NULL; } -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ + - /* - * Macros for readable font typechecking + * Macros for readable font typechecking */ /* Font weight */ @@ -6772,8 +6772,8 @@ static wfp loadfont(wdp wd, char *s, int len) #define IS_FONT_WIDE(flag) (flag & FONTFLAG_WIDE) /* Font slant */ -#define IS_FONT_ROMAN(flag) (flag & FONTFLAG_ROMAN) -#define IS_FONT_ITALIC(flag) (flag & FONTFLAG_ITALIC) +#define IS_FONT_ROMAN(flag) (flag & FONTFLAG_ROMAN) +#define IS_FONT_ITALIC(flag) (flag & FONTFLAG_ITALIC) #define IS_FONT_OBLIQUE(flag) (flag & FONTFLAG_OBLIQUE) /* Font spacing */ @@ -6796,11 +6796,11 @@ char *find_fontfile(char *family, int flags) { static char fontdir[MAX_LEN]; char *fname = NULL, *abspath, *ptr; int len; -#ifdef MSWindows +#ifdef MSWindows const char PS = '\\'; -#else /* MSWindows */ +#else /* MSWindows */ const char PS = '/'; -#endif /* MSWindows */ +#endif /* MSWindows */ /* * Check if {family} is a .ttf or .oft. Return the filename if so. @@ -6811,7 +6811,7 @@ char *find_fontfile(char *family, int flags) { if (access(family, F_OK) != -1) { abspath = strdup(family); if (!abspath) return NULL; - return abspath; + return abspath; } } @@ -6822,7 +6822,7 @@ char *find_fontfile(char *family, int flags) { /* NOTE: findonpath() does not support '~' */ if (!findonpath(UNICONX_EXE, fontdir, MAX_LEN)) { fprintf(stderr,"could not find iconx on path\n"); - return NULL; + return NULL; } /* @@ -6863,14 +6863,14 @@ char *find_fontfile(char *family, int flags) { /* * Otherwise the family name is the name of a font - use a decision tree - * + * * The goal is to return a font if a font name is specified, so the - * decision tree generalizes heavily. If there are issues, change the + * decision tree generalizes heavily. If there are issues, change the * logic manually for each font. */ else { /* default? */ if (!strcmp(family, "avant garde") || !strcmp(family, "avantgarde")) { - if (IS_FONT_DEMI(flags)) { + if (IS_FONT_DEMI(flags)) { /* AvantGarde-DemiOblique - urwgo4.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { fname = "urwgo4.ttf"; @@ -6923,7 +6923,7 @@ char *find_fontfile(char *family, int flags) { /* Courier-BoldOblique - nimbu29.ttf */ if (IS_FONT_OBLIQUE(flags) || IS_FONT_ITALIC(flags)) { fname = "nimbu29.ttf"; - } + } /* Courier-Bold - nimbu27.ttf */ else { fname = "nimbu27.ttf"; @@ -6932,7 +6932,7 @@ char *find_fontfile(char *family, int flags) { /* Courier-Oblique - nimbu28.ttf */ else if (IS_FONT_OBLIQUE(flags) || IS_FONT_ITALIC(flags)) { fname = "nimbu28.ttf"; - } + } /* default: Courier - nimbu26.ttf */ else { fname = "nimbu26.ttf"; @@ -6990,21 +6990,21 @@ char *find_fontfile(char *family, int flags) { if (IS_FONT_BOLD(flags)) { /* Palatino-BoldItalic - urwpa33.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "urwpa33.ttf"; + fname = "urwpa33.ttf"; } /* Palatino-Bold - urwpa31.ttf */ else { - fname = "urwpa31.ttf"; + fname = "urwpa31.ttf"; } } else { /* Palatino-Italic - urwpa32.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "urwpa32.ttf"; + fname = "urwpa32.ttf"; } /* Palatino-Roman - urwpa30.ttf */ else { - fname = "urwpa30.ttf"; + fname = "urwpa30.ttf"; } } } @@ -7013,21 +7013,21 @@ char *find_fontfile(char *family, int flags) { if (IS_FONT_BOLD(flags)) { /* NewCenturySchlbk-BoldItalic - centu12.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "centu12.ttf"; + fname = "centu12.ttf"; } /* NewCenturySchlbk-Bold - centu10.ttf */ else { - fname = "centu10.ttf"; + fname = "centu10.ttf"; } } else { /* NewCenturySchlbk-Italic - centu11.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "centu11.ttf"; + fname = "centu11.ttf"; } /* NewCenturySchlbk-Roman - centu9.ttf */ else { - fname = "centu9.ttf"; + fname = "centu9.ttf"; } } } @@ -7036,21 +7036,21 @@ char *find_fontfile(char *family, int flags) { if (IS_FONT_BOLD(flags)) { /* Times-BoldItalic - nimbu25.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "nimbu25.ttf"; + fname = "nimbu25.ttf"; } /* Times-Bold - nimbu23.ttf */ else { - fname = "nimbu23.ttf"; + fname = "nimbu23.ttf"; } } else { /* Times-Italic - nimbu24.ttf */ if (IS_FONT_ITALIC(flags) || IS_FONT_OBLIQUE(flags)) { - fname = "nimbu24.ttf"; + fname = "nimbu24.ttf"; } /* Times-Roman - nimbu22.ttf */ else { - fname = "nimbu22.ttf"; + fname = "nimbu22.ttf"; } } } @@ -7062,18 +7062,18 @@ char *find_fontfile(char *family, int flags) { fname = "stand34.ttf"; } else { - /* + /* * How should this be dealt with? For now, just let Font()/Wattrib() * fail. This is a TODO item. */ fprintf(stderr,"font '%s' not supported\n", family); return NULL; - } + } } /* * Pseudo LUT for default Unicon font types. This is only used if - * a specific font name was not given. + * a specific font name was not given. * * For now, it covers basic cases. Should add extra cases to cover * extremes of font attributes Unicon users could pass, e.g. "normal", @@ -7082,7 +7082,7 @@ char *find_fontfile(char *family, int flags) { */ if (!fname) { switch (flags & 0x1FFFF) { /* ignore charsets & font attrs */ - /* + /* * Unicon "mono" fonts (fixed width sans serif) * * Testing out SourceCodePro @@ -7103,12 +7103,12 @@ char *find_fontfile(char *family, int flags) { fname = "SourceCodePro-BoldIt.ttf"; break; - /* + /* * Unicon "typewriter" fonts (fixed width serif) */ /* Courier - nimbu26.ttf */ - case FONTFLAG_MONO | FONTFLAG_SERIF: + case FONTFLAG_MONO | FONTFLAG_SERIF: fname = "nimbu26.ttf"; break; @@ -7128,7 +7128,7 @@ char *find_fontfile(char *family, int flags) { break; - /* + /* * Unicon "sans" fonts (proportional width sans serif) */ @@ -7148,7 +7148,7 @@ char *find_fontfile(char *family, int flags) { break; /* Helvetica-BoldOblique - numbu17.ttf */ - case FONTFLAG_PROPORTIONAL | FONTFLAG_SANS | FONTFLAG_BOLD | + case FONTFLAG_PROPORTIONAL | FONTFLAG_SANS | FONTFLAG_BOLD | FONTFLAG_OBLIQUE: fname = "nimbu17.ttf"; break; @@ -7176,7 +7176,7 @@ char *find_fontfile(char *family, int flags) { fname = "nimbu21.ttf"; break; - /* + /* * Unicon "serif" fonts (proportional width serif) */ @@ -7231,7 +7231,7 @@ char *find_fontfile(char *family, int flags) { return abspath; } - + int gl_setleading(wbp w, int leading) { @@ -7243,10 +7243,10 @@ int gl_setleading(wbp w, int leading) const int intcode = GL2D_LEADING; int nfields; - if (!ws->updateRC) + if (!ws->updateRC) wc->leading = leading; - if (ws->initAttrs) + if (ws->initAttrs) return Succeeded; ws->busy_flag = 1; @@ -7262,23 +7262,23 @@ int gl_setleading(wbp w, int leading) MakeStr("Leading", 7, &(rp->fields[0])); MakeInt(intcode, &(rp->fields[1])); MakeInt(leading, &(rp->fields[2])); - + wcr->leading = leading; - c_put(&(w->window->funclist2d), &f); + c_put(&(w->window->funclist2d), &f); ws->busy_flag = 0; return Succeeded; } - + /********************************************************** * (4) Window management functions (platform independent) * **********************************************************/ - + int gl_allowresize(wbp w, int on) { @@ -7289,7 +7289,7 @@ int gl_allowresize(wbp w, int on) return Succeeded; } - + wcp gl_clone_context(wbp w) { @@ -7304,7 +7304,7 @@ wcp gl_clone_context(wbp w) return rv; } - + /* * initialize child window w from parent window wp @@ -7317,7 +7317,7 @@ char gl_child_window_stuff(wbp w, wbp wp, int child_window) is_3d = (child_window==CHILD_WIN3D)? 1 : 0; /* - * New canvas, so allocate display lists before attribute + * New canvas, so allocate display lists before attribute * initialization */ if (is_3d) { @@ -7330,13 +7330,13 @@ char gl_child_window_stuff(wbp w, wbp wp, int child_window) /* preserve certain parent attributes */ #ifdef XWindows w->window->iconic = wp->window->iconic; -#endif /* XWindows */ +#endif /* XWindows */ w->window->buffermode = wp->window->buffermode; - + return 1; } - + int gl_rebind(wbp w, wbp w2) { @@ -7345,7 +7345,7 @@ int gl_rebind(wbp w, wbp w2) return Succeeded; } - + /* * OpenGL implementation doesn't use Pixmaps @@ -7355,7 +7355,7 @@ int gl_resizePixmap(wbp w, int width, int height) return Succeeded; } - + int gl_setcursor(wbp w, int on) { @@ -7366,7 +7366,7 @@ int gl_setcursor(wbp w, int on) return Succeeded; } - + /* * Used in macros in fsys.r... what to do? @@ -7400,11 +7400,11 @@ int gl_wputc(int ci, wbp w) */ over = ws->y + GL_DESCENT(w) - height; if (over > 0) { - ws->y -= over; + ws->y -= over; /* * Copy from (0, over) to (0, 0) with dimensions of (width X height) */ - gl_copyArea(w, w, 0, over, width, height+over, 0, 0); + gl_copyArea(w, w, 0, over, width, height+over, 0, 0); } break; } @@ -7463,7 +7463,7 @@ int gl_wputc(int ci, wbp w) return 1; } - + @@ -7472,7 +7472,7 @@ int gl_wputc(int ci, wbp w) *******************************************************/ - + /* * allocate a context. Can't be called until w has a display and window. @@ -7480,7 +7480,7 @@ int gl_wputc(int ci, wbp w) wcp gl_alc_context(wbp w) { wcp wc; - + wc = alc_context(w); /* platform-specific init */ if (!wc) return NULL; @@ -7492,7 +7492,7 @@ wcp gl_alc_context(wbp w) } - + /* * allocate a display on machine s @@ -7529,7 +7529,7 @@ wdp gl_alc_display(char *s) return wd; } - + /* * allocate a window state structure @@ -7542,14 +7542,14 @@ wsp gl_alc_winstate() #ifdef XWindows ws->pix = (Pixmap) NULL; /* OpenGL impl. doesn't use backing store */ ws->ctx = (GLXContext) NULL; -#endif /* XWindows */ +#endif /* XWindows */ ws->is_gl = 1; - ws->buffermode = UGL_IMMEDIATE; - ws->rendermode = UGL2D; + ws->buffermode = UGL_IMMEDIATE; + ws->rendermode = UGL2D; /* 2d initialization */ - ws->lastwcserial = -1; + ws->lastwcserial = -1; ws->updateRC = 0; ws->initAttrs = 0; ws->resize = 0; @@ -7573,14 +7573,14 @@ wsp gl_alc_winstate() } - + void gl_free_context(wcp wc) { return free_context(wc); } - + /* * free a display @@ -7596,7 +7596,7 @@ void gl_free_display(wdp wd) * Free all 2d facility textures */ for (i = 0; i < 16; i++) { - if (wd->stdPatTexIds[i]) + if (wd->stdPatTexIds[i]) glDeleteTextures(1, &(wd->stdPatTexIds[i])); wd->stdPatTexIds[i] = 0; } @@ -7622,42 +7622,42 @@ void gl_free_display(wdp wd) wf->chars[i].pixmap = NULL; } } - wf = wf->next; + wf = wf->next; } wd->glfonts = NULL; -#endif /* HAVE_LIBFREETYPE */ +#endif /* HAVE_LIBFREETYPE */ } #ifdef XWindows /* Why doesn't Windows need to allocate a display? */ free_display(wd); -#endif /* XWindows */ +#endif /* XWindows */ } - + int gl_free_window(wsp ws) { return free_window(ws); } - + /* - * OpenGL doesn't need to allocate many colors, but this might come in handy + * OpenGL doesn't need to allocate many colors, but this might come in handy */ void gl_freecolor(wbp w, char *s) { return freecolor(w, s); } - + int gl_do_config(wbp w, int status) { return do_config(w, status); } - + /* * from rxwin.ri @@ -7668,10 +7668,10 @@ void gl_getcanvas(wbp w, char *s) } - + /* - * from rxwin.ri... + * from rxwin.ri... */ int gl_getdefault(wbp w, char *prog, char *opt, char *answer) { @@ -7679,7 +7679,7 @@ int gl_getdefault(wbp w, char *prog, char *opt, char *answer) } - + void gl_getdisplay(wbp w, char *s) { @@ -7687,21 +7687,21 @@ void gl_getdisplay(wbp w, char *s) } - + void gl_geticonic(wbp w, char *s) { return geticonic(w, s); } - + int gl_geticonpos(wbp w, char *s) { return geticonpos(w, s); } - + void gl_getpointername(wbp w, char *s) @@ -7709,27 +7709,27 @@ void gl_getpointername(wbp w, char *s) return getpointername(w, s); } - + int gl_getpos(wbp w) { return getpos(w); } - + int gl_getvisual(wbp w, char *s) { return getvisual(w, s); } - + int gl_nativecolor(wbp w, char *s, long *r, long *g, long *b) { return nativecolor(w, s, r, g, b); } - + int gl_lowerWindow(wbp w) @@ -7737,70 +7737,70 @@ int gl_lowerWindow(wbp w) return lowerWindow(w); } - + int gl_raiseWindow(wbp w) { - return raiseWindow(w); + return raiseWindow(w); } - + int gl_setcanvas(wbp w, char *s) { return setcanvas(w, s); } - + int gl_setdisplay(wbp w, char *s) { return setdisplay(w, s); } - + int gl_seticonicstate(wbp w, char *s) { return seticonicstate(w, s); } - + int gl_seticonimage(wbp w, dptr dp) { return seticonimage(w, dp); } - + int gl_seticonlabel(wbp w, char *s) { return seticonlabel(w, s); } - + int gl_seticonpos(wbp w, char *s) { return seticonpos(w, s); } - + int gl_setimage(wbp w, char *s) { return setimage(w, s); } - + int gl_setpointer(wbp w, char *s) { return setpointer(w, s); } - + int gl_setwidth(wbp w, SHORT new_width) { @@ -7808,21 +7808,21 @@ int gl_setwidth(wbp w, SHORT new_width) } - + int gl_setheight(wbp w, SHORT new_height) { return setheight(w, new_height); } - + int gl_setgeometry(wbp w, char *s) { return setgeometry(w, s); } - + int gl_setwindowlabel(wbp w, char *s) @@ -7830,57 +7830,57 @@ int gl_setwindowlabel(wbp w, char *s) return setwindowlabel(w, s); } - + int gl_query_pointer(wbp w, XPoint *xp) { return query_pointer(w, xp); } - + int gl_query_rootpointer(XPoint *xp) { return query_rootpointer(xp); } - + int gl_walert(wbp w, int volume) { return walert(w, volume); } - + void gl_warpPointer(wbp w, int x, int y) { return warpPointer(w, x, y); } - + int gl_wclose(wbp w) { return wclose(w); } - + void gl_wflush(wbp w) { return wflush(w); } - + #ifdef XWindows void gl_wflushall() { return wflushall(); } -#endif /* XWindows */ +#endif /* XWindows */ + - int gl_wgetq(wbp w, dptr res, int t) { @@ -7899,27 +7899,27 @@ int gl_wgetq(wbp w, dptr res, int t) return wgetq(w, res, t); } - + FILE *gl_wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int is_3d) { - return wopen(name, lp, attr, n, err_index, is_3d, 1); + return wopen(name, lp, attr, n, err_index, is_3d, 1); } - + int gl_wmap(wbp w) { #ifdef XWindows - return wmap(w); -#else /* XWindows */ + return wmap(w); +#else /* XWindows */ /* placeholder until implemented in MSWin and OSX */ - return my_wmap(w); -#endif /* XWindows */ + return my_wmap(w); +#endif /* XWindows */ } - + void gl_wsync(wbp w) { diff --git a/src/runtime/rposix.r b/src/runtime/rposix.r index f1ee14fc5..3d87559a0 100644 --- a/src/runtime/rposix.r +++ b/src/runtime/rposix.r @@ -26,140 +26,140 @@ #define ipad(wp) do ; while (0) #endif -/* Signal definitions */ -#passthru #if !defined(SIGABRT) -#passthru #define SIGABRT 0 -#passthru #endif -#passthru #if !defined(SIGALRM) -#passthru #define SIGALRM 0 -#passthru #endif -#passthru #if !defined(SIGBREAK) -#passthru #define SIGBREAK 0 -#passthru #endif -#passthru #if !defined(SIGBUS) -#passthru #define SIGBUS 0 -#passthru #endif -#passthru #if !defined(SIGCHLD) -#passthru #define SIGCHLD 0 -#passthru #endif -#passthru #if !defined(SIGCLD) -#passthru #define SIGCLD 0 -#passthru #endif -#passthru #if !defined(SIGCONT) -#passthru #define SIGCONT 0 -#passthru #endif -#passthru #if !defined(SIGEMT) -#passthru #define SIGEMT 0 -#passthru #endif -#passthru #if !defined(SIGFPE) -#passthru #define SIGFPE 0 -#passthru #endif -#passthru #if !defined(SIGFREEZE) -#passthru #define SIGFREEZE 0 -#passthru #endif -#passthru #if !defined(SIGHUP) -#passthru #define SIGHUP 0 -#passthru #endif -#passthru #if !defined(SIGILL) -#passthru #define SIGILL 0 -#passthru #endif -#passthru #if !defined(SIGINT) -#passthru #define SIGINT 0 -#passthru #endif -#passthru #if !defined(SIGIO) -#passthru #define SIGIO 0 -#passthru #endif -#passthru #if !defined(SIGIOT) -#passthru #define SIGIOT 0 -#passthru #endif -#passthru #if !defined(SIGKILL) -#passthru #define SIGKILL 0 -#passthru #endif -#passthru #if !defined(SIGLOST) -#passthru #define SIGLOST 0 -#passthru #endif -#passthru #if !defined(SIGLWP) -#passthru #define SIGLWP 0 -#passthru #endif -#passthru #if !defined(SIGPIPE) -#passthru #define SIGPIPE 0 -#passthru #endif -#passthru #if !defined(SIGPOLL) -#passthru #define SIGPOLL 0 -#passthru #endif -#passthru #if !defined(SIGPROF) -#passthru #define SIGPROF 0 -#passthru #endif -#passthru #if !defined(SIGPWR) -#passthru #define SIGPWR 0 -#passthru #endif -#passthru #if !defined(SIGQUIT) -#passthru #define SIGQUIT 0 -#passthru #endif -#passthru #if !defined(SIGSEGV) -#passthru #define SIGSEGV 0 -#passthru #endif -#passthru #if !defined(SIGSTOP) -#passthru #define SIGSTOP 0 -#passthru #endif -#passthru #if !defined(SIGSYS) -#passthru #define SIGSYS 0 -#passthru #endif -#passthru #if !defined(SIGTERM) -#passthru #define SIGTERM 0 -#passthru #endif -#passthru #if !defined(SIGTHAW) -#passthru #define SIGTHAW 0 -#passthru #endif -#passthru #if !defined(SIGTRAP) -#passthru #define SIGTRAP 0 -#passthru #endif -#passthru #if !defined(SIGTSTP) -#passthru #define SIGTSTP 0 -#passthru #endif -#passthru #if !defined(SIGTTIN) -#passthru #define SIGTTIN 0 -#passthru #endif -#passthru #if !defined(SIGTTOU) -#passthru #define SIGTTOU 0 -#passthru #endif -#passthru #if !defined(SIGURG) -#passthru #define SIGURG 0 -#passthru #endif -#passthru #if !defined(SIGUSR1) -#passthru #define SIGUSR1 0 -#passthru #endif -#passthru #if !defined(SIGUSR2) -#passthru #define SIGUSR2 0 -#passthru #endif -#passthru #if !defined(SIGVTALRM) -#passthru #define SIGVTALRM 0 -#passthru #endif -#passthru #if !defined(SIGWAITING) -#passthru #define SIGWAITING 0 -#passthru #endif -#passthru #if !defined(SIGWINCH) -#passthru #define SIGWINCH 0 -#passthru #endif -#passthru #if !defined(SIGXCPU) -#passthru #define SIGXCPU 0 -#passthru #endif -#passthru #if !defined(SIGXFSZ) -#passthru #define SIGXFSZ 0 -#passthru #endif +/* Signal definitions */ +#passthru #if !defined(SIGABRT) +#passthru #define SIGABRT 0 +#passthru #endif +#passthru #if !defined(SIGALRM) +#passthru #define SIGALRM 0 +#passthru #endif +#passthru #if !defined(SIGBREAK) +#passthru #define SIGBREAK 0 +#passthru #endif +#passthru #if !defined(SIGBUS) +#passthru #define SIGBUS 0 +#passthru #endif +#passthru #if !defined(SIGCHLD) +#passthru #define SIGCHLD 0 +#passthru #endif +#passthru #if !defined(SIGCLD) +#passthru #define SIGCLD 0 +#passthru #endif +#passthru #if !defined(SIGCONT) +#passthru #define SIGCONT 0 +#passthru #endif +#passthru #if !defined(SIGEMT) +#passthru #define SIGEMT 0 +#passthru #endif +#passthru #if !defined(SIGFPE) +#passthru #define SIGFPE 0 +#passthru #endif +#passthru #if !defined(SIGFREEZE) +#passthru #define SIGFREEZE 0 +#passthru #endif +#passthru #if !defined(SIGHUP) +#passthru #define SIGHUP 0 +#passthru #endif +#passthru #if !defined(SIGILL) +#passthru #define SIGILL 0 +#passthru #endif +#passthru #if !defined(SIGINT) +#passthru #define SIGINT 0 +#passthru #endif +#passthru #if !defined(SIGIO) +#passthru #define SIGIO 0 +#passthru #endif +#passthru #if !defined(SIGIOT) +#passthru #define SIGIOT 0 +#passthru #endif +#passthru #if !defined(SIGKILL) +#passthru #define SIGKILL 0 +#passthru #endif +#passthru #if !defined(SIGLOST) +#passthru #define SIGLOST 0 +#passthru #endif +#passthru #if !defined(SIGLWP) +#passthru #define SIGLWP 0 +#passthru #endif +#passthru #if !defined(SIGPIPE) +#passthru #define SIGPIPE 0 +#passthru #endif +#passthru #if !defined(SIGPOLL) +#passthru #define SIGPOLL 0 +#passthru #endif +#passthru #if !defined(SIGPROF) +#passthru #define SIGPROF 0 +#passthru #endif +#passthru #if !defined(SIGPWR) +#passthru #define SIGPWR 0 +#passthru #endif +#passthru #if !defined(SIGQUIT) +#passthru #define SIGQUIT 0 +#passthru #endif +#passthru #if !defined(SIGSEGV) +#passthru #define SIGSEGV 0 +#passthru #endif +#passthru #if !defined(SIGSTOP) +#passthru #define SIGSTOP 0 +#passthru #endif +#passthru #if !defined(SIGSYS) +#passthru #define SIGSYS 0 +#passthru #endif +#passthru #if !defined(SIGTERM) +#passthru #define SIGTERM 0 +#passthru #endif +#passthru #if !defined(SIGTHAW) +#passthru #define SIGTHAW 0 +#passthru #endif +#passthru #if !defined(SIGTRAP) +#passthru #define SIGTRAP 0 +#passthru #endif +#passthru #if !defined(SIGTSTP) +#passthru #define SIGTSTP 0 +#passthru #endif +#passthru #if !defined(SIGTTIN) +#passthru #define SIGTTIN 0 +#passthru #endif +#passthru #if !defined(SIGTTOU) +#passthru #define SIGTTOU 0 +#passthru #endif +#passthru #if !defined(SIGURG) +#passthru #define SIGURG 0 +#passthru #endif +#passthru #if !defined(SIGUSR1) +#passthru #define SIGUSR1 0 +#passthru #endif +#passthru #if !defined(SIGUSR2) +#passthru #define SIGUSR2 0 +#passthru #endif +#passthru #if !defined(SIGVTALRM) +#passthru #define SIGVTALRM 0 +#passthru #endif +#passthru #if !defined(SIGWAITING) +#passthru #define SIGWAITING 0 +#passthru #endif +#passthru #if !defined(SIGWINCH) +#passthru #define SIGWINCH 0 +#passthru #endif +#passthru #if !defined(SIGXCPU) +#passthru #define SIGXCPU 0 +#passthru #endif +#passthru #if !defined(SIGXFSZ) +#passthru #define SIGXFSZ 0 +#passthru #endif stringint signalnames[] = { - { 0, 40 }, - { "SIGABRT", SIGABRT }, + { 0, 40 }, + { "SIGABRT", SIGABRT }, { "SIGALRM", SIGALRM }, { "SIGBREAK", SIGBREAK }, { "SIGBUS", SIGBUS }, { "SIGCHLD", SIGCHLD }, - { "SIGCLD", SIGCLD }, + { "SIGCLD", SIGCLD }, { "SIGCONT", SIGCONT }, { "SIGEMT", SIGEMT }, { "SIGFPE", SIGFPE }, - { "SIGFREEZE", SIGFREEZE }, + { "SIGFREEZE", SIGFREEZE }, { "SIGHUP", SIGHUP }, { "SIGILL", SIGILL }, { "SIGINT", SIGINT }, @@ -167,9 +167,9 @@ stringint signalnames[] = { { "SIGIOT", SIGIOT }, { "SIGKILL", SIGKILL }, { "SIGLOST", SIGLOST }, - { "SIGLWP", SIGLWP }, + { "SIGLWP", SIGLWP }, { "SIGPIPE", SIGPIPE }, - { "SIGPOLL", SIGPOLL }, + { "SIGPOLL", SIGPOLL }, { "SIGPROF", SIGPROF }, { "SIGPWR", SIGPWR }, { "SIGQUIT", SIGQUIT }, @@ -177,7 +177,7 @@ stringint signalnames[] = { { "SIGSTOP", SIGSTOP }, { "SIGSYS", SIGSYS }, { "SIGTERM", SIGTERM }, - { "SIGTHAW", SIGTHAW }, + { "SIGTHAW", SIGTHAW }, { "SIGTRAP", SIGTRAP }, { "SIGTSTP", SIGTSTP }, { "SIGTTIN", SIGTTIN }, @@ -186,7 +186,7 @@ stringint signalnames[] = { { "SIGUSR1", SIGUSR1 }, { "SIGUSR2", SIGUSR2 }, { "SIGVTALRM", SIGVTALRM }, - { "SIGWAITING", SIGWAITING }, + { "SIGWAITING", SIGWAITING }, { "SIGWINCH", SIGWINCH }, { "SIGXCPU", SIGXCPU }, { "SIGXFSZ", SIGXFSZ }, @@ -219,7 +219,7 @@ int CleanupWinSocket(void) WINSOCK_INITIAL = 0; return 1; } -#endif /* NT */ +#endif /* NT */ /* * get_fd() - get file descriptor @@ -241,41 +241,41 @@ int get_fd(struct descrip file, unsigned int errmask) #ifdef Graphics if (status & Fs_Window) { if (!(status & Fs_Read)) { - return -1; - } + return -1; + } #ifdef XWindows return XConnectionNumber(BlkD(file,File)->fd.wb-> - window->display->display); -#else /* XWindows */ + window->display->display); +#else /* XWindows */ return -1; -#endif /* XWindows */ +#endif /* XWindows */ } -#endif /* Graphics */ +#endif /* Graphics */ #ifdef PseudoPty if (status & Fs_Pty) { #if NT return -1; -#else /* NT */ +#else /* NT */ return BlkD(file,File)->fd.pt->master_fd; -#endif /* NT */ +#endif /* NT */ } -#endif /* PseudoPty */ +#endif /* PseudoPty */ if (errmask && !(status & errmask)) return -2; #if NT #define fileno _fileno -#endif /* NT */ +#endif /* NT */ if (status & Fs_Socket) { #if HAVE_LIBSSL if(status & Fs_Encrypt) return SSL_get_fd(BlkD(file,File)->fd.ssl); else -#endif /* LIBSSL */ - return BlkD(file,File)->fd.fd; +#endif /* LIBSSL */ + return BlkD(file,File)->fd.fd; } if (status & Fs_Messaging) @@ -290,13 +290,13 @@ char *name; { #if NT return -1; -#else /* NT */ - struct passwd *pw, pwbuf; +#else /* NT */ + struct passwd *pw, pwbuf; char buf[1024]; if ((getpwnam_r(name, &pwbuf, buf, 1024, &pw)!=0) || (pw == NULL)) return -1; return pw->pw_uid; -#endif /* NT */ +#endif /* NT */ } int get_gid(name) @@ -304,13 +304,13 @@ char *name; { #if NT return -1; -#else /* NT */ +#else /* NT */ struct group *gr, grbuf; char buf[4096]; if ((getgrnam_r(name, &grbuf, buf, 4096, &gr)!=0) || (gr == NULL)) return -1; return gr->gr_gid; -#endif /* NT */ +#endif /* NT */ } static int newmode(mode, oldmode) @@ -318,7 +318,7 @@ char *mode; int oldmode; { int i; - + /* The pattern is [ugoa]*[+-=][rwxRWXstugo]* */ int which = 0, do_umask; char *p = mode, *q, op; @@ -339,10 +339,10 @@ int oldmode; mlen = strlen(mode); if (mlen != 9 && (mlen != 10 || !strchr("-ldcb|s", mode[0]))) - break; + break; if (mlen == 10) - /* We know there's a leading char we're not interested in */ + /* We know there's a leading char we're not interested in */ mode++; strcpy(allperms, "rwxrwxrwx"); @@ -373,27 +373,27 @@ int oldmode; cmode = 0; for(i = 0; i < 9; i++) { - cmode = cmode << 1; - if (mode[i] == '-') { - cmode |= 1; - } else if (mode[i] != allperms[i]) { - cmode = -1; - break; - } + cmode = cmode << 1; + if (mode[i] == '-') { + cmode |= 1; + } else if (mode[i] != allperms[i]) { + cmode = -1; + break; + } } if (cmode < 0) - break; + break; cmode |= highbits << 9; return cmode; } while(0); while ((q = strchr(fields, *p))) { if (!*p) - return -2; + return -2; if (*p == 'a') - which = 7; + which = 7; else - which |= 1 << (q - fields); + which |= 1 << (q - fields); p++; } if (!strchr("+=-", *p)) @@ -401,17 +401,17 @@ int oldmode; if ((do_umask = (which == 0))) which = 7; - + op = *p++; /* We have: which field(s) in "which", an operator in "op" */ if (op == '=') { for(i = 0; i < 3; i++) - if (which & (1 << i)) { - retmode &= ~(7 << (i*3)); - retmode &= ~(1 << (i + 9)); - } + if (which & (1 << i)) { + retmode &= ~(7 << (i*3)); + retmode &= ~(1 << (i + 9)); + } op = '+'; } @@ -428,40 +428,40 @@ int oldmode; case 'g': value = (oldmode & 0070) >> 3; break; case 'o': value = oldmode & 0007; break; case 's': - if (which & 4) - value = 04000; - if (which & 2) - value |= 02000; - retmode |= value; - continue; + if (which & 4) + value = 04000; + if (which & 2) + value |= 02000; + retmode |= value; + continue; case 't': - if (which & 1) - retmode |= 01000; - continue; + if (which & 1) + retmode |= 01000; + continue; default: - return -2; + return -2; } for(i = 0; i < 3; i++) { - int nvalue; - if (which & (1 << i)) { - if (do_umask) { + int nvalue; + if (which & (1 << i)) { + if (do_umask) { #if NT - int u = _umask(0); - _umask(u); -#else /* NT */ - int u = umask(0); - umask(u); -#endif /* NT */ - nvalue = value & ~u; - } else - nvalue = value; - switch (op) { - case '-': retmode &= ~nvalue; break; - case '+': retmode |= nvalue; break; - } - } - value = (value << 3); + int u = _umask(0); + _umask(u); +#else /* NT */ + int u = umask(0); + umask(u); +#endif /* NT */ + nvalue = value & ~u; + } else + nvalue = value; + switch (op) { + case '-': retmode &= ~nvalue; break; + case '+': retmode |= nvalue; break; + } + } + value = (value << 3); } } @@ -481,7 +481,7 @@ char *mode; #passthru #if (__GNUC__==4) && (__GNUC_MINOR__>7) #passthru #define stat _stat64i32 #passthru #endif -#endif /* NTGCC && WordBits==32*/ +#endif /* NTGCC && WordBits==32*/ struct stat st; if (fstat(fd, &st) < 0) return -1; @@ -514,9 +514,9 @@ char *mode; void stat2rec(st, dp, rp) #if NT struct _stat *st; -#else /* NT */ +#else /* NT */ struct stat *st; -#endif /* NT */ +#endif /* NT */ struct descrip *dp; struct b_record **rp; { @@ -525,7 +525,7 @@ struct b_record **rp; #if !NT struct passwd *pw = NULL, pwbuf; struct group *gr = NULL, grbuf; -#endif /* !NT */ +#endif /* !NT */ char buf[4096]; dp->dword = D_Record; @@ -562,7 +562,7 @@ struct b_record **rp; if (st->st_mode & S_IREAD) mode[1] = mode[4] = mode[7] = 'r'; if (st->st_mode & S_IWRITE) mode[2] = mode[5] = mode[8] = 'w'; if (st->st_mode & S_IEXEC) mode[3] = mode[6] = mode[9] = 'x'; -#else /* NT */ +#else /* NT */ if (S_ISLNK(st->st_mode)) mode[0] = 'l'; else if (S_ISREG(st->st_mode)) mode[0] = '-'; else if (S_ISDIR(st->st_mode)) mode[0] = 'd'; @@ -584,14 +584,14 @@ struct b_record **rp; if (S_ISUID & st->st_mode) mode[3] = (mode[3] == 'x') ? 's' : 'S'; if (S_ISGID & st->st_mode) mode[6] = (mode[6] == 'x') ? 's' : 'S'; if (S_ISVTX & st->st_mode) mode[9] = (mode[9] == 'x') ? 't' : 'T'; -#endif /* NT */ +#endif /* NT */ StrLoc((*rp)->fields[2]) = alcstr(mode, 10); StrLen((*rp)->fields[2]) = 10; #if NT (*rp)->fields[4] = (*rp)->fields[5] = emptystr; -#else /* NT */ +#else /* NT */ /* * If we can get the user name, use it. Otherwise use the user id #. * getpwuid_r's interface is a fair bit different than getpwuid! @@ -608,7 +608,7 @@ struct b_record **rp; } StrLoc((*rp)->fields[4]) = alcstr(user, strlen(user)); StrLen((*rp)->fields[4]) = strlen(user); - + getgrgid_r(st->st_gid, &grbuf, buf, 4096, &gr); if (gr == 0){ sprintf(mode, "%d", st->st_gid); @@ -619,7 +619,7 @@ struct b_record **rp; } StrLoc((*rp)->fields[5]) = alcstr(group, strlen(group)); StrLen((*rp)->fields[5]) = strlen(group); -#endif /* NT */ +#endif /* NT */ } @@ -668,7 +668,7 @@ void rusage2rec(struct rusage *usg, struct descrip *dp, struct b_record **rp) IntVal((*rp)->fields[7]) = (word)usg->ru_nvcsw; IntVal((*rp)->fields[8]) = (word)usg->ru_nivcsw; } -#endif /* NT */ +#endif /* NT */ struct descrip posix_lock = {D_Null}; struct descrip posix_timeval = {D_Null}; @@ -689,121 +689,121 @@ char *name; if (!strcmp(name, "posix_lock")) { if (is:null(posix_lock)) { - AsgnCStr(s, "posix_lock"); - AsgnCStr(fields[0], "value"); - AsgnCStr(fields[1], "pid"); - posix_lock.dword = D_Proc; - posix_lock.vword.bptr = (union block *)dynrecord(&s, fields, 2); - } + AsgnCStr(s, "posix_lock"); + AsgnCStr(fields[0], "value"); + AsgnCStr(fields[1], "pid"); + posix_lock.dword = D_Proc; + posix_lock.vword.bptr = (union block *)dynrecord(&s, fields, 2); + } return &posix_lock; } else if (!strcmp(name, "posix_message")) { if (is:null(posix_message)) { - AsgnCStr(s, "posix_message"); - AsgnCStr(fields[0], "addr"); - AsgnCStr(fields[1], "msg"); - posix_message.dword = D_Proc; - posix_message.vword.bptr = (union block *)dynrecord(&s, fields, 2); - } + AsgnCStr(s, "posix_message"); + AsgnCStr(fields[0], "addr"); + AsgnCStr(fields[1], "msg"); + posix_message.dword = D_Proc; + posix_message.vword.bptr = (union block *)dynrecord(&s, fields, 2); + } return &posix_message; } else if (!strcmp(name, "posix_servent")) { if (is:null(posix_servent)) { - AsgnCStr(s, "posix_servent"); - AsgnCStr(fields[0], "name"); - AsgnCStr(fields[1], "aliases"); - AsgnCStr(fields[2], "port"); - AsgnCStr(fields[3], "proto"); - posix_servent.dword = D_Proc; - posix_servent.vword.bptr = (union block *)dynrecord(&s, fields, 4); - } + AsgnCStr(s, "posix_servent"); + AsgnCStr(fields[0], "name"); + AsgnCStr(fields[1], "aliases"); + AsgnCStr(fields[2], "port"); + AsgnCStr(fields[3], "proto"); + posix_servent.dword = D_Proc; + posix_servent.vword.bptr = (union block *)dynrecord(&s, fields, 4); + } return &posix_servent; } else if (!strcmp(name, "posix_hostent")) { if (is:null(posix_hostent)) { - AsgnCStr(s, "posix_hostent"); - AsgnCStr(fields[0], "name"); - AsgnCStr(fields[1], "aliases"); - AsgnCStr(fields[2], "addresses"); - posix_hostent.dword = D_Proc; - posix_hostent.vword.bptr = (union block *)dynrecord(&s, fields, 3); - } + AsgnCStr(s, "posix_hostent"); + AsgnCStr(fields[0], "name"); + AsgnCStr(fields[1], "aliases"); + AsgnCStr(fields[2], "addresses"); + posix_hostent.dword = D_Proc; + posix_hostent.vword.bptr = (union block *)dynrecord(&s, fields, 3); + } return &posix_hostent; } else if (!strcmp(name, "posix_timeval")) { if (is:null(posix_timeval)) { - AsgnCStr(s, "posix_timeval"); - AsgnCStr(fields[0], "sec"); - AsgnCStr(fields[1], "usec"); - posix_timeval.dword = D_Proc; - posix_timeval.vword.bptr = (union block *)dynrecord(&s, fields, 2); - } + AsgnCStr(s, "posix_timeval"); + AsgnCStr(fields[0], "sec"); + AsgnCStr(fields[1], "usec"); + posix_timeval.dword = D_Proc; + posix_timeval.vword.bptr = (union block *)dynrecord(&s, fields, 2); + } return &posix_timeval; } else if (!strcmp(name, "posix_rusage")) { if (is:null(posix_rusage)) { - AsgnCStr(s, "posix_rusage"); - AsgnCStr(fields[0], "utime"); - AsgnCStr(fields[1], "stime"); - AsgnCStr(fields[2], "maxrss"); - AsgnCStr(fields[3], "minflt"); - AsgnCStr(fields[4], "majflt"); - AsgnCStr(fields[5], "inblock"); - AsgnCStr(fields[6], "oublock"); - AsgnCStr(fields[7], "nvcsw"); - AsgnCStr(fields[8], "nivcsw"); - posix_rusage.dword = D_Proc; - posix_rusage.vword.bptr = (union block *)dynrecord(&s, fields, 9); - } + AsgnCStr(s, "posix_rusage"); + AsgnCStr(fields[0], "utime"); + AsgnCStr(fields[1], "stime"); + AsgnCStr(fields[2], "maxrss"); + AsgnCStr(fields[3], "minflt"); + AsgnCStr(fields[4], "majflt"); + AsgnCStr(fields[5], "inblock"); + AsgnCStr(fields[6], "oublock"); + AsgnCStr(fields[7], "nvcsw"); + AsgnCStr(fields[8], "nivcsw"); + posix_rusage.dword = D_Proc; + posix_rusage.vword.bptr = (union block *)dynrecord(&s, fields, 9); + } return &posix_rusage; } else if (!strcmp(name, "posix_group")) { if (is:null(posix_group)) { - AsgnCStr(s, "posix_group"); - AsgnCStr(fields[0], "name"); - AsgnCStr(fields[1], "passwd"); - AsgnCStr(fields[2], "gid"); - AsgnCStr(fields[3], "members"); - posix_group.dword = D_Proc; - posix_group.vword.bptr = (union block *)dynrecord(&s, fields, 4); - } + AsgnCStr(s, "posix_group"); + AsgnCStr(fields[0], "name"); + AsgnCStr(fields[1], "passwd"); + AsgnCStr(fields[2], "gid"); + AsgnCStr(fields[3], "members"); + posix_group.dword = D_Proc; + posix_group.vword.bptr = (union block *)dynrecord(&s, fields, 4); + } return &posix_group; } else if (!strcmp(name, "posix_passwd")) { if (is:null(posix_passwd)) { - AsgnCStr(s, "posix_passwd"); - AsgnCStr(fields[0], "name"); - AsgnCStr(fields[1], "passwd"); - AsgnCStr(fields[2], "uid"); - AsgnCStr(fields[3], "gid"); - AsgnCStr(fields[4], "gecos"); - AsgnCStr(fields[5], "dir"); - AsgnCStr(fields[6], "shell"); - posix_passwd.dword = D_Proc; - posix_passwd.vword.bptr = (union block *)dynrecord(&s, fields, 7); - } + AsgnCStr(s, "posix_passwd"); + AsgnCStr(fields[0], "name"); + AsgnCStr(fields[1], "passwd"); + AsgnCStr(fields[2], "uid"); + AsgnCStr(fields[3], "gid"); + AsgnCStr(fields[4], "gecos"); + AsgnCStr(fields[5], "dir"); + AsgnCStr(fields[6], "shell"); + posix_passwd.dword = D_Proc; + posix_passwd.vword.bptr = (union block *)dynrecord(&s, fields, 7); + } return &posix_passwd; } else if (!strcmp(name, "posix_stat")) { if (is:null(posix_stat)) { - AsgnCStr(s, "posix_stat"); - AsgnCStr(fields[0], "dev"); - AsgnCStr(fields[1], "ino"); - AsgnCStr(fields[2], "mode"); - AsgnCStr(fields[3], "nlink"); - AsgnCStr(fields[4], "uid"); - AsgnCStr(fields[5], "gid"); - AsgnCStr(fields[6], "rdev"); - AsgnCStr(fields[7], "size"); - AsgnCStr(fields[8], "atime"); - AsgnCStr(fields[9], "mtime"); - AsgnCStr(fields[10], "ctime"); - AsgnCStr(fields[11], "blksize"); - AsgnCStr(fields[12], "blocks"); - AsgnCStr(fields[13], "symlink"); - posix_stat.dword = D_Proc; - posix_stat.vword.bptr = (union block *)dynrecord(&s, fields, 14); - } + AsgnCStr(s, "posix_stat"); + AsgnCStr(fields[0], "dev"); + AsgnCStr(fields[1], "ino"); + AsgnCStr(fields[2], "mode"); + AsgnCStr(fields[3], "nlink"); + AsgnCStr(fields[4], "uid"); + AsgnCStr(fields[5], "gid"); + AsgnCStr(fields[6], "rdev"); + AsgnCStr(fields[7], "size"); + AsgnCStr(fields[8], "atime"); + AsgnCStr(fields[9], "mtime"); + AsgnCStr(fields[10], "ctime"); + AsgnCStr(fields[11], "blksize"); + AsgnCStr(fields[12], "blocks"); + AsgnCStr(fields[13], "symlink"); + posix_stat.dword = D_Proc; + posix_stat.vword.bptr = (union block *)dynrecord(&s, fields, 14); + } return &posix_stat; } @@ -817,20 +817,20 @@ char *name; if (is:proc(globals[i])) return &globals[i]; else - return 0; - } + return 0; + } return 0; } -/* +/* * Sockets * * IMPORTANT NOTE: IPv6 (AF_INET6) is NOT implemented. * * There are two routines that are provided (via open()) - connect (for a - * client) and listen (for servers). - * + * client) and listen (for servers). + * * Four procedures are not required for starting a TCP server, we combine * them. The standard BSD way of doing it is: * @@ -885,27 +885,27 @@ struct addrinfo **saddrs; #if !defined(MAXHOSTNAMELEN) #define MAXHOSTNAMELEN 32 -#endif /* MAXHOSTNAMELEN */ +#endif /* MAXHOSTNAMELEN */ /* * debugging function to dump addrinfo struct */ int dump_addrinfo(struct addrinfo *ai) { - struct addrinfo *runp; - char hostbuf[50], portbuf[10]; - for (runp = ai; runp != NULL; runp = runp->ai_next) { - printf("family: %d, socktype: %d, protocol: %d, ", - runp->ai_family, runp->ai_socktype, runp->ai_protocol); - (void) getnameinfo( - runp->ai_addr, runp->ai_addrlen, - hostbuf, sizeof(hostbuf), - portbuf, sizeof(portbuf), - NI_NUMERICHOST | NI_NUMERICSERV - ); - printf("host: %s, port: %s\n", hostbuf, portbuf); - } - return 0; + struct addrinfo *runp; + char hostbuf[50], portbuf[10]; + for (runp = ai; runp != NULL; runp = runp->ai_next) { + printf("family: %d, socktype: %d, protocol: %d, ", + runp->ai_family, runp->ai_socktype, runp->ai_protocol); + (void) getnameinfo( + runp->ai_addr, runp->ai_addrlen, + hostbuf, sizeof(hostbuf), + portbuf, sizeof(portbuf), + NI_NUMERICHOST | NI_NUMERICSERV + ); + printf("host: %s, port: %s\n", hostbuf, portbuf); + } + return 0; } char* print_sockaddr(struct sockaddr* sa, char* buf, int buflen ) { @@ -973,10 +973,10 @@ struct addrinfo *uni_getaddrinfo(char* addr, char* p, int is_udp, int family){ nohost = 1; #if NT if (!StartupWinSocket()) return 0; -#endif /*NT*/ +#endif /*NT*/ INIT_ADDRINFO_HINTS(hints, family, (is_udp? SOCK_DGRAM : SOCK_STREAM), - (nohost?AI_PASSIVE:0), (is_udp?IPPROTO_UDP:IPPROTO_TCP)); + (nohost?AI_PASSIVE:0), (is_udp?IPPROTO_UDP:IPPROTO_TCP)); if ( (rc = getaddrinfo((nohost?NULL:addr), p, &hints, &res0)) != 0) { set_gaierrortext(rc); return NULL; @@ -989,7 +989,7 @@ struct addrinfo *uni_getaddrinfo(char* addr, char* p, int is_udp, int family){ /* * Empty handler for connection alarm signals (used for timeouts). */ -/* static void on_alarm(int x) +/* static void on_alarm(int x) { } */ @@ -1004,7 +1004,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) #if UNIX struct sockaddr_un saddr_un; int pathbuf_len = sizeof(saddr_un.sun_path); -#endif /* UNIX */ +#endif /* UNIX */ errno = 0; SAFE_strncpy(fname, fn, sizeof(fname)); @@ -1019,31 +1019,31 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) *p = ':'; if (!res0) - return 0; + return 0; s = -1; for (res = res0; res; res = res->ai_next) { - s = socket(res->ai_family, res->ai_socktype, - res->ai_protocol); - if (s < 0) { - continue; - } - - /* - if (connect(s, res->ai_addr, res->ai_addrlen) < 0) { - close(s); - s = -1; - continue; - } - */ - - break; /* okay we got one */ + s = socket(res->ai_family, res->ai_socktype, + res->ai_protocol); + if (s < 0) { + continue; + } + + /* + if (connect(s, res->ai_addr, res->ai_addrlen) < 0) { + close(s); + s = -1; + continue; + } + */ + + break; /* okay we got one */ } if (s < 0) { - // failed to create a socket to any of the resloved names - freeaddrinfo(res0); - return 0; + // failed to create a socket to any of the resloved names + freeaddrinfo(res0); + return 0; } // This is the node we care about, free all other nodes before and after it @@ -1051,21 +1051,21 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) sa = saddrinfo->ai_addr; len = saddrinfo->ai_addrlen; if (saddrinfo == res0){ - if (saddrinfo->ai_next != NULL){ - freeaddrinfo(saddrinfo->ai_next); - saddrinfo->ai_next = NULL; - } + if (saddrinfo->ai_next != NULL){ + freeaddrinfo(saddrinfo->ai_next); + saddrinfo->ai_next = NULL; + } } else { - for (res = res0; res->ai_next != saddrinfo; res = res->ai_next); - res->ai_next = NULL; - freeaddrinfo(res0); - - res = saddrinfo->ai_next; - if (res){ - saddrinfo->ai_next = NULL; - freeaddrinfo(res); - } + for (res = res0; res->ai_next != saddrinfo; res = res->ai_next); + res->ai_next = NULL; + freeaddrinfo(res0); + + res = saddrinfo->ai_next; + if (res){ + saddrinfo->ai_next = NULL; + freeaddrinfo(res); + } } } else { @@ -1075,7 +1075,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) #endif #if UNIX if (is_udp || (s = socket(PF_UNIX, SOCK_STREAM, 0)) < 0) - return 0; + return 0; saddr_un.sun_family = AF_UNIX; strncpy(saddr_un.sun_path, fname, pathbuf_len); /* NUL-terminate just in case.... */ @@ -1086,7 +1086,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) saddr_un.sun_len = len; #endif sa = (struct sockaddr*) &saddr_un; -#endif /* UNIX */ +#endif /* UNIX */ } /* We don't connect UDP sockets but always use sendto(2). */ @@ -1094,9 +1094,9 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) /* save the sockaddr struct */ saddrs = realloc(saddrs, (s+1) * (sizeof(struct addrinfo *))); if (saddrs == NULL) { - close(s); - return 0; - } + close(s); + return 0; + } saddrs[s] = saddrinfo; return s; } @@ -1115,7 +1115,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) close(s); return 0; } -#endif /* UNIX */ +#endif /* UNIX */ #if NT /* Turn on non-blocking flag so connect will return immediately. */ unsigned long imode = 1; @@ -1124,7 +1124,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) closesocket(s); return 0; } -#endif /* NT */ +#endif /* NT */ } rc = connect(s, sa, len); @@ -1144,7 +1144,7 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) fd_set ws, es; struct timeval tv; int sc, cc; - unsigned int cclen; + unsigned int cclen; tv.tv_sec = timeout / 1000; tv.tv_usec = 1000 * (timeout % 1000); @@ -1153,11 +1153,11 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) FD_ZERO(&es); FD_SET(s, &es); errno = 0; - sc = select(FD_SETSIZE, NULL, &ws, &es, &tv); + sc = select(FD_SETSIZE, NULL, &ws, &es, &tv); /* - * A result of 0 means timeout; in this case errno will be zero too, + * A result of 0 means timeout; in this case errno will be zero too, * and that can be used to distinguish from another error condition. - */ + */ if (sc <= 0) { close(s); return 0; @@ -1168,24 +1168,24 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) if (getsockopt(s, SOL_SOCKET, SO_ERROR, &cc, &cclen) < 0) { close(s); return 0; - } + } if (cc != 0) { /* There was an error, so set errno and fail */ errno = cc; close(s); return 0; - } + } return s; } -#endif /* UNIX */ +#endif /* UNIX */ #if NT /* Turn off non-blocking flag */ int connect_err = WSAGetLastError(); unsigned long imode = 0; if (ioctlsocket(s, FIONBIO, &imode) < 0) { - errno = WSAGetLastError(); + errno = WSAGetLastError(); closesocket(s); return 0; } @@ -1204,11 +1204,11 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) FD_ZERO(&es); FD_SET(s, &es); WSASetLastError(0); - sc = select(FD_SETSIZE, NULL, &ws, &es, &tv); + sc = select(FD_SETSIZE, NULL, &ws, &es, &tv); /* A result of 0 means timeout; in this case WSAGetLastError() will return zero, and that can be used to distinguish from another error condition. */ if (sc <= 0) { - errno = WSAGetLastError(); + errno = WSAGetLastError(); closesocket(s); return 0; } @@ -1216,21 +1216,21 @@ int sock_connect(char *fn, int is_udp, int timeout, int af_fam) /* Get the error code of the connect */ cclen = sizeof(cc); if (getsockopt(s, SOL_SOCKET, SO_ERROR, (char*)&cc, &cclen) < 0) { - errno = WSAGetLastError(); + errno = WSAGetLastError(); closesocket(s); return 0; - } + } if (cc != 0) { /* There was an error, so set errno and fail */ errno = cc; closesocket(s); return 0; - } + } return s; } -#endif /* NT */ +#endif /* NT */ } if (rc < 0) { @@ -1278,35 +1278,35 @@ int sock_listen(char *addr, int is_udp_or_listener, int af_fam) */ if ((p=strrchr(addr, ':')) != NULL) { - *p = 0; - res0 = uni_getaddrinfo(addr, p+1, is_udp_or_listener == 1, af_fam); - *p = ':'; - - if (!res0) - return 0; - - s = -1; - for (res = res0; res; res = res->ai_next) { - s = socket(res->ai_family, res->ai_socktype, - res->ai_protocol); - if (s < 0) { - continue; - } - - if (bind(s, res->ai_addr, res->ai_addrlen) < 0) { - close(s); - s = -1; - continue; - } - - break; /* okay we got one */ - } - - if (res0) - freeaddrinfo(res0); - if (s < 0) { - return 0; // failed to bind to any address - } + *p = 0; + res0 = uni_getaddrinfo(addr, p+1, is_udp_or_listener == 1, af_fam); + *p = ':'; + + if (!res0) + return 0; + + s = -1; + for (res = res0; res; res = res->ai_next) { + s = socket(res->ai_family, res->ai_socktype, + res->ai_protocol); + if (s < 0) { + continue; + } + + if (bind(s, res->ai_addr, res->ai_addrlen) < 0) { + close(s); + s = -1; + continue; + } + + break; /* okay we got one */ + } + + if (res0) + freeaddrinfo(res0); + if (s < 0) { + return 0; // failed to bind to any address + } } else { @@ -1315,28 +1315,28 @@ int sock_listen(char *addr, int is_udp_or_listener, int af_fam) return 0; #endif #if UNIX - struct sockaddr_un saddr_un; + struct sockaddr_un saddr_un; int pathbuf_len; - if ((is_udp_or_listener==1) || - (s = socket(PF_UNIX, SOCK_STREAM, 0)) < 0) - return 0; + if ((is_udp_or_listener==1) || + (s = socket(PF_UNIX, SOCK_STREAM, 0)) < 0) + return 0; pathbuf_len = sizeof(saddr_un.sun_path); - saddr_un.sun_family = AF_UNIX; - strncpy(saddr_un.sun_path, addr, pathbuf_len); + saddr_un.sun_family = AF_UNIX; + strncpy(saddr_un.sun_path, addr, pathbuf_len); saddr_un.sun_path[pathbuf_len - 1] = 0; len = sizeof(saddr_un.sun_family) + strlen(saddr_un.sun_path); #ifdef BSD_4_4_LITE len += sizeof(saddr_un.sun_len); - saddr_un.sun_len = len; + saddr_un.sun_len = len; #endif - (void) unlink(saddr_un.sun_path); - sa = (struct sockaddr*) &saddr_un; -#endif /* UNIX */ - if (bind(s, sa, len) < 0) { - return 0; - } + (void) unlink(saddr_un.sun_path); + sa = (struct sockaddr*) &saddr_un; +#endif /* UNIX */ + if (bind(s, sa, len) < 0) { + return 0; + } } } /* No need to listen on UDP sockets */ @@ -1461,7 +1461,7 @@ int sock_send(char *adr, char *msg, int msglen, int af_fam) s = -1; for (res = res0; res; res = res->ai_next) { s = socket(res->ai_family, res->ai_socktype, - res->ai_protocol); + res->ai_protocol); if (s >= 0) break; /* okay we got one */ } @@ -1499,7 +1499,7 @@ int sock_recv(int s, struct b_record **rp) #if NT if (!StartupWinSocket()) return 0; -#endif /* NT */ +#endif /* NT */ if (getsockopt(s, SOL_SOCKET, SO_TYPE, (char *)&s_type, &len) < 0) return 0; @@ -1544,7 +1544,7 @@ int sock_write(int f, char *msg, int n) if (s_type == SOCK_DGRAM){ rv = sendto(fd, msg, n, 0, - saddrs[fd]->ai_addr, saddrs[fd]->ai_addrlen); + saddrs[fd]->ai_addr, saddrs[fd]->ai_addrlen); } else rv = send(fd, msg, n, 0); @@ -1566,7 +1566,7 @@ char *s; int i; for (i = 0; i < nsock; i++) if (strcmp(s, sock_map[i].name) == 0) - return sock_map[i].fd; + return sock_map[i].fd; return -1; } @@ -1617,64 +1617,64 @@ SSL_CTX * create_ssl_context(dptr attr, int n, int type ) { } else if (cnv:C_string(attr[a], tmps)) { /* - * quick santiy check, reject any attribute - * - under 3 characters - * - starts or ends with '=' - */ + * quick santiy check, reject any attribute + * - under 3 characters + * - starts or ends with '=' + */ if (strlen(tmps) < 3 || tmps[0] == '=' || tmps[strlen(tmps)-1] == '=') { - set_errortext_with_val(1302, tmps); - return NULL; + set_errortext_with_val(1302, tmps); + return NULL; } /* - * split the attribute at the '=' sign - * attrib name up to '=', val is whatever comes after '=' - */ + * split the attribute at the '=' sign + * attrib name up to '=', val is whatever comes after '=' + */ val = strchr(tmps,'='); if (val != NULL) { - *val = '\0'; - val++; - if (strlen(val) == 0) { - set_errortext_with_val(1302, tmps); - return NULL; - } - //printf("attr: %s=%s\n", tmps, val); - if (strcmp(tmps, "cert") == 0) - certFile = val; - else if (strcmp(tmps, "key") == 0) - keyFile = val; - else if (strcmp(tmps, "password") == 0) - password = val; - else if (strcmp(tmps, "ca") == 0) - ca_file = val; - else if (strcmp(tmps, "caDir") == 0) - ca_dir = val; - else if (strcmp(tmps, "caStore") == 0) - ca_store = val; - else if (strcmp(tmps, "ciphers") == 0) - ciphers = val; - else if (strcmp(tmps, "ciphers1.3") == 0) - ciphers13 = val; - else if (strcmp(tmps, "minProto") == 0) - min_proto = val; - else if (strcmp(tmps, "maxProto") == 0) - max_proto = val; - else if (strcmp(tmps, "verifyPeer") == 0) - verifyPeer = val; - else { - set_errortext_with_val(1302, tmps); - return NULL; - } + *val = '\0'; + val++; + if (strlen(val) == 0) { + set_errortext_with_val(1302, tmps); + return NULL; + } + //printf("attr: %s=%s\n", tmps, val); + if (strcmp(tmps, "cert") == 0) + certFile = val; + else if (strcmp(tmps, "key") == 0) + keyFile = val; + else if (strcmp(tmps, "password") == 0) + password = val; + else if (strcmp(tmps, "ca") == 0) + ca_file = val; + else if (strcmp(tmps, "caDir") == 0) + ca_dir = val; + else if (strcmp(tmps, "caStore") == 0) + ca_store = val; + else if (strcmp(tmps, "ciphers") == 0) + ciphers = val; + else if (strcmp(tmps, "ciphers1.3") == 0) + ciphers13 = val; + else if (strcmp(tmps, "minProto") == 0) + min_proto = val; + else if (strcmp(tmps, "maxProto") == 0) + max_proto = val; + else if (strcmp(tmps, "verifyPeer") == 0) + verifyPeer = val; + else { + set_errortext_with_val(1302, tmps); + return NULL; + } } else { - set_errortext_with_val(1302, tmps); - return NULL; - } + set_errortext_with_val(1302, tmps); + return NULL; + } } else { - set_errortext(1302); - return NULL; - } + set_errortext(1302); + return NULL; + } } /* @@ -1742,13 +1742,13 @@ SSL_CTX * create_ssl_context(dptr attr, int n, int type ) { do { char *proto; if (count == 2) - proto = min_proto; + proto = min_proto; else - proto = max_proto; + proto = max_proto; if (proto != NULL) { // supported versions are SSL3_VERSION, TLS1_VERSION, TLS1_1_VERSION, - // TLS1_2_VERSION, TLS1_3_VERSION for TLS and DTLS1_VERSION, DTLS1_2_VERSION for DTLS. + // TLS1_2_VERSION, TLS1_3_VERSION for TLS and DTLS1_VERSION, DTLS1_2_VERSION for DTLS. #if !defined(MacOS) && (OPENSSL_VERSION_NUMBER < 0x10100000L) #define TLS1_VERSION 10 #define TLS1_1_VERSION 11 @@ -1759,77 +1759,77 @@ SSL_CTX * create_ssl_context(dptr attr, int n, int type ) { #define DTLS1_2_VERSION 22 #endif - int ver; + int ver; if (strcmp(proto, "TLS1.3") == 0) ver = TLS1_3_VERSION; - else if (strcmp(proto, "TLS1.2") == 0) - ver = TLS1_2_VERSION; - else if (strcmp(proto, "TLS1.1") == 0) - ver = TLS1_1_VERSION; - else if (strcmp(proto, "TLS1.0") == 0) - ver = TLS1_VERSION; - /* else if (strcmp(proto, "SSL3.0") == 0) - ver = SSL3_VERSION; */ - else if (strcmp(proto, "DTLS1.2") == 0) - ver = DTLS1_2_VERSION; - else if (strcmp(proto, "DTLS1.0") == 0) - ver = DTLS1_VERSION; + else if (strcmp(proto, "TLS1.2") == 0) + ver = TLS1_2_VERSION; + else if (strcmp(proto, "TLS1.1") == 0) + ver = TLS1_1_VERSION; + else if (strcmp(proto, "TLS1.0") == 0) + ver = TLS1_VERSION; + /* else if (strcmp(proto, "SSL3.0") == 0) + ver = SSL3_VERSION; */ + else if (strcmp(proto, "DTLS1.2") == 0) + ver = DTLS1_2_VERSION; + else if (strcmp(proto, "DTLS1.0") == 0) + ver = DTLS1_VERSION; else { - set_ssl_context_errortext(1308, proto); - SSL_CTX_free(ctx); - return NULL; - } - - /* - * Set min/max acceptable protocol - * OpenSSL 1.1 and after supports and easy way to set min/max - * but we have to "manully" do it for earlier versions - * Notice that only TLS protocols are considered, - * SSL protocls are already old and deprecated - */ - - if (count == 2) { + set_ssl_context_errortext(1308, proto); + SSL_CTX_free(ctx); + return NULL; + } + + /* + * Set min/max acceptable protocol + * OpenSSL 1.1 and after supports and easy way to set min/max + * but we have to "manully" do it for earlier versions + * Notice that only TLS protocols are considered, + * SSL protocls are already old and deprecated + */ + + if (count == 2) { #if !defined(MacOS) && (OPENSSL_VERSION_NUMBER < 0x10100000L) - switch (ver) { - case TLS1_2_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1 | SSL_OP_NO_TLSv1_1 | - SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; - case TLS1_1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1 | - SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; - case TLS1_VERSION: old_ssl_flags |= SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; - default: - set_ssl_context_errortext(1308, proto); - SSL_CTX_free(ctx); - return NULL; - } - SSL_CTX_set_options(ctx, old_ssl_flags); + switch (ver) { + case TLS1_2_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1 | SSL_OP_NO_TLSv1_1 | + SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; + case TLS1_1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1 | + SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; + case TLS1_VERSION: old_ssl_flags |= SSL_OP_NO_SSLv2 | SSL_OP_NO_SSLv3; break; + default: + set_ssl_context_errortext(1308, proto); + SSL_CTX_free(ctx); + return NULL; + } + SSL_CTX_set_options(ctx, old_ssl_flags); #else - if (SSL_CTX_set_min_proto_version(ctx, ver) != 1) { - set_ssl_context_errortext(1301, proto); - SSL_CTX_free(ctx); - return NULL; - } + if (SSL_CTX_set_min_proto_version(ctx, ver) != 1) { + set_ssl_context_errortext(1301, proto); + SSL_CTX_free(ctx); + return NULL; + } #endif - } - else { + } + else { #if !defined(MacOS) && (OPENSSL_VERSION_NUMBER < 0x10100000L) - switch (ver) { - case TLS1_2_VERSION: break; - case TLS1_1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1_2; break; - case TLS1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1_1 | SSL_OP_NO_TLSv1_2; break; - default: - set_ssl_context_errortext(1308, proto); - SSL_CTX_free(ctx); - return NULL; - } - SSL_CTX_set_options(ctx, old_ssl_flags); + switch (ver) { + case TLS1_2_VERSION: break; + case TLS1_1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1_2; break; + case TLS1_VERSION: old_ssl_flags |= SSL_OP_NO_TLSv1_1 | SSL_OP_NO_TLSv1_2; break; + default: + set_ssl_context_errortext(1308, proto); + SSL_CTX_free(ctx); + return NULL; + } + SSL_CTX_set_options(ctx, old_ssl_flags); #else - if (SSL_CTX_set_max_proto_version(ctx, ver) != 1) { - set_ssl_context_errortext(1301, proto); - SSL_CTX_free(ctx); - return NULL; - } + if (SSL_CTX_set_max_proto_version(ctx, ver) != 1) { + set_ssl_context_errortext(1301, proto); + SSL_CTX_free(ctx); + return NULL; + } #endif - } + } } } while (--count>0); @@ -1848,9 +1848,9 @@ SSL_CTX * create_ssl_context(dptr attr, int n, int type ) { } else { if (strcmp(verifyPeer, "yes") == 0) { if ((type == TLS_CLIENT) || (type == DTLS_CLIENT)) - SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL); + SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL); else - SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT, NULL); + SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT, NULL); } else if (strcmp(verifyPeer, "no") != 0) { set_errortext_with_val(1302, verifyPeer); SSL_CTX_free(ctx); @@ -1915,7 +1915,7 @@ SSL_CTX * create_ssl_context(dptr attr, int n, int type ) { return ctx; } -#endif /* LIBSSL */ +#endif /* LIBSSL */ #if !NT @@ -1945,7 +1945,7 @@ dptr result; String(rp->fields[6], pw->pw_shell); return result; } -#endif /* !NT */ +#endif /* !NT */ void catstrs(char **ptrs, dptr d) { @@ -1957,11 +1957,11 @@ void catstrs(char **ptrs, dptr d) nmem++; StrLoc(*d) = p = alcstr(NULL, nmem*9); - + for (i = 0; i < nmem; i++) { char *q = ptrs[i]; while ((*p = *q++)) - p++; + p++; *p++ = ','; } if (nmem > 0) @@ -1995,11 +1995,11 @@ dptr result; String(rp->fields[1], gr->gr_passwd); rp->fields[2].dword = D_Integer; IntVal(rp->fields[2]) = gr->gr_gid; - + catstrs(gr->gr_mem, &rp->fields[3]); return result; } -#endif /* !NT */ +#endif /* !NT */ dptr make_serv(s, result) struct servent *s; @@ -2056,7 +2056,7 @@ struct addrinfo *res0; String(rp->fields[0], res0->ai_canonname); else String(rp->fields[0], name); - + String(rp->fields[1], name); /* Retrieve each address and print out the hex bytes */ @@ -2064,7 +2064,7 @@ struct addrinfo *res0; for(res = res0; res != NULL ; res = res->ai_next) { len += res->ai_addrlen; } - + StrLoc(rp->fields[2]) = p = alcstr(NULL, len); for(res = res0; res != NULL ; res = res->ai_next) { @@ -2074,37 +2074,37 @@ struct addrinfo *res0; switch (res->ai_family) { case AF_INET: - a = ntohl(((struct sockaddr_in *) res->ai_addr)->sin_addr.s_addr); - sprintf(p, "%u.%u.%u.%u,", (a & 0xff000000) >> 24, - (a & 0xff0000) >> 16, (a & 0xff00)>>8, a & 0xff); + a = ntohl(((struct sockaddr_in *) res->ai_addr)->sin_addr.s_addr); + sprintf(p, "%u.%u.%u.%u,", (a & 0xff000000) >> 24, + (a & 0xff0000) >> 16, (a & 0xff00)>>8, a & 0xff); - while(*p) p++; + while(*p) p++; break; case AF_INET6: #if NT /* - * The buffer length is changed by each call to - * WSAAddresstoString, So we need to set it for each + * The buffer length is changed by each call to + * WSAAddresstoString, So we need to set it for each * iteration through the loop for safety - */ + */ ipbuflen = 46; if (WSAAddressToString(((LPSOCKADDR) res->ai_addr), - (DWORD) res->ai_addrlen, NULL, + (DWORD) res->ai_addrlen, NULL, ipstrbuf, (LPDWORD) &ipbuflen)!=0) - ipstrbuf[0]='\0'; + ipstrbuf[0]='\0'; #else - if (inet_ntop(AF_INET6, (void *) - &(((struct sockaddr_in6 *) res->ai_addr)->sin6_addr.s6_addr), - ipstrbuf, ipbuflen) == NULL) - ipstrbuf[0]='\0'; + if (inet_ntop(AF_INET6, (void *) + &(((struct sockaddr_in6 *) res->ai_addr)->sin6_addr.s6_addr), + ipstrbuf, ipbuflen) == NULL) + ipstrbuf[0]='\0'; #endif - sprintf(p, "%s,", ipstrbuf); + sprintf(p, "%s,", ipstrbuf); - while(*p) p++; + while(*p) p++; break; default: @@ -2113,7 +2113,7 @@ struct addrinfo *res0; } /* * Not Yet used! left here for possible expansions in the future. - * + * printf("\tSocket type: "); switch (res->ai_socktype) { case 0: @@ -2165,7 +2165,7 @@ struct addrinfo *res0; return result; } -#endif /* HAVE_GETADDRINFO */ +#endif /* HAVE_GETADDRINFO */ dptr make_host(hs, result) struct hostent *hs; @@ -2195,12 +2195,12 @@ struct hostent *hs; nmem++; StrLoc(rp->fields[2]) = p = alcstr(NULL, nmem*16); - + addr = (unsigned int *) hs->h_addr_list[0]; for (i = 0; i < nmem; i++) { int a = ntohl(*addr); sprintf(p, "%d.%d.%d.%d,", (a & 0xff000000) >> 24, - (a & 0xff0000) >> 16, (a & 0xff00)>>8, a & 0xff); + (a & 0xff0000) >> 16, (a & 0xff00)>>8, a & 0xff); while(*p) p++; addr++; } @@ -2233,12 +2233,12 @@ dptr calliconproc(struct descrip p, dptr args, int nargs) return &rv; return NULL; /* failure */ } -#else /* COMPILER */ +#else /* COMPILER */ /* No provision for resumption */ #ifndef Concurrent word *callproc, callproc_ibuf[100]; -#endif /* Concurrent */ +#endif /* Concurrent */ dptr calliconproc(struct descrip proc, dptr args, int nargs) { int i, off, retval; @@ -2252,9 +2252,9 @@ dptr calliconproc(struct descrip proc, dptr args, int nargs) #ifdef HP bcopy(&ipc, &saved_ipc, sizeof(ipc)); -#else /* HP */ +#else /* HP */ saved_ipc = ipc; -#endif /* HP */ +#endif /* HP */ wp.opnd = callproc = callproc_ibuf; ipad(wp); *wp.op++ = Op_Mark; *wp.opnd++ = (2 + nargs+1)*2 * WordSize; @@ -2280,11 +2280,11 @@ dptr calliconproc(struct descrip proc, dptr args, int nargs) sp += (nargs+1)*2; ipc.op = (int *)callproc; -#ifdef TSTATARG +#ifdef TSTATARG retval = interp(0, NULL, CURTSTATARG); -#else /* TSTATARG */ +#else /* TSTATARG */ retval = interp(0, NULL); -#endif /* TSTATARG */ +#endif /* TSTATARG */ /* need to double-check all return codes from interp() */ if ((retval != A_Resume) && (retval != A_Trapfail)) ret = (dptr)(sp-1); @@ -2298,7 +2298,7 @@ dptr calliconproc(struct descrip proc, dptr args, int nargs) return ret; } -#endif /* !COMPILER */ +#endif /* !COMPILER */ /* * Signals and trapping @@ -2314,7 +2314,7 @@ void init_sighandlers() for(i = 0; i < 41; i++) handlers[i] = nulldesc; } -#else /* MultiProgram */ +#else /* MultiProgram */ void init_sighandlers(pstate) struct progstate *pstate; @@ -2323,7 +2323,7 @@ struct progstate *pstate; for(i = 0; i < 41; i++) pstate->Handlers[i] = nulldesc; } -#endif /* MultiProgram */ +#endif /* MultiProgram */ struct descrip register_sig(sig, handler) int sig; @@ -2333,7 +2333,7 @@ struct descrip handler; #ifdef MultiProgram curpstate->signal = 0; -#endif /* MultiProgram */ +#endif /* MultiProgram */ MUTEX_LOCKID(MTX_HANDLERS); old = handlers[sig]; handlers[sig] = handler; @@ -2349,7 +2349,7 @@ int sig; proc = handlers[sig]; #ifdef MultiProgram curpstate->signal = 0; -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * proc is NULL if there is no signal handler for current signal. @@ -2359,27 +2359,27 @@ int sig; if (is:null(proc)) { #ifdef MultiProgram if ((!is:null(curpstate->eventmask)) && - Testb((word)ToAscii(E_Signal), curpstate->eventmask)) { - /* if we are in the TP and it has no signal handling - * report the signal back to its parent - */ - curpstate->signal = sig; - return; - } + Testb((word)ToAscii(E_Signal), curpstate->eventmask)) { + /* if we are in the TP and it has no signal handling + * report the signal back to its parent + */ + curpstate->signal = sig; + return; + } else { - /* - * Child has no handler and parent does not want to deal with it. - * Execute the default behavior for this signal. - */ - signal(sig, SIG_DFL); - raise(sig); - return; - } + /* + * Child has no handler and parent does not want to deal with it. + * Execute the default behavior for this signal. + */ + signal(sig, SIG_DFL); + raise(sig); + return; + } #else signal(sig, SIG_DFL); raise(sig); return; -#endif /* MultiProgram */ +#endif /* MultiProgram */ } #if COMPILER @@ -2395,8 +2395,8 @@ int sig; (void) calliconproc(proc, &val, 1); } -#endif /* COMPILER */ - +#endif /* COMPILER */ + /* Restore signal just in case (for non-BSD systems) */ signal(sig, signal_dispatcher); } @@ -2423,22 +2423,22 @@ dptr u_read(dptr f, int n, int fstatus, dptr d) StrLen(*d) = 0; if (fstatus & Fs_Socket) { #if HAVE_LIBSSL - if (fstatus & Fs_Encrypt) { - tally = SSL_read(BlkD(*f,File)->fd.ssl, StrLoc(*d), n); - if (tally <= 0) - set_ssl_connection_errortext(BlkD(*f,File)->fd.ssl, tally); - } - else -#endif /* LIBSSL */ - tally = recv(fd, StrLoc(*d), n, 0); + if (fstatus & Fs_Encrypt) { + tally = SSL_read(BlkD(*f,File)->fd.ssl, StrLoc(*d), n); + if (tally <= 0) + set_ssl_connection_errortext(BlkD(*f,File)->fd.ssl, tally); + } + else +#endif /* LIBSSL */ + tally = recv(fd, StrLoc(*d), n, 0); } else - tally = read(fd, StrLoc(*d), n); + tally = read(fd, StrLoc(*d), n); if (tally <= 0) { - strtotal += n; - strfree = StrLoc(*d); - return 0; + strtotal += n; + strfree = StrLoc(*d); + return 0; } StrLen(*d) = tally; /* @@ -2455,97 +2455,97 @@ dptr u_read(dptr f, int n, int fstatus, dptr d) StrLoc(*d) = strfree; StrLen(*d) = 0; for(;;) { - int srv, kk=0; - fd_set readset; - struct timeval tv; - FD_ZERO(&readset); - FD_SET(fd, &readset); - tv.tv_sec = tv.tv_usec = 0; - if ((srv = select(fd+1, &readset, NULL, NULL, &tv)) == 0) { - /* Nothing more is available */ - break; - } - else if (srv == -1) { - set_syserrortext(errno); - return 0; - } - - /* Something is available: allocate another chunk */ - if (i == 0) - StrLoc(*d) = alcstr(NULL, bufsize); - else - /* Extend the string */ - (void) alcstr(NULL, bufsize); + int srv, kk=0; + fd_set readset; + struct timeval tv; + FD_ZERO(&readset); + FD_SET(fd, &readset); + tv.tv_sec = tv.tv_usec = 0; + if ((srv = select(fd+1, &readset, NULL, NULL, &tv)) == 0) { + /* Nothing more is available */ + break; + } + else if (srv == -1) { + set_syserrortext(errno); + return 0; + } + + /* Something is available: allocate another chunk */ + if (i == 0) + StrLoc(*d) = alcstr(NULL, bufsize); + else + /* Extend the string */ + (void) alcstr(NULL, bufsize); tryagain: - if (fstatus & Fs_Socket) { + if (fstatus & Fs_Socket) { #if HAVE_LIBSSL - if (fstatus & Fs_Encrypt) { - tally = SSL_read(BlkD(*f,File)->fd.ssl, StrLoc(*d) + i*bufsize, bufsize); - if (tally <= 0) { - set_ssl_connection_errortext(BlkD(*f,File)->fd.ssl, tally); - strtotal += bufsize; - strfree = StrLoc(*d); - return 0; + if (fstatus & Fs_Encrypt) { + tally = SSL_read(BlkD(*f,File)->fd.ssl, StrLoc(*d) + i*bufsize, bufsize); + if (tally <= 0) { + set_ssl_connection_errortext(BlkD(*f,File)->fd.ssl, tally); + strtotal += bufsize; + strfree = StrLoc(*d); + return 0; } - } - else { -#endif /* LIBSSL */ - tally = recv(fd, StrLoc(*d) + i*bufsize, bufsize, 0); - - if (tally < 0) { - /* - * Error on recv(). Some kinds of errors might be recoverable. - */ - kk++; + } + else { +#endif /* LIBSSL */ + tally = recv(fd, StrLoc(*d) + i*bufsize, bufsize, 0); + + if (tally < 0) { + /* + * Error on recv(). Some kinds of errors might be recoverable. + */ + kk++; #if NT - errno = WSAGetLastError(); -#endif /* NT */ - switch (errno) { + errno = WSAGetLastError(); +#endif /* NT */ + switch (errno) { #if NT - case WSAEINTR: case WSAEINPROGRESS: -#else /* NT */ - case EINTR: case EINPROGRESS: -#endif /* NT */ - if (kk < 5) goto tryagain; - break; - default: - strtotal += bufsize; - strfree = StrLoc(*d); - set_errortext(214); - return 0; - } - } /* tally < 0 */ - if ((i == 0) && (tally == 0)) { - strtotal += bufsize; - strfree = StrLoc(*d); - return 0; - } + case WSAEINTR: case WSAEINPROGRESS: +#else /* NT */ + case EINTR: case EINPROGRESS: +#endif /* NT */ + if (kk < 5) goto tryagain; + break; + default: + strtotal += bufsize; + strfree = StrLoc(*d); + set_errortext(214); + return 0; + } + } /* tally < 0 */ + if ((i == 0) && (tally == 0)) { + strtotal += bufsize; + strfree = StrLoc(*d); + return 0; + } #if HAVE_LIBSSL - } -#endif /* LIBSSL */ - } - else { // not a socket, use read() - tally = read(fd, StrLoc(*d) + i*bufsize, bufsize); + } +#endif /* LIBSSL */ + } + else { // not a socket, use read() + tally = read(fd, StrLoc(*d) + i*bufsize, bufsize); if ((i == 0) && (tally <= 0)) { - strtotal += bufsize; - strfree = StrLoc(*d); - return 0; - } - } - - total += tally; - StrLen(*d) = total; - if (tally < bufsize) { - /* We're done; return unused storage */ - nbytes = DiffPtrs(StrLoc(*d) + total, strfree); - EVStrAlc(nbytes); - strtotal += nbytes; - strfree = StrLoc(*d) + total; - break; - } - i++; + strtotal += bufsize; + strfree = StrLoc(*d); + return 0; + } + } + + total += tally; + StrLen(*d) = total; + if (tally < bufsize) { + /* We're done; return unused storage */ + nbytes = DiffPtrs(StrLoc(*d) + total, strfree); + EVStrAlc(nbytes); + strtotal += nbytes; + strfree = StrLoc(*d) + total; + break; + } + i++; } } return d; @@ -2608,36 +2608,36 @@ struct b_list *findactivewindow(struct b_list *lws) */ for ( ; BlkType(ep) == T_Lelem; ep = Blk(ep,Lelem)->listnext) { for (i = 0; i < Blk(ep,Lelem)->nused; i++) { - union block *bp; + union block *bp; wbp w; wsp ws; - int status; - j = ep->Lelem.first + i; - if (j >= ep->Lelem.nslots) - j -= ep->Lelem.nslots; - + int status; + j = ep->Lelem.first + i; + if (j >= ep->Lelem.nslots) + j -= ep->Lelem.nslots; + if (!(is:file(ep->Lelem.lslots[j]) && - (status = BlkD(ep->Lelem.lslots[j],File)->status) && - (status & Fs_Window))) + (status = BlkD(ep->Lelem.lslots[j],File)->status) && + (status & Fs_Window))) syserr("internal error calling findactivewindow()"); if (!(status & Fs_Read)) { /* a closed window was found on the list, ignore it */ - continue; - } - bp = BlkLoc(ep->Lelem.lslots[j]); - w = Blk(bp,File)->fd.wb; - ws = w->window; - if (BlkD(ws->listp,List)->size > 0) { - if (is:null(d)) { - BlkLoc(d) = (union block *)alclist(0, MinListSlots); - d.dword = D_List; - } - c_put(&d, &(Blk(ep,Lelem)->lslots[j])); - } - } + continue; + } + bp = BlkLoc(ep->Lelem.lslots[j]); + w = Blk(bp,File)->fd.wb; + ws = w->window; + if (BlkD(ws->listp,List)->size > 0) { + if (is:null(d)) { + BlkLoc(d) = (union block *)alclist(0, MinListSlots); + d.dword = D_List; + } + c_put(&d, &(Blk(ep,Lelem)->lslots[j])); + } + } } if (is:null(d)) return NULL; return BlkD(d, List); -} -#endif /* Graphics */ -#endif /* PosixFns */ +} +#endif /* Graphics */ +#endif /* PosixFns */ diff --git a/src/runtime/rstruct.r b/src/runtime/rstruct.r index 23fe47de1..e858c9bce 100644 --- a/src/runtime/rstruct.r +++ b/src/runtime/rstruct.r @@ -16,7 +16,7 @@ void addmem(struct b_set *ps,struct b_selem *pe,union block **pl) pe->clink = *pl; *pl = (union block *) pe; } - + /* * cpslots(dp1, slotptr, i, j) - copy elements of sublist dp1[i:j] * into an array of descriptors. @@ -44,10 +44,10 @@ void cpslots(dptr dp1, dptr slotptr, word i, word j) * Locate the block containing element i in the source list. */ if (size > 0) { - while (i > bp1->nused) { - i -= bp1->nused; - bp1 = (struct b_lelem *) bp1->listnext; - } + while (i > bp1->nused) { + i -= bp1->nused; + bp1 = (struct b_lelem *) bp1->listnext; + } } /* @@ -56,13 +56,13 @@ void cpslots(dptr dp1, dptr slotptr, word i, word j) * block have been copied. */ while (size > 0) { - j = bp1->first + i - 1; - if (j >= bp1->nslots) - j -= bp1->nslots; - *slotptr++ = bp1->lslots[j]; - if (++i > bp1->nused) { - i = 1; - bp1 = (struct b_lelem *) bp1->listnext; + j = bp1->first + i - 1; + if (j >= bp1->nslots) + j -= bp1->nslots; + *slotptr++ = bp1->lslots[j]; + if (++i > bp1->nused) { + i = 1; + bp1 = (struct b_lelem *) bp1->listnext; } size--; } @@ -111,10 +111,10 @@ void cpslots(dptr dp1, dptr slotptr, word i, word j) struct b_real *xp; xp = alcreal((double)ap->a[i++]); slotptr[k].vword.bptr = (union block *) xp; - } -#endif /* DescriptorDouble */ - slotptr[k].dword = D_Real; - } + } +#endif /* DescriptorDouble */ + slotptr[k].dword = D_Real; + } } /* if (ndims==1) */ else { // TODO: multi-dimensional @@ -123,7 +123,7 @@ void cpslots(dptr dp1, dptr slotptr, word i, word j) break; } /* Realrray */ -#endif /* Arrays */ +#endif /* Arrays */ default: syserr("impossible cpslots\n"); @@ -163,11 +163,11 @@ int f(dptr dp1, dptr dp2, word i, word j) #ifdef MultiProgram cplist_macro(cplist_0, 0) cplist_macro(cplist_1, E_Lcreate) -#else /* MultiProgram */ +#else /* MultiProgram */ cplist_macro(cplist, 0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - #begdef cpset_macro(f, e) /* * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries. @@ -183,9 +183,9 @@ int f(dptr dp1, dptr dp2, word n) #ifdef MultiProgram cpset_macro(cpset_0, 0) cpset_macro(cpset_1, E_Screate) -#else /* MultiProgram */ +#else /* MultiProgram */ cpset_macro(cpset, 0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cptable_macro(f, e) int f(dptr dp1, dptr dp2, word n) @@ -200,9 +200,9 @@ int f(dptr dp1, dptr dp2, word n) #ifdef MultiProgram cptable_macro(cptable_0, 0) cptable_macro(cptable_1, E_Tcreate) -#else /* MultiProgram */ +#else /* MultiProgram */ cptable_macro(cptable, 0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ int cphash(dp1, dp2, n, tcode) dptr dp1, dp2; @@ -227,36 +227,36 @@ int tcode; * Copy the header and slot blocks. */ src = BlkLoc(*dp1); - dst->Set.size = src->Set.size; /* actual set size */ - dst->Set.mask = src->Set.mask; /* hash mask */ + dst->Set.size = src->Set.size; /* actual set size */ + dst->Set.mask = src->Set.mask; /* hash mask */ for (i = 0; i < HSegs && src->Set.hdir[i] != NULL; i++) memcpy((char *)dst->Set.hdir[i], (char *)src->Set.hdir[i], src->Set.hdir[i]->blksize); /* * Work down the chain of element blocks in each bucket - * and create identical chains in new set. + * and create identical chains in new set. */ for (i = 0; i < HSegs && (seg = BlkPH(dst,Set,hdir)[i]) != NULL; i++) for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--) { - prev = NULL; + prev = NULL; for (ep = (struct b_selem *)seg->hslots[slotnum]; - ep != NULL && BlkType(ep) != T_Table; - ep = (struct b_selem *)ep->clink) { - if (tcode == T_Set) { + ep != NULL && BlkType(ep) != T_Table; + ep = (struct b_selem *)ep->clink) { + if (tcode == T_Set) { Protect(se = alcselem(&ep->setmem, ep->hashnum),return RunError); se->clink = ep->clink; - } - else { - Protect(se = (struct b_selem *)alctelem(), return RunError); - *(struct b_telem *)se = *(struct b_telem *)ep; /* copy table entry */ - if (BlkType(se->clink) == T_Table) - se->clink = dst; - } - if (prev == NULL) - seg->hslots[slotnum] = (union block *)se; - else - prev->clink = (union block *)se; - prev = se; + } + else { + Protect(se = (struct b_selem *)alctelem(), return RunError); + *(struct b_telem *)se = *(struct b_telem *)ep; /* copy table entry */ + if (BlkType(se->clink) == T_Table) + se->clink = dst; + } + if (prev == NULL) + seg->hslots[slotnum] = (union block *)se; + else + prev->clink = (union block *)se; + prev = se; } } dp2->dword = tcode | D_Typecode | F_Ptr; @@ -265,7 +265,7 @@ int tcode; hshrink(dst); return Succeeded; } - + /* * hmake - make a hash structure (Set or Table) with a given number of slots. * If *nslots* is zero, a value appropriate for *nelem* elements is chosen. @@ -283,12 +283,12 @@ word nslots, nelem; nslots = (nelem + MaxHLoad - 1) / MaxHLoad; for (seg = t = 0; seg < (HSegs - 1) && (t += segsize[seg]) < nslots; seg++) ; - nslots = ((word)HSlots) << seg; /* ensure legal power of 2 */ + nslots = ((word)HSlots) << seg; /* ensure legal power of 2 */ if (tcode == T_Table) { blksize = sizeof(struct b_table); elemsize = sizeof(struct b_telem); } - else { /* T_Set */ + else { /* T_Set */ blksize = sizeof(struct b_set); elemsize = sizeof(struct b_selem); } @@ -303,19 +303,19 @@ word nslots, nelem; Blk(blk,Table)->hdir[seg] = segp; else Blk(blk,Set)->hdir[seg] = segp; -#else /* DebugHeap */ +#else /* DebugHeap */ blk->Set.hdir[seg] = segp; -#endif /* DebugHeap */ +#endif /* DebugHeap */ if (tcode == T_Table) { - int j; - for (j = 0; j < segsize[seg]; j++) - segp->hslots[j] = blk; + int j; + for (j = 0; j < segsize[seg]; j++) + segp->hslots[j] = blk; } } blk->Set.mask = nslots - 1; return blk; } - + /* * hchain - return a pointer to the word that points to the head of the * hash chain for hash number hn in hashed structure s. @@ -459,7 +459,7 @@ register uword hn; segslot = hn & (segsize[segnum] - 1); return &ps->hdir[segnum]->hslots[segslot]; } - + /* * hgfirst - initialize for generating set or table, and return first element. */ @@ -470,7 +470,7 @@ struct hgstate *s; { int i; - s->segnum = 0; /* set initial state */ + s->segnum = 0; /* set initial state */ s->slotnum = -1; s->tmask = BlkPH(bp,Table,mask); for (i = 0; i < HSegs; i++) @@ -486,7 +486,7 @@ struct hgstate *s; * the time of the split and checking past history when starting to process * a new chain. * - * Elements inserted or deleted between calls may or may not be generated. + * Elements inserted or deleted between calls may or may not be generated. * * We assume that no structure *shrinks* after its initial creation; they * can only *grow*. @@ -508,21 +508,21 @@ union block *ep; * by doing nothing now. */ if (BlkPH(bp,Table,mask) != s->tmask && - (BlkPE(ep,Selem,clink) == NULL || - BlkType(BlkPE(ep,Telem,clink)) == T_Table || - BlkPE(BlkPE(ep,Telem,clink),Telem,hashnum) != BlkPE(ep,Telem,hashnum))){ + (BlkPE(ep,Selem,clink) == NULL || + BlkType(BlkPE(ep,Telem,clink)) == T_Table || + BlkPE(BlkPE(ep,Telem,clink),Telem,hashnum) != BlkPE(ep,Telem,hashnum))){ /* * Yes, they did split. Make a note of the current state. */ hn = BlkPE(ep,Telem,hashnum); for (i = 1; i < HSegs; i++) if ((((word)HSlots) << (i - 1)) > s->tmask) { - /* - * For the newly created segments only, save the mask and - * hash number being processed at time of creation. - */ - s->sgmask[i] = s->tmask; - s->sghash[i] = hn; + /* + * For the newly created segments only, save the mask and + * hash number being processed at time of creation. + */ + s->sgmask[i] = s->tmask; + s->sghash[i] = hn; } s->tmask = BlkPH(bp,Table,mask); /* @@ -533,7 +533,7 @@ union block *ep; */ ep = BlkPH(bp,Table,hdir)[s->segnum]->hslots[s->slotnum]; while (ep != NULL && BlkType(ep) != T_Table && - BlkPE(ep,Telem,hashnum) <= hn) + BlkPE(ep,Telem,hashnum) <= hn) ep = BlkPE(ep,Telem,clink); } @@ -543,8 +543,8 @@ union block *ep; * that have identical hash numbers. Find the next element in * the current hash chain. */ - if (ep != NULL && BlkType(ep) != T_Table) /* NULL on very first call */ - ep = BlkPE(ep,Telem,clink); /* next element in chain, if any */ + if (ep != NULL && BlkType(ep) != T_Table) /* NULL on very first call */ + ep = BlkPE(ep,Telem,clink); /* next element in chain, if any */ } /* @@ -556,10 +556,10 @@ union block *ep; */ s->slotnum++; if (s->slotnum >= segsize[s->segnum]) { - s->slotnum = 0; /* need to move to next segment */ - s->segnum++; - if (s->segnum >= HSegs || BlkPH(bp,Table,hdir)[s->segnum] == NULL) - return 0; /* return NULL at end of set/table */ + s->slotnum = 0; /* need to move to next segment */ + s->segnum++; + if (s->segnum >= HSegs || BlkPH(bp,Table,hdir)[s->segnum] == NULL) + return 0; /* return NULL at end of set/table */ } ep = BlkPH(bp,Table,hdir)[s->segnum]->hslots[s->slotnum]; /* @@ -569,15 +569,15 @@ union block *ep; */ for (i = s->segnum; (m = s->sgmask[i]) != 0; i--) { d = (word)(m & s->slotnum) - (word)(m & s->sghash[i]); - if (d < 0) /* if all elements processed earlier */ - ep = NULL; /* skip this slot */ + if (d < 0) /* if all elements processed earlier */ + ep = NULL; /* skip this slot */ else if (d == 0) { /* * This chain was split from its parent while the parent was * being processed. Skip past elements already processed. */ while (ep != NULL && BlkType(ep) != T_Table && - BlkPE(ep,Telem,hashnum) <= s->sghash[i]) + BlkPE(ep,Telem,hashnum) <= s->sghash[i]) ep = BlkPE(ep,Telem,clink); } } @@ -589,7 +589,7 @@ union block *ep; if (ep && BlkType(ep) == T_Table) ep = NULL; return ep; } - + /* * hgrow - split a hashed structure (doubling the buckets) for faster access. */ @@ -610,7 +610,7 @@ union block *bp; heaperr("invalid title not set/table", (union block *)ps, T_Set); #endif if (ps->hdir[HSegs-1] != NULL) - return; /* can't split further */ + return; /* can't split further */ newslots = ps->mask + 1; EVVal((word)newslots, E_HashSlots); @@ -623,22 +623,22 @@ union block *bp; curslot = newseg->hslots; for (segnum = 0; (seg = ps->hdir[segnum]) != NULL; segnum++) for (slotnum = 0; slotnum < segsize[segnum]; slotnum++) { - tp0 = &seg->hslots[slotnum]; /* ptr to tail of old slot */ - tp1 = curslot++; /* ptr to tail of new slot */ + tp0 = &seg->hslots[slotnum]; /* ptr to tail of old slot */ + tp1 = curslot++; /* ptr to tail of new slot */ for (ep = *tp0; - ep != NULL && BlkType(ep) != T_Table; - ep = BlkPE(ep,Telem,clink)) { + ep != NULL && BlkType(ep) != T_Table; + ep = BlkPE(ep,Telem,clink)) { if ((BlkPE(ep,Telem,hashnum) & newslots) == 0) { - *tp0 = ep; /* element does not move */ + *tp0 = ep; /* element does not move */ tp0 = &(ep->Selem.clink); } else { - *tp1 = ep; /* element moves to new slot */ + *tp1 = ep; /* element moves to new slot */ tp1 = &(ep->Selem.clink); } } - if ( BlkType(ps) == T_Table ) - *tp0 = *tp1 = (union block *) ps; + if ( BlkType(ps) == T_Table ) + *tp0 = *tp1 = (union block *) ps; else *tp0 = *tp1 = NULL; } @@ -649,9 +649,9 @@ union block *bp; vrfy_Live_Table((struct b_table *)ps); } #endif /* VerifyHeap */ - + } - + /* * hshrink - combine buckets in a set or table that is too sparse. * @@ -686,11 +686,11 @@ union block *bp; ps->hdir[topseg--] = NULL; for (curseg = 0; (seg = ps->hdir[curseg]) != NULL; curseg++) for (slotnum = 0; slotnum < segsize[curseg]; slotnum++) { - tp = &seg->hslots[slotnum]; /* tail pointer */ - ep0 = seg->hslots[slotnum]; /* lower slot entry pointer */ - ep1 = *uppslot++; /* upper slot entry pointer */ + tp = &seg->hslots[slotnum]; /* tail pointer */ + ep0 = seg->hslots[slotnum]; /* lower slot entry pointer */ + ep1 = *uppslot++; /* upper slot entry pointer */ while (ep0 != NULL && BlkType(ep0) != T_Table && - ep1 != NULL && BlkType(ep1) != T_Table) + ep1 != NULL && BlkType(ep1) != T_Table) if (Blk(ep0,Selem)->hashnum < Blk(ep1,Selem)->hashnum) { *tp = ep0; tp = &(ep0->Selem.clink); @@ -716,12 +716,12 @@ union block *bp; } #ifdef VerifyHeap if ( BlkType(bp) == T_Table ) { - vrfy_Live_Table(&bp->Table); + vrfy_Live_Table(&bp->Table); } #endif /* VerifyHeap */ } - + /* * memb - sets res flag to 1 if x is a member of a set or table, 0 if not. * Returns a pointer to the word which points to the element, or which @@ -750,13 +750,13 @@ union block **memb(union block *pb, dptr x, uword hn, int *res) while ((pe = (struct b_selem *)*lp) != NULL && BlkType(pe) != T_Table) { chainlen++; eh = pe->hashnum; - if (eh > hn) { /* too far - it isn't there */ - EVVal((word)chainlen, E_HashChain); + if (eh > hn) { /* too far - it isn't there */ + EVVal((word)chainlen, E_HashChain); return lp; - } + } else if ((eh == hn) && (equiv(&pe->setmem, x))) { *res = 1; - EVVal((word)chainlen, E_HashChain); + EVVal((word)chainlen, E_HashChain); return lp; } /* @@ -786,7 +786,7 @@ union block **memb(union block *pb, dptr x, uword hn, int *res) #ifndef MultiProgram int longest_dr = 0; struct b_proc_list **dr_arrays; -#endif /* MultiProgram */ +#endif /* MultiProgram */ #if COMPILER static word mdw_dynrec_start = 0; @@ -815,7 +815,7 @@ dynrec_recname_create(name, flds, nflds) printf("dynrec_name_create: name exceeds max.\n"); return NULL; } - + Protect(rslt = alcstr(NULL, 256), return NULL); for (p=rslt,i=0; iProc.lnames[i]) && (strncmp(fld, StrLoc(desc->Proc.lnames[i]), len) == 0)) { break; - } + } } if (i >= desc->Proc.nfields) i = -1; @@ -959,14 +959,14 @@ struct b_proc *dynrecord(dptr s, dptr fields, int n) dr_arrays = realloc(dr_arrays, n * sizeof (struct b_proc *)); if (dr_arrays == NULL){ RESUME_THREADS(); - return NULL; - } + return NULL; + } while(longest_dr0) for(bpelem = dr_arrays[n-1]; bpelem; bpelem = bpelem->next, ct++) { @@ -999,12 +999,12 @@ struct b_proc *dynrecord(dptr s, dptr fields, int n) for(i=0;irecname)[i]=StrLoc(*s)[i]; StrLoc(bp->recname)[StrLen(*s)] = '\0'; for(i=0;ilnames[i]) = StrLen(fields[i]); - StrLoc(bp->lnames[i]) = malloc(StrLen(fields[i])+1); - if (StrLoc(bp->lnames[i]) == NULL) return NULL; - strncpy(StrLoc(bp->lnames[i]), StrLoc(fields[i]), StrLen(fields[i])); - StrLoc(bp->lnames[i])[StrLen(fields[i])] = '\0'; - } + StrLen(bp->lnames[i]) = StrLen(fields[i]); + StrLoc(bp->lnames[i]) = malloc(StrLen(fields[i])+1); + if (StrLoc(bp->lnames[i]) == NULL) return NULL; + strncpy(StrLoc(bp->lnames[i]), StrLoc(fields[i]), StrLen(fields[i])); + StrLoc(bp->lnames[i])[StrLen(fields[i])] = '\0'; + } bpelem = malloc(sizeof (struct b_proc_list)); if (bpelem == NULL) return NULL; bpelem->this = bp; @@ -1048,7 +1048,7 @@ int invaluemask(struct progstate *p, int evcode, struct descrip *val) return Succeeded; } } -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * Insert an array of alternating keys and values into a table. @@ -1069,34 +1069,34 @@ int cinserttable(union block **pbp, int n, dptr x) /* get this now because can't tend pd */ Protect(te = alctelem(), return -1); - pd = memb(*pbp, x+argc, hn, &res); /* search table for key */ + pd = memb(*pbp, x+argc, hn, &res); /* search table for key */ if (res == 0) { - /* - * The element is not in the table - insert it. - */ - Blk(*pbp, Table)->size++; - te->clink = *pd; - *pd = (union block *)te; - te->hashnum = hn; - te->tref = x[argc]; - if (argc+1 < n) - te->tval = x[argc+1]; - else - te->tval = nulldesc; - if (TooCrowded(*pbp)) - hgrow(*pbp); - } + /* + * The element is not in the table - insert it. + */ + Blk(*pbp, Table)->size++; + te->clink = *pd; + *pd = (union block *)te; + te->hashnum = hn; + te->tref = x[argc]; + if (argc+1 < n) + te->tval = x[argc+1]; + else + te->tval = nulldesc; + if (TooCrowded(*pbp)) + hgrow(*pbp); + } else { - /* - * We found an existing entry; just change its value. - */ - deallocate((union block *)te); - te = (struct b_telem *) *pd; - if (argc+1 < n) - te->tval = x[argc+1]; - else - te->tval = nulldesc; - } + /* + * We found an existing entry; just change its value. + */ + deallocate((union block *)te); + te = (struct b_telem *) *pd; + if (argc+1 < n) + te->tval = x[argc+1]; + else + te->tval = nulldesc; + } EVValD(&s, E_Tinsert); EVValD(x+argc, E_Tsub); } @@ -1104,7 +1104,7 @@ int cinserttable(union block **pbp, int n, dptr x) } -/* +/* * Make simple Icon lists (all elements the same type) from C arrays. * Intended primarily to be called from loaded C code. If you are * considering using this, you may also want to consider using @@ -1132,7 +1132,7 @@ union block * mkIlist(int x[], int n) bp = (struct b_lelem *)hp->listhead; /* List has only one list-element block: */ hp->listhead = hp->listtail = (union block *) bp; - + /* Set slot i to a descriptor for the integer x[i] */ for (i = 0; i < size; i++) { bp->lslots[i].dword = D_Integer; @@ -1149,7 +1149,7 @@ union block * mkIlist(int x[], int n) * an Icon list made from "x". */ union block * mkRlist(double x[], int n) -{ +{ tended struct b_list *hp; tended struct b_lelem *bp; register word i, size; @@ -1168,13 +1168,13 @@ union block * mkRlist(double x[], int n) for (i = 0; i < size; i++) { #ifdef DescriptorDouble bp->lslots[i].vword.realval = x[i]; -#else /* DescriptorDouble */ +#else /* DescriptorDouble */ { register struct b_real *rblk; /* does not need to be tended */ Protect(rblk = alcreal(x[i]), ReturnErrNum(307,NULL)); bp->lslots[i].vword.bptr = (union block *)rblk; } -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ bp->lslots[i].dword = D_Real; } @@ -1233,10 +1233,10 @@ double *getRArrDataPtr( struct b_list * L) int arraytolist(struct descrip *arr) { - int ndims, lsize, i; + int ndims, lsize, i; register struct b_lelem *lelemp; tended struct b_list *lparr; - + if (is:list(*arr)) { lparr = (struct b_list *) BlkD(*arr, List); if (lparr->listtail!=NULL) return Succeeded; @@ -1247,148 +1247,148 @@ int arraytolist(struct descrip *arr) if (BlkType(lparr->listhead) == T_Realarray) { struct b_realarray *ap = (struct b_realarray *) lparr->listhead; - + ndims = (ap->dims ? - ((ap->dims->Intarray.blksize - sizeof(struct b_intarray) + - sizeof(word)) / sizeof(word)) - : 1); + ((ap->dims->Intarray.blksize - sizeof(struct b_intarray) + + sizeof(word)) / sizeof(word)) + : 1); lsize = (ndims>1 ? ap->dims->Intarray.a[0] : - (ap->blksize - sizeof(struct b_realarray) + sizeof(double)) / - sizeof(double)); + (ap->blksize - sizeof(struct b_realarray) + sizeof(double)) / + sizeof(double)); - Protect(lelemp = alclstb(lsize, (word)0, (word)0) , return RunError ); + Protect(lelemp = alclstb(lsize, (word)0, (word)0) , return RunError ); lelemp->listprev = lelemp->listnext = (union block *) lparr; lparr->listhead = lparr->listtail = (union block *)lelemp; - + if (ndims==1) { - for (i=0; ilslots[i].vword.realval = (double)ap->a[i]; -#else /* DescriptorDouble */ - { - struct b_real *xp; - xp = alcreal((double)ap->a[i]); - lelemp->lslots[i].vword.bptr = (union block *) xp; - } -#endif /* DescriptorDouble */ - lelemp->lslots[i].dword = D_Real; - lelemp->nused++; - } + lelemp->lslots[i].vword.realval = (double)ap->a[i]; +#else /* DescriptorDouble */ + { + struct b_real *xp; + xp = alcreal((double)ap->a[i]); + lelemp->lslots[i].vword.bptr = (union block *) xp; + } +#endif /* DescriptorDouble */ + lelemp->lslots[i].dword = D_Real; + lelemp->nused++; + } } /* if (ndims==1) */ else if (ndims==2) { - struct b_realarray *ap2; - int n=ap->dims->Intarray.a[1]; - int base=0, j; + struct b_realarray *ap2; + int n=ap->dims->Intarray.a[1]; + int base=0, j; - for (i=0; idims=NULL; - for(j=0; ja[j]=ap->a[base++]; + ap2->dims=NULL; + for(j=0; ja[j]=ap->a[base++]; - lelemp->lslots[i].vword.bptr = (union block *) ap2; - lelemp->lslots[i].dword = D_Realarray; - lelemp->nused++; - } + lelemp->lslots[i].vword.bptr = (union block *) ap2; + lelemp->lslots[i].dword = D_Realarray; + lelemp->nused++; + } - } /* (ndims==2) */ + } /* (ndims==2) */ else { /* (ndims > 2) */ - struct b_realarray *ap2; - int n=ap->dims->Intarray.a[1]; - int base=0, j; - - for(i=2; idims->Intarray.a[i]; - - for (i=0; idims = (union block *)dims; - for(j=1; ja[j-1]=ap->dims->Intarray.a[j]; /* to the new array */ - - for(j=0; ja[j]=ap->a[base++]; - - lelemp->lslots[i].vword.bptr = (union block *) ap2; - lelemp->lslots[i].dword = D_Realarray; - lelemp->nused++; - } - - } /* (ndims>2) */ - + struct b_realarray *ap2; + int n=ap->dims->Intarray.a[1]; + int base=0, j; + + for(i=2; idims->Intarray.a[i]; + + for (i=0; idims = (union block *)dims; + for(j=1; ja[j-1]=ap->dims->Intarray.a[j]; /* to the new array */ + + for(j=0; ja[j]=ap->a[base++]; + + lelemp->lslots[i].vword.bptr = (union block *) ap2; + lelemp->lslots[i].dword = D_Realarray; + lelemp->nused++; + } + + } /* (ndims>2) */ + } /* Realrray */ else if (BlkType(lparr->listhead)==T_Intarray) { struct b_intarray *ap = (struct b_intarray *) lparr->listhead; - + ndims = (ap->dims? ((ap->dims->Intarray.blksize - sizeof(struct b_intarray) +sizeof(word)) / sizeof(word)) : 1); - + lsize = (ndims>1? ap->dims->Intarray.a[0]: (ap->blksize - sizeof(struct b_intarray) + sizeof(word))/sizeof(word)); - Protect(lelemp = alclstb(lsize, (word)0, (word)0) , return RunError ); + Protect(lelemp = alclstb(lsize, (word)0, (word)0) , return RunError ); lelemp->listprev = lelemp->listnext = (union block *) lparr; lparr->listhead = lparr->listtail = (union block *)lelemp; - + if (ndims==1){ - for (i=0; ia[i],&(lelemp->lslots[i])); - lelemp->nused++; - } + for (i=0; ia[i],&(lelemp->lslots[i])); + lelemp->nused++; + } } /* if (ndims==1) */ else if (ndims==2){ - struct b_intarray *ap2; - int n=ap->dims->Intarray.a[1]; - int base=0, j; + struct b_intarray *ap2; + int n=ap->dims->Intarray.a[1]; + int base=0, j; - for (i=0; idims=NULL; - for(j=0; ja[j]=ap->a[base++]; + ap2->dims=NULL; + for(j=0; ja[j]=ap->a[base++]; - lelemp->lslots[i].vword.bptr = (union block *) ap2; - lelemp->lslots[i].dword = D_Intarray; - lelemp->nused++; - } + lelemp->lslots[i].vword.bptr = (union block *) ap2; + lelemp->lslots[i].dword = D_Intarray; + lelemp->nused++; + } - } /* (ndims==2) */ + } /* (ndims==2) */ else { /* (ndims > 2) */ - struct b_intarray *ap2; - int n=ap->dims->Intarray.a[1]; - int base=0, j; - - for(i=2; idims->Intarray.a[i]; - - for (i=0; idims = (union block *)dims; - for(j=1; ja[j-1]=ap->dims->Intarray.a[j]; /* to the new array */ - - for(j=0; ja[j]=ap->a[base++]; - - lelemp->lslots[i].vword.bptr = (union block *) ap2; - lelemp->lslots[i].dword = D_Intarray; - lelemp->nused++; - } - - } /* (ndims>2) */ + struct b_intarray *ap2; + int n=ap->dims->Intarray.a[1]; + int base=0, j; + + for(i=2; idims->Intarray.a[i]; + + for (i=0; idims = (union block *)dims; + for(j=1; ja[j-1]=ap->dims->Intarray.a[j]; /* to the new array */ + + for(j=0; ja[j]=ap->a[base++]; + + lelemp->lslots[i].vword.bptr = (union block *) ap2; + lelemp->lslots[i].dword = D_Intarray; + lelemp->nused++; + } + + } /* (ndims>2) */ } /* IntArray*/ else @@ -1431,13 +1431,13 @@ int c_traverse(struct b_list *hp, struct descrip * res, int position) used = bp->nused; for (j=0; j < position; j++){ if (used <= 1){ - bp = (struct b_lelem *) bp->listnext; + bp = (struct b_lelem *) bp->listnext; used = bp->nused; i = bp->first; } else { - if (i++ >= bp->nslots) i = 0; - used--; + if (i++ >= bp->nslots) i = 0; + used--; } } *res = bp->lslots[i]; @@ -1448,58 +1448,58 @@ int cplist2realarray(dptr dp, dptr dp2, word i, word j, word skipcopyelements) { word size; tended struct b_realarray *ap2; - + /* * Calculate the size of the sublist. */ size =j - i ; if (!reserve(Blocks, (word)(sizeof(struct b_list) + (word)sizeof(struct b_realarray) + size * (word)sizeof(double)))) return RunError; - + Protect(ap2 = (struct b_realarray *) alcrealarray(size), return RunError); if (!skipcopyelements){ word k; /* copy elements i throgh j to the new array ap2*/ if (is:list(*dp)){ - tended struct b_list *lp; - lp = (struct b_list *) BlkD(*dp, List); - if (BlkType(lp->listhead) == T_Realarray){ - double *a, *a2; - a = &(((struct b_realarray *) lp->listhead )->a[i]); - a2 = ap2->a; - for (k=0; klisthead) == T_Intarray){ - word *a; - double *a2; - a = &(((struct b_intarray *) lp->listhead )->a[i]); - a2 = ap2->a; - for (k=0; ka[k])) - return RunError; - } - } - } + tended struct b_list *lp; + lp = (struct b_list *) BlkD(*dp, List); + if (BlkType(lp->listhead) == T_Realarray){ + double *a, *a2; + a = &(((struct b_realarray *) lp->listhead )->a[i]); + a2 = ap2->a; + for (k=0; klisthead) == T_Intarray){ + word *a; + double *a2; + a = &(((struct b_intarray *) lp->listhead )->a[i]); + a2 = ap2->a; + for (k=0; ka[k])) + return RunError; + } + } + } else{ /*( *dp is not a list, it is a ptr to an array of descriptors)*/ - dp = &dp[i]; - for (k=0; ka[k])) - return RunError; - } - } + dp = &dp[i]; + for (k=0; ka[k])) + return RunError; + } + } } /* skip */ - + /* for now, we only handle one dimensional lists */ ap2->dims=NULL; - + /* * Fix type and location fields for the new realarray */ @@ -1516,43 +1516,43 @@ int cpint2realarray(dptr dp1, dptr dp2, word i, word j, int copyelements) word size, bytes; struct b_intarray *ap; tended struct b_realarray *ap2; - + /* * Calculate the size of the sublist. */ size = j - i; bytes = (word)(sizeof(struct b_list) + (word)sizeof(struct b_realarray) + - size * (word)sizeof(double)); + size * (word)sizeof(double)); if (!reserve(Blocks, bytes)) return RunError; - + Protect(ap2 = (struct b_realarray *) alcrealarray(size), return RunError); ap = (struct b_intarray *) BlkD(*dp1, List)->listhead; - + if (copyelements){ word *a, k; double *b; - + a=ap->a; b=ap2->a; - + /* cop elements i throgh j to the new array ap2*/ for (k=i-1, j=0; jdims){ word ndims; ndims = (ap->dims->Intarray.blksize - sizeof(struct b_intarray) + - sizeof(word)) / sizeof(word); + sizeof(word)) / sizeof(word); /* The first dimension of the new array is reduced to size */ ap2->dims->Intarray.a[1] = size ; /* The remaining dimensions are the same, just copy them. */ for(i=2; idims->Intarray.a[i] = ap->dims->Intarray.a[i]; + ap2->dims->Intarray.a[i] = ap->dims->Intarray.a[i]; } else ap2->dims = NULL; - + /* * Fix type and location fields for the new realarray */ @@ -1574,43 +1574,43 @@ int f(dptr dp1, dptr dp2, word i, word j) word size, copyelements=1; struct b_realarray *ap; tended struct b_realarray *ap2; - + /* * Calculate the size of the sublist. */ size =j - i; if (!reserve(Blocks, (word)(sizeof(struct b_list) + - (word)sizeof(struct b_realarray) + - size * (word)sizeof(double)))) return RunError; - + (word)sizeof(struct b_realarray) + + size * (word)sizeof(double)))) return RunError; + Protect(ap2 = (struct b_realarray *) alcrealarray(size), return RunError); ap = (struct b_realarray *) BlkD(*dp1, List)->listhead; if (copyelements){ word k; double *a, *b; - + a = ap->a; b = ap2->a; - + /* cop elements i throgh j to the new array ap2*/ for (k=i-1, j=0; jdims) { word ndims; ndims = (ap->dims->Intarray.blksize - sizeof(struct b_intarray) + - sizeof(word)) / sizeof(word); + sizeof(word)) / sizeof(word); /* the first dimension of the new array is reduced to size */ ap2->dims->Intarray.a[1]= size ; /* the remaining dimensions are the same, just copy them */ for(i=2; idims->Intarray.a[i] = ap->dims->Intarray.a[i]; + ap2->dims->Intarray.a[i] = ap->dims->Intarray.a[i]; } else ap2->dims=NULL; - + /* * Fix type and location fields for the new realarray */ @@ -1625,9 +1625,9 @@ int f(dptr dp1, dptr dp2, word i, word j) #ifdef MultiProgram cprealarray_macro(cprealarray_0, 0) -#else /* MultiProgram */ +#else /* MultiProgram */ cprealarray_macro(cprealarray, 0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ #begdef cpintarray_macro(f, e) /* @@ -1638,39 +1638,39 @@ int f(dptr dp1, dptr dp2, word i, word j) word size, copyelements=1; struct b_intarray *ap; tended struct b_intarray *ap2; - + /* * Calculate the size of the sublist. */ size =j - i; if (!reserve(Blocks, (word)(sizeof(struct b_list) + - (word) sizeof(struct b_intarray) + - size * (word) sizeof(word)))) return RunError; - + (word) sizeof(struct b_intarray) + + size * (word) sizeof(word)))) return RunError; + Protect(ap2 = (struct b_intarray *) alcintarray(size), return RunError); ap = (struct b_intarray *) BlkD(*dp1, List)->listhead; - + if (copyelements){ word *a, *b, k; - + a = ap->a; b = ap2->a; - + /* copy elements i through j to the new array ap2 */ for (k=i-1, j=0; jdims) { word ndims = (ap->dims->Intarray.blksize - sizeof(struct b_intarray) + - sizeof(word)) / sizeof(word); + sizeof(word)) / sizeof(word); ap2->dims->Intarray.a[1] = size; for(i=2; idims->Intarray.a[i]=ap->dims->Intarray.a[i]; + ap2->dims->Intarray.a[i]=ap->dims->Intarray.a[i]; } else ap2->dims=NULL; - + /* * Fix type and location fields for the new intarray */ @@ -1684,9 +1684,9 @@ int f(dptr dp1, dptr dp2, word i, word j) #ifdef MultiProgram cpintarray_macro(cpintarray_0, 0) -#else /* MultiProgram */ +#else /* MultiProgram */ cpintarray_macro(cpintarray, 0) -#endif /* MultiProgram */ +#endif /* MultiProgram */ /* * Convert a list to an array. If not possible, return the original list @@ -1816,4 +1816,4 @@ struct descrip listtoarray(dptr l) return ans; } -#endif /* Arrays */ +#endif /* Arrays */ diff --git a/src/runtime/rsys.r b/src/runtime/rsys.r index fc0e15de5..afb5e8203 100644 --- a/src/runtime/rsys.r +++ b/src/runtime/rsys.r @@ -25,29 +25,29 @@ dptr file; r = SSL_peek(BlkD(*file, File)->fd.ssl, buf, maxi); if (r <= 0) { if (set_ssl_connection_errortext(BlkD(*file, File)->fd.ssl, r) == SSL_ERROR_ZERO_RETURN) - return -1; + return -1; else - return -3; + return -3; } } else -#endif /* LIBSSL */ +#endif /* LIBSSL */ if ((r=recv((SOCKET)BlkD(*file,File)->fd.fd, buf, maxi, MSG_PEEK))==SOCKET_ERROR) { #if NT i = WSAGetLastError(); - if (i == WSAESHUTDOWN) - return -1; + if (i == WSAESHUTDOWN) + return -1; set_errortext(1040); /* could use i to do better */ -#else /* NT */ +#else /* NT */ set_syserrortext(errno); -#endif /* NT */ +#endif /* NT */ return -3; } if (r == 0) return -1; - + stmp = buf; while (stmp - buf < r) { if (*stmp == '\n') break; @@ -56,11 +56,11 @@ dptr file; if (stmp - buf < r) { if(stmp == buf) - i = stmp - buf + 1; + i = stmp - buf + 1; else - i = stmp - buf; + i = stmp - buf; } - else + else i = r; #if HAVE_LIBSSL @@ -68,30 +68,30 @@ dptr file; r = SSL_read(BlkD(*file,File)->fd.ssl, buf, i); if (r <= 0) { if (set_ssl_connection_errortext(BlkD(*file,File)->fd.ssl, r) == SSL_ERROR_ZERO_RETURN) - return -1; + return -1; else - return -3; + return -3; } } else -#endif /* LIBSSL */ +#endif /* LIBSSL */ if ((r=recv((SOCKET)BlkD(*file,File)->fd.fd, buf, i, 0)) == SOCKET_ERROR) { #if NT if (WSAGetLastError() == WSAESHUTDOWN) - return -1; -#endif /* NT */ + return -1; +#endif /* NT */ set_errortext(1040); return -3; } return r; } -#endif /* NT */ - +#endif /* NT */ + #if NT #if !defined(NTGCC) #define pclose _pclose -#endif /* !NTGCC */ -#endif /* NT */ +#endif /* !NTGCC */ +#endif /* NT */ /* * getstrg - read a line into buf from file fbp. At most maxi characters @@ -114,49 +114,49 @@ struct b_file *fbp; */ static char savedbuf[BUFSIZ]; static int nsaved = 0; -#endif /* PosixFns */ +#endif /* PosixFns */ #ifdef Messaging if (fbp->status & Fs_Messaging) { struct MFile* mf = (struct MFile *)fd; if (strcmp(mf->tp->uri.scheme, "pop") == 0) { - return -1; - } + return -1; + } if (MFIN(mf, WRITING)) { - Mstartreading(mf); - } + Mstartreading(mf); + } if (!MFIN(mf, READING)) { - return -1; - } + return -1; + } l = tp_readln(mf->tp, buf, maxi); if (l <= 0) { - tp_free(mf->tp); - MFSTATE(mf, CLOSED); - return -1; - } + tp_free(mf->tp); + MFSTATE(mf, CLOSED); + return -1; + } if (buf[l-1] == '\n') { - l--; - } + l--; + } else if ((buf[l-1] == '\0') && (l==maxi)) { - return -2; - } + return -2; + } if ((!(fbp->status & Fs_Untrans)) && (buf[l-1] == '\r')) { - l--; - } + l--; + } return l; } #endif /* Messaging */ #ifdef XWindows wflushall(); -#endif /* XWindows */ +#endif /* XWindows */ #if NT if (fbp->status & Fs_Pipe) { if (feof(fd) || (fgets(buf, maxi, fd) == NULL)) { pclose(fd); - fbp->status = Fs_Pipe; + fbp->status = Fs_Pipe; return -1; } l = strlen(buf); @@ -164,11 +164,11 @@ struct b_file *fbp; if (l>0 && buf[l-1] == '\r' && (fbp->status & Fs_Untrans) == 0) l--; if (feof(fd)) { pclose(fd); - fbp->status = 0; + fbp->status = 0; } return l; } -#endif /* NT */ +#endif /* NT */ l = 0; @@ -179,112 +179,112 @@ struct b_file *fbp; l = nsaved; buf += l; } -#endif /* PosixFns */ +#endif /* PosixFns */ while (1) { #ifdef Graphics /* insert non-blocking read/code to service windows here */ -#endif /* Graphics */ +#endif /* Graphics */ #if NT if (fbp->status & Fs_Pipe) { - if (feof(fd)) { - pclose(fd); - fbp->status = 0; - if (l>0) return 1; - else return -1; - } - } -#endif /* NT */ + if (feof(fd)) { + pclose(fd); + fbp->status = 0; + if (l>0) return 1; + else return -1; + } + } +#endif /* NT */ errno = 0; DEC_NARTHREADS; - if ((c = fgetc(fd)) == '\n') { /* \n terminates line */ + if ((c = fgetc(fd)) == '\n') { /* \n terminates line */ INC_NARTHREADS_CONTROLLED; - break; + break; } INC_NARTHREADS_CONTROLLED; if (c == '\r' && (fbp->status & Fs_Untrans) == 0) { - /* \r terminates line in translated mode */ + /* \r terminates line in translated mode */ #if NT if (fbp->status & Fs_Pipe) { if (feof(fd)) { pclose(fd); - fbp->status = 0; + fbp->status = 0; if (l>0) return 1; else return -1; } } -#endif /* NT */ - if ((c = fgetc(fd)) != '\n') /* consume following \n */ - ungetc(c, fd); /* (put back if not \n) */ - break; - } +#endif /* NT */ + if ((c = fgetc(fd)) != '\n') /* consume following \n */ + ungetc(c, fd); /* (put back if not \n) */ + break; + } #if NT if (fbp->status & Fs_Pipe) { if (feof(fd)) { pclose(fd); - fbp->status = 0; + fbp->status = 0; if (l>0) return 1; else return -1; } } -#endif /* NT */ +#endif /* NT */ if (c == EOF) { #if NT if (fbp->status & Fs_Pipe) { pclose(fd); - fbp->status = 0; + fbp->status = 0; } -#endif /* NT */ +#endif /* NT */ #ifdef PosixFns - /* - * If errno is EAGAIN, we will not return any chars just yet. - */ - if (errno == EAGAIN + /* + * If errno is EAGAIN, we will not return any chars just yet. + */ + if (errno == EAGAIN #if !NT - || errno == EWOULDBLOCK + || errno == EWOULDBLOCK #endif - ) { - return -1; - } -#endif /* PosixFns */ + ) { + return -1; + } +#endif /* PosixFns */ - if (l > 0) { + if (l > 0) { #if defined(PosixFns) && !defined(Concurrent) - /* Clear the saved chars buffer */ - nsaved = 0; -#endif /* PosixFns && !Concurrent */ - return l; - } - else { - return -1; - } - } + /* Clear the saved chars buffer */ + nsaved = 0; +#endif /* PosixFns && !Concurrent */ + return l; + } + else { + return -1; + } + } if (++l > maxi) { - ungetc(c, fd); + ungetc(c, fd); #if defined(PosixFns) && !defined(Concurrent) - /* Clear the saved chars buffer */ - nsaved = 0; -#endif /* PosixFns && !Concurrent */ - return -2; - } + /* Clear the saved chars buffer */ + nsaved = 0; +#endif /* PosixFns && !Concurrent */ + return -2; + } #if defined(PosixFns) && !defined(Concurrent) savedbuf[nsaved++] = c; -#endif /* PosixFns && !Concurrent */ +#endif /* PosixFns && !Concurrent */ *buf++ = c; } #if defined(PosixFns) && !defined(Concurrent) /* We can clear the saved static buffer */ nsaved = 0; -#endif /* PosixFns && !Concurrent */ +#endif /* PosixFns && !Concurrent */ return l; } - + /* * iconhost - return some sort of host name into the buffer pointed at * by hostname. This code accommodates several different host name @@ -299,7 +299,7 @@ char *hostname; * The string constant HostStr contains the host name. */ strcpy(hostname,HostStr); -#elif VMS /* HostStr */ +#elif VMS /* HostStr */ /* * VMS has its own special logic. */ @@ -309,7 +309,7 @@ char *hostname; else h=hbuf; strcpy(hostname,h); -#else /* HostStr */ +#else /* HostStr */ { /* * Use the uname system call. (POSIX) @@ -318,10 +318,10 @@ char *hostname; uname(&utsn); strcpy(hostname,utsn.nodename); } -#endif /* HostStr */ +#endif /* HostStr */ } - + /* * Read a long string in shorter parts. (Standard read may not handle * long strings.) @@ -342,34 +342,34 @@ word len; * after a wlongread(). We work around it here by fseeking after fread. */ word pos = ftell(fd); -#endif /* NT */ +#endif /* NT */ #ifdef XWindows if (isatty(fileno(fd))) wflushall(); -#endif /* XWindows */ +#endif /* XWindows */ while (len > 0) { n = fread(ts, width, (int)((len < MaxIn) ? len : MaxIn), fd); if (n <= 0) { #if NT fseek(fd, pos + tally, SEEK_SET); -#endif /* NT */ +#endif /* NT */ return tally; - } + } tally += n; ts += n; len -= n; } #if NT fseek(fd, pos + tally, SEEK_SET); -#endif /* NT */ +#endif /* NT */ return tally; } - + #if HAVE_LIBZ /* - * Read a long string in shorter parts from a compressed file. + * Read a long string in shorter parts from a compressed file. * (Standard read may not handle long strings.) */ word gzlongread(s,width,len,fd) @@ -393,34 +393,34 @@ FILE *fd; * be turned on if it is asked for explicitly. */ word pos = ftell(fd); -#endif /* NT_FIXFTELL */ +#endif /* NT_FIXFTELL */ #if defined(XWindows) && !defined(MacOS) if (isatty(fileno(fd))) wflushall(); -#endif /* XWindows && !MacOS */ +#endif /* XWindows && !MacOS */ while (len > 0) { n = gzread(fd,ts, width * ((int)((len < MaxIn) ? len : MaxIn))); if (n <= 0) { #ifdef NT_FIXFTELL gzseek(fd, pos + tally, SEEK_SET); -#endif /* NT_FIXFTELL */ +#endif /* NT_FIXFTELL */ return tally; - } + } tally += n; ts += n; len -= n; } #ifdef NT_FIXFTELL gzseek(fd, pos + tally, SEEK_SET); -#endif /* NT_FIXFTELL */ +#endif /* NT_FIXFTELL */ return tally; } -#endif /* HAVE_LIBZ */ +#endif /* HAVE_LIBZ */ + - /* * Print string referenced by descriptor d. Note, d must not move during * a garbage collection. @@ -453,12 +453,12 @@ dptr d; else return Failed; } -#else /* VMS */ +#else /* VMS */ if (longwrite(s,l,f) < 0) return Failed; else return Succeeded; -#endif /* VMS */ +#endif /* VMS */ } /* @@ -475,9 +475,9 @@ int iselect(int fd, int t) FD_ZERO(&fds); FD_SET(fd, &fds); return select(fd+1, &fds, NULL, NULL, &tv); -#else /* PosixFns */ +#else /* PosixFns */ return -1; -#endif /* PosixFns */ +#endif /* PosixFns */ } @@ -492,11 +492,11 @@ int n; if (n < 0){ /* delay < 0 = block the current thread */ CURTSTATE(); DEC_NARTHREADS; - sem_wait(curtstate->c->semp); /* block this thread */ + sem_wait(curtstate->c->semp); /* block this thread */ INC_NARTHREADS_CONTROLLED; - return Succeeded; + return Succeeded; } -#endif /* Concurrent */ +#endif /* Concurrent */ /* * The following code is operating-system dependent [@fsys.01]. @@ -504,7 +504,7 @@ int n; #if VMS delay_vms(n); return Succeeded; -#endif /* VMS */ +#endif /* VMS */ #if UNIX { @@ -514,16 +514,16 @@ int n; fd_stdin.fd = fileno(stdin); fd_stdin.events = POLLIN; poll(&fd_stdin, 1, n); -#else /* KbhitPoll || KbhitIoctl */ +#else /* KbhitPoll || KbhitIoctl */ t.tv_sec = n / 1000; t.tv_usec = (n % 1000) * 1000; DEC_NARTHREADS; select(1, NULL, NULL, NULL, &t); INC_NARTHREADS_CONTROLLED; -#endif /* KbhitPoll || KbhitIoctl */ +#endif /* KbhitPoll || KbhitIoctl */ return Succeeded; } -#endif /* UNIX */ +#endif /* UNIX */ #if MSDOS #if NT @@ -531,14 +531,14 @@ int n; Sleep(n); INC_NARTHREADS_CONTROLLED; return Succeeded; -#else /* NT */ +#else /* NT */ return Failed; -#endif /* NT */ -#endif /* MSDOS */ +#endif /* NT */ +#endif /* MSDOS */ #if PORT || MVS || VM return Failed; -#endif /* PORT || ... */ +#endif /* PORT || ... */ /* * End of operating-system dependent code. @@ -547,8 +547,8 @@ int n; #ifdef Network -/* - * parsing the url, separate scheme, host, port, path parts +/* + * parsing the url, separate scheme, host, port, path parts * the function calling it allocate space for variables scheme, * host, port, and path. */ @@ -562,7 +562,7 @@ void parse_url(char *url, char *scheme, char *host, char *port, char *path) int NOHOST = 0; /* All operations on turl so as not to mess contents of url */ - + strcpy(turl, url); delim = "://"; @@ -570,19 +570,19 @@ void parse_url(char *url, char *scheme, char *host, char *port, char *path) if ((colon = strstr(turl, delim)) == NULL) { if ( *turl == '/' ) { strcpy(scheme, "file"); - NOHOST = 1; - t = turl + 1; + NOHOST = 1; + t = turl + 1; } else { - strcpy(scheme, "http"); - t = turl; + strcpy(scheme, "http"); + t = turl; } - } + } else { *colon = '\0'; strcpy(scheme, turl); if ( strcasecmp(scheme, "file") == 0 ) - NOHOST = 1; + NOHOST = 1; t = colon + strlen(delim); } @@ -592,24 +592,24 @@ void parse_url(char *url, char *scheme, char *host, char *port, char *path) /* If there isn't even one slash, the path must be empty */ if ( NOHOST == 0 ) { strcpy(host, t); - strcpy(path, "/"); + strcpy(path, "/"); } else { - host = NULL; - strcpy(path, "/"); - strcat(path, t); + host = NULL; + strcpy(path, "/"); + strcat(path, t); } - } + } else { - if ( NOHOST == 0 ) { + if ( NOHOST == 0 ) { strcpy(path, slash); - *slash = '\0'; /* Terminate host name */ - strcpy(host, t); + *slash = '\0'; /* Terminate host name */ + strcpy(host, t); } else { - strcpy(path, "/"); - strcat(path, t); - host = NULL; + strcpy(path, "/"); + strcat(path, t); + host = NULL; } } @@ -617,17 +617,17 @@ void parse_url(char *url, char *scheme, char *host, char *port, char *path) if ( NOHOST == 0 ) { if ((colon = strchr(host, ':')) == NULL) - strcpy(port, "http"); + strcpy(port, "http"); else { - *colon = '\0'; - if (isdigit(colon[1])) - strcpy(port, colon + 1); - else { - /* - * : with no number following (site:/file) denotes the default port - */ - strcpy(scheme, "http"); - } + *colon = '\0'; + if (isdigit(colon[1])) + strcpy(port, colon + 1); + else { + /* + * : with no number following (site:/file) denotes the default port + */ + strcpy(scheme, "http"); + } } } } @@ -637,14 +637,14 @@ void myhandler(int i) fprintf(stderr, "I am handling things by not handling them\n"); } -/* +/* * urlopen opens a local file or a remote file depending on the url input. * It checks the http_proxy environment variable. If it is set, then sending * the request to the proxy server for the remote file, otherwise, only support * sending the http request to the remote http server for retrieving the file * at the remote site. */ - + int urlopen(char *url, int flag, struct netfd *retval) { char request[MAXPATHLEN + 35]; @@ -667,16 +667,16 @@ int urlopen(char *url, int flag, struct netfd *retval) #ifdef DEBUG fprintf(stderr, "URL scheme = %s\n", scheme); - fprintf(stderr, "URL host = %s\n", host); + fprintf(stderr, "URL host = %s\n", host); fprintf(stderr, "URL port = %s\n", port); fprintf(stderr, "URL path = %s\n", path); #endif if (strcasecmp(scheme, "http") != 0 && strcasecmp(scheme, "file") != 0) { fprintf(stderr, "httpget cannot operate on %s URLs without a proxy\n", scheme); - return -1; + return -1; } - } + } else { parse_url(proxy, scheme, host, port, path); } @@ -685,64 +685,64 @@ int urlopen(char *url, int flag, struct netfd *retval) /* Find out the IP address */ res0 = uni_getaddrinfo(host, port, SOCK_STREAM, AF_INET); if (!res0) - return NULL; + return NULL; s = -1; for (res = res0; res; res = res->ai_next) { - s = socket(res->ai_family, res->ai_socktype, - res->ai_protocol); - if (s >= 0) - break; /* okay we got one */ + s = socket(res->ai_family, res->ai_socktype, + res->ai_protocol); + if (s >= 0) + break; /* okay we got one */ } if (s < 0) { - // failed to create a socket to any of the resloved names - freeaddrinfo(res0); - set_syserrortext(errno); - return -3; + // failed to create a socket to any of the resloved names + freeaddrinfo(res0); + set_syserrortext(errno); + return -3; } - + signal(SIGALRM, myhandler); alarm(5); if (connect(s, res->ai_addr, res->ai_addrlen) == -1) { alarm(0); - if (errno != EINTR) { /* if not just a timeout, print an error */ - freeaddrinfo(res0); - set_syserrortext(errno); - //perror("httpget: connect()"); - } - close(s); - s = -1; - return -4; + if (errno != EINTR) { /* if not just a timeout, print an error */ + freeaddrinfo(res0); + set_syserrortext(errno); + //perror("httpget: connect()"); + } + close(s); + s = -1; + return -4; } alarm(0); if (proxy) { - if ( flag == BODY_ONLY ) sprintf(request, "GET %s\r\n", url); - else if ( flag == HEADER_ONLY ) + if ( flag == BODY_ONLY ) sprintf(request, "GET %s\r\n", url); + else if ( flag == HEADER_ONLY ) sprintf(request, "HEAD %s HTTP/1.0\r\n", url); - } + } else { - if ( flag == BODY_ONLY ) sprintf(request, "GET %s\r\n", path); - else if ( flag == HEADER_ONLY ) - sprintf(request, "HEAD %s HTTP/1.0\r\n", path); + if ( flag == BODY_ONLY ) sprintf(request, "GET %s\r\n", path); + else if ( flag == HEADER_ONLY ) + sprintf(request, "HEAD %s HTTP/1.0\r\n", path); } strcat(request, "Accept: */*\r\n\r\n"); - + write(s, request, strlen(request)); retval->flag = HTTP_FLAG; } else { if ( (s = open(path, O_RDONLY)) == -1 ) { - fprintf(stderr, "file open error: %s\n", strerror(errno)); + fprintf(stderr, "file open error: %s\n", strerror(errno)); return -5; } - retval->flag = FILE_FLAG; + retval->flag = FILE_FLAG; } - retval->s = s; + retval->s = s; return 0; /* success */ } @@ -761,7 +761,7 @@ FILE * netopen(char *url, char *type) if ( (retval = urlopen(url, BODY_ONLY, &temp)) < 0 ) { fprintf(stderr, "netopen: urlopen(%s) failed with error code: %d\n", url, - retval); + retval); return NULL; } @@ -783,9 +783,9 @@ FILE *socketopen(char *url, char *type) struct addrinfo *res0, *res; strcpy(turl, url); - + /* parsing the url to get host name and port number */ - + if ( (colon = strchr(turl, ':')) != NULL ) { *colon = '\0'; host = colon + 1; @@ -799,7 +799,7 @@ FILE *socketopen(char *url, char *type) *colon = '\0'; port = colon + 1; } - else + else port = "http"; /* Find out the IP address */ @@ -810,7 +810,7 @@ FILE *socketopen(char *url, char *type) s = -1; for (res = res0; res; res = res->ai_next) { s = socket(res->ai_family, res->ai_socktype, - res->ai_protocol); + res->ai_protocol); if (s >= 0) break; /* okay we got one */ } @@ -822,22 +822,22 @@ FILE *socketopen(char *url, char *type) return NULL; } - + if (connect(s, res->ai_addr, res->ai_addrlen) == -1) { freeaddrinfo(res0); set_syserrortext(errno); - return NULL; + return NULL; } freeaddrinfo(res0); fp = fdopen(s, "r+"); - + return (fp); -} +} /* - * parse the http header information + * parse the http header information */ void parse_token (char *s, struct http_stat *buf) @@ -853,7 +853,7 @@ void parse_token (char *s, struct http_stat *buf) if (isspace(*tmp)) tmp++; /* past space past : */ if (tmp[strlen(tmp)-1] == '\015') /* truncate trailing carriage return */ tmp[strlen(tmp)-1] = '\0'; - + if ( strcasecmp (s, "server") == 0 ) { buf->server = strdup(tmp); } @@ -869,12 +869,12 @@ void parse_token (char *s, struct http_stat *buf) buf->exp_date = strdup(tmp); else if ( strcasecmp(s, "content-length") == 0 ) buf->length = atoi(tmp); - else + else {}; -/* fprintf(stderr, "This info is not collected: %s\n", s); */ +/* fprintf(stderr, "This info is not collected: %s\n", s); */ } -/* +/* * parsing the status line of the http return header. */ @@ -882,7 +882,7 @@ void parse_statline ( char *s, struct http_stat *buf) { char *tmp; int scode; - + tmp = strchr (s, ' '); tmp ++; scode = atoi (tmp); @@ -890,17 +890,17 @@ void parse_statline ( char *s, struct http_stat *buf) switch ( scode ) { case 200: buf->scode = OK; - break; + break; case 201: - buf->scode = CREATED; - break; + buf->scode = CREATED; + break; case 202: buf->scode = ACCEPTED; break; case 204: buf->scode = NOCONTENT; break; - case 301: + case 301: buf->scode = MV_PERM; break; case 302: @@ -915,7 +915,7 @@ void parse_statline ( char *s, struct http_stat *buf) case 401: buf->scode = UNAUTH; break; - case 403: + case 403: buf->scode = FORB; break; case 404: @@ -930,7 +930,7 @@ void parse_statline ( char *s, struct http_stat *buf) case 502: buf->scode = BADGATE; break; - case 503: + case 503: buf->scode = UNAVAIL; break; default: @@ -939,10 +939,10 @@ void parse_statline ( char *s, struct http_stat *buf) } } -/* +/* Upon successful completion a value of 0 is returned. Other- wise, a negative value is returned and errno is set to indicate - the error. + the error. */ int hstat (int sd, struct http_stat *buf ) @@ -970,15 +970,15 @@ int hstat (int sd, struct http_stat *buf ) if ( (str = malloc(bytes) ) == NULL ) { fprintf(stderr, "malloc fail: %s \n", strerror(errno)); return -1; - } + } strcat (str, temp); } else { if ( (str = realloc (str, strlen(str)+bytes+1) ) == NULL ) { fprintf(stderr, "realloc fail: %s \n", strerror(errno)); - return -2; - } - strcat (str, temp); + return -2; + } + strcat (str, temp); } } @@ -988,23 +988,23 @@ int hstat (int sd, struct http_stat *buf ) /* fprintf(stderr, "empty header, %d bytes\n", bytes); */ return -3; } - else + else parse_statline (ptr, buf); while ( (ptr = strtok (NULL, "\n")) != NULL ) - parse_token (ptr, buf); + parse_token (ptr, buf); free(str); return 0; } -/* +/* Upon successful completion a value of 0 is returned. Other- wise, a value of -1 is returned and errno is set to indicate the error. The file status information is saved in the structure buf. */ - + int netstatus (char *url, struct netstat *buf) { struct netfd temp; @@ -1013,26 +1013,26 @@ int netstatus (char *url, struct netstat *buf) if ( (rel = urlopen(url, HEADER_ONLY, &temp)) < 0 ) { fprintf(stderr, "netstatus: urlopen(%s) failed with return value: %d\n", - url, rel) ; + url, rel) ; return -1; } switch (temp.flag) { - case FILE_FLAG: + case FILE_FLAG: buf->flag = FILE_FLAG; - retval = fstat (temp.s, &(buf->u.fbuf) ); - break; + retval = fstat (temp.s, &(buf->u.fbuf) ); + break; case HTTP_FLAG: buf->flag = HTTP_FLAG; - retval = hstat (temp.s, &(buf->u.hbuf) ); - break; + retval = hstat (temp.s, &(buf->u.hbuf) ); + break; } close (temp.s); return retval; } -#endif /* Network */ +#endif /* Network */ #if NT #ifdef Dbm @@ -1052,7 +1052,7 @@ int link(char *s1, char *s2) fclose(f2); return 0; } -#endif /* Dbm */ +#endif /* Dbm */ struct b_cons *LstTmpFiles; void closetmpfiles() @@ -1060,9 +1060,9 @@ void closetmpfiles() while (LstTmpFiles) { struct b_file *fp = Blk(LstTmpFiles->data,File); if (fp->status & (Fs_Read | Fs_Write)) { - fclose(fp->fd.fp); - fp->status = 0; - } + fclose(fp->fd.fp); + fp->status = 0; + } remove(StrLoc(fp->fname)); LstTmpFiles = (struct b_cons *)(LstTmpFiles->next); } @@ -1086,9 +1086,9 @@ FILE *mstmpfile() free(temp); return f; } -#endif /* NT */ +#endif /* NT */ -// FIXME: This is no longer needed on Windows with recent APIs +// FIXME: This is no longer needed on Windows with recent APIs #ifdef DROPNTGCC /* libc replacement functions for win32. @@ -1202,7 +1202,7 @@ FILE *popen (const char* cmd, const char *mode) tmpsize=strlen(tmpbuf); else tmpsize=0; - + new_cmd = malloc(tmpsize+4+strlen(cmd)+1); sprintf(new_cmd, "%s /c %s",tmpbuf, cmd); free(app_name); @@ -1234,8 +1234,8 @@ FILE *popen (const char* cmd, const char *mode) si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); si.hStdError = GetStdHandle(STD_ERROR_HANDLE); - if (DuplicateHandle(current_pid, father_out, - current_pid, &father_out_dup, + if (DuplicateHandle(current_pid, father_out, + current_pid, &father_out_dup, 0, FALSE, DUPLICATE_SAME_ACCESS) == FALSE) { return NULL; } @@ -1253,8 +1253,8 @@ FILE *popen (const char* cmd, const char *mode) si.hStdInput = GetStdHandle(STD_INPUT_HANDLE); si.hStdOutput = child_out; si.hStdError = GetStdHandle(STD_ERROR_HANDLE); - if (DuplicateHandle(current_pid, father_in, - current_pid, &father_in_dup, + if (DuplicateHandle(current_pid, father_in, + current_pid, &father_in_dup, 0, FALSE, DUPLICATE_SAME_ACCESS) == FALSE) { fprintf(stderr, "popen: error DuplicateHandle father_in\n"); return NULL; @@ -1282,7 +1282,7 @@ FILE *popen (const char* cmd, const char *mode) ) == FALSE) { return NULL; } - + /* Only the process handle is needed */ if (CloseHandle(pi.hThread) == FALSE) { fprintf(stderr, "popen: error closing thread handle\n"); @@ -1339,8 +1339,8 @@ int pclose (FILE * f) long exit_code; /* Look for f is the access key in the linked list */ - for (q = NULL, p = _popen_list; - p != &_z && p->f != f; + for (q = NULL, p = _popen_list; + p != &_z && p->f != f; q = p, p = p->next); if (p == &_z) { @@ -1376,10 +1376,10 @@ int pclose (FILE * f) else _popen_list = p->next; free(p); - + return exit_code; } -#endif /* defined(OLD_NTGCC) && (__GNUC__ < 3) */ +#endif /* defined(OLD_NTGCC) && (__GNUC__ < 3) */ #endif #ifdef PseudoPty @@ -1392,14 +1392,14 @@ void ptclose(struct ptstruct *ptStruct) #if NT CloseHandle(ptStruct->master_read); CloseHandle(ptStruct->master_write); -#else /* NT */ +#else /* NT */ /* close the master and slave file descriptors */ close(ptStruct->master_fd); close(ptStruct->slave_fd); /* terminate the child process */ waitpid(ptStruct->slave_pid,&status,WNOHANG); kill(ptStruct->slave_pid,SIGKILL); -#endif /* NT */ +#endif /* NT */ /* free the space allocated for the structure */ free(ptStruct); return; @@ -1412,7 +1412,7 @@ struct ptstruct *ptopen(char *command) char **av; #if defined(MacOS) || defined(FreeBSD) char *tmps; -#endif /* MacOS || FreeBSD */ +#endif /* MacOS || FreeBSD */ #if NT HANDLE hOutputReadMaster,hOutputRead,hOutputWrite; HANDLE hInputWriteMaster,hInputRead,hInputWrite; @@ -1421,7 +1421,7 @@ struct ptstruct *ptopen(char *command) SECURITY_ATTRIBUTES sa; PROCESS_INFORMATION pi; STARTUPINFO si; -#endif /* NT */ +#endif /* NT */ /* allocating new ptstruct */ struct ptstruct *newPtStruct = @@ -1430,7 +1430,7 @@ struct ptstruct *ptopen(char *command) EXITERROR(newPtStruct); } strcpy(newPtStruct->slave_command, command); - + CmdParamToArgv(command, &av, 0); /* * Maybe need to conduct a path search for av[0], augment @@ -1462,25 +1462,25 @@ struct ptstruct *ptopen(char *command) /* Launch the process that you want to redirect */ if (!CreateProcess(NULL,newPtStruct->slave_command,NULL,NULL,TRUE, - CREATE_NEW_CONSOLE,NULL,NULL,&si,&pi)) { + CREATE_NEW_CONSOLE,NULL,NULL,&si,&pi)) { EXITERROR(newPtStruct); } /* Set global child process handle to cause threads to exit. */ newPtStruct->slave_pid = pi.hProcess; -#else /* NT */ +#else /* NT */ /* open master pty file descriptor */ #ifdef SUN if((newPtStruct->master_fd=open("/dev/ptmx",O_RDWR|O_NONBLOCK)) == -1) { EXITERROR(newPtStruct); } -#else /* SUN */ +#else /* SUN */ if((newPtStruct->master_fd=posix_openpt(O_RDWR|O_NONBLOCK)) == -1) { EXITERROR(newPtStruct); } -#endif /* SUN */ +#endif /* SUN */ /* change permissions of slave pty to correspond with the master pty */ if(grantpt(newPtStruct->master_fd) == -1) { @@ -1498,23 +1498,23 @@ struct ptstruct *ptopen(char *command) */ #ifdef SUN if(ttyname_r(newPtStruct->master_fd,newPtStruct->slave_filename, - sizeof(newPtStruct->slave_filename)) != 0) { -#else /* SUN */ + sizeof(newPtStruct->slave_filename)) != 0) { +#else /* SUN */ #if defined(MacOS) || defined(FreeBSD) if (((tmps = ptsname(newPtStruct->master_fd)) == NULL) || (strlen(tmps) > sizeof(newPtStruct->slave_filename)-1) || (!strcpy(newPtStruct->slave_filename, tmps))){ -#else /* MacOS || FreeBSD */ +#else /* MacOS || FreeBSD */ if(ptsname_r(newPtStruct->master_fd,newPtStruct->slave_filename, - sizeof(newPtStruct->slave_filename)) != 0) { -#endif /* MacOS || FreeBSD */ -#endif /* SUN */ + sizeof(newPtStruct->slave_filename)) != 0) { +#endif /* MacOS || FreeBSD */ +#endif /* SUN */ EXITERROR(newPtStruct); } /* finally open the slave pty file descriptor */ if((newPtStruct->slave_fd=open(newPtStruct->slave_filename, - O_RDWR)) == -1) { + O_RDWR)) == -1) { EXITERROR(newPtStruct); } @@ -1525,25 +1525,25 @@ struct ptstruct *ptopen(char *command) else if(newPtStruct->slave_pid == 0) { /* create a session id and make this process the process group leader */ if(setsid() == -1) /* was setpgid */ - EXITERROR(newPtStruct); + EXITERROR(newPtStruct); /* * dup standard file descriptors to be associated with pseudo terminal */ if(dup2(newPtStruct->slave_fd,0) == -1) { - EXITERROR(newPtStruct); - } + EXITERROR(newPtStruct); + } if(dup2(newPtStruct->slave_fd,1) == -1) { - EXITERROR(newPtStruct); - } + EXITERROR(newPtStruct); + } if(dup2(newPtStruct->slave_fd,2) == -1) { - EXITERROR(newPtStruct); - } + EXITERROR(newPtStruct); + } /* attempt to execute the command slave process */ if(execve(av[0], av, NULL) == -1) { EXITERROR(newPtStruct); } } -#endif /* NT */ +#endif /* NT */ return newPtStruct; #undef EXITERROR @@ -1558,7 +1558,7 @@ struct ptstruct *ptopen(char *command) * error reporting. */ int ptgetstrt(char *buffer, const int bufsiz, struct ptstruct *ptStruct, - unsigned long waittime, int longread) + unsigned long waittime, int longread) { int tot_bytes_read=0, wait_fd, i=0, ret=0, premstop=0; #if NT @@ -1574,7 +1574,7 @@ int ptgetstrt(char *buffer, const int bufsiz, struct ptstruct *ptStruct, } #if !NT - + /* clear the buffer */ memset(buffer, '\0', bufsiz); @@ -1586,7 +1586,7 @@ int ptgetstrt(char *buffer, const int bufsiz, struct ptstruct *ptStruct, /* set the wait file descriptor for use with select */ wait_fd = ptStruct->master_fd+1; - + /* set file descriptor sets for reading with select */ FD_ZERO(&rd_set); if (ptStruct->master_fd > -1) { @@ -1600,78 +1600,78 @@ int ptgetstrt(char *buffer, const int bufsiz, struct ptstruct *ptStruct, * if select returns without any errors and * if the characters are available to read from input ... */ -#endif /* NT */ +#endif /* NT */ #if NT /* clear the buffer */ ZeroMemory(buffer,bufsiz); if(WaitForSingleObject(ptStruct->master_read,waittime) != WAIT_FAILED) { -#else /* NT */ +#else /* NT */ if((ret=select(wait_fd,&rd_set,NULL,NULL,timeoutp)) > 0 && FD_ISSET(ptStruct->master_fd,&rd_set) ) { -#endif /* NT */ +#endif /* NT */ while(!premstop && tot_bytes_read < bufsiz) { - /* - * Read a byte. See if we have a newline. Probably needs to - * be rewritten to try for multiple bytes. - */ + /* + * Read a byte. See if we have a newline. Probably needs to + * be rewritten to try for multiple bytes. + */ #if NT - if ((ret=ReadFile(ptStruct->master_read,&buffer[i],1, - &bytes_read,NULL)) != 0) { -#else /* NT */ - if ((bytes_read=read(ptStruct->master_fd,&buffer[i],1)) > 0) { -#endif /* NT */ - - if(!longread && buffer[i] == '\n') { - if (buffer[i-1] == '\r') { - tot_bytes_read--; - } - premstop=1; - } - tot_bytes_read += bytes_read; - i++; + if ((ret=ReadFile(ptStruct->master_read,&buffer[i],1, + &bytes_read,NULL)) != 0) { +#else /* NT */ + if ((bytes_read=read(ptStruct->master_fd,&buffer[i],1)) > 0) { +#endif /* NT */ + + if(!longread && buffer[i] == '\n') { + if (buffer[i-1] == '\r') { + tot_bytes_read--; + } + premstop=1; + } + tot_bytes_read += bytes_read; + i++; #if NT -#else /* NT */ - FD_ZERO(&rd_set); - FD_SET(ptStruct->master_fd,&rd_set); -#endif /* NT */ +#else /* NT */ + FD_ZERO(&rd_set); + FD_SET(ptStruct->master_fd,&rd_set); +#endif /* NT */ - } /* if bytes read */ - else { + } /* if bytes read */ + else { #if NT - /* - * Handle ReadFile() != 0 here. Use GetLastError(). - * Do we ever retry? Is ERROR_IO_PENDING possible? - */ - break; -#else /* NT */ - /* - * Negative read() is an error; 0 just means wait for more. - * But even if negative, we might just need to try again. - */ - if ((bytes_read < 0) && (errno != EAGAIN)) { - /* non-continuing error */ - break; - } - usleep(5000); - continue; -#endif /* NT */ - } - } /* while */ - } /* if we had input before timeout */ + /* + * Handle ReadFile() != 0 here. Use GetLastError(). + * Do we ever retry? Is ERROR_IO_PENDING possible? + */ + break; +#else /* NT */ + /* + * Negative read() is an error; 0 just means wait for more. + * But even if negative, we might just need to try again. + */ + if ((bytes_read < 0) && (errno != EAGAIN)) { + /* non-continuing error */ + break; + } + usleep(5000); + continue; +#endif /* NT */ + } + } /* while */ + } /* if we had input before timeout */ #if NT else ret = -1; if (ret == 0) - ret = -1; -#else /* NT */ + ret = -1; +#else /* NT */ else { } -#endif /* NT */ +#endif /* NT */ /* if some bytes were read than return the number read */ @@ -1697,13 +1697,13 @@ int ptgetstr(char *buffer, const int bufsiz, struct ptstruct *ptStruct, struct t if(buffer == NULL | ptStruct == NULL | timeout == NULL) return -1; - + /* set the wait file descriptor for use with select */ wait_fd = ptStruct->master_fd+1; - + /* clear the buffer */ memset(buffer,0,sizeof(buffer)); - + /* set file descriptor sets for reading with select */ FD_ZERO(&rd_set); if(ptStruct->master_fd > -1) @@ -1713,14 +1713,14 @@ int ptgetstr(char *buffer, const int bufsiz, struct ptstruct *ptStruct, struct t /* if select returns without any errors then ... */ /* if the characters are availabe to read from input ... */ while((sel_ret=select(wait_fd,&rd_set,NULL,NULL,timeout)) > 0 - && FD_ISSET(ptStruct->master_fd,&rd_set) - && bytes_read < bufsiz - && (ret=read(ptStruct->master_fd,&buffer[i],1)) > 0) { - bytes_read += ret; - i++; - FD_ZERO(&rd_set); - FD_SET(ptStruct->master_fd,&rd_set); - } + && FD_ISSET(ptStruct->master_fd,&rd_set) + && bytes_read < bufsiz + && (ret=read(ptStruct->master_fd,&buffer[i],1)) > 0) { + bytes_read += ret; + i++; + FD_ZERO(&rd_set); + FD_SET(ptStruct->master_fd,&rd_set); + } if(bytes_read > 0) { return bytes_read; } else if(bytes_read == 0 && !FD_ISSET(ptStruct->master_fd,&rd_set)) { @@ -1736,23 +1736,23 @@ int ptlongread(char *buffer, const int nelem, struct ptstruct *ptStruct) #if 0 fd_set rd_set; int bytes_read=0, ret=0, wait_fd, i=0; - + /* size_t max_read_bytes=sizeof(char)*256; */ /* if ptystruct pointer is NULL than return with error code */ if(ptStruct == NULL) return -1; - + /* set the wait file descriptor for use with select */ wait_fd = ptStruct->master_fd+1; /* clear the buffer */ memset(buffer,0,sizeof(buffer)); - + /* set file descriptor sets for reading with select */ FD_ZERO(&rd_set); - if(ptStruct->master_fd > -1) + if(ptStruct->master_fd > -1) FD_SET(ptStruct->master_fd,&rd_set); - + /* if select returns without any errors then ... */ if(select(wait_fd,&rd_set,NULL,NULL,NULL) > 0) { /* if the characters are availabe to read from input ... */ @@ -1761,20 +1761,20 @@ int ptlongread(char *buffer, const int nelem, struct ptstruct *ptStruct) /* 1) none are available */ /* 2) the maximum buffer size has been reached */ /* 3) a newline has been read */ - while((ret=read(ptStruct->master_fd,&buffer[i],1)) > 0 - && (bytes_read+=ret) < nelem) - i++; + while((ret=read(ptStruct->master_fd,&buffer[i],1)) > 0 + && (bytes_read+=ret) < nelem) + i++; /* if there was an error then return an error code */ if( ret < 0) - ret = -1; /* -1 indicates error reading from slave */ - else - ret = bytes_read; + ret = -1; /* -1 indicates error reading from slave */ + else + ret = bytes_read; } else { /* select timed out */ ret = -2; } - } else + } else ret = -1; /* error occurred from select */ return ret; #endif @@ -1792,9 +1792,9 @@ int ptputstr(struct ptstruct *ptStruct, char *buffer, int bufsize) if ( (WaitForSingleObject(ptStruct->master_write,0) == WAIT_FAILED) || (!WriteFile(ptStruct->master_write,buffer,bufsize,&bytes_written,NULL))) ret = -1; - else + else ret = bytes_written; -#else /* NT */ +#else /* NT */ { fd_set wd_set; @@ -1802,10 +1802,10 @@ int ptputstr(struct ptstruct *ptStruct, char *buffer, int bufsize) timeout.tv_sec=0L; timeout.tv_usec=0L; - + /* set file descriptors for writing with select */ FD_ZERO(&wd_set); - if(ptStruct->master_fd > -1) + if(ptStruct->master_fd > -1) FD_SET(ptStruct->master_fd,&wd_set); else return -3; /* invalid output file descriptor - return error */ @@ -1813,22 +1813,22 @@ int ptputstr(struct ptstruct *ptStruct, char *buffer, int bufsize) if ((sel_ret=select(ptStruct->master_fd+1,NULL,&wd_set,NULL,&timeout)) > 0){ /* if the file descriptor is ready to write to ... */ if(FD_ISSET(ptStruct->master_fd,&wd_set)) { - if((bytes_written=write(ptStruct->master_fd,buffer,bufsize)) < 0) - ret = -1; /* -1 indicates error writing to file descriptor */ - else - ret=bytes_written; - } + if((bytes_written=write(ptStruct->master_fd,buffer,bufsize)) < 0) + ret = -1; /* -1 indicates error writing to file descriptor */ + else + ret=bytes_written; + } else { - /* select timed out */ - ret = 0; /* was -2 */ - } + /* select timed out */ + ret = 0; /* was -2 */ + } } else { ret = sel_ret; /* return value returned by select */ } } -#endif /* NT */ +#endif /* NT */ return ret; } @@ -1858,7 +1858,7 @@ int ptflush(struct ptstruct *ptStruct) return -1; } -#endif /* PseudoPty */ +#endif /* PseudoPty */ FILE *finredir, *fouredir, *ferredir; @@ -1873,38 +1873,38 @@ void detectRedirection() #passthru #if (__GNUC__==4) && (__GNUC_MINOR__>7) #passthru #define stat _stat64i32 #passthru #endif -#endif /* NTGCC && WordBits==32*/ +#endif /* NTGCC && WordBits==32*/ struct stat sb; /* * Look at the standard file handles and attempt to detect * redirection. */ if (fstat(fileno(stdin), &sb) == 0) { - if (sb.st_mode & S_IFCHR) { /* stdin is a device */ - } - if (sb.st_mode & S_IFREG) { /* stdin is a regular file */ - } + if (sb.st_mode & S_IFCHR) { /* stdin is a device */ + } + if (sb.st_mode & S_IFREG) { /* stdin is a regular file */ + } /* stdin is of size sb.st_size */ if (sb.st_size > 0) { ConsoleFlags |= StdInRedirect; - } + } } - else { /* unable to identify stdin */ + else { /* unable to identify stdin */ } if (fstat(fileno(stdout), &sb) == 0) { - if (sb.st_mode & S_IFCHR) { /* stdout is a device */ - } - if (sb.st_mode & S_IFREG) { /* stdout is a regular file */ - } + if (sb.st_mode & S_IFCHR) { /* stdout is a device */ + } + if (sb.st_mode & S_IFREG) { /* stdout is a regular file */ + } /* stdout is of size sb.st_size */ if (sb.st_size == 0) ConsoleFlags |= StdOutRedirect; } - else { /* unable to identify stdout */ + else { /* unable to identify stdout */ } } -#endif /* Graphics */ +#endif /* Graphics */ /* * CmdParamToArgv() - convert a command line to an argv array. Return argc. @@ -1925,108 +1925,108 @@ int CmdParamToArgv(char *s, char ***avp, int dequote) #ifdef Graphics if (dequote) detectRedirection(); -#endif /* Graphics */ +#endif /* Graphics */ while (*t2) { while (*t2 && isspace(*t2)) t2++; switch (*t2) { - case '\0': break; + case '\0': break; #ifdef Graphics - /* - * perform file redirection; this is for MS Windows - * and other situations where Wiconx is launched from - * a shell that does not process < and > characters. - */ - case '<': case '>': { - FILE *f; - char c, buf[128], *t3; - if (dequote == 0) goto skipredirect; - c = *t2++; - while (*t2 && isspace(*t2)) t2++; - t3 = buf; - while (*t2 && !isspace(*t2)) *t3++ = *t2++; - *t3 = '\0'; - if (c == '<') - f = fopen(buf, "r"); - else - f = fopen(buf, "w"); - if (f == NULL) { - fprintf(stderr, "system error: unable to redirect i/o"); - c_exit(-1); - } - if (c == '<') { - finredir = f; - ConsoleFlags |= StdInRedirect; - } - else { - fouredir = f; - ConsoleFlags |= StdOutRedirect; - } - break; - } -#endif /* Graphics */ - case '"': { - char *t3, c = '\0'; - if (dequote) t3 = ++t2; /* skip " */ - else t3 = t2++; + /* + * perform file redirection; this is for MS Windows + * and other situations where Wiconx is launched from + * a shell that does not process < and > characters. + */ + case '<': case '>': { + FILE *f; + char c, buf[128], *t3; + if (dequote == 0) goto skipredirect; + c = *t2++; + while (*t2 && isspace(*t2)) t2++; + t3 = buf; + while (*t2 && !isspace(*t2)) *t3++ = *t2++; + *t3 = '\0'; + if (c == '<') + f = fopen(buf, "r"); + else + f = fopen(buf, "w"); + if (f == NULL) { + fprintf(stderr, "system error: unable to redirect i/o"); + c_exit(-1); + } + if (c == '<') { + finredir = f; + ConsoleFlags |= StdInRedirect; + } + else { + fouredir = f; + ConsoleFlags |= StdOutRedirect; + } + break; + } +#endif /* Graphics */ + case '"': { + char *t3, c = '\0'; + if (dequote) t3 = ++t2; /* skip " */ + else t3 = t2++; while (*t2 && (*t2 != '"')) t2++; - if (*t2 && !dequote) t2++; + if (*t2 && !dequote) t2++; if ((c = *t2)) { - *t2++ = '\0'; - } - *avp = realloc(*avp, (rv + 2) * sizeof (char *)); - (*avp)[rv++] = salloc(t3); + *t2++ = '\0'; + } + *avp = realloc(*avp, (rv + 2) * sizeof (char *)); + (*avp)[rv++] = salloc(t3); (*avp)[rv] = NULL; - if(!dequote && c) *--t2 = c; + if(!dequote && c) *--t2 = c; - break; - } + break; + } default: { #if NT FINDDATA_T fd; -#endif /* NT */ - char *t3; +#endif /* NT */ + char *t3; #ifdef Graphics skipredirect: -#endif /* Graphics */ - t3 = t2; +#endif /* Graphics */ + t3 = t2; while (*t2 && !isspace(*t2)) t2++; - if (*t2) - *t2++ = '\0'; + if (*t2) + *t2++ = '\0'; strcpy(tmp, t3); #if NT - if (!strcmp(tmp, ">") || !FINDFIRST(tmp, &fd)) { + if (!strcmp(tmp, ">") || !FINDFIRST(tmp, &fd)) { #endif - *avp = realloc(*avp, (rv + 2) * sizeof (char *)); - (*avp)[rv++] = salloc(t3); + *avp = realloc(*avp, (rv + 2) * sizeof (char *)); + (*avp)[rv++] = salloc(t3); (*avp)[rv] = NULL; #if NT } - else { - char dir[MaxPath]; + else { + char dir[MaxPath]; int end; strcpy(dir, t3); - do { - end = strlen(dir)-1; - while (end >= 0 && dir[end] != '\\' && dir[end] != '/' && - dir[end] != ':') { + do { + end = strlen(dir)-1; + while (end >= 0 && dir[end] != '\\' && dir[end] != '/' && + dir[end] != ':') { dir[end] = '\0'; - end--; - } - strcat(dir, FILENAME(&fd)); - *avp = realloc(*avp, (rv + 2) * sizeof (char *)); - (*avp)[rv++] = salloc(dir); + end--; + } + strcat(dir, FILENAME(&fd)); + *avp = realloc(*avp, (rv + 2) * sizeof (char *)); + (*avp)[rv++] = salloc(dir); (*avp)[rv] = NULL; - } while (FINDNEXT(&fd)); - FINDCLOSE(&fd); - } -#endif /* NT */ + } while (FINDNEXT(&fd)); + FINDCLOSE(&fd); + } +#endif /* NT */ break; - } + } } } free(t); @@ -2046,55 +2046,55 @@ __findenv(const char *name, int *offset); int getenv_r(const char *name, char *buf, size_t len) { - int offset; - char *result; - int rv = -1; - - pthread_rwlock_rdlock(&__environ_lock); - result = __findenv(name, &offset); - if (result == NULL) { - errno = ENOENT; - goto out; - } - if (strlen(result) >= len) { - errno = ERANGE; - goto out; - } - strncpy(buf, result, len); - rv = 0; + int offset; + char *result; + int rv = -1; + + pthread_rwlock_rdlock(&__environ_lock); + result = __findenv(name, &offset); + if (result == NULL) { + errno = ENOENT; + goto out; + } + if (strlen(result) >= len) { + errno = ERANGE; + goto out; + } + strncpy(buf, result, len); + rv = 0; out: - pthread_rwlock_unlock(&__environ_lock); - return rv; + pthread_rwlock_unlock(&__environ_lock); + return rv; } /* * __findenv -- - * Returns pointer to value associated with name, if any, else NULL. - * Sets offset to be the offset of the name/value combination in the - * environmental array, for use by setenv(3) and unsetenv(3). - * Explicitly removes '=' in argument name. + * Returns pointer to value associated with name, if any, else NULL. + * Sets offset to be the offset of the name/value combination in the + * environmental array, for use by setenv(3) and unsetenv(3). + * Explicitly removes '=' in argument name. * - * This routine *should* be a static; don't use it. + * This routine *should* be a static; don't use it. */ char * __findenv(const char *name, int *offset) { - size_t len; - const char *np; - char **p, *c; - - if (name == NULL || environ == NULL) - return NULL; - for (np = name; *np && *np != '='; ++np) - continue; - len = np - name; - for (p = environ; (c = *p) != NULL; ++p) - if (strncmp(c, name, len) == 0 && c[len] == '=') { - *offset = p - environ; - return c + len + 1; - } - *offset = p - environ; - return NULL; + size_t len; + const char *np; + char **p, *c; + + if (name == NULL || environ == NULL) + return NULL; + for (np = name; *np && *np != '='; ++np) + continue; + len = np - name; + for (p = environ; (c = *p) != NULL; ++p) + if (strncmp(c, name, len) == 0 && c[len] == '=') { + *offset = p - environ; + return c + len + 1; + } + *offset = p - environ; + return NULL; } #else @@ -2104,9 +2104,9 @@ getenv_r(const char *name, char *buf, size_t len) char *buf2 = getenv(name); if (buf2) { if (strlen(buf2) >= len) { - errno = ERANGE; - return -1; - } + errno = ERANGE; + return -1; + } errno = 0; strcpy(buf, buf2); return 0; @@ -2117,4 +2117,4 @@ getenv_r(const char *name, char *buf, size_t len) } } -#endif /* HAVE_LIBPTHREAD */ +#endif /* HAVE_LIBPTHREAD */ diff --git a/src/runtime/rwin3d.ri b/src/runtime/rwin3d.ri index 7d83727f4..921b8ebe2 100644 --- a/src/runtime/rwin3d.ri +++ b/src/runtime/rwin3d.ri @@ -57,41 +57,41 @@ char * gl_endmark_fields[] = {"depth"}; * real number arguments to convert. */ stringint redraw3Dnames[] = { - { 0, 34 }, /* number of entries */ - { "DrawCube", REDRAW_CUBE | 4 }, - { "DrawCylinder", REDRAW_CYLINDER | 6}, - { "DrawDisk", REDRAW_DISK | 7 }, - { "DrawLine", REDRAW_LINE }, - { "DrawPoint", REDRAW_POINT }, - { "DrawPolygon", REDRAW_POLYGON }, - { "DrawSegment", REDRAW_SEGMENT }, - { "DrawSphere", REDRAW_SPHERE | 4 }, + { 0, 34 }, /* number of entries */ + { "DrawCube", REDRAW_CUBE | 4 }, + { "DrawCylinder", REDRAW_CYLINDER | 6}, + { "DrawDisk", REDRAW_DISK | 7 }, + { "DrawLine", REDRAW_LINE }, + { "DrawPoint", REDRAW_POINT }, + { "DrawPolygon", REDRAW_POLYGON }, + { "DrawSegment", REDRAW_SEGMENT }, + { "DrawSphere", REDRAW_SPHERE | 4 }, { "DrawString3d", REDRAW_DRAWSTRING3D | 3}, - { "DrawTorus", REDRAW_TORUS | 5}, + { "DrawTorus", REDRAW_TORUS | 5}, { "EndMark", REDRAW_ENDMARK}, - { "Fg", REDRAW_FG}, - { "FillPolygon", REDRAW_FILLPOLYGON }, + { "Fg", REDRAW_FG}, + { "FillPolygon", REDRAW_FILLPOLYGON }, { "Font3d", REDRAW_FONT3D }, - { "Identity", REDRAW_IDENTITY }, + { "Identity", REDRAW_IDENTITY }, { "Mark", REDRAW_MARK}, - { "MatrixMode", REDRAW_MATRIXMODE }, + { "MatrixMode", REDRAW_MATRIXMODE }, { "MeshMode", REDRAW_MESHMODE }, - { "MultMatrix", REDRAW_MULTMATRIX }, - { "Normals", REDRAW_NORMALS }, - { "Pick" , REDRAW_PICK}, - { "PopMatrix", REDRAW_POPMATRIX }, - { "PushMatrix", REDRAW_PUSHMATRIX }, - { "Rotate", REDRAW_ROTATE | 4 }, - { "Scale", REDRAW_SCALE | 3 }, - { "Texcoord", REDRAW_TEXCOORD }, - { "Texture", REDRAW_TEXTURE }, - { "Translate", REDRAW_TRANSLATE | 3 }, - { "dim", REDRAW_DIM }, - { "linewidth", REDRAW_LINEWIDTH }, - { "normode", REDRAW_NORMODE }, - { "rings", REDRAW_RINGS }, - { "slices", REDRAW_SLICES }, - { "texmode", REDRAW_TEXMODE }, + { "MultMatrix", REDRAW_MULTMATRIX }, + { "Normals", REDRAW_NORMALS }, + { "Pick" , REDRAW_PICK}, + { "PopMatrix", REDRAW_POPMATRIX }, + { "PushMatrix", REDRAW_PUSHMATRIX }, + { "Rotate", REDRAW_ROTATE | 4 }, + { "Scale", REDRAW_SCALE | 3 }, + { "Texcoord", REDRAW_TEXCOORD }, + { "Texture", REDRAW_TEXTURE }, + { "Translate", REDRAW_TRANSLATE | 3 }, + { "dim", REDRAW_DIM }, + { "linewidth", REDRAW_LINEWIDTH }, + { "normode", REDRAW_NORMODE }, + { "rings", REDRAW_RINGS }, + { "slices", REDRAW_SLICES }, + { "texmode", REDRAW_TEXMODE }, }; /* @@ -138,7 +138,7 @@ dptr rec_structor3d(int type) return rec_structinate(&gl_cylinder, "gl_cylinder", 8, gl_cylinder_fields); case GL3D_DISK: return rec_structinate(&gl_disk, "gl_disk", 9, gl_disk_fields); - + case GL3D_SPHERE: return rec_structinate(&gl_sphere, "gl_sphere", 6, gl_sphere_fields); case GL3D_TORUS: @@ -162,9 +162,9 @@ dptr rec_structor3d(int type) case GL3D_FONT: return rec_structinate(&gl_font3d, "gl_font3d", 3, gl_font_fields); case GL3D_DRAWSTRING: - return rec_structinate(&gl_drawstring3d, "gl_drawstring3d", 6, gl_drawstring3d_fields); + return rec_structinate(&gl_drawstring3d, "gl_drawstring3d", 6, gl_drawstring3d_fields); case GL3D_MARK: - return rec_structinate(&gl_mark, "gl_mark", 7, gl_mark_fields); + return rec_structinate(&gl_mark, "gl_mark", 7, gl_mark_fields); case GL3D_ENDMARK: return rec_structinate(&gl_endmark, "gl_endmark", 3, gl_mark_fields); case GL3D_MESHMODE: @@ -172,23 +172,23 @@ dptr rec_structor3d(int type) default: break; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ return 0; } int create3Dlisthdr(dptr dp, char *strname, word size){ int draw_code; - struct descrip funcname, g; /* do not need to be tended */ + struct descrip funcname, g; /* do not need to be tended */ tended struct b_list *func; - + /* create a list to save function information */ Protect(func = alclist(0, size), return RunError); dp->dword = D_List; dp->vword.bptr = (union block *) func; MakeStr(strname, strlen(strname), &funcname); c_put(dp, &funcname); - + draw_code = si_s2i(redraw3Dnames, strname); if (draw_code == -1) return RunError; @@ -266,7 +266,7 @@ int gettexture(wbp w, dptr dp) int init_3dcontext(wcp wc) { /* set defaults for attributes */ - wc->dim = 3; + wc->dim = 3; wc->slices = 15; wc->rings = 10; wc->selectionenabled = 0; @@ -282,7 +282,7 @@ int init_3dcontext(wcp wc) wc->normals = NULL; wc->texmode = wc->numtexcoords = 0; - wc->texcoords = NULL; + wc->texcoords = NULL; wc->curtexture = -1; wc->buffermode = IMMEDIATE3D; wc->meshmode = U3D_POLYGON; @@ -384,23 +384,23 @@ int section_length(wbp w) if (k<0) k=bp->nslots-1; if (used<=0) { - bp = (struct b_lelem *) bp->listprev; - used = bp->nused; + bp = (struct b_lelem *) bp->listprev; + used = bp->nused; k = bp->first + used-1; if (k>=bp->nslots) k=k-bp->nslots-1; } if (is:record(flist)) { - rp = BlkD(flist, Record); + rp = BlkD(flist, Record); fname = rp->fields[0]; tmp=si_s2i(redraw3Dnames, StrLoc(fname)); - if (tmp == -1) { - return Failed; - } + if (tmp == -1) { + return Failed; + } if ((tmp & ~0xf)==REDRAW_MARK) { if (!cnv:C_integer(rp->fields[4], v)) return Failed; - if (v==0) { - save_flist = flist; + if (v==0) { + save_flist = flist; flag = 1; break; } @@ -452,9 +452,9 @@ int seteye(wbp w, char *s) wsp ws = w->window; if (sscanf(s, " %lf , %lf , %lf , %lf , %lf , %lf , %lf , %lf , %lf ", - &(ws->eyeposx), &(ws->eyeposy), &(ws->eyeposz), - &(ws->eyedirx), &(ws->eyediry), &(ws->eyedirz), - &(ws->eyeupx), &(ws->eyeupy), &(ws->eyeupz)) != 9) { + &(ws->eyeposx), &(ws->eyeposy), &(ws->eyeposz), + &(ws->eyedirx), &(ws->eyediry), &(ws->eyedirz), + &(ws->eyeupx), &(ws->eyeupy), &(ws->eyeupz)) != 9) { return RunError; } @@ -614,7 +614,7 @@ int setfov(wbp w, char* s) fov = atof(s); ws->fov = fov; - + return Succeeded; } @@ -626,12 +626,12 @@ int setnormode(wbp w, char* s) tended struct b_list *func; tended struct descrip mode; wcp wc = w->context; - + MakeCurrent(w); /* create a list */ if (create3Dlisthdr(&f, "normode", 4)!=Succeeded) return RunError; - + if (!strcmp("on", s)) wc->normode = 2; else if (!strcmp("auto", s)) @@ -642,7 +642,7 @@ int setnormode(wbp w, char* s) /* not a valid normals mode so generate an error */ else return RunError; - + MakeInt(wc->normode, &mode); c_put(&f, &mode); c_put(&(w->window->funclist), &f); @@ -656,19 +656,19 @@ int setrings(wbp w, char* s) tended struct descrip val; int rings; wcp wc = w->context; - + MakeCurrent(w); /* create a list */ if (create3Dlisthdr(&f, "rings", 4)!=Succeeded) return RunError; - + rings = atoi(s); /* must be positive integer */ if (rings<=0) return RunError; MakeInt(rings, &val); - c_put(&f, &val); + c_put(&f, &val); wc->rings = rings; - + c_put(&(w->window->funclist), &f); return Succeeded; @@ -681,19 +681,19 @@ int setslices(wbp w, char* s) tended struct descrip val; int slices; wcp wc = w->context; - + MakeCurrent(w); /* create a list */ if (create3Dlisthdr(&f, "slices", 4) != Succeeded) return RunError; - + slices = atoi(s); - /* must be positive integer */ + /* must be positive integer */ if (slices <= 0) return RunError; MakeInt(slices, &val); - c_put(&f, &val); + c_put(&f, &val); wc->slices = slices; - + c_put(&(w->window->funclist), &f); return Succeeded; @@ -757,7 +757,7 @@ int setautogen(wbp w, int i) /* set a texture */ int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, - int is_init) + int is_init) { wcp wc = w->context; char* s; @@ -772,14 +772,14 @@ int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, if (!is_init){ if (!constr && !(constr = rec_structor3d(GL3D_TEXTURE))) - syserr("failed to create opengl record constructor"); - nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; + syserr("failed to create opengl record constructor"); + nfields = (int) ((struct b_proc *)BlkLoc(*constr))->nfields; - /* - * create a record of the graphical object and its parameters - */ + /* + * create a record of the graphical object and its parameters + */ if (!(rp = alcrecd(nfields, BlkLoc(*constr)))) - return Failed; + return Failed; (*f).dword = D_Record; (*f).vword.bptr = (union block *)rp; MakeStr("Texture", 7, &(rp->fields[0])); @@ -790,9 +790,9 @@ int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, MakeInt(draw_code, &(rp->fields[1])); Protect(BlkLoc(rp->fields[3]) = - (union block *)alcfile((FILE *)w, Fs_Window|Fs_Read|Fs_Write - | (w->context->rendermode == UGL3D?Fs_Window3D:0) - , &emptystr), return Failed); + (union block *)alcfile((FILE *)w, Fs_Window|Fs_Read|Fs_Write + | (w->context->rendermode == UGL3D?Fs_Window3D:0) + , &emptystr), return Failed); rp->fields[3].dword = D_File; } @@ -805,7 +805,7 @@ int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, while(isspace(*s)) s++; if (*s == ',') /* must be an image string */ ttype = 3; - else { /* it is a file name */ + else { /* it is a file name */ ttype = 1; } @@ -824,7 +824,7 @@ int settexture(wbp w, char* str, int len, struct descrip *f, int curtex, return Succeeded; } -/* +/* * Create an empty list for function calls for a 3D window */ int create_display_list(wbp w, int size) @@ -838,8 +838,8 @@ int create_display_list(wbp w, int size) if ((BlkLoc(w->window->funclist2d) = (union block *)alclist(0, size)) == NULL) return Failed; w->window->funclist2d.dword = D_List; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ return Succeeded; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ diff --git a/src/runtime/rwindow.r b/src/runtime/rwindow.r index 8f5814a2e..08d2b69b3 100644 --- a/src/runtime/rwindow.r +++ b/src/runtime/rwindow.r @@ -3,15 +3,15 @@ * non window-system-specific window support routines */ -unsigned long ConsoleFlags = 0; /* Console flags */ +unsigned long ConsoleFlags = 0; /* Console flags */ #ifdef Graphics -static int colorphrase (char *buf, long *r, long *g, long *b, long *a); -static double rgbval (double n1, double n2, double hue); +static int colorphrase (char *buf, long *r, long *g, long *b, long *a); +static double rgbval (double n1, double n2, double hue); -static int setpos (wbp w, char *s); -static int sicmp (siptr sip1, siptr sip2); +static int setpos (wbp w, char *s); +static int sicmp (siptr sip1, siptr sip2); /* * Global variables. @@ -22,7 +22,7 @@ static int sicmp (siptr sip1, siptr sip2); #ifndef Concurrent int pollctr; -#endif /* Concurrent */ +#endif /* Concurrent */ FILE *ConsoleBinding = NULL; /* @@ -41,7 +41,7 @@ wfont *start_font, *end_font, *curr_font; extern wclrp scp; extern HPALETTE palette; extern int numColors; -#endif /* MSWindows */ +#endif /* MSWindows */ #ifndef MultiProgram struct descrip amperX = {D_Integer}; @@ -53,9 +53,9 @@ struct descrip amperPick = {D_Null}; struct descrip lastEventWin = {D_Null}; int lastEvFWidth = 0, lastEvLeading = 0, lastEvAscent = 0; uword xmod_control, xmod_shift, xmod_meta; -#endif /* MultiProgram */ +#endif /* MultiProgram */ + - /* * subscript the already-processed-events "queue" to index i. * used in "cooked mode" I/O to determine, e.g. how far to backspace. @@ -77,7 +77,7 @@ int i; return NULL; } } - + /* * get event from window, assigning to &x, &y, and &interval @@ -95,41 +95,41 @@ int t; uword i; int retval; - if (wstates != NULL && wstates->next != NULL /* if multiple windows*/ - && (BlkD(w->window->listp,List)->size == 0)) { /* & queue is empty */ + if (wstates != NULL && wstates->next != NULL /* if multiple windows*/ + && (BlkD(w->window->listp,List)->size == 0)) { /* & queue is empty */ while (BlkD(w->window->listp,List)->size == 0) { #ifdef XWindows extern void postcursor(wbp); extern void scrubcursor(wbp); if (ISCLOSED(w)) { - return -1; - } - if (ISCURSORON(w)) { - postcursor(w); - } -#endif /* XWindows */ + return -1; + } + if (ISCURSORON(w)) { + postcursor(w); + } +#endif /* XWindows */ #ifdef MSWindows - if (ISCURSORON(w) && w->window->hasCaret == 0) { - wsp ws = w->window; - CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w)); - SetCaretBlinkTime(500); - SetCaretPos(ws->x, ws->y - ASCENT(w)); - ShowCaret(ws->iconwin); - ws->hasCaret = 1; - } -#endif /* MSWindows */ - if (pollevent() < 0) /* poll all windows */ - break; /* break on error */ + if (ISCURSORON(w) && w->window->hasCaret == 0) { + wsp ws = w->window; + CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w)); + SetCaretBlinkTime(500); + SetCaretPos(ws->x, ws->y - ASCENT(w)); + ShowCaret(ws->iconwin); + ws->hasCaret = 1; + } +#endif /* MSWindows */ + if (pollevent() < 0) /* poll all windows */ + break; /* break on error */ #if UNIX || VMS idelay(XICONSLEEP); -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ #ifdef MSWindows - Sleep(20); -#endif /* MSWindows */ - } + Sleep(20); +#endif /* MSWindows */ + } #ifdef XWindows if (ISCURSORON(w)) - scrubcursor(w); + scrubcursor(w); #endif } @@ -137,15 +137,15 @@ int t; if (w->window->is_gl) retval = gl_wgetq(w,res,t); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ retval = wgetq(w,res,t); if (retval == -1) - return -1; /* window died */ + return -1; /* window died */ if (retval == -2) - return -3; /* timeout expired */ + return -3; /* timeout expired */ if (BlkD(w->window->listp,List)->size < 2) - return -2; /* malformed queue */ + return -2; /* malformed queue */ #ifdef GraphicsGL if (w->window->is_gl) { @@ -153,7 +153,7 @@ int t; gl_wgetq(w,&ydesc,-1); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { wgetq(w,&xdesc,-1); wgetq(w,&ydesc,-1); @@ -168,7 +168,7 @@ int t; if (w->window->is_gl) gl_wgetq( w, &erPick, -1); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wgetq( w, &erPick, -1); } else @@ -176,17 +176,17 @@ int t; } else amperPick = nulldesc; -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (xdesc.dword != D_Integer || ydesc.dword != D_Integer) { - return -2; /* bad values on queue */ + return -2; /* bad values on queue */ } - IntVal(amperX) = IntVal(xdesc) & 0xFFFF; /* &x */ + IntVal(amperX) = IntVal(xdesc) & 0xFFFF; /* &x */ if (IntVal(amperX) >= 0x8000) IntVal(amperX) -= 0x10000; - IntVal(amperY) = IntVal(ydesc) & 0xFFFF; /* &y */ + IntVal(amperY) = IntVal(ydesc) & 0xFFFF; /* &y */ if (IntVal(amperY) >= 0x8000) IntVal(amperY) -= 0x10000; IntVal(amperX) -= w->context->dx; @@ -194,26 +194,26 @@ int t; #ifdef GraphicsGL if (w->window->is_gl) { - MakeInt(1 + GL_XTOCOL(w,IntVal(amperX)), &(amperCol)); /* &col */ - MakeInt(GL_YTOROW(w,IntVal(amperY)) , &(amperRow)); /* &row */ + MakeInt(1 + GL_XTOCOL(w,IntVal(amperX)), &(amperCol)); /* &col */ + MakeInt(GL_YTOROW(w,IntVal(amperY)) , &(amperRow)); /* &row */ } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { - MakeInt(1 + XTOCOL(w,IntVal(amperX)), &(amperCol)); /* &col */ - MakeInt(YTOROW(w,IntVal(amperY)) , &(amperRow)); /* &row */ + MakeInt(1 + XTOCOL(w,IntVal(amperX)), &(amperCol)); /* &col */ + MakeInt(YTOROW(w,IntVal(amperY)) , &(amperRow)); /* &row */ } - xmod_control = IntVal(xdesc) & EQ_MOD_CONTROL; /* &control */ - xmod_meta = IntVal(xdesc) & EQ_MOD_META; /* &meta */ - xmod_shift = IntVal(xdesc) & EQ_MOD_SHIFT; /* &shift */ + xmod_control = IntVal(xdesc) & EQ_MOD_CONTROL; /* &control */ + xmod_meta = IntVal(xdesc) & EQ_MOD_META; /* &meta */ + xmod_shift = IntVal(xdesc) & EQ_MOD_SHIFT; /* &shift */ - i = (((uword) IntVal(ydesc)) >> 16) & 0xFFF; /* mantissa */ - i <<= 4 * ((((uword) IntVal(ydesc)) >> 28) & 0x7); /* scale it */ - IntVal(amperInterval) = i; /* &interval */ + i = (((uword) IntVal(ydesc)) >> 16) & 0xFFF; /* mantissa */ + i <<= 4 * ((((uword) IntVal(ydesc)) >> 28) & 0x7); /* scale it */ + IntVal(amperInterval) = i; /* &interval */ return 0; } - + /* * get event from window (drop mouse events), no echo * @@ -228,13 +228,13 @@ dptr res; while (1) { i = wgetevent(w,res,-1); if (i != 0) - return i; + return i; if (is:string(*res)) { #ifdef MSWindows if (*StrLoc(*res) == '\032') return -3; /* control-Z gives EOF */ -#endif /* MSWindows */ +#endif /* MSWindows */ return 1; - } + } } } @@ -259,14 +259,14 @@ dptr res; if (i == '\r') gl_wputc((int)'\n', w); /* CR -> CR/LF */ } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { wputc(i, w); if (i == '\r') wputc((int)'\n', w); /* CR -> CR/LF */ }} return 1; } - + /* * Get a window that has an event pending (queued) */ @@ -300,25 +300,25 @@ wsp getactivewindow() switch (pollevent()) { case -1: ReturnErrNum(141, NULL); case 0: return NULL; - } + } /* * go through windows, looking for one with an event pending */ for (ws = ptr, i = 0, j = next + 1; i < nwindows; - (ws = (ws->next) ? ws->next : wstates), i++, j++) - if (ws != stdws && BlkD(ws->listp,List)->size > 0) { - next = j; - return ws; - } + (ws = (ws->next) ? ws->next : wstates), i++, j++) + if (ws != stdws && BlkD(ws->listp,List)->size > 0) { + next = j; + return ws; + } #if UNIX || VMS /* * couldn't find a pending event - wait awhile */ idelay(XICONSLEEP); -#endif /* UNIX || VMS */ +#endif /* UNIX || VMS */ } } - + /* * wlongread(s,elsize,nelem,f) -- read string from window for reads(w) * @@ -338,9 +338,9 @@ FILE *f; while (l < bytes) { c = wgetche((wbp)f, &foo); if (c == -3 && l > 0) - return l; + return l; if (c < 0) - return c; + return c; c = *StrLoc(foo); switch(c) { case '\177': @@ -374,9 +374,9 @@ FILE *f; while (l < maxlen) { c = wgetche((wbp)f,&foo); if (c == -3 && l > 0) - return l; + return l; if (c < 0) - return c; + return c; c = *StrLoc(foo); switch(c) { case '\177': @@ -407,14 +407,14 @@ dptr dx; ((BlkD(lastEventWin,File)->status & Fs_Window) == 0) || ((BlkD(lastEventWin,File)->status & (Fs_Read|Fs_Write)) == 0)) { MakeInt(1 + IntVal(amperX)/lastEvFWidth, &erCol); - } + } else { w = BlkD(lastEventWin,File)->fd.wb; #ifdef GraphicsGL if (w->window->is_gl) MakeInt(1 + GL_XTOCOL(w, IntVal(amperX)), &erCol); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ MakeInt(1 + XTOCOL(w, IntVal(amperX)), &erCol); } } @@ -431,7 +431,7 @@ dptr dx; if (w->window->is_gl) MakeInt(GL_YTOROW(w, IntVal(amperY)), &erRow); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ MakeInt(YTOROW(w, IntVal(amperY)), &erRow); } } @@ -448,7 +448,7 @@ dptr dx; if (w->window->is_gl) MakeInt(GL_COLTOX(w, IntVal(amperCol)), &erX); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ MakeInt(COLTOX(w, IntVal(amperCol)), &erX); } } @@ -465,7 +465,7 @@ dptr dx; if (w->window->is_gl) MakeInt(GL_ROWTOY(w, IntVal(amperRow)), &erY); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ MakeInt(ROWTOY(w, IntVal(amperRow)), &erY); } } @@ -486,7 +486,7 @@ void linkfiletowindow(wbp w, struct b_file *fl) lastEvAscent = GL_ASCENT(w); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { lastEvFWidth = FWIDTH(w); lastEvLeading = LEADING(w); @@ -500,38 +500,38 @@ void linkfiletowindow(wbp w, struct b_file *fl) * Enqueue an event, encoding time interval and key state with x and y values. */ void qevent(ws,e,x,y,t,f) -wsp ws; /* canvas */ -dptr e; /* event code (descriptor pointer) */ -int x, y; /* x and y values */ -uword t; /* ms clock value */ -long f; /* modifier key flags */ +wsp ws; /* canvas */ +dptr e; /* event code (descriptor pointer) */ +int x, y; /* x and y values */ +uword t; /* ms clock value */ +long f; /* modifier key flags */ { - dptr q = &(ws->listp); /* a window's event queue (Icon list value) */ + dptr q = &(ws->listp); /* a window's event queue (Icon list value) */ struct descrip d; uword ivl, mod; int expo; - mod = 0; /* set modifier key bits */ + mod = 0; /* set modifier key bits */ if (f & ControlMask) mod |= EQ_MOD_CONTROL; if (f & Mod1Mask) mod |= EQ_MOD_META; if (f & ShiftMask) mod |= EQ_MOD_SHIFT; - if (t != ~(uword)0) { /* if clock value supplied */ - if (ws->timestamp == 0) /* if first time */ - ws->timestamp = t; - if (t < ws->timestamp) /* if clock went backwards */ - t = ws->timestamp; - ivl = t - ws->timestamp; /* calc interval in milliseconds */ - ws->timestamp = t; /* save new clock value */ + if (t != ~(uword)0) { /* if clock value supplied */ + if (ws->timestamp == 0) /* if first time */ + ws->timestamp = t; + if (t < ws->timestamp) /* if clock went backwards */ + t = ws->timestamp; + ivl = t - ws->timestamp; /* calc interval in milliseconds */ + ws->timestamp = t; /* save new clock value */ expo = 0; - while (ivl >= 0x1000) { /* if too big */ - ivl >>= 4; /* reduce significance */ - expo += 0x1000; /* bump exponent */ - } - ivl += expo; /* combine exponent with mantissa */ + while (ivl >= 0x1000) { /* if too big */ + ivl >>= 4; /* reduce significance */ + expo += 0x1000; /* bump exponent */ + } + ivl += expo; /* combine exponent with mantissa */ } else - ivl = 0; /* report 0 if interval unknown */ + ivl = 0; /* report 0 if interval unknown */ c_put(q, e); d.dword = D_Integer; @@ -581,11 +581,11 @@ char *s; } w->window->real_posx = posx; w->window->real_posy = posy; -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) return gl_setgeometry(w,tmp); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ return setgeometry(w,tmp); } @@ -623,7 +623,7 @@ char *s; if (w->window->is_gl) return gl_setgeometry(w,tmp); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ return setgeometry(w,tmp); } @@ -637,7 +637,7 @@ int setrgbmode(wbp w, char *s) else if (!strcmp(s, "24")) { w->context->rgbmode = 1; return Succeeded; } else if (!strcmp(s, "auto")) { w->context->rgbmode = 0; return Succeeded; } else if (!strcmp(s, "normalized") || !strcmp(s, "normal") || - !strcmp(s, "norm")) { w->context->rgbmode = 3; return Succeeded; } + !strcmp(s, "norm")) { w->context->rgbmode = 3; return Succeeded; } return Failed; } @@ -683,39 +683,39 @@ int len; char *catenation; int i, j=0; for(i=0; ichild, &result); while (StrLen(result) + len + j + 1 > 32700) { - while((StrLen(result) > 0) && (StrLoc(result)[0] != '\n')) { - StrLoc(result) ++; - StrLen(result) --; - } - if (StrLen(result) > 0) { - StrLoc(result)++; StrLen(result)--; - } - } - - reserve(Strings, StrLen(result) + len + j + 1); - catenation = alcstr(StrLoc(result), StrLen(result)); + while((StrLen(result) > 0) && (StrLoc(result)[0] != '\n')) { + StrLoc(result) ++; + StrLen(result) --; + } + if (StrLen(result) > 0) { + StrLoc(result)++; StrLen(result)--; + } + } + + reserve(Strings, StrLen(result) + len + j + 1); + catenation = alcstr(StrLoc(result), StrLen(result)); alcstr(s, len+j); - { int i, k=0; - for(i=0; ichild, catenation); + seteditregion(ws->child, catenation); movechild(ws->child, 0, 0, ws->width, ws->height); setfocusonchild(ws, ws->child, ws->width, ws->height); - setchildselection(ws, ws->child, StrLen(result), StrLen(result)+len); - return; - } + setchildselection(ws, ws->child, StrLen(result), StrLen(result)+len); + return; + } #define fprintf Consolefprintf -#endif /* ScrollingConsoleWin */ +#endif /* ScrollingConsoleWin */ while (len > 0) { /* @@ -723,19 +723,19 @@ int len; */ #ifdef MSWindows while (len > 0) { - if (IsDBCSLeadByte(*s2)) { - s2++; s2++; len--; len--; - } - else if (isprint(*s2)) { - s2++; len--; - } - else break; - } -#else /* MSWindows */ + if (IsDBCSLeadByte(*s2)) { + s2++; s2++; len--; len--; + } + else if (isprint(*s2)) { + s2++; len--; + } + else break; + } +#else /* MSWindows */ while (isprint(*s2) && len > 0) { - s2++; len--; - } -#endif /* MSWindows */ + s2++; len--; + } +#endif /* MSWindows */ /* * if a chunk was parsed, write it out */ @@ -744,7 +744,7 @@ int len; if (w->window->is_gl) gl_xdis(w, s, s2 - s); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ xdis(w, s, s2 - s); } /* @@ -755,7 +755,7 @@ int len; if (w->window->is_gl) gl_wputc(*s2++, w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wputc(*s2++, w); } s = s2; @@ -772,20 +772,20 @@ int len; * Tables must be kept lexically sorted. */ -typedef struct { /* color name entry */ - char name[8]; /* basic color name */ - char ish[12]; /* -ish form */ - short hue; /* hue, in degrees */ - char lgt; /* lightness, as percentage */ - char sat; /* saturation, as percentage */ +typedef struct { /* color name entry */ + char name[8]; /* basic color name */ + char ish[12]; /* -ish form */ + short hue; /* hue, in degrees */ + char lgt; /* lightness, as percentage */ + char sat; /* saturation, as percentage */ } colrname; -typedef struct { /* arbitrary lookup entry */ - char word[15]; /* word */ - char val; /* value, as percentage */ +typedef struct { /* arbitrary lookup entry */ + char word[15]; /* word */ + char val; /* value, as percentage */ } colrmod; -static colrname colortable[] = { /* known colors */ +static colrname colortable[] = { /* known colors */ /* color ish-form hue lgt sat */ { "black", "blackish", 0, 0, 0 }, { "blue", "bluish", 240, 50, 100 }, @@ -804,23 +804,23 @@ static colrname colortable[] = { /* known colors */ { "yellow", "yellowish", 60, 50, 100 }, }; -static colrmod lighttable[] = { /* lightness modifiers */ +static colrmod lighttable[] = { /* lightness modifiers */ { "dark", 0 }, - { "deep", 0 }, /* = very dark (see code) */ + { "deep", 0 }, /* = very dark (see code) */ { "light", 100 }, { "medium", 50 }, - { "pale", 100 }, /* = very light (see code) */ + { "pale", 100 }, /* = very light (see code) */ }; -static colrmod sattable[] = { /* saturation levels */ +static colrmod sattable[] = { /* saturation levels */ { "moderate", 50 }, { "strong", 75 }, { "vivid", 100 }, { "weak", 25 }, }; -static colrmod transptable[] = { /* transparency levels */ - { "dull", 75 }, /* alias for subtranslucent */ +static colrmod transptable[] = { /* transparency levels */ + { "dull", 75 }, /* alias for subtranslucent */ { "opaque", 100 }, { "subtranslucent", 75 }, { "subtransparent", 25 }, @@ -857,8 +857,8 @@ static char *texturetable[] = { }; static int texturephrase(char *buf, long *r, long *g, long *b, long *a); -#endif /* Graphics3D */ - +#endif /* Graphics3D */ + /* * parsecolor(w, s, &r, &g, &b, &a) - parse a color specification * @@ -867,14 +867,14 @@ static int texturephrase(char *buf, long *r, long *g, long *b, long *a); * * An Icon color specification can be any of the forms * - * #rgb (hexadecimal digits) + * #rgb (hexadecimal digits) * #rgba * #rrggbb * #rrggbbaa - * #rrrgggbbb (note: no 3 digit rrrgggbbbaaa) + * #rrrgggbbb (note: no 3 digit rrrgggbbbaaa) * #rrrrggggbbbb * #rrrrggggbbbbaaaa - * nnnnn,nnnnn,nnnnn (numbers, interpret by rgbmode) + * nnnnn,nnnnn,nnnnn (numbers, interpret by rgbmode) * * * @@ -893,9 +893,9 @@ long *r, *g, *b, *a; *r = *g = *b = 0L; #ifdef GraphicsGL *a = (long) (w->context->alpha*65535.0); -#else /* GraphicsGL */ +#else /* GraphicsGL */ *a = 65535; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ /* trim leading spaces */ while (isspace(*buf)) @@ -907,7 +907,7 @@ long *r, *g, *b, *a; *a = da; goto RGBnums; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* try interpreting as three comma-separated numbers */ if (sscanf(buf, "%lf,%lf,%lf%c", &dr, &dg, &db, &c) == 3) { @@ -917,35 +917,35 @@ RGBnums: *b = db; if (w && w->context && w->context->rgbmode == 0) { /* auto */ - /* see if we need to revert it to 48-bit mode. */ - if (dr>=256 || dg>=256 || db>=256) { - w->context->rgbmode = 2; - } - } + /* see if we need to revert it to 48-bit mode. */ + if (dr>=256 || dg>=256 || db>=256) { + w->context->rgbmode = 2; + } + } if (w && w->context) switch (w->context->rgbmode) { - case 0: /* nonreverted auto treated as 24-bit color */ + case 0: /* nonreverted auto treated as 24-bit color */ #ifdef Graphics3D - /* unless you are in 3D using normalized */ - if (w->context->rendermode == UGL3D && dr>=0 && dr<=1.0 && - dg>=0 && dg<=1.0 && db>=0 && db<=1.0) - goto normalized; -#endif /* Graphics3D */ - case 1: /* convert app 24-bit color to 48-bits */ - *r *= 257; - *g *= 257; - *b *= 257; - break; - case 2: /* no-op, 48 bit color is internal default */ - break; + /* unless you are in 3D using normalized */ + if (w->context->rendermode == UGL3D && dr>=0 && dr<=1.0 && + dg>=0 && dg<=1.0 && db>=0 && db<=1.0) + goto normalized; +#endif /* Graphics3D */ + case 1: /* convert app 24-bit color to 48-bits */ + *r *= 257; + *g *= 257; + *b *= 257; + break; + case 2: /* no-op, 48 bit color is internal default */ + break; case 3: normalized: - *r = dr * 65535; - *g = dg * 65535; - *b = db * 65535; - *a = da * 65535; - } + *r = dr * 65535; + *g = dg * 65535; + *b = db * 65535; + *a = da * 65535; + } if (*r>=0 && *r<=65535 && *g>=0 && *g<=65535 && *b>=0 && *b<=65535) @@ -971,7 +971,7 @@ normalized: if ((len == 4) || (len == 8) || (len == 16)) { if (sscanf(buf, fmt, r, g, b, a, &c) != 4) return Failed; - *a *= mul; + *a *= mul; } else if (sscanf(buf, fmt, r, g, b, &c) != 3) return Failed; @@ -986,7 +986,7 @@ normalized: return Failed; /* not handling textures yet */ } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* try interpreting as a color phrase or as a native color spec */ #ifdef GraphicsGL @@ -997,13 +997,13 @@ normalized: return Failed; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (colorphrase(buf, r, g, b, a) || nativecolor(w, buf, r, g, b)) return Succeeded; else return Failed; } - + #ifdef Graphics3D int mystrcmp(char *s1, char *s2) { @@ -1032,20 +1032,20 @@ long *r, *g, *b, *a; * if it is a texture. */ p2 = qsearch(p, (char *)texturetable, - ElemCount(texturetable), ElemSize(texturetable), mystrcmp); + ElemCount(texturetable), ElemSize(texturetable), mystrcmp); if (p2) { texture = ((char **)p2 - texturetable) + 1; if (p != buf2) { - p--; - *p = '\0'; - if (colorphrase(buf2, r, g, b, a)) return texture; - else return 0; - } + p--; + *p = '\0'; + if (colorphrase(buf2, r, g, b, a)) return texture; + else return 0; + } else return -texture; } return 0; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* * colorphrase(s, &r, &g, &b, &a) -- parse Icon color phrase. @@ -1073,9 +1073,9 @@ long *r, *g, *b, *a; * "pale" means "very light"; "deep" means "very dark". * * This naming scheme is based loosely on - * A New Color-Naming System for Graphics Languages - * Toby Berk, Lee Brownston, and Arie Kaufman - * IEEE Computer Graphics & Applications, May 1982 + * A New Color-Naming System for Graphics Languages + * Toby Berk, Lee Brownston, and Arie Kaufman + * IEEE Computer Graphics & Applications, May 1982 */ static int colorphrase(buf, r, g, b, a) @@ -1087,15 +1087,15 @@ long *r, *g, *b, *a; float lgt, sat, blend, bl2, m1, m2, alpha, tmpf; float h1, l1, s1, h2, l2, s2, r2, g2, b2; - alpha = (float)(*a/65535.0); /* default transparency */ - lgt = -1.0; /* default no lightness mod */ - sat = 1.0; /* default vivid saturation */ + alpha = (float)(*a/65535.0); /* default transparency */ + lgt = -1.0; /* default no lightness mod */ + sat = 1.0; /* default vivid saturation */ len = strlen(buf); while (isspace(buf[len-1])) - len--; /* trim trailing spaces */ + len--; /* trim trailing spaces */ if (len >= sizeof(cbuffer)) - return 0; /* if too long for valid Icon spec */ + return 0; /* if too long for valid Icon spec */ /* * copy spec, lowering case and replacing spaces and hyphens with NULs @@ -1148,9 +1148,9 @@ long *r, *g, *b, *a; if (p) { /* set the "very" flag for "pale" or "deep" */ if (strcmp(buf, "pale") == 0) - very = 1; /* pale = very light */ + very = 1; /* pale = very light */ else if (strcmp(buf, "deep") == 0) - very = 1; /* deep = very dark */ + very = 1; /* deep = very dark */ /* skip past word */ buf += strlen(buf) + 1; if (buf >= ebuf) @@ -1173,7 +1173,7 @@ long *r, *g, *b, *a; } if (buf + strlen(buf) >= ebuf) - blend = h1 = l1 = s1 = 0.0; /* only one word left */ + blend = h1 = l1 = s1 = 0.0; /* only one word left */ else { /* we have two (or more) name words; get the first */ if ((p = qsearch(buf, colortable[0].name, @@ -1280,82 +1280,82 @@ double n1, n2, hue; else return n1; } - + /* * Functions and data for reading and writing GIF and JPEG images */ -#define GifSeparator 0x2C /* (',') beginning of image */ -#define GifTerminator 0x3B /* (';') end of image */ -#define GifExtension 0x21 /* ('!') extension block */ -#define GifControlExt 0xF9 /* graphic control extension label */ -#define GifEmpty -1 /* internal flag indicating no prefix */ +#define GifSeparator 0x2C /* (',') beginning of image */ +#define GifTerminator 0x3B /* (';') end of image */ +#define GifExtension 0x21 /* ('!') extension block */ +#define GifControlExt 0xF9 /* graphic control extension label */ +#define GifEmpty -1 /* internal flag indicating no prefix */ -#define GifTableSize 4096 /* maximum number of entries in table */ -#define GifBlockSize 255 /* size of output block */ +#define GifTableSize 4096 /* maximum number of entries in table */ +#define GifBlockSize 255 /* size of output block */ -typedef struct lzwnode { /* structure of LZW encoding tree node */ - unsigned short tcode; /* token code */ - unsigned short child; /* first child node */ - unsigned short sibling; /* next sibling */ +typedef struct lzwnode { /* structure of LZW encoding tree node */ + unsigned short tcode; /* token code */ + unsigned short child; /* first child node */ + unsigned short sibling; /* next sibling */ } lzwnode; #if HAVE_LIBJPEG struct my_error_mgr { /* a part of JPEG error handling */ - struct jpeg_error_mgr pub; /* "public" fields */ - jmp_buf setjmp_buffer; /* for return to caller */ + struct jpeg_error_mgr pub; /* "public" fields */ + jmp_buf setjmp_buffer; /* for return to caller */ }; typedef struct my_error_mgr * my_error_ptr; /* a part of error handling */ -#endif /* HAVE_LIBJPEG */ - -static int gfread (char *fn, int p); -static int gfheader (FILE *f); -static int gfskip (FILE *f); -static void gfcontrol (FILE *f); -static int gfimhdr (FILE *f); -static int gfmap (FILE *f, int p); -static int gfsetup (void); -static int gfrdata (FILE *f); -static int gfrcode (FILE *f); -static void gfinsert (int prev, int c); -static int gffirst (int c); -static void gfgen (int c); -static void gfput (int b); - -static int gfwrite (wbp w, char *filename, - int x, int y, int width, int height); -static int bmpwrite (wbp w, char *filename, - int x, int y, int width, int height); -static void gfpack (unsigned char *data, long len, - struct palentry *paltbl); -static void gfmktree (lzwnode *tree); -static void gfout (int tcode); -static void gfdump (void); - -static FILE *gf_f; /* input file */ - -static int gf_gcmap, gf_lcmap; /* global color map? local color map? */ -static int gf_nbits; /* number of bits per pixel */ -static int gf_ilace; /* interlace flag */ -static int gf_width, gf_height; /* image size */ - -static short *gf_prefix, *gf_suffix; /* prefix and suffix tables */ -static int gf_free; /* next free position */ - -static struct palentry *gf_paltbl; /* palette table */ -static unsigned char *gf_string; /* image string */ -static unsigned char *gf_nxt, *gf_lim; /* store pointer and its limit */ -static int gf_row, gf_step; /* current row and step size */ - -static int gf_cdsize; /* code size */ -static int gf_clear, gf_eoi; /* values of CLEAR and EOI codes */ -static int gf_lzwbits, gf_lzwmask; /* current bits per code */ - -static unsigned char *gf_obuf; /* output buffer */ -static unsigned long gf_curr; /* current partial byte(s) */ -static int gf_valid; /* number of valid bits */ -static int gf_rem; /* remaining bytes in this block */ +#endif /* HAVE_LIBJPEG */ + +static int gfread (char *fn, int p); +static int gfheader (FILE *f); +static int gfskip (FILE *f); +static void gfcontrol (FILE *f); +static int gfimhdr (FILE *f); +static int gfmap (FILE *f, int p); +static int gfsetup (void); +static int gfrdata (FILE *f); +static int gfrcode (FILE *f); +static void gfinsert (int prev, int c); +static int gffirst (int c); +static void gfgen (int c); +static void gfput (int b); + +static int gfwrite (wbp w, char *filename, + int x, int y, int width, int height); +static int bmpwrite (wbp w, char *filename, + int x, int y, int width, int height); +static void gfpack (unsigned char *data, long len, + struct palentry *paltbl); +static void gfmktree (lzwnode *tree); +static void gfout (int tcode); +static void gfdump (void); + +static FILE *gf_f; /* input file */ + +static int gf_gcmap, gf_lcmap; /* global color map? local color map? */ +static int gf_nbits; /* number of bits per pixel */ +static int gf_ilace; /* interlace flag */ +static int gf_width, gf_height; /* image size */ + +static short *gf_prefix, *gf_suffix; /* prefix and suffix tables */ +static int gf_free; /* next free position */ + +static struct palentry *gf_paltbl; /* palette table */ +static unsigned char *gf_string; /* image string */ +static unsigned char *gf_nxt, *gf_lim; /* store pointer and its limit */ +static int gf_row, gf_step; /* current row and step size */ + +static int gf_cdsize; /* code size */ +static int gf_clear, gf_eoi; /* values of CLEAR and EOI codes */ +static int gf_lzwbits, gf_lzwmask; /* current bits per code */ + +static unsigned char *gf_obuf; /* output buffer */ +static unsigned long gf_curr; /* current partial byte(s) */ +static int gf_valid; /* number of valid bits */ +static int gf_rem; /* remaining bytes in this block */ /* * Construct Icon-style paltbl from BMP-style colortable @@ -1392,7 +1392,7 @@ unsigned char * bmp_data(int width, int height, int bpp, char * rasterdata, int for(i=0;iwidth = width; imd->height = height; @@ -1471,11 +1471,11 @@ int readBMP(char *filename, int p, struct imgdata *imd) imd->paltbl = NULL; imd->data = bmp_data(width, height, 3, rasterdata, imd->is_bottom_up); #if NT - if (imd->format == UCOLOR_RGB && bitcount == 24 ){ - unsigned char *byte, t; - for (byte=imd->data; bytedata+width*height*3; byte+=3) - {t = byte[0]; byte[0] = byte[2]; byte[2] = t;} - } + if (imd->format == UCOLOR_RGB && bitcount == 24 ){ + unsigned char *byte, t; + for (byte=imd->data; bytedata+width*height*3; byte+=3) + {t = byte[0]; byte[0] = byte[2]; byte[2] = t;} + } #endif } return Succeeded; @@ -1493,7 +1493,7 @@ int readGIF(char *filename, int p, struct imgdata *imd) { int r; - r = gfread(filename, p); /* read image */ + r = gfread(filename, p); /* read image */ if (gf_prefix) { free((pointer)gf_prefix); @@ -1508,24 +1508,24 @@ int readGIF(char *filename, int p, struct imgdata *imd) gf_f = NULL; } - if (r != Succeeded) { /* if no success, free mem */ + if (r != Succeeded) { /* if no success, free mem */ if (gf_paltbl) { - free((pointer) gf_paltbl); - gf_paltbl = NULL; - } + free((pointer) gf_paltbl); + gf_paltbl = NULL; + } if (gf_string) { - free((pointer) gf_string); - gf_string = NULL; - } - return r; /* return Failed or RunError */ + free((pointer) gf_string); + gf_string = NULL; + } + return r; /* return Failed or RunError */ } - imd->width = gf_width; /* set return variables */ + imd->width = gf_width; /* set return variables */ imd->height = gf_height; imd->paltbl = gf_paltbl; imd->data = gf_string; - return Succeeded; /* return success */ + return Succeeded; /* return success */ } /* @@ -1546,32 +1546,32 @@ int p; return Failed; #ifdef MSWindows - if ((gf_f = fopen(filename, "rb")) == NULL) -#else /* MSWindows */ - if ((gf_f = fopen(filename, "r")) == NULL) -#endif /* MSWindows */ + if ((gf_f = fopen(filename, "rb")) == NULL) +#else /* MSWindows */ + if ((gf_f = fopen(filename, "r")) == NULL) +#endif /* MSWindows */ return Failed; - for (i = 0; i < 256; i++) /* init palette table */ + for (i = 0; i < 256; i++) /* init palette table */ gf_paltbl[i].used = gf_paltbl[i].valid = gf_paltbl[i].transpt = 0; - if (!gfheader(gf_f)) /* read file header */ + if (!gfheader(gf_f)) /* read file header */ return Failed; - if (gf_gcmap) /* read global color map, if any */ + if (gf_gcmap) /* read global color map, if any */ if (!gfmap(gf_f, p)) return Failed; - if (!gfskip(gf_f)) /* skip to start of image */ + if (!gfskip(gf_f)) /* skip to start of image */ return Failed; - if (!gfimhdr(gf_f)) /* read image header */ + if (!gfimhdr(gf_f)) /* read image header */ return Failed; - if (gf_lcmap) /* read local color map, if any */ + if (gf_lcmap) /* read local color map, if any */ if (!gfmap(gf_f, p)) return Failed; - if (!gfsetup()) /* prepare to read image */ + if (!gfsetup()) /* prepare to read image */ return RunError; - if (!gfrdata(gf_f)) /* read image data */ + if (!gfrdata(gf_f)) /* read image data */ return Failed; - while (gf_row < gf_height) /* pad if too short */ + while (gf_row < gf_height) /* pad if too short */ gfput(0); return Succeeded; @@ -1583,18 +1583,18 @@ int p; static int gfheader(f) FILE *f; { - unsigned char hdr[13]; /* size of a GIF header */ + unsigned char hdr[13]; /* size of a GIF header */ int b; if (fread((char *)hdr, sizeof(char), sizeof(hdr), f) != sizeof(hdr)) - return 0; /* header short or missing */ + return 0; /* header short or missing */ if (strncmp((char *)hdr, "GIF", 3) != 0 || !isdigit(hdr[3]) || !isdigit(hdr[4])) - return 0; /* not GIFnn */ + return 0; /* not GIFnn */ - b = hdr[10]; /* flag byte */ - gf_gcmap = b & 0x80; /* global color map flag */ - gf_nbits = (b & 7) + 1; /* number of bits per pixel */ + b = hdr[10]; /* flag byte */ + gf_gcmap = b & 0x80; /* global color map flag */ + gf_nbits = (b & 7) + 1; /* number of bits per pixel */ return 1; } @@ -1609,15 +1609,15 @@ FILE *f; while ((c = getc(f)) != GifSeparator) { /* look for start-of-image flag */ if (c == EOF) return 0; - if (c == GifExtension) { /* if extension block is present */ - c = getc(f); /* get label */ - if ((c & 0xFF) == GifControlExt) - gfcontrol(f); /* process control subblock */ - while ((n = getc(f)) != 0) { /* read blks until empty one */ + if (c == GifExtension) { /* if extension block is present */ + c = getc(f); /* get label */ + if ((c & 0xFF) == GifControlExt) + gfcontrol(f); /* process control subblock */ + while ((n = getc(f)) != 0) { /* read blks until empty one */ if (n == EOF) return 0; - n &= 0xFF; /* ensure positive count */ - while (n--) /* skip block contents */ + n &= 0xFF; /* ensure positive count */ + while (n--) /* skip block contents */ getc(f); } } @@ -1633,15 +1633,15 @@ FILE *f; { int i, n, c, t; - n = getc(f) & 0xFF; /* subblock length (s/b 4) */ + n = getc(f) & 0xFF; /* subblock length (s/b 4) */ for (i = t = 0; i < n; i++) { c = getc(f) & 0xFF; if (i == 0) - t = c & 1; /* transparency flag */ + t = c & 1; /* transparency flag */ else if (i == 3 && t != 0) { - gf_paltbl[c].transpt = 1; /* set flag for transpt color */ - gf_paltbl[c].valid = 0; /* color is no longer "valid" */ - } + gf_paltbl[c].transpt = 1; /* set flag for transpt color */ + gf_paltbl[c].valid = 0; /* color is no longer "valid" */ + } } } @@ -1651,18 +1651,18 @@ FILE *f; static int gfimhdr(f) FILE *f; { - unsigned char hdr[9]; /* size of image hdr excl separator */ + unsigned char hdr[9]; /* size of image hdr excl separator */ int b; if (fread((char *)hdr, sizeof(char), sizeof(hdr), f) != sizeof(hdr)) - return 0; /* header short or missing */ + return 0; /* header short or missing */ gf_width = hdr[4] + 256 * hdr[5]; gf_height = hdr[6] + 256 * hdr[7]; - b = hdr[8]; /* flag byte */ - gf_lcmap = b & 0x80; /* local color map flag */ - gf_ilace = b & 0x40; /* interlace flag */ + b = hdr[8]; /* flag byte */ + gf_lcmap = b & 0x80; /* local color map flag */ + gf_ilace = b & 0x40; /* interlace flag */ if (gf_lcmap) - gf_nbits = (b & 7) + 1; /* if local map, reset nbits also */ + gf_nbits = (b & 7) + 1; /* if local map, reset nbits also */ return 1; } @@ -1692,12 +1692,12 @@ int p; gf_paltbl[i].clr = stdpal[c].clr; } else { - gf_paltbl[i].clr.red = 257 * r; /* 257 * 255 -> 65535 */ + gf_paltbl[i].clr.red = 257 * r; /* 257 * 255 -> 65535 */ gf_paltbl[i].clr.green = 257 * g; gf_paltbl[i].clr.blue = 257 * b; } - if (!gf_paltbl[i].transpt) /* if not transparent color */ - gf_paltbl[i].valid = 1; /* mark as valid/opaque */ + if (!gf_paltbl[i].transpt) /* if not transparent color */ + gf_paltbl[i].valid = 1; /* mark as valid/opaque */ } return 1; @@ -1722,16 +1722,16 @@ static int gfsetup() gf_suffix[i] = i; } - gf_row = 0; /* current row is 0 */ - gf_nxt = gf_string; /* set store pointer */ + gf_row = 0; /* current row is 0 */ + gf_nxt = gf_string; /* set store pointer */ - if (gf_ilace) { /* if interlaced */ - gf_step = 8; /* step rows by 8 */ - gf_lim = gf_string + gf_width; /* stop at end of one row */ + if (gf_ilace) { /* if interlaced */ + gf_step = 8; /* step rows by 8 */ + gf_lim = gf_string + gf_width; /* stop at end of one row */ } else { - gf_lim = gf_string + len; /* do whole image at once */ - gf_step = gf_height; /* step to end when full */ + gf_lim = gf_string + len; /* do whole image at once */ + gf_step = gf_height; /* step to end when full */ } return 1; @@ -1760,30 +1760,30 @@ FILE *f; prev = curr = gfrcode(f); while (curr != gf_eoi) { - if (curr == gf_clear) { /* if reset code */ + if (curr == gf_clear) { /* if reset code */ gf_lzwbits = gf_cdsize + 1; gf_lzwmask = (1 << gf_lzwbits) - 1; gf_free = gf_eoi + 1; prev = curr = gfrcode(f); gfgen(curr); } - else if (curr < gf_free) { /* if code is in table */ + else if (curr < gf_free) { /* if code is in table */ gfgen(curr); gfinsert(prev, gffirst(curr)); prev = curr; } - else if (curr == gf_free) { /* not yet in table */ + else if (curr == gf_free) { /* not yet in table */ c = gffirst(prev); gfgen(prev); gfput(c); gfinsert(prev, c); prev = curr; } - else { /* illegal code */ + else { /* illegal code */ if (gf_nxt == gf_lim) - return 1; /* assume just extra stuff after end */ + return 1; /* assume just extra stuff after end */ else - return 0; /* more badly confused */ + return 0; /* more badly confused */ } curr = gfrcode(f); } @@ -1822,7 +1822,7 @@ static void gfinsert(prev, c) int prev, c; { - if (gf_free >= GifTableSize) /* sanity check */ + if (gf_free >= GifTableSize) /* sanity check */ return; gf_prefix[gf_free] = prev; @@ -1845,7 +1845,7 @@ int c; int d; if (c >= gf_free) - return 0; /* not in table (error) */ + return 0; /* not in table (error) */ while ((d = gf_prefix[c]) != GifEmpty) c = d; return gf_suffix[c]; @@ -1870,40 +1870,40 @@ int c; static void gfput(b) int b; { - if (gf_nxt >= gf_lim) { /* if current row is full */ + if (gf_nxt >= gf_lim) { /* if current row is full */ gf_row += gf_step; while (gf_row >= gf_height && gf_ilace && gf_step > 2) { if (gf_step == 4) { gf_row = 1; gf_step = 2; } - else if ((gf_row % 8) != 0) { + else if ((gf_row % 8) != 0) { gf_row = 2; gf_step = 4; } else { gf_row = 4; - /* gf_step remains 8 */ - } - } + /* gf_step remains 8 */ + } + } if (gf_row >= gf_height) { - gf_step = 0; - return; /* too much data; ignore it */ - } + gf_step = 0; + return; /* too much data; ignore it */ + } gf_nxt = gf_string + ((word)gf_row * (word)gf_width); gf_lim = gf_nxt + gf_width; } - *gf_nxt++ = b; /* store byte */ - gf_paltbl[b].used = 1; /* mark color entry as used */ + *gf_nxt++ = b; /* store byte */ + gf_paltbl[b].used = 1; /* mark color entry as used */ } - + #if HAVE_LIBJPEG /* - * jpeg error handler + * jpeg error handler */ void my_error_exit (j_common_ptr cinfo) @@ -1924,14 +1924,14 @@ static int jpegread(char *filename, int p, struct imgdata *imd) unsigned char *row_ptr; int row_stride, row_stride_shift; int i; - static FILE *jpg_f = NULL; /* input file */ + static FILE *jpg_f = NULL; /* input file */ #ifdef MSWindows if ((jpg_f = fopen(filename, "rb")) == NULL) -#else /* MSWindows */ +#else /* MSWindows */ if ((jpg_f = fopen(filename, "r")) == NULL) -#endif /* MSWindows */ - return Failed; +#endif /* MSWindows */ + return Failed; cinfo.err = jpeg_std_error(&jerr.pub); jerr.pub.error_exit = my_error_exit; @@ -1939,7 +1939,7 @@ static int jpegread(char *filename, int p, struct imgdata *imd) if (setjmp(jerr.setjmp_buffer)) { jpeg_destroy_decompress(&cinfo); if (jpg_f != NULL) - fclose(jpg_f); + fclose(jpg_f); return Failed; } @@ -1956,10 +1956,10 @@ static int jpegread(char *filename, int p, struct imgdata *imd) } else { /* - * Check the requested image color format. Use BGR on windows + * Check the requested image color format. Use BGR on windows * if it is available (jpeg-turbo) by checking for JCS_EXTENSIONS macro */ - + cinfo.out_color_space = JCS_RGB; cinfo.quantize_colors = FALSE; @@ -1978,25 +1978,25 @@ static int jpegread(char *filename, int p, struct imgdata *imd) if (p == 1) { if (!(imd->paltbl=(struct palentry *)malloc(256 * sizeof(struct palentry)))) - return Failed; + return Failed; for (i = 0; i < cinfo.actual_number_of_colors; i++) { - /* init palette table */ - imd->paltbl[i].used = 1; - imd->paltbl[i].valid = 1; - imd->paltbl[i].transpt = 0; - imd->paltbl[i].clr.red = cinfo.colormap[0][i] * 257; - imd->paltbl[i].clr.green = cinfo.colormap[1][i] * 257; - imd->paltbl[i].clr.blue = cinfo.colormap[2][i] * 257; - } + /* init palette table */ + imd->paltbl[i].used = 1; + imd->paltbl[i].valid = 1; + imd->paltbl[i].transpt = 0; + imd->paltbl[i].clr.red = cinfo.colormap[0][i] * 257; + imd->paltbl[i].clr.green = cinfo.colormap[1][i] * 257; + imd->paltbl[i].clr.blue = cinfo.colormap[2][i] * 257; + } for(;i < 256; i++) { - imd->paltbl[i].used = imd->paltbl[i].valid = imd->paltbl[i].transpt = 0; - } + imd->paltbl[i].used = imd->paltbl[i].valid = imd->paltbl[i].transpt = 0; + } } imd->data = calloc(row_stride*cinfo.output_height, - sizeof(unsigned char)); + sizeof(unsigned char)); /* * Make a one-row-high sample array that will go away when done with image */ @@ -2030,7 +2030,7 @@ static int jpegread(char *filename, int p, struct imgdata *imd) c = *byte; *byte = byte[2]; byte[2] = c; } } -#endif /* !JCS_EXTENSIONS */ +#endif /* !JCS_EXTENSIONS */ /* * Finish and release the JPEG decompression object @@ -2055,14 +2055,14 @@ int readJPEG(char *filename, int p, struct imgdata *imd) imd->paltbl = NULL; imd->data = NULL; - r = jpegread(filename, p, imd); /* read image */ + r = jpegread(filename, p, imd); /* read image */ if (r == Failed){ if (imd->paltbl) free(imd->paltbl); if (imd->data) free(imd->data); return Failed; } - return Succeeded; /* return success */ + return Succeeded; /* return success */ } #endif @@ -2089,17 +2089,17 @@ static int pngread(char *filename, int p, struct imgdata *imd) #ifdef MSWindows if ((png_f = fopen(filename, "rb")) == NULL) { - #else /* MSWindows */ + #else /* MSWindows */ if ((png_f = fopen(filename, "r")) == NULL) { - #endif /* MSWindows */ - return Failed; - } + #endif /* MSWindows */ + return Failed; + } /* read the first n bytes (1-8, 8 used here) and test for png signature */ if (fread(header, 1, 8, png_f) < 8) { fclose(png_f); return Failed; - } + } if (png_sig_cmp(header, 0, 8)) { fclose(png_f); @@ -2109,21 +2109,21 @@ static int pngread(char *filename, int p, struct imgdata *imd) png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL); if (!png_ptr){ - fclose(png_f); + fclose(png_f); return Failed; } info_ptr = png_create_info_struct(png_ptr); if (!info_ptr) { png_destroy_read_struct(&png_ptr, NULL, NULL); - fclose(png_f); + fclose(png_f); return Failed; } end_info = png_create_info_struct(png_ptr); if (!end_info){ png_destroy_read_struct(&png_ptr, &info_ptr, NULL); - fclose(png_f); + fclose(png_f); return Failed; } @@ -2137,12 +2137,12 @@ static int pngread(char *filename, int p, struct imgdata *imd) png_set_sig_bytes(png_ptr, 8); png_read_info(png_ptr, info_ptr); - png_get_IHDR(png_ptr, info_ptr, &mywidth, &myheight, &bit_depth, - &color_type, NULL, NULL, NULL); + png_get_IHDR(png_ptr, info_ptr, &mywidth, &myheight, &bit_depth, + &color_type, NULL, NULL, NULL); imd->width = (int) mywidth; imd->height = (int) myheight; - + /* * Expand palette images to RGB, low-bit-depth grayscale images to 8 bits, * transparency chunks to full alpha channel; strip 16-bit-per-sample @@ -2151,24 +2151,24 @@ static int pngread(char *filename, int p, struct imgdata *imd) switch (color_type) { case PNG_COLOR_TYPE_PALETTE: - png_set_palette_to_rgb(png_ptr); - break; + png_set_palette_to_rgb(png_ptr); + break; case PNG_COLOR_TYPE_GRAY: - if (bit_depth < 8) - png_set_expand_gray_1_2_4_to_8(png_ptr); - png_set_gray_to_rgb(png_ptr); - break; + if (bit_depth < 8) + png_set_expand_gray_1_2_4_to_8(png_ptr); + png_set_gray_to_rgb(png_ptr); + break; case PNG_COLOR_TYPE_GRAY_ALPHA: - if (bit_depth < 8) - png_set_expand_gray_1_2_4_to_8(png_ptr); - png_set_gray_to_rgb(png_ptr); - png_set_strip_alpha(png_ptr); - break; + if (bit_depth < 8) + png_set_expand_gray_1_2_4_to_8(png_ptr); + png_set_gray_to_rgb(png_ptr); + png_set_strip_alpha(png_ptr); + break; case PNG_COLOR_TYPE_RGB: - break; + break; case PNG_COLOR_TYPE_RGB_ALPHA: - png_set_strip_alpha(png_ptr); - break; + png_set_strip_alpha(png_ptr); + break; } if (bit_depth == 16) @@ -2189,13 +2189,13 @@ static int pngread(char *filename, int p, struct imgdata *imd) /*png_set_tRNS_to_alpha(png_ptr);*/ png_set_strip_alpha(png_ptr); } - + if (png_get_bKGD(png_ptr, info_ptr, &image_background)) png_set_background(png_ptr, image_background, - PNG_BACKGROUND_GAMMA_FILE, 1, 1.0); + PNG_BACKGROUND_GAMMA_FILE, 1, 1.0); /*else png_set_background(png_ptr, &my_background, - PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0); + PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0); */ /* @@ -2268,14 +2268,14 @@ int readPNG(char *filename, int p, struct imgdata *imd) imd->paltbl = NULL; imd->data = NULL; - r = pngread(filename, p, imd); /* read image */ + r = pngread(filename, p, imd); /* read image */ if (r == Failed){ if (imd->paltbl) free(imd->paltbl); if (imd->data) free(imd->data); return Failed; } - return Succeeded; /* return success */ + return Succeeded; /* return success */ } @@ -2284,7 +2284,7 @@ int readPNG(char *filename, int p, struct imgdata *imd) #undef fprintf #undef putc #define putc fputc -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ /* * pngwrite(w, filename, x, y, width, height) - write PNG file @@ -2368,7 +2368,7 @@ int writePNG(wbp w, char *filename, int x, int y, int width, int height) } } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (!getimstr24(w, x, y, width, height, imgBuf)) { free(imgBuf); return RunError; @@ -2383,11 +2383,11 @@ int writePNG(wbp w, char *filename, int x, int y, int width, int height) free(imgBuf); fclose(png_f); - + return r; } -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ /* * writeBMP(w, filename, x, y, width, height) - write BMP image @@ -2419,7 +2419,7 @@ static int bmpwrite(wbp w, char *filename, int x, int y, int width, int height) long len; struct palentry paltbl[DMAXCOLORS]; - len = (long)width * (long)height; /* total length of data */ + len = (long)width * (long)height; /* total length of data */ if (!(gf_f = fopen(filename, "wb"))) return Failed; @@ -2433,8 +2433,8 @@ static int bmpwrite(wbp w, char *filename, int x, int y, int width, int height) if (!gl_getimstr(w, x, y, width, height, paltbl, gf_string)) return RunError; } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ if (!getimstr(w, x, y, width, height, paltbl, gf_string)) return RunError; @@ -2493,7 +2493,7 @@ int x, y, width, height; #undef fprintf #undef putc #define putc fputc -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ /* * gfwrite(w, filename, x, y, width, height) - write GIF file * @@ -2514,7 +2514,7 @@ int x, y, width, height; unsigned char obuf[GifBlockSize]; lzwnode tree[GifTableSize + 1]; - len = (long)width * (long)height; /* total length of data */ + len = (long)width * (long)height; /* total length of data */ if (!(gf_f = fopen(filename, "wb"))) return Failed; @@ -2529,13 +2529,13 @@ int x, y, width, height; return RunError; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (!getimstr(w, x, y, width, height, paltbl, gf_string)) return RunError; - gfpack(gf_string, len, paltbl); /* pack color table, set color params */ + gfpack(gf_string, len, paltbl); /* pack color table, set color params */ - gf_clear = 1 << gf_cdsize; /* set encoding variables */ + gf_clear = 1 << gf_cdsize; /* set encoding variables */ gf_eoi = gf_clear + 1; gf_free = gf_eoi + 1; gf_lzwbits = gf_cdsize + 1; @@ -2548,7 +2548,7 @@ int x, y, width, height; 0x80 | ((gf_nbits - 1) << 4) | (gf_nbits - 1), 0, 0); - for (i = 0; i < (1 << gf_nbits); i++) { /* output color table */ + for (i = 0; i < (1 << gf_nbits); i++) { /* output color table */ if (i < DMAXCOLORS && paltbl[i].valid) { cp = &paltbl[i].clr; putc(cp->red >> 8, gf_f); @@ -2568,61 +2568,61 @@ int x, y, width, height; /* * Encode and write the image. */ - gf_obuf = obuf; /* initialize output state */ + gf_obuf = obuf; /* initialize output state */ gf_curr = 0; gf_valid = 0; gf_rem = GifBlockSize; - gfmktree(tree); /* initialize encoding tree */ + gfmktree(tree); /* initialize encoding tree */ - gfout(gf_clear); /* start with CLEAR code */ + gfout(gf_clear); /* start with CLEAR code */ p = gf_string; q = p + len; - cur = *p++; /* first pixel is special */ + cur = *p++; /* first pixel is special */ while (p < q) { - c = *p++; /* get code */ + c = *p++; /* get code */ for (i = tree[cur].child; i != 0; i = tree[i].sibling) - if (tree[i].tcode == c) /* find as suffix of previous string */ + if (tree[i].tcode == c) /* find as suffix of previous string */ break; - if (i != 0) { /* if found in encoding tree */ - cur = i; /* note where */ - continue; /* and accumulate more */ + if (i != 0) { /* if found in encoding tree */ + cur = i; /* note where */ + continue; /* and accumulate more */ } - gfout(cur); /* new combination -- output prefix */ - tree[gf_free].tcode = c; /* make node for new combination */ + gfout(cur); /* new combination -- output prefix */ + tree[gf_free].tcode = c; /* make node for new combination */ tree[gf_free].child = 0; tree[gf_free].sibling = tree[cur].child; tree[cur].child = gf_free; - cur = c; /* restart string from single pixel */ - ++gf_free; /* grow tree to account for new node */ + cur = c; /* restart string from single pixel */ + ++gf_free; /* grow tree to account for new node */ if (gf_free > (1 << gf_lzwbits)) { if (gf_free > GifTableSize) { - gfout(gf_clear); /* table is full; reset to empty */ + gfout(gf_clear); /* table is full; reset to empty */ gf_lzwbits = gf_cdsize + 1; gfmktree(tree); } else - gf_lzwbits++; /* time to make output one bit wider */ + gf_lzwbits++; /* time to make output one bit wider */ } } /* * Finish up. */ - gfout(cur); /* flush accumulated prefix */ - gfout(gf_eoi); /* send EOI code */ + gfout(cur); /* flush accumulated prefix */ + gfout(gf_eoi); /* send EOI code */ gf_lzwbits = 7; - gfout(0); /* force out last partial byte */ - gfdump(); /* dump final block */ - putc(0, gf_f); /* terminate image (block of size 0) */ - putc(GifTerminator, gf_f); /* terminate file */ + gfout(0); /* force out last partial byte */ + gfdump(); /* dump final block */ + putc(0, gf_f); /* terminate image (block of size 0) */ + putc(GifTerminator, gf_f); /* terminate file */ fflush(gf_f); if (ferror(gf_f)) return Failed; else - return Succeeded; /* caller will close file */ + return Succeeded; /* caller will close file */ } /* @@ -2643,11 +2643,11 @@ struct palentry *paltbl; for (i = 0; i < DMAXCOLORS; i++) if (paltbl[i].used) { lastcolor = i; - cmap[i] = ncolors; /* mapping to output color */ + cmap[i] = ncolors; /* mapping to output color */ if (i != ncolors) { - paltbl[ncolors] = paltbl[i]; /* shift down */ + paltbl[ncolors] = paltbl[i]; /* shift down */ paltbl[i].used = paltbl[i].valid = paltbl[i].transpt = 0; - /* invalidate old */ + /* invalidate old */ } ncolors++; } @@ -2656,7 +2656,7 @@ struct palentry *paltbl; p = data; q = p + len; while (p < q) { - *p = cmap[*p]; /* adjust color values in data string */ + *p = cmap[*p]; /* adjust color values in data string */ p++; } } @@ -2679,13 +2679,13 @@ lzwnode *tree; { int i; - for (i = 0; i < gf_clear; i++) { /* for each basic entry */ - tree[i].tcode = i; /* code is pixel value */ - tree[i].child = 0; /* no suffixes yet */ - tree[i].sibling = i + 1; /* next code is sibling */ + for (i = 0; i < gf_clear; i++) { /* for each basic entry */ + tree[i].tcode = i; /* code is pixel value */ + tree[i].child = 0; /* no suffixes yet */ + tree[i].sibling = i + 1; /* next code is sibling */ } - tree[gf_clear - 1].sibling = 0; /* last entry has no sibling */ - gf_free = gf_eoi + 1; /* reset next free entry */ + tree[gf_clear - 1].sibling = 0; /* last entry has no sibling */ + gf_free = gf_eoi + 1; /* reset next free entry */ } /* @@ -2694,13 +2694,13 @@ lzwnode *tree; static void gfout(tcode) int tcode; { - gf_curr |= tcode << gf_valid; /* add to current word */ - gf_valid += gf_lzwbits; /* count the bits */ - while (gf_valid >= 8) { /* while we have a byte to output */ - gf_obuf[GifBlockSize - gf_rem] = gf_curr; /* put in buffer */ - gf_curr >>= 8; /* remove from word */ + gf_curr |= tcode << gf_valid; /* add to current word */ + gf_valid += gf_lzwbits; /* count the bits */ + while (gf_valid >= 8) { /* while we have a byte to output */ + gf_obuf[GifBlockSize - gf_rem] = gf_curr; /* put in buffer */ + gf_curr >>= 8; /* remove from word */ gf_valid -= 8; - if (--gf_rem == 0) /* flush buffer when full */ + if (--gf_rem == 0) /* flush buffer when full */ gfdump(); } } @@ -2713,9 +2713,9 @@ static void gfdump() int n; n = GifBlockSize - gf_rem; - putc(n, gf_f); /* write block size */ + putc(n, gf_f); /* write block size */ fwrite((pointer)gf_obuf, 1, n, gf_f); /*write block */ - gf_rem = GifBlockSize; /* reset buffer to empty */ + gf_rem = GifBlockSize; /* reset buffer to empty */ } @@ -2725,7 +2725,7 @@ static void gfdump() #undef fprintf #undef putc #define putc fputc -#endif /* ConsoleWindow */ +#endif /* ConsoleWindow */ /* * jpegwrite(w, filename, x, y, width, height) - write JPEG file @@ -2739,8 +2739,8 @@ static int jpegwrite(wbp w, char *filename, int x, int y, int width,int height) struct jpeg_compress_struct cinfo; struct my_error_mgr jerr; - JSAMPROW row_pointer[1]; /* pointer to JSAMPLE row[s] */ - int row_stride; /* physical row width in image buffer */ + JSAMPROW row_pointer[1]; /* pointer to JSAMPLE row[s] */ + int row_stride; /* physical row width in image buffer */ int quality; quality = 95; @@ -2765,10 +2765,10 @@ static int jpegwrite(wbp w, char *filename, int x, int y, int width,int height) jpeg_stdio_dest(&cinfo, jpg_f); - cinfo.image_width = width; /* image width and height, in pixels */ + cinfo.image_width = width; /* image width and height, in pixels */ cinfo.image_height = height; - cinfo.input_components = 3; /* # of color components per pixel */ + cinfo.input_components = 3; /* # of color components per pixel */ cinfo.in_color_space = JCS_RGB; /* colorspace of input image */ jpeg_set_defaults(&cinfo); @@ -2776,7 +2776,7 @@ static int jpegwrite(wbp w, char *filename, int x, int y, int width,int height) jpeg_start_compress(&cinfo, TRUE); - row_stride = cinfo.image_width *3; /* JSAMPLEs per row in image_buffer */ + row_stride = cinfo.image_width *3; /* JSAMPLEs per row in image_buffer */ if (!(imgBuf = (unsigned char*)malloc( height * row_stride * sizeof(unsigned char)))) return RunError; @@ -2789,7 +2789,7 @@ static int jpegwrite(wbp w, char *filename, int x, int y, int width,int height) } } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (!getimstr24(w, x, y, width, height, imgBuf)) { free(imgBuf); return RunError; @@ -2820,13 +2820,13 @@ int writeJPEG(wbp w, char *filename, int x, int y, int width, int height) return r; } -#endif /* HAVE_LIBJPEG */ +#endif /* HAVE_LIBJPEG */ -#define IMAGE_UNKNOWN 0 -#define IMAGE_GIF 1 -#define IMAGE_JPEG 2 -#define IMAGE_PNG 3 -#define IMAGE_BMP 4 +#define IMAGE_UNKNOWN 0 +#define IMAGE_GIF 1 +#define IMAGE_JPEG 2 +#define IMAGE_PNG 3 +#define IMAGE_BMP 4 int image_type(fname) char *fname; @@ -2837,28 +2837,28 @@ char *fname; return IMAGE_UNKNOWN; if (fname[i] == 'j' || fname[i] == 'J') - if ( (fname[++i] == 'p' || fname[i] == 'P') && - (fname[++i] == 'g' || fname[i] == 'G')) - return IMAGE_JPEG; + if ( (fname[++i] == 'p' || fname[i] == 'P') && + (fname[++i] == 'g' || fname[i] == 'G')) + return IMAGE_JPEG; if (fname[i] == 'p' || fname[i] == 'P') - if ( (fname[++i] == 'n' || fname[i] == 'N') && - (fname[++i] == 'g' || fname[i] == 'G')) - return IMAGE_PNG; + if ( (fname[++i] == 'n' || fname[i] == 'N') && + (fname[++i] == 'g' || fname[i] == 'G')) + return IMAGE_PNG; if (fname[i] == 'g' || fname[i] == 'G') - if ( (fname[++i] == 'i' || fname[i] == 'I') && - (fname[++i] == 'f' || fname[i] == 'F')) - return IMAGE_GIF; + if ( (fname[++i] == 'i' || fname[i] == 'I') && + (fname[++i] == 'f' || fname[i] == 'F')) + return IMAGE_GIF; if (fname[i] == 'b' || fname[i] == 'B') - if ( (fname[++i] == 'm' || fname[i] == 'M') && - (fname[++i] == 'p' || fname[i] == 'P')) - return IMAGE_BMP; + if ( (fname[++i] == 'm' || fname[i] == 'M') && + (fname[++i] == 'p' || fname[i] == 'P')) + return IMAGE_BMP; return IMAGE_UNKNOWN; } - + /* * readImage(filename, p, imd) - read an image file into image data structure * p is a palette number to which the image colors are to be coerced; @@ -2870,26 +2870,26 @@ int readImage(char *filename, int p, struct imgdata *imd){ itype = image_type(filename); switch (itype){ - case IMAGE_JPEG: + case IMAGE_JPEG: #if HAVE_LIBJPEG r = readJPEG(filename, p, imd); -#endif /* HAVE_LIBJPEG */ - break; - case IMAGE_PNG: +#endif /* HAVE_LIBJPEG */ + break; + case IMAGE_PNG: #if HAVE_LIBPNG r = readPNG(filename, p, imd); -#endif /* HAVE_LIBPNG */ - break; - case IMAGE_GIF: +#endif /* HAVE_LIBPNG */ + break; + case IMAGE_GIF: r = readGIF(filename, p, imd); - break; - case IMAGE_BMP: + break; + case IMAGE_BMP: r = readBMP(filename, p, imd); - break; + break; } if (r == Succeeded) - return Succeeded; /* return success */ + return Succeeded; /* return success */ /* * We couldn't read the file based on its extension @@ -2898,12 +2898,12 @@ int readImage(char *filename, int p, struct imgdata *imd){ #if HAVE_LIBJPEG if (itype != IMAGE_JPEG && readJPEG(filename, p, imd) == Succeeded) return Succeeded; -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ #if HAVE_LIBPNG if (itype != IMAGE_PNG && readPNG(filename, p, imd) == Succeeded) return Succeeded; -#endif /* HAVE_LIBPNG */ +#endif /* HAVE_LIBPNG */ if (itype != IMAGE_GIF && readGIF(filename, p, imd) == Succeeded) return Succeeded; @@ -2914,25 +2914,25 @@ int readImage(char *filename, int p, struct imgdata *imd){ return Failed; } -int writeImage (wbp w, char *filename, int x, int y, int width, int height){ +int writeImage (wbp w, char *filename, int x, int y, int width, int height){ int itype; itype = image_type(filename); switch (itype){ - case IMAGE_JPEG: + case IMAGE_JPEG: #if HAVE_LIBJPEG -#endif /* HAVE_LIBJPEG */ - break; - case IMAGE_PNG: +#endif /* HAVE_LIBJPEG */ + break; + case IMAGE_PNG: #if HAVE_LIBPNG -#endif /* HAVE_LIBPNG */ - break; - case IMAGE_GIF: +#endif /* HAVE_LIBPNG */ + break; + case IMAGE_GIF: - break; - case IMAGE_BMP: + break; + case IMAGE_BMP: - break; + break; } return Failed; } @@ -2942,8 +2942,8 @@ int writeImage (wbp w, char *filename, int x, int y, int width, int height){ #define fprintf Consolefprintf #undef putc #define putc Consoleputc -#endif /* ConsoleWindow */ - +#endif /* ConsoleWindow */ + /* * Static data for XDrawImage and XPalette functions */ @@ -2971,7 +2971,7 @@ static char *cgrays[] = { "0123456", "kxw", "@abMcdZ", "0$%&L*+-g/?@}", * * This is 10x10x10 cube (A Thousand Points of Light). */ -#define C1Side 10 /* length of one side of C1 cube */ +#define C1Side 10 /* length of one side of C1 cube */ static char c1cube[] = { '0', '0', 'w', 'w', 'w', 'W', 'W', 'W', 'J', 'J', '0', '0', 'v', 'v', 'v', 'W', 'W', 'W', 'J', 'J', 's', 't', 't', 'v', 'v', 'V', 'V', 'V', 'V', 'J', @@ -3049,98 +3049,98 @@ static char c1cube[] = { * Each entry gives r,g,b in linear range 0 to 48. */ static unsigned char c1rgb[] = { - 0, 0, 0, /* 0 black */ - 8, 8, 8, /* 1 very dark gray */ - 16, 16, 16, /* 2 dark gray */ - 24, 24, 24, /* 3 gray */ - 32, 32, 32, /* 4 light gray */ - 40, 40, 40, /* 5 very light gray */ - 48, 48, 48, /* 6 white */ - 48, 24, 30, /* 7 pink */ - 36, 24, 48, /* 8 violet */ - 48, 36, 24, /* 9 very light brown */ - 24, 12, 0, /* ? brown */ - 8, 4, 0, /* ! very dark brown */ - 16, 0, 0, /* n very dark red */ - 32, 0, 0, /* N dark red */ - 48, 0, 0, /* A red */ - 48, 16, 16, /* a light red */ - 48, 32, 32, /* # very light red */ - 30, 18, 18, /* @ weak red */ - 16, 4, 0, /* o very dark orange */ - 32, 8, 0, /* O dark orange */ - 48, 12, 0, /* B orange */ - 48, 24, 16, /* b light orange */ - 48, 36, 32, /* $ very light orange */ - 30, 21, 18, /* % weak orange */ - 16, 8, 0, /* p very dark red-yellow */ - 32, 16, 0, /* P dark red-yellow */ - 48, 24, 0, /* C red-yellow */ - 48, 32, 16, /* c light red-yellow */ - 48, 40, 32, /* & very light red-yellow */ - 30, 24, 18, /* | weak red-yellow */ - 16, 16, 0, /* q very dark yellow */ - 32, 32, 0, /* Q dark yellow */ - 48, 48, 0, /* D yellow */ - 48, 48, 16, /* d light yellow */ - 48, 48, 32, /* , very light yellow */ - 30, 30, 18, /* . weak yellow */ - 8, 16, 0, /* r very dark yellow-green */ - 16, 32, 0, /* R dark yellow-green */ - 24, 48, 0, /* E yellow-green */ - 32, 48, 16, /* e light yellow-green */ - 40, 48, 32, /* ; very light yellow-green */ - 24, 30, 18, /* : weak yellow-green */ - 0, 16, 0, /* s very dark green */ - 0, 32, 0, /* S dark green */ - 0, 48, 0, /* F green */ - 16, 48, 16, /* f light green */ - 32, 48, 32, /* + very light green */ - 18, 30, 18, /* - weak green */ - 0, 16, 8, /* t very dark cyan-green */ - 0, 32, 16, /* T dark cyan-green */ - 0, 48, 24, /* G cyan-green */ - 16, 48, 32, /* g light cyan-green */ - 32, 48, 40, /* * very light cyan-green */ - 18, 30, 24, /* / weak cyan-green */ - 0, 16, 16, /* u very dark cyan */ - 0, 32, 32, /* U dark cyan */ - 0, 48, 48, /* H cyan */ - 16, 48, 48, /* h light cyan */ - 32, 48, 48, /* ` very light cyan */ - 18, 30, 30, /* ' weak cyan */ - 0, 8, 16, /* v very dark blue-cyan */ - 0, 16, 32, /* V dark blue-cyan */ - 0, 24, 48, /* I blue-cyan */ - 16, 32, 48, /* i light blue-cyan */ - 32, 40, 48, /* < very light blue-cyan */ - 18, 24, 30, /* > weak blue-cyan */ - 0, 0, 16, /* w very dark blue */ - 0, 0, 32, /* W dark blue */ - 0, 0, 48, /* J blue */ - 16, 16, 48, /* j light blue */ - 32, 32, 48, /* ( very light blue */ - 18, 18, 30, /* ) weak blue */ - 8, 0, 16, /* x very dark purple */ - 16, 0, 32, /* X dark purple */ - 24, 0, 48, /* K purple */ - 32, 16, 48, /* k light purple */ - 40, 32, 48, /* [ very light purple */ - 24, 18, 30, /* ] weak purple */ - 16, 0, 16, /* y very dark magenta */ - 32, 0, 32, /* Y dark magenta */ - 48, 0, 48, /* L magenta */ - 48, 16, 48, /* l light magenta */ - 48, 32, 48, /* { very light magenta */ - 30, 18, 30, /* } weak magenta */ - 16, 0, 8, /* z very dark magenta-red */ - 32, 0, 16, /* Z dark magenta-red */ - 48, 0, 24, /* M magenta-red */ - 48, 16, 32, /* m light magenta-red */ - 48, 32, 40, /* ^ very light magenta-red */ - 30, 18, 24, /* = weak magenta-red */ + 0, 0, 0, /* 0 black */ + 8, 8, 8, /* 1 very dark gray */ + 16, 16, 16, /* 2 dark gray */ + 24, 24, 24, /* 3 gray */ + 32, 32, 32, /* 4 light gray */ + 40, 40, 40, /* 5 very light gray */ + 48, 48, 48, /* 6 white */ + 48, 24, 30, /* 7 pink */ + 36, 24, 48, /* 8 violet */ + 48, 36, 24, /* 9 very light brown */ + 24, 12, 0, /* ? brown */ + 8, 4, 0, /* ! very dark brown */ + 16, 0, 0, /* n very dark red */ + 32, 0, 0, /* N dark red */ + 48, 0, 0, /* A red */ + 48, 16, 16, /* a light red */ + 48, 32, 32, /* # very light red */ + 30, 18, 18, /* @ weak red */ + 16, 4, 0, /* o very dark orange */ + 32, 8, 0, /* O dark orange */ + 48, 12, 0, /* B orange */ + 48, 24, 16, /* b light orange */ + 48, 36, 32, /* $ very light orange */ + 30, 21, 18, /* % weak orange */ + 16, 8, 0, /* p very dark red-yellow */ + 32, 16, 0, /* P dark red-yellow */ + 48, 24, 0, /* C red-yellow */ + 48, 32, 16, /* c light red-yellow */ + 48, 40, 32, /* & very light red-yellow */ + 30, 24, 18, /* | weak red-yellow */ + 16, 16, 0, /* q very dark yellow */ + 32, 32, 0, /* Q dark yellow */ + 48, 48, 0, /* D yellow */ + 48, 48, 16, /* d light yellow */ + 48, 48, 32, /* , very light yellow */ + 30, 30, 18, /* . weak yellow */ + 8, 16, 0, /* r very dark yellow-green */ + 16, 32, 0, /* R dark yellow-green */ + 24, 48, 0, /* E yellow-green */ + 32, 48, 16, /* e light yellow-green */ + 40, 48, 32, /* ; very light yellow-green */ + 24, 30, 18, /* : weak yellow-green */ + 0, 16, 0, /* s very dark green */ + 0, 32, 0, /* S dark green */ + 0, 48, 0, /* F green */ + 16, 48, 16, /* f light green */ + 32, 48, 32, /* + very light green */ + 18, 30, 18, /* - weak green */ + 0, 16, 8, /* t very dark cyan-green */ + 0, 32, 16, /* T dark cyan-green */ + 0, 48, 24, /* G cyan-green */ + 16, 48, 32, /* g light cyan-green */ + 32, 48, 40, /* * very light cyan-green */ + 18, 30, 24, /* / weak cyan-green */ + 0, 16, 16, /* u very dark cyan */ + 0, 32, 32, /* U dark cyan */ + 0, 48, 48, /* H cyan */ + 16, 48, 48, /* h light cyan */ + 32, 48, 48, /* ` very light cyan */ + 18, 30, 30, /* ' weak cyan */ + 0, 8, 16, /* v very dark blue-cyan */ + 0, 16, 32, /* V dark blue-cyan */ + 0, 24, 48, /* I blue-cyan */ + 16, 32, 48, /* i light blue-cyan */ + 32, 40, 48, /* < very light blue-cyan */ + 18, 24, 30, /* > weak blue-cyan */ + 0, 0, 16, /* w very dark blue */ + 0, 0, 32, /* W dark blue */ + 0, 0, 48, /* J blue */ + 16, 16, 48, /* j light blue */ + 32, 32, 48, /* ( very light blue */ + 18, 18, 30, /* ) weak blue */ + 8, 0, 16, /* x very dark purple */ + 16, 0, 32, /* X dark purple */ + 24, 0, 48, /* K purple */ + 32, 16, 48, /* k light purple */ + 40, 32, 48, /* [ very light purple */ + 24, 18, 30, /* ] weak purple */ + 16, 0, 16, /* y very dark magenta */ + 32, 0, 32, /* Y dark magenta */ + 48, 0, 48, /* L magenta */ + 48, 16, 48, /* l light magenta */ + 48, 32, 48, /* { very light magenta */ + 30, 18, 30, /* } weak magenta */ + 16, 0, 8, /* z very dark magenta-red */ + 32, 0, 16, /* Z dark magenta-red */ + 48, 0, 24, /* M magenta-red */ + 48, 16, 32, /* m light magenta-red */ + 48, 32, 40, /* ^ very light magenta-red */ + 30, 18, 24, /* = weak magenta-red */ }; - + /* * palnum(d) - return palette number, or 0 if unrecognized. * @@ -3169,9 +3169,9 @@ dptr d; return -n; return 0; } - -struct palentry *palsetup_palette; /* current palette */ + +struct palentry *palsetup_palette; /* current palette */ /* * palsetup(p) - set up palette for specified palette. @@ -3185,13 +3185,13 @@ int p; double m; struct palentry *e; - static int palnumber; /* current palette number */ + static int palnumber; /* current palette number */ if (palnumber == p) return palsetup_palette; if (palsetup_palette == NULL) { palsetup_palette = - (struct palentry *)malloc(256 * sizeof(struct palentry)); + (struct palentry *)malloc(256 * sizeof(struct palentry)); if (palsetup_palette == NULL) return NULL; } @@ -3202,7 +3202,7 @@ int p; palsetup_palette[TCH1].transpt = 1; palsetup_palette[TCH2].transpt = 1; - if (p < 0) { /* grayscale palette */ + if (p < 0) { /* grayscale palette */ n = -p; if (n <= 64) s = (unsigned char *)c4list; @@ -3215,12 +3215,12 @@ int p; gg = 65535 * m * i; e->clr.red = e->clr.green = e->clr.blue = gg; e->valid = 1; - e->transpt = 0; + e->transpt = 0; } return palsetup_palette; } - if (p == 1) { /* special c1 palette */ + if (p == 1) { /* special c1 palette */ s = (unsigned char *)c1list; t = c1rgb; while ((c = *s++) != 0) { @@ -3229,17 +3229,17 @@ int p; e->clr.green = 65535 * (((int)*t++) / 48.0); e->clr.blue = 65535 * (((int)*t++) / 48.0); e->valid = 1; - e->transpt = 0; + e->transpt = 0; } return palsetup_palette; } - switch (p) { /* color cube plus extra grays */ - case 2: s = (unsigned char *)c2list; break; /* c2 */ - case 3: s = (unsigned char *)c3list; break; /* c3 */ - case 4: s = (unsigned char *)c4list; break; /* c4 */ - case 5: s = allchars; break; /* c5 */ - case 6: s = allchars; break; /* c6 */ + switch (p) { /* color cube plus extra grays */ + case 2: s = (unsigned char *)c2list; break; /* c2 */ + case 3: s = (unsigned char *)c3list; break; /* c3 */ + case 4: s = (unsigned char *)c4list; break; /* c4 */ + case 5: s = allchars; break; /* c5 */ + case 6: s = allchars; break; /* c6 */ } m = 1.0 / (p - 1); for (r = 0; r < p; r++) { @@ -3253,7 +3253,7 @@ int p; e->clr.green = gg; e->clr.blue = bb; e->valid = 1; - e->transpt = 0; + e->transpt = 0; } } } @@ -3264,11 +3264,11 @@ int p; e = &palsetup_palette[*s++]; e->clr.red = e->clr.green = e->clr.blue = gg; e->valid = 1; - e->transpt = 0; + e->transpt = 0; } return palsetup_palette; } - + /* * rgbkey(p,r,g,b) - return pointer to key of closest color in palette number p. * @@ -3282,7 +3282,7 @@ double r, g, b; double m; char *s; - if (p > 0) { /* color */ + if (p > 0) { /* color */ if (r == g && g == b) { if (p == 1) m = 6; @@ -3300,16 +3300,16 @@ double r, g, b; i = n * i + (int)(0.501 + m * g); i = n * i + (int)(0.501 + m * b); switch(p) { - case 1: return c1cube + i; /* c1 */ - case 2: return c2list + i; /* c2 */ - case 3: return c3list + i; /* c3 */ - case 4: return c4list + i; /* c4 */ - case 5: return (char *)allchars + i; /* c5 */ - case 6: return (char *)allchars + i; /* c6 */ + case 1: return c1cube + i; /* c1 */ + case 2: return c2list + i; /* c2 */ + case 3: return c3list + i; /* c3 */ + case 4: return c4list + i; /* c4 */ + case 5: return (char *)allchars + i; /* c5 */ + case 6: return (char *)allchars + i; /* c6 */ } } } - else { /* grayscale */ + else { /* grayscale */ if (p < -64) s = (char *)allchars; else @@ -3320,36 +3320,36 @@ double r, g, b; /*NOTREACHED*/ return 0; /* avoid gcc warning */ } - + /* * mapping from recognized style attributes to flag values */ stringint fontwords[] = { - { 0, 24 }, /* number of entries */ - { "arabic", FONTATT_CHARSET | FONTFLAG_ARABIC }, - { "bold", FONTATT_WEIGHT | FONTFLAG_BOLD }, - { "condensed", FONTATT_WIDTH | FONTFLAG_CONDENSED }, - { "cyrillic", FONTATT_CHARSET | FONTFLAG_CYRILLIC }, - { "demi", FONTATT_WEIGHT | FONTFLAG_DEMI }, - { "demibold", FONTATT_WEIGHT | FONTFLAG_DEMI | FONTFLAG_BOLD }, - { "extended", FONTATT_WIDTH | FONTFLAG_EXTENDED }, - { "greek", FONTATT_CHARSET | FONTFLAG_GREEK }, - { "hebrew", FONTATT_CHARSET | FONTFLAG_HEBREW }, - { "italic", FONTATT_SLANT | FONTFLAG_ITALIC }, - { "latin1", FONTATT_CHARSET | FONTFLAG_LATIN1 }, - { "latin2", FONTATT_CHARSET | FONTFLAG_LATIN2 }, - { "latin6", FONTATT_CHARSET | FONTFLAG_LATIN6 }, - { "light", FONTATT_WEIGHT | FONTFLAG_LIGHT }, - { "medium", FONTATT_WEIGHT | FONTFLAG_MEDIUM }, - { "mono", FONTATT_SPACING | FONTFLAG_MONO }, - { "narrow", FONTATT_WIDTH | FONTFLAG_NARROW }, - { "normal", FONTATT_WIDTH | FONTFLAG_NORMAL }, - { "oblique", FONTATT_SLANT | FONTFLAG_OBLIQUE }, - { "proportional", FONTATT_SPACING | FONTFLAG_PROPORTIONAL }, - { "roman", FONTATT_SLANT | FONTFLAG_ROMAN }, - { "sans", FONTATT_SERIF | FONTFLAG_SANS }, - { "serif", FONTATT_SERIF | FONTFLAG_SERIF }, - { "wide", FONTATT_WIDTH | FONTFLAG_WIDE }, + { 0, 24 }, /* number of entries */ + { "arabic", FONTATT_CHARSET | FONTFLAG_ARABIC }, + { "bold", FONTATT_WEIGHT | FONTFLAG_BOLD }, + { "condensed", FONTATT_WIDTH | FONTFLAG_CONDENSED }, + { "cyrillic", FONTATT_CHARSET | FONTFLAG_CYRILLIC }, + { "demi", FONTATT_WEIGHT | FONTFLAG_DEMI }, + { "demibold", FONTATT_WEIGHT | FONTFLAG_DEMI | FONTFLAG_BOLD }, + { "extended", FONTATT_WIDTH | FONTFLAG_EXTENDED }, + { "greek", FONTATT_CHARSET | FONTFLAG_GREEK }, + { "hebrew", FONTATT_CHARSET | FONTFLAG_HEBREW }, + { "italic", FONTATT_SLANT | FONTFLAG_ITALIC }, + { "latin1", FONTATT_CHARSET | FONTFLAG_LATIN1 }, + { "latin2", FONTATT_CHARSET | FONTFLAG_LATIN2 }, + { "latin6", FONTATT_CHARSET | FONTFLAG_LATIN6 }, + { "light", FONTATT_WEIGHT | FONTFLAG_LIGHT }, + { "medium", FONTATT_WEIGHT | FONTFLAG_MEDIUM }, + { "mono", FONTATT_SPACING | FONTFLAG_MONO }, + { "narrow", FONTATT_WIDTH | FONTFLAG_NARROW }, + { "normal", FONTATT_WIDTH | FONTFLAG_NORMAL }, + { "oblique", FONTATT_SLANT | FONTFLAG_OBLIQUE }, + { "proportional", FONTATT_SPACING | FONTFLAG_PROPORTIONAL }, + { "roman", FONTATT_SLANT | FONTFLAG_ROMAN }, + { "sans", FONTATT_SERIF | FONTFLAG_SANS }, + { "serif", FONTATT_SERIF | FONTFLAG_SERIF }, + { "wide", FONTATT_WIDTH | FONTFLAG_WIDE }, }; stringint font_type[] = { @@ -3397,9 +3397,9 @@ int *tp; /* * find start of next comma-separated attribute word */ - while (isspace(*s) || *s == ',') /* trim leading spaces & empty words */ + while (isspace(*s) || *s == ',') /* trim leading spaces & empty words */ s++; - if (*s == '\0') /* stop at end of string */ + if (*s == '\0') /* stop at end of string */ break; /* @@ -3410,7 +3410,7 @@ int *tp; c = tolower(c); *a++ = c; if (a - attr >= MAXFONTWORD) - return 0; /* too long */ + return 0; /* too long */ } /* @@ -3424,27 +3424,27 @@ int *tp; * interpret word as family name, size, or style characteristic */ if (*family == '\0') - strcpy(family, attr); /* first word is the family name */ + strcpy(family, attr); /* first word is the family name */ else if (sscanf(attr, "%d%c", &tmp, &c) == 1 && tmp > 0) { if (*size != -1 && *size != tmp) - return 0; /* if conflicting sizes given */ - *size = tmp; /* integer value is a size */ + return 0; /* if conflicting sizes given */ + *size = tmp; /* integer value is a size */ } - else { /* otherwise it's a style attribute */ - tmp = si_s2i(fontwords, attr); /* look up in table */ - if (tmp != -1) { /* if recognized */ + else { /* otherwise it's a style attribute */ + tmp = si_s2i(fontwords, attr); /* look up in table */ + if (tmp != -1) { /* if recognized */ if ((tmp & *style) != 0 && (tmp & *style) != tmp) - return 0; /* conflicting attribute */ + return 0; /* conflicting attribute */ *style |= tmp; } - else { - *tp=0; - for (tmp=1; tmp<=font_type[0].i; tmp++) { - if (!strcmp(font_type[tmp].s, attr)) - *tp = font_type[tmp].i-1; - } + else { + *tp=0; + for (tmp=1; tmp<=font_type[0].i; tmp++) { + if (!strcmp(font_type[tmp].s, attr)) + *tp = font_type[tmp].i-1; + } } } } @@ -3452,7 +3452,7 @@ int *tp; /* got to end of string; it's OK if it had at least a font family */ return (*family != '\0'); } - + /* * parsepattern() - parse an encoded numeric stipple pattern */ @@ -3479,7 +3479,7 @@ C_integer *bits; len--; s++; } if ((len <= 1) || (*s != ',')) return RunError; - len--; s++; /* skip over ',' */ + len--; s++; /* skip over ',' */ if (*s == '#') { /* @@ -3494,20 +3494,20 @@ C_integer *bits; if (*nbits > maxbits) return Failed; for (i = 0; i < *nbits; i++) { v = 0; - for (j = 0; j < hexdigits_per_row; j++, len--, s++) { - if (len == 0) break; - v <<= 4; - if (isdigit(*s)) v += *s - '0'; - else switch (*s) { - case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': - v += *s - 'a' + 10; break; - case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': - v += *s - 'A' + 10; break; - default: return RunError; - } - } - *bits++ = v; - } + for (j = 0; j < hexdigits_per_row; j++, len--, s++) { + if (len == 0) break; + v <<= 4; + if (isdigit(*s)) v += *s - '0'; + else switch (*s) { + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + v += *s - 'a' + 10; break; + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + v += *s - 'A' + 10; break; + default: return RunError; + } + } + *bits++ = v; + } } else { if (*width > 32) return Failed; @@ -3517,26 +3517,26 @@ C_integer *bits; v = 0; *nbits = 0; while (len > 0) { - while ((len > 0) && isdigit(*s)) { - v = v * 10 + *s - '0'; - len--; s++; - } - (*nbits)++; - if (*nbits > maxbits) return Failed; - *bits++ = v; - v = 0; - - if (len > 0) { - if (*s == ',') { len--; s++; } - else { - ReturnErrNum(205, RunError); - } - } - } + while ((len > 0) && isdigit(*s)) { + v = v * 10 + *s - '0'; + len--; s++; + } + (*nbits)++; + if (*nbits > maxbits) return Failed; + *bits++ = v; + v = 0; + + if (len > 0) { + if (*s == ',') { len--; s++; } + else { + ReturnErrNum(205, RunError); + } + } + } } return Succeeded; } - + /* * parsegeometry - parse a string of the form: intxint[+-]int[+-]int * Returns: @@ -3570,7 +3570,7 @@ SHORT *x, *y, *width, *height; } return retval; } - + /* return failure if operation returns either failure or error */ #define AttemptAttr(operation) do { switch (operation) { case RunError: t_errornumber=145; StrLen(t_errorvalue)=strlen(val);StrLoc(t_errorvalue)=val;return RunError; case Succeeded: break; default: return Failed; } } while(0) @@ -3639,47 +3639,47 @@ char * abuf; switch (a = si_s2i(attribs, abuf)) { case A_LINES: case A_ROWS: { - if (!cnv:C_integer(d, tmp)) - return Failed; - if ((new_height = tmp) < 1) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; + if ((new_height = tmp) < 1) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - new_height = GL_ROWTOY(w, new_height); - new_height += GL_MAXDESCENDER(w); - } - else -#endif /* GraphicsGL */ - { - new_height = ROWTOY(w, new_height); - new_height += MAXDESCENDER(w); - } + if (ws->is_gl) { + new_height = GL_ROWTOY(w, new_height); + new_height += GL_MAXDESCENDER(w); + } + else +#endif /* GraphicsGL */ + { + new_height = ROWTOY(w, new_height); + new_height += MAXDESCENDER(w); + } #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setheight(w, new_height) == Failed) return Failed; - } - else -#endif /* GraphicsGL */ - if (setheight(w, new_height) == Failed) return Failed; - break; + if (ws->is_gl) { + if (gl_setheight(w, new_height) == Failed) return Failed; + } + else +#endif /* GraphicsGL */ + if (setheight(w, new_height) == Failed) return Failed; + break; } case A_COLUMNS: { - if (!cnv:C_integer(d, tmp)) - return Failed; - if ((new_width = tmp) < 1) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; + if ((new_width = tmp) < 1) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - new_width = GL_COLTOX(w, new_width + 1); - if (gl_setwidth(w, new_width) == Failed) return Failed; - } - else -#endif /* GraphicsGL */ - { - new_width = COLTOX(w, new_width + 1); - if (setwidth(w, new_width) == Failed) return Failed; - } - break; + if (ws->is_gl) { + new_width = GL_COLTOX(w, new_width + 1); + if (gl_setwidth(w, new_width) == Failed) return Failed; + } + else +#endif /* GraphicsGL */ + { + new_width = COLTOX(w, new_width + 1); + if (setwidth(w, new_width) == Failed) return Failed; + } + break; } #ifdef Graphics3D case A_RENDERMODE: @@ -3687,49 +3687,49 @@ char * abuf; wc->rendermode = UGL2D; else if (!strcmp(val,"3d")) wc->rendermode = UGL3D; - else + else return Failed; - break; + break; case A_DIM: - AttemptAttr(setdim(w, val)); - break; + AttemptAttr(setdim(w, val)); + break; case A_EYE: - AttemptAttr(seteye(w, val)); - break; + AttemptAttr(seteye(w, val)); + break; case A_EYEPOS: - AttemptAttr(seteyepos(w, val)); - break; + AttemptAttr(seteyepos(w, val)); + break; case A_EYEUP: - AttemptAttr(seteyeup(w, val)); - break; + AttemptAttr(seteyeup(w, val)); + break; case A_EYEDIR: - AttemptAttr(seteyedir(w, val)); - break; + AttemptAttr(seteyedir(w, val)); + break; #if HAVE_LIBGL case A_LIGHT: case A_LIGHT0: - AttemptAttr(setlight(w, val, GL_LIGHT0)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT0)); + break; case A_LIGHT1: - AttemptAttr(setlight(w, val, GL_LIGHT1)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT1)); + break; case A_LIGHT2: - AttemptAttr(setlight(w, val, GL_LIGHT2)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT2)); + break; case A_LIGHT3: - AttemptAttr( setlight(w, val, GL_LIGHT3)); - break; + AttemptAttr( setlight(w, val, GL_LIGHT3)); + break; case A_LIGHT4: - AttemptAttr(setlight(w, val, GL_LIGHT4)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT4)); + break; case A_LIGHT5: - AttemptAttr(setlight(w, val, GL_LIGHT5)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT5)); + break; case A_LIGHT6: - AttemptAttr(setlight(w, val, GL_LIGHT6)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT6)); + break; case A_LIGHT7: - AttemptAttr(setlight(w, val, GL_LIGHT7)); - break; + AttemptAttr(setlight(w, val, GL_LIGHT7)); + break; case A_ALPHA: { double alpha; @@ -3738,331 +3738,331 @@ char * abuf; if (alpha == 0.0) return Failed; - alpha = Abs(alpha); - if (alpha >= 1.0) + alpha = Abs(alpha); + if (alpha >= 1.0) alpha = 1.0; wc->alpha = alpha; - break; + break; } case A_PROJECTION: - if (!strcmp(val,"ortho")) - ws->projection = UGL_ORTHOGONAL; - else if (!strcmp(val,"perspec")) - ws->projection = UGL_PERSPECTIVE; - break; + if (!strcmp(val,"ortho")) + ws->projection = UGL_ORTHOGONAL; + else if (!strcmp(val,"perspec")) + ws->projection = UGL_PERSPECTIVE; + break; case A_CAMWIDTH: - { - double width; + { + double width; - width = atof(val); - if (width == 0.0) - return Failed; + width = atof(val); + if (width == 0.0) + return Failed; ws->camwidth = Abs(width); - break; - } -#endif /* HAVE_LIBGL */ + break; + } +#endif /* HAVE_LIBGL */ case A_MESHMODE: - if (!setmeshmode(w,val)) return Failed; - break; + if (!setmeshmode(w,val)) return Failed; + break; case A_TEXTURE:{ /* -1 means no curtexture, 0 means f is not initialized */ - AttemptAttr( settexture(w, StrLoc(d), StrLen(d), &f, -1, 0)); - break; - } + AttemptAttr( settexture(w, StrLoc(d), StrLen(d), &f, -1, 0)); + break; + } case A_TEXCOORD: - AttemptAttr(settexcoords(w, val)); - break; + AttemptAttr(settexcoords(w, val)); + break; case A_TEXMODE: - AttemptAttr(settexmode(w, val)); - break; + AttemptAttr(settexmode(w, val)); + break; case A_NORMODE: - AttemptAttr(setnormode(w, val)); - break; + AttemptAttr(setnormode(w, val)); + break; case A_SLICES: - AttemptAttr(setslices(w, val)); - break; + AttemptAttr(setslices(w, val)); + break; case A_RINGS: - AttemptAttr(setrings(w, val)); - break; + AttemptAttr(setrings(w, val)); + break; case A_FOV: - AttemptAttr(setfov(w, val)); + AttemptAttr(setfov(w, val)); break; case A_PICK: - AttemptAttr(setselectionmode(w, val)); - break; + AttemptAttr(setselectionmode(w, val)); + break; case A_BUFFERMODE: { if (!strcmp(val,"on")) { wc->buffermode=BUFFERED3D; ws->buffermode=UGL_BUFFERED; } - else if (!strcmp(val,"off")) { + else if (!strcmp(val,"off")) { wc->buffermode = IMMEDIATE3D; ws->buffermode=UGL_IMMEDIATE; } else return Failed; if (!ws->initAttrs) ApplyBuffermode(w, ws->buffermode); break; - } -#endif /* Graphics3D */ + } +#endif /* Graphics3D */ case A_RGBMODE: - AttemptAttr(setrgbmode(w, val)); - break; + AttemptAttr(setrgbmode(w, val)); + break; case A_HEIGHT: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; if ((new_height = tmp) < 1) return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setheight(w, new_height) == Failed) return Failed; - } - else -#endif /* GraphicsGL */ - if (setheight(w, new_height) == Failed) return Failed; - break; + if (ws->is_gl) { + if (gl_setheight(w, new_height) == Failed) return Failed; + } + else +#endif /* GraphicsGL */ + if (setheight(w, new_height) == Failed) return Failed; + break; } case A_WIDTH: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; if ((new_width = tmp) < 1) return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setwidth(w, new_width) == Failed) return Failed; - } - else -#endif /* GraphicsGL */ - if (setwidth(w, new_width) == Failed) return Failed; - break; + if (ws->is_gl) { + if (gl_setwidth(w, new_width) == Failed) return Failed; + } + else +#endif /* GraphicsGL */ + if (setwidth(w, new_width) == Failed) return Failed; + break; } case A_SIZE: { - AttemptAttr(setsize(w, val)); - break; - } + AttemptAttr(setsize(w, val)); + break; + } case A_GEOMETRY: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setgeometry(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setgeometry(w, val)); - break; + if (ws->is_gl) + AttemptAttr(gl_setgeometry(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setgeometry(w, val)); + break; } case A_SELECTION: { - if (setselection(w, &d) == Succeeded) { + if (setselection(w, &d) == Succeeded) { *answer = d; #ifdef GraphicsGL if (ws->is_gl) gl_wflush(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wflush(w); return Succeeded; } - break; - } + break; + } case A_INPUTMASK: { - AttemptAttr(setinputmask(w, val)); - break; - } + AttemptAttr(setinputmask(w, val)); + break; + } case A_RESIZE: { - if (strcmp(val, "on") & strcmp(val, "off")) - return Failed; + if (strcmp(val, "on") & strcmp(val, "off")) + return Failed; #ifdef GraphicsGL if (ws->is_gl) gl_allowresize(w, ATOBOOL(val)); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ allowresize(w, ATOBOOL(val)); - break; + break; } case A_TITLEBAR: { if (w->window->pix != 0) return Failed; - if (strcmp(val, "on") & strcmp(val, "off")) - return Failed; + if (strcmp(val, "on") & strcmp(val, "off")) + return Failed; if (ATOBOOL(val)) { SETTITLEBAR(w->window); } else { CLRTITLEBAR(w->window); } - break; + break; } case A_ROW: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) - ws->y = GL_ROWTOY(w, tmp) + wc->dy; - else -#endif /* GraphicsGL */ - ws->y = ROWTOY(w, tmp) + wc->dy; - break; - } + if (ws->is_gl) + ws->y = GL_ROWTOY(w, tmp) + wc->dy; + else +#endif /* GraphicsGL */ + ws->y = ROWTOY(w, tmp) + wc->dy; + break; + } case A_COL: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) - ws->x = GL_COLTOX(w, tmp) + wc->dx; - else -#endif /* GraphicsGL */ - ws->x = COLTOX(w, tmp) + wc->dx; - break; - } + if (ws->is_gl) + ws->x = GL_COLTOX(w, tmp) + wc->dx; + else +#endif /* GraphicsGL */ + ws->x = COLTOX(w, tmp) + wc->dx; + break; + } case A_CANVAS: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setcanvas(w,val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setcanvas(w,val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_setcanvas(w,val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setcanvas(w,val)); + break; + } case A_ICONIC: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_seticonicstate(w,val)); - else -#endif /* GraphicsGL */ - AttemptAttr(seticonicstate(w,val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_seticonicstate(w,val)); + else +#endif /* GraphicsGL */ + AttemptAttr(seticonicstate(w,val)); + break; + } case A_ICONIMAGE: { - if (!val[0]) return Failed; + if (!val[0]) return Failed; #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_seticonimage(w, &d)); - else -#endif /* GraphicsGL */ - AttemptAttr(seticonimage(w, &d)); + if (ws->is_gl) + AttemptAttr(gl_seticonimage(w, &d)); + else +#endif /* GraphicsGL */ + AttemptAttr(seticonimage(w, &d)); break; - } + } case A_ICONLABEL: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_seticonlabel(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(seticonlabel(w, val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_seticonlabel(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(seticonlabel(w, val)); + break; + } case A_ICONPOS: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_seticonpos(w,val)); - else -#endif /* GraphicsGL */ - AttemptAttr(seticonpos(w,val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_seticonpos(w,val)); + else +#endif /* GraphicsGL */ + AttemptAttr(seticonpos(w,val)); + break; + } case A_LABEL: case A_WINDOWLABEL: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setwindowlabel(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setwindowlabel(w, val)); - break; + if (ws->is_gl) + AttemptAttr(gl_setwindowlabel(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setwindowlabel(w, val)); + break; } case A_CURSOR: { - int on_off; - if (strcmp(val, "on") & strcmp(val, "off")) - return Failed; - on_off = ATOBOOL(val); + int on_off; + if (strcmp(val, "on") & strcmp(val, "off")) + return Failed; + on_off = ATOBOOL(val); #ifdef GraphicsGL if (ws->is_gl) gl_setcursor(w, on_off); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ setcursor(w, on_off); - break; + break; } case A_FONT: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setfont(w, &valptr)); - else -#endif /* GraphicsGL */ - AttemptAttr(setfont(w, &valptr)); - break; + if (ws->is_gl) + AttemptAttr(gl_setfont(w, &valptr)); + else +#endif /* GraphicsGL */ + AttemptAttr(setfont(w, &valptr)); + break; } case A_PATTERN: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_SetPattern(w, val, strlen(val))); - else -#endif /* GraphicsGL */ - AttemptAttr(SetPattern(w, val, strlen(val))); + if (ws->is_gl) + AttemptAttr(gl_SetPattern(w, val, strlen(val))); + else +#endif /* GraphicsGL */ + AttemptAttr(SetPattern(w, val, strlen(val))); break; - } + } case A_POS: { - AttemptAttr(setpos(w, val)); - break; - } + AttemptAttr(setpos(w, val)); + break; + } case A_POSX: { - char tmp[268]; - sprintf(tmp,"%s,%d",val,ws->posy); - AttemptAttr(setpos(w, tmp)); - break; - } + char tmp[268]; + sprintf(tmp,"%s,%d",val,ws->posy); + AttemptAttr(setpos(w, tmp)); + break; + } case A_POSY: { - char tmp[268]; - sprintf(tmp,"%d,%s",ws->posx,val); - AttemptAttr(setpos(w, tmp)); + char tmp[268]; + sprintf(tmp,"%d,%s",ws->posx,val); + AttemptAttr(setpos(w, tmp)); break; - } + } case A_FG: { - if (cnv:C_integer(d, tmp) && tmp < 0) { + if (cnv:C_integer(d, tmp) && tmp < 0) { #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_isetfg(w, tmp) != Succeeded) return Failed; - } - else -#endif /* GraphicsGL */ - if (isetfg(w, tmp) != Succeeded) return Failed; - } - else { + if (ws->is_gl) { + if (gl_isetfg(w, tmp) != Succeeded) return Failed; + } + else +#endif /* GraphicsGL */ + if (isetfg(w, tmp) != Succeeded) return Failed; + } + else { #ifdef Graphics3D if (w->context->rendermode == UGL3D) { - if (setmaterials(w,val) != Succeeded) - return Failed; + if (setmaterials(w,val) != Succeeded) + return Failed; } - else -#endif /* Graphics3D */ + else +#endif /* Graphics3D */ #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setfg(w, val) != Succeeded) return Failed; + if (ws->is_gl) { + if (gl_setfg(w, val) != Succeeded) return Failed; } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ { - if (setfg(w, val) != Succeeded) return Failed; + if (setfg(w, val) != Succeeded) return Failed; }} - break; + break; } case A_BG: { - if (cnv:C_integer(d, tmp) && tmp < 0) { + if (cnv:C_integer(d, tmp) && tmp < 0) { #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_isetbg(w, tmp) != Succeeded) return Failed; - } - else -#endif /* GraphicsGL */ - if (isetbg(w, tmp) != Succeeded) return Failed; - } - else { + if (ws->is_gl) { + if (gl_isetbg(w, tmp) != Succeeded) return Failed; + } + else +#endif /* GraphicsGL */ + if (isetbg(w, tmp) != Succeeded) return Failed; + } + else { #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setbg(w, val) != Succeeded) return Failed; + if (ws->is_gl) { + if (gl_setbg(w, val) != Succeeded) return Failed; } - else -#endif /* GraphicsGL */ - if (setbg(w, val) != Succeeded) return Failed; - } - break; + else +#endif /* GraphicsGL */ + if (setbg(w, val) != Succeeded) return Failed; + } + break; } case A_GAMMA: { if (sscanf(val, "%lf%c", &gamma, &c) != 1 || gamma <= 0.0) @@ -4073,122 +4073,122 @@ char * abuf; return Failed; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (setgamma(w, gamma) != Succeeded) return Failed; break; } case A_FILLSTYLE: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setfillstyle(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setfillstyle(w, val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_setfillstyle(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setfillstyle(w, val)); + break; + } case A_LINESTYLE: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setlinestyle(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setlinestyle(w, val)); - break; - } + if (ws->is_gl) + AttemptAttr(gl_setlinestyle(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setlinestyle(w, val)); + break; + } case A_LINEWIDTH: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef Graphics3D - if (w->context->rendermode == UGL3D) { + if (w->context->rendermode == UGL3D) { if (setlinewidth3D(w, tmp) == RunError) - return Failed; - } + return Failed; + } else -#endif /* Graphics3D */ +#endif /* Graphics3D */ #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_setlinewidth(w, tmp) == RunError) - return Failed; - } - else -#endif /* GraphicsGL */ - if (setlinewidth(w, tmp) == RunError) - return Failed; - break; - } + if (ws->is_gl) { + if (gl_setlinewidth(w, tmp) == RunError) + return Failed; + } + else +#endif /* GraphicsGL */ + if (setlinewidth(w, tmp) == RunError) + return Failed; + break; + } case A_POINTER: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setpointer(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setpointer(w, val)); - break; + if (ws->is_gl) + AttemptAttr(gl_setpointer(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setpointer(w, val)); + break; } case A_DRAWOP: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setdrawop(w, val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setdrawop(w, val)); - break; + if (ws->is_gl) + AttemptAttr(gl_setdrawop(w, val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setdrawop(w, val)); + break; } case A_DISPLAY: { #ifdef GraphicsGL - if (ws->is_gl) - AttemptAttr(gl_setdisplay(w,val)); - else -#endif /* GraphicsGL */ - AttemptAttr(setdisplay(w,val)); - break; + if (ws->is_gl) + AttemptAttr(gl_setdisplay(w,val)); + else +#endif /* GraphicsGL */ + AttemptAttr(setdisplay(w,val)); + break; } case A_X: { - if (!cnv:C_integer(d, tmp)) - return Failed; - ws->x = tmp + wc->dx; - UpdateCursorPos(ws, wc); /* tell system where to blink it */ - break; - } + if (!cnv:C_integer(d, tmp)) + return Failed; + ws->x = tmp + wc->dx; + UpdateCursorPos(ws, wc); /* tell system where to blink it */ + break; + } case A_Y: { - if (!cnv:C_integer(d, tmp)) - return Failed; - ws->y = tmp + wc->dy; - UpdateCursorPos(ws, wc); /* tell system where to blink it */ - break; - } + if (!cnv:C_integer(d, tmp)) + return Failed; + ws->y = tmp + wc->dy; + UpdateCursorPos(ws, wc); /* tell system where to blink it */ + break; + } case A_DX: { - if (!cnv:C_integer(d, tmp)) - return Failed; - wc->dx = tmp; + if (!cnv:C_integer(d, tmp)) + return Failed; + wc->dx = tmp; #ifdef GraphicsGL - if (ws->is_gl) + if (ws->is_gl) gl_setdx(w); -#endif /* GraphicsGL */ - UpdateCursorPos(ws, wc); /* tell system where to blink it */ - break; - } +#endif /* GraphicsGL */ + UpdateCursorPos(ws, wc); /* tell system where to blink it */ + break; + } case A_DY: { - if (!cnv:C_integer(d, tmp)) - return Failed; - wc->dy = tmp; + if (!cnv:C_integer(d, tmp)) + return Failed; + wc->dy = tmp; #ifdef GraphicsGL - if (ws->is_gl) + if (ws->is_gl) gl_setdy(w); -#endif /* GraphicsGL */ - UpdateCursorPos(ws, wc); /* tell system where to blink it */ - break; - } +#endif /* GraphicsGL */ + UpdateCursorPos(ws, wc); /* tell system where to blink it */ + break; + } case A_LEADING: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) - gl_setleading(w, tmp); - else -#endif /* GraphicsGL */ - setleading(w, tmp); + if (ws->is_gl) + gl_setleading(w, tmp); + else +#endif /* GraphicsGL */ + setleading(w, tmp); break; } case A_IMAGE: { @@ -4196,7 +4196,7 @@ char * abuf; ws->initimage.format = UCOLOR_BGR; #else ws->initimage.format = UCOLOR_RGB; -#endif +#endif ws->initimage.is_bottom_up = 0; /* first try supported image file formats; then try platform-dependent format */ @@ -4208,7 +4208,7 @@ char * abuf; gl_setheight(w, ws->initimage.height); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { setwidth(w, ws->initimage.width); setheight(w, ws->initimage.height); @@ -4218,130 +4218,130 @@ char * abuf; if (ws->is_gl) r = gl_setimage(w, val); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ r = setimage(w, val); } - AttemptAttr(r); + AttemptAttr(r); break; } case A_ECHO: { - if (strcmp(val, "on") & strcmp(val, "off")) - return Failed; - if (ATOBOOL(val)) SETECHOON(w); - else CLRECHOON(w); - break; + if (strcmp(val, "on") & strcmp(val, "off")) + return Failed; + if (ATOBOOL(val)) SETECHOON(w); + else CLRECHOON(w); + break; } case A_CLIPX: case A_CLIPY: case A_CLIPW: case A_CLIPH: { - if (!*val) { - wc->clipx = wc->clipy = 0; - wc->clipw = wc->cliph = -1; + if (!*val) { + wc->clipx = wc->clipy = 0; + wc->clipw = wc->cliph = -1; #ifdef GraphicsGL - if (ws->is_gl) - gl_unsetclip(w); - else -#endif /* GraphicsGL */ - unsetclip(w); - } - else { - if (!cnv:C_integer(d, tmp)) - return Failed; - if (wc->clipw < 0) { - wc->clipx = wc->clipy = 0; - wc->clipw = ws->width; - wc->cliph = ws->height; - } - switch (a) { - case A_CLIPX: wc->clipx = tmp; break; - case A_CLIPY: wc->clipy = tmp; break; - case A_CLIPW: wc->clipw = tmp; break; - case A_CLIPH: wc->cliph = tmp; break; - } + if (ws->is_gl) + gl_unsetclip(w); + else +#endif /* GraphicsGL */ + unsetclip(w); + } + else { + if (!cnv:C_integer(d, tmp)) + return Failed; + if (wc->clipw < 0) { + wc->clipx = wc->clipy = 0; + wc->clipw = ws->width; + wc->cliph = ws->height; + } + switch (a) { + case A_CLIPX: wc->clipx = tmp; break; + case A_CLIPY: wc->clipy = tmp; break; + case A_CLIPW: wc->clipw = tmp; break; + case A_CLIPH: wc->cliph = tmp; break; + } #ifdef GraphicsGL - if (ws->is_gl) - gl_setclip(w); - else -#endif /* GraphicsGL */ - setclip(w); - } - break; - } + if (ws->is_gl) + gl_setclip(w); + else +#endif /* GraphicsGL */ + setclip(w); + } + break; + } case A_REVERSE: { - if (strcmp(val, "on") && strcmp(val, "off")) - return Failed; - if ((!ATOBOOL(val) && ISREVERSE(w)) || - (ATOBOOL(val) && !ISREVERSE(w))) { + if (strcmp(val, "on") && strcmp(val, "off")) + return Failed; + if ((!ATOBOOL(val) && ISREVERSE(w)) || + (ATOBOOL(val) && !ISREVERSE(w))) { #ifdef GraphicsGL if (ws->is_gl) - gl_toggle_fgbg(w); - else -#endif /* GraphicsGL */ - { - toggle_fgbg(w); - ISREVERSE(w) ? CLRREVERSE(w) : SETREVERSE(w); - } - } - break; + gl_toggle_fgbg(w); + else +#endif /* GraphicsGL */ + { + toggle_fgbg(w); + ISREVERSE(w) ? CLRREVERSE(w) : SETREVERSE(w); + } + } + break; } case A_POINTERX: { - if (!cnv:C_integer(d, tmp)) - return Failed; - ws->pointerx = tmp + wc->dx; + if (!cnv:C_integer(d, tmp)) + return Failed; + ws->pointerx = tmp + wc->dx; #ifdef GraphicsGL - if (ws->is_gl) - gl_warpPointer(w, ws->pointerx, ws->pointery); - else -#endif /* GraphicsGL */ - warpPointer(w, ws->pointerx, ws->pointery); - break; - } + if (ws->is_gl) + gl_warpPointer(w, ws->pointerx, ws->pointery); + else +#endif /* GraphicsGL */ + warpPointer(w, ws->pointerx, ws->pointery); + break; + } case A_POINTERY: { - if (!cnv:C_integer(d, tmp)) - return Failed; - ws->pointery = tmp + wc->dy; + if (!cnv:C_integer(d, tmp)) + return Failed; + ws->pointery = tmp + wc->dy; #ifdef GraphicsGL - if (ws->is_gl) - gl_warpPointer(w, ws->pointerx, ws->pointery); - else -#endif /* GraphicsGL */ - warpPointer(w, ws->pointerx, ws->pointery); - break; - } + if (ws->is_gl) + gl_warpPointer(w, ws->pointerx, ws->pointery); + else +#endif /* GraphicsGL */ + warpPointer(w, ws->pointerx, ws->pointery); + break; + } case A_POINTERCOL: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - ws->pointerx = GL_COLTOX(w, tmp) + wc->dx; - gl_warpPointer(w, ws->pointerx, ws->pointery); - } - else -#endif /* GraphicsGL */ - { - ws->pointerx = COLTOX(w, tmp) + wc->dx; - warpPointer(w, ws->pointerx, ws->pointery); - } - break; - } + if (ws->is_gl) { + ws->pointerx = GL_COLTOX(w, tmp) + wc->dx; + gl_warpPointer(w, ws->pointerx, ws->pointery); + } + else +#endif /* GraphicsGL */ + { + ws->pointerx = COLTOX(w, tmp) + wc->dx; + warpPointer(w, ws->pointerx, ws->pointery); + } + break; + } case A_POINTERROW: { - if (!cnv:C_integer(d, tmp)) - return Failed; + if (!cnv:C_integer(d, tmp)) + return Failed; #ifdef GraphicsGL - if (ws->is_gl) { - ws->pointery = GL_ROWTOY(w, tmp) + wc->dy; - gl_warpPointer(w, ws->pointerx, ws->pointery); - } - else -#endif /* GraphicsGL */ - { - ws->pointery = ROWTOY(w, tmp) + wc->dy; - warpPointer(w, ws->pointerx, ws->pointery); - } - break; - } + if (ws->is_gl) { + ws->pointery = GL_ROWTOY(w, tmp) + wc->dy; + gl_warpPointer(w, ws->pointerx, ws->pointery); + } + else +#endif /* GraphicsGL */ + { + ws->pointery = ROWTOY(w, tmp) + wc->dy; + warpPointer(w, ws->pointerx, ws->pointery); + } + break; + } /* * remaining valid attributes are error #147 */ @@ -4357,8 +4357,8 @@ char * abuf; * invalid attribute */ default: - ReturnErrNum(145, RunError); - } + ReturnErrNum(145, RunError); + } strncpy(abuf, s, len); abuf[len] = '\0'; } @@ -4372,46 +4372,46 @@ char * abuf; abuf[len] = '\0'; switch (a=si_s2i(attribs, abuf)) { case A_SELECTION: - if ((selectiontemp=getselection(w, abuf)) == NULL) return Failed; - MakeStr(selectiontemp, strlen(selectiontemp), answer); - break; + if ((selectiontemp=getselection(w, abuf)) == NULL) return Failed; + MakeStr(selectiontemp, strlen(selectiontemp), answer); + break; case A_IMAGE: ReturnErrNum(147, RunError); break; #ifdef Graphics3D case A_RENDERMODE: if (wc->rendermode == UGL3D) - sprintf(abuf, "3d"); + sprintf(abuf, "3d"); else - sprintf(abuf, "2d"); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf, "2d"); + MakeStr(abuf, strlen(abuf), answer); + break; case A_DIM: - MakeInt(wc->dim, answer); - break; + MakeInt(wc->dim, answer); + break; case A_EYE: - sprintf(abuf,"%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f", - ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, - ws->eyediry, ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f,%.2f", + ws->eyeposx, ws->eyeposy, ws->eyeposz, ws->eyedirx, + ws->eyediry, ws->eyedirz, ws->eyeupx, ws->eyeupy, ws->eyeupz); + MakeStr(abuf, strlen(abuf), answer); + break; case A_EYEPOS: - sprintf(abuf,"%.2f,%.2f,%.2f", ws->eyeposx, ws->eyeposy, ws->eyeposz); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%.2f,%.2f,%.2f", ws->eyeposx, ws->eyeposy, ws->eyeposz); + MakeStr(abuf, strlen(abuf), answer); + break; case A_EYEUP: - sprintf(abuf, "%.2f,%.2f,%.2f", ws->eyeupx, ws->eyeupy, ws->eyeupz); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf, "%.2f,%.2f,%.2f", ws->eyeupx, ws->eyeupy, ws->eyeupz); + MakeStr(abuf, strlen(abuf), answer); + break; case A_EYEDIR: - sprintf(abuf, "%.2f,%.2f,%.2f", ws->eyedirx, ws->eyediry, ws->eyedirz); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf, "%.2f,%.2f,%.2f", ws->eyedirx, ws->eyediry, ws->eyedirz); + MakeStr(abuf, strlen(abuf), answer); + break; case A_LIGHT: case A_LIGHT0: - getlight(0, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + getlight(0, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_LIGHT1: getlight(1, abuf); MakeStr(abuf, strlen(abuf), answer); @@ -4443,164 +4443,164 @@ char * abuf; case A_ALPHA: sprintf(abuf,"%f",wc->alpha); MakeStr(abuf, strlen(abuf), answer); - break; + break; case A_PROJECTION: - if (ws->projection == UGL_PERSPECTIVE) + if (ws->projection == UGL_PERSPECTIVE) sprintf(abuf,"perspec"); - else + else sprintf(abuf,"ortho"); MakeStr(abuf, strlen(abuf), answer); - break; + break; case A_CAMWIDTH: sprintf(abuf,"%f",ws->camwidth); MakeStr(abuf, strlen(abuf), answer); - break; + break; case A_MESHMODE: getmeshmode(w, abuf); - MakeStr(abuf, strlen(abuf), answer); + MakeStr(abuf, strlen(abuf), answer); break; case A_TEXTURE: - gettexture( w, answer ); - /* looks like a memory leak to me */ - if (is:string(*answer)) StrLoc(*answer) = strdup(StrLoc(*answer)); + gettexture( w, answer ); + /* looks like a memory leak to me */ + if (is:string(*answer)) StrLoc(*answer) = strdup(StrLoc(*answer)); break; case A_TEXMODE: - gettexmode( w, abuf, answer ); + gettexmode( w, abuf, answer ); break; case A_NORMODE: - if (!wc->normode){ - strcpy(abuf, "off"); - MakeStr(abuf, 3, answer); - } - else if (wc->normode==1){ - strcpy(abuf, "auto"); - MakeStr(abuf, 4, answer); - } - else{ - strcpy(abuf, "on"); - MakeStr(abuf, 2, answer); - } - break; + if (!wc->normode){ + strcpy(abuf, "off"); + MakeStr(abuf, 3, answer); + } + else if (wc->normode==1){ + strcpy(abuf, "auto"); + MakeStr(abuf, 4, answer); + } + else{ + strcpy(abuf, "on"); + MakeStr(abuf, 2, answer); + } + break; case A_TEXCOORD: - strcpy(abuf, "auto"); - if (wc->autogen) - MakeStr(abuf, 4, answer); - else { - gettexcoords(w, abuf); - MakeStr(strdup(abuf), strlen(abuf), answer); - } - break; + strcpy(abuf, "auto"); + if (wc->autogen) + MakeStr(abuf, 4, answer); + else { + gettexcoords(w, abuf); + MakeStr(strdup(abuf), strlen(abuf), answer); + } + break; case A_SLICES: - MakeInt(wc->slices, answer); - break; + MakeInt(wc->slices, answer); + break; case A_RINGS: - MakeInt(wc->rings, answer); - break; + MakeInt(wc->rings, answer); + break; case A_RGBMODE: - switch (wc->rgbmode) { - case 0: strcpy(abuf, "auto"); break; - case 1: strcpy(abuf, "24"); break; - case 2: strcpy(abuf, "48"); break; - case 3: strcpy(abuf, "normalized"); break; - } - MakeStr(abuf, strlen(abuf), answer); - break; + switch (wc->rgbmode) { + case 0: strcpy(abuf, "auto"); break; + case 1: strcpy(abuf, "24"); break; + case 2: strcpy(abuf, "48"); break; + case 3: strcpy(abuf, "normalized"); break; + } + MakeStr(abuf, strlen(abuf), answer); + break; case A_PICK: { - sprintf(abuf,"%s",((w->context->selectionenabled==1)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; - } + sprintf(abuf,"%s",((w->context->selectionenabled==1)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; + } case A_GLRENDERER: { #if HAVE_LIBGL - sprintf(abuf,"%s", (char *) glGetString(GL_RENDERER)); -#else /* HAVE_LIBGL */ - sprintf(abuf,"%s", "Unknown"); -#endif /* HAVE_LIBGL */ - MakeStr(abuf, strlen(abuf), answer); - break; - } + sprintf(abuf,"%s", (char *) glGetString(GL_RENDERER)); +#else /* HAVE_LIBGL */ + sprintf(abuf,"%s", "Unknown"); +#endif /* HAVE_LIBGL */ + MakeStr(abuf, strlen(abuf), answer); + break; + } case A_GLVENDOR: { #if HAVE_LIBGL - sprintf(abuf,"%s", (char *) glGetString(GL_VENDOR)); -#else /* HAVE_LIBGL */ - sprintf(abuf,"%s", "Unknown"); -#endif /* HAVE_LIBGL */ - MakeStr(abuf, strlen(abuf), answer); - break; - } + sprintf(abuf,"%s", (char *) glGetString(GL_VENDOR)); +#else /* HAVE_LIBGL */ + sprintf(abuf,"%s", "Unknown"); +#endif /* HAVE_LIBGL */ + MakeStr(abuf, strlen(abuf), answer); + break; + } case A_GLVERSION: { #if HAVE_LIBGL - sprintf(abuf,"%s", (char *) glGetString(GL_VERSION)); -#else /* HAVE_LIBGL */ - sprintf(abuf,"%s", "Unknown"); -#endif /* HAVE_LIBGL */ - MakeStr(abuf, strlen(abuf), answer); - break; - } + sprintf(abuf,"%s", (char *) glGetString(GL_VERSION)); +#else /* HAVE_LIBGL */ + sprintf(abuf,"%s", "Unknown"); +#endif /* HAVE_LIBGL */ + MakeStr(abuf, strlen(abuf), answer); + break; + } case A_BUFFERMODE: { - sprintf(abuf,"%s",((ws->buffermode==UGL_BUFFERED)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; - } -#endif /* Graphics3D */ + sprintf(abuf,"%s",((ws->buffermode==UGL_BUFFERED)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; + } +#endif /* Graphics3D */ case A_VISUAL: #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_getvisual(w, abuf) == Failed) return Failed; - } - else -#endif /* GraphicsGL */ - if (getvisual(w, abuf) == Failed) return Failed; - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) { + if (gl_getvisual(w, abuf) == Failed) return Failed; + } + else +#endif /* GraphicsGL */ + if (getvisual(w, abuf) == Failed) return Failed; + MakeStr(abuf, strlen(abuf), answer); + break; case A_DEPTH: - MakeInt(SCREENDEPTH(w), answer); - break; + MakeInt(SCREENDEPTH(w), answer); + break; case A_DISPLAY: #ifdef GraphicsGL - if (ws->is_gl) - gl_getdisplay(w, abuf); - else -#endif /* GraphicsGL */ - getdisplay(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getdisplay(w, abuf); + else +#endif /* GraphicsGL */ + getdisplay(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_ASCENT: #ifdef GraphicsGL - if (ws->is_gl) { - MakeInt(GL_ASCENT(w), answer); + if (ws->is_gl) { + MakeInt(GL_ASCENT(w), answer); } else -#endif /* GraphicsGL */ - MakeInt(ASCENT(w), answer); - break; +#endif /* GraphicsGL */ + MakeInt(ASCENT(w), answer); + break; case A_DESCENT: #ifdef GraphicsGL - if (ws->is_gl) { - MakeInt(GL_DESCENT(w), answer); + if (ws->is_gl) { + MakeInt(GL_DESCENT(w), answer); } else -#endif /* GraphicsGL */ - MakeInt(DESCENT(w), answer); - break; +#endif /* GraphicsGL */ + MakeInt(DESCENT(w), answer); + break; case A_FHEIGHT: #ifdef GraphicsGL - if (ws->is_gl) { - MakeInt(GL_FHEIGHT(w), answer); + if (ws->is_gl) { + MakeInt(GL_FHEIGHT(w), answer); } else -#endif /* GraphicsGL */ - MakeInt(FHEIGHT(w), answer); - break; +#endif /* GraphicsGL */ + MakeInt(FHEIGHT(w), answer); + break; case A_FWIDTH: #ifdef GraphicsGL - if (ws->is_gl) { - MakeInt(GL_FWIDTH(w), answer); + if (ws->is_gl) { + MakeInt(GL_FWIDTH(w), answer); } else -#endif /* GraphicsGL */ - MakeInt(FWIDTH(w), answer); - break; +#endif /* GraphicsGL */ + MakeInt(FWIDTH(w), answer); + break; case A_INPUTMASK: { char *s = abuf; int mask = w->window->inputmask; @@ -4611,343 +4611,343 @@ char * abuf; if (mask & WindowClosureMask) *s++ = 'c'; *s = 0; - MakeStr(abuf, strlen(abuf), answer); - break; + MakeStr(abuf, strlen(abuf), answer); + break; } case A_ROW: #ifdef GraphicsGL - if (ws->is_gl) - MakeInt(GL_YTOROW(w, ws->y - wc->dy), answer); - else -#endif /* GraphicsGL */ - MakeInt(YTOROW(w, ws->y - wc->dy), answer); - break; + if (ws->is_gl) + MakeInt(GL_YTOROW(w, ws->y - wc->dy), answer); + else +#endif /* GraphicsGL */ + MakeInt(YTOROW(w, ws->y - wc->dy), answer); + break; case A_COL: #ifdef GraphicsGL - if (ws->is_gl) - MakeInt(1 + GL_XTOCOL(w, ws->x - wc->dx), answer); - else -#endif /* GraphicsGL */ - MakeInt(1 + XTOCOL(w, ws->x - wc->dx), answer); - break; + if (ws->is_gl) + MakeInt(1 + GL_XTOCOL(w, ws->x - wc->dx), answer); + else +#endif /* GraphicsGL */ + MakeInt(1 + XTOCOL(w, ws->x - wc->dx), answer); + break; case A_POINTERROW: { - XPoint xp; + XPoint xp; #ifdef GraphicsGL - if (ws->is_gl) { - gl_query_pointer(w, &xp); - MakeInt(GL_YTOROW(w, xp.y - wc->dy), answer); - } - else -#endif /* GraphicsGL */ - { - query_pointer(w, &xp); - MakeInt(YTOROW(w, xp.y - wc->dy), answer); - } - break; - } + if (ws->is_gl) { + gl_query_pointer(w, &xp); + MakeInt(GL_YTOROW(w, xp.y - wc->dy), answer); + } + else +#endif /* GraphicsGL */ + { + query_pointer(w, &xp); + MakeInt(YTOROW(w, xp.y - wc->dy), answer); + } + break; + } case A_POINTERCOL: { - XPoint xp; + XPoint xp; #ifdef GraphicsGL - if (ws->is_gl) { - gl_query_pointer(w, &xp); - MakeInt(1 + GL_XTOCOL(w, xp.x - wc->dx), answer); - } - else -#endif /* GraphicsGL */ - { - query_pointer(w, &xp); - MakeInt(1 + XTOCOL(w, xp.x - wc->dx), answer); - } - break; - } + if (ws->is_gl) { + gl_query_pointer(w, &xp); + MakeInt(1 + GL_XTOCOL(w, xp.x - wc->dx), answer); + } + else +#endif /* GraphicsGL */ + { + query_pointer(w, &xp); + MakeInt(1 + XTOCOL(w, xp.x - wc->dx), answer); + } + break; + } case A_LINES: case A_ROWS: #ifdef GraphicsGL - if (ws->is_gl) - MakeInt(GL_YTOROW(w,ws->height - DESCENT(w)), answer); - else -#endif /* GraphicsGL */ - MakeInt(YTOROW(w,ws->height - DESCENT(w)), answer); - break; + if (ws->is_gl) + MakeInt(GL_YTOROW(w,ws->height - DESCENT(w)), answer); + else +#endif /* GraphicsGL */ + MakeInt(YTOROW(w,ws->height - DESCENT(w)), answer); + break; case A_COLUMNS: #ifdef GraphicsGL - if (ws->is_gl) - MakeInt(GL_XTOCOL(w,ws->width), answer); - else -#endif /* GraphicsGL */ - MakeInt(XTOCOL(w,ws->width), answer); - break; + if (ws->is_gl) + MakeInt(GL_XTOCOL(w,ws->width), answer); + else +#endif /* GraphicsGL */ + MakeInt(XTOCOL(w,ws->width), answer); + break; case A_POS: case A_POSX: case A_POSY: #ifdef GraphicsGL - if (ws->is_gl) { - if (gl_getpos(w) == Failed) - return Failed; - } - else -#endif /* GraphicsGL */ - if (getpos(w) == Failed) - return Failed; - switch (a) { - case A_POS: - sprintf(abuf, "%d,%d", ws->posx, ws->posy); - MakeStr(abuf, strlen(abuf), answer); - break; - case A_POSX: - MakeInt(ws->posx, answer); - break; - case A_POSY: - MakeInt(ws->posy, answer); - break; - } - break; + if (ws->is_gl) { + if (gl_getpos(w) == Failed) + return Failed; + } + else +#endif /* GraphicsGL */ + if (getpos(w) == Failed) + return Failed; + switch (a) { + case A_POS: + sprintf(abuf, "%d,%d", ws->posx, ws->posy); + MakeStr(abuf, strlen(abuf), answer); + break; + case A_POSX: + MakeInt(ws->posx, answer); + break; + case A_POSY: + MakeInt(ws->posy, answer); + break; + } + break; case A_FG: #ifdef Graphics3D - if (w->context->rendermode == UGL3D) - getmaterials(abuf); - else + if (w->context->rendermode == UGL3D) + getmaterials(abuf); + else #endif -#ifdef GraphicsGL - if (ws->is_gl) - gl_getfg(w, abuf); - else -#endif /* GraphicsGL */ - getfg(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; +#ifdef GraphicsGL + if (ws->is_gl) + gl_getfg(w, abuf); + else +#endif /* GraphicsGL */ + getfg(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_BG: -#ifdef GraphicsGL - if (ws->is_gl) - gl_getbg(w, abuf); - else -#endif /* GraphicsGL */ - getbg(w, abuf); - MakeStr(abuf, strlen(abuf), answer); +#ifdef GraphicsGL + if (ws->is_gl) + gl_getbg(w, abuf); + else +#endif /* GraphicsGL */ + getbg(w, abuf); + MakeStr(abuf, strlen(abuf), answer); break; case A_GAMMA: #ifdef DescriptorDouble - answer->vword.realval = wc->gamma; -#else /* DescriptorDouble */ + answer->vword.realval = wc->gamma; +#else /* DescriptorDouble */ Protect(BlkLoc(*answer) = (union block *)alcreal(wc->gamma), return RunError); -#endif /* DescriptorDouble */ +#endif /* DescriptorDouble */ answer->dword = D_Real; break; case A_FILLSTYLE: sprintf(abuf, "%s", (wc->fillstyle == FS_SOLID) ? "solid" : (wc->fillstyle == FS_STIPPLE) ? "masked" : "textured"); - MakeStr(abuf, strlen(abuf), answer); - break; + MakeStr(abuf, strlen(abuf), answer); + break; case A_LINESTYLE: #ifdef GraphicsGL - if (ws->is_gl) - gl_getlinestyle(w, abuf); - else -#endif /* GraphicsGL */ - getlinestyle(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getlinestyle(w, abuf); + else +#endif /* GraphicsGL */ + getlinestyle(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_LINEWIDTH: - MakeInt(LINEWIDTH(w), answer); - break; + MakeInt(LINEWIDTH(w), answer); + break; case A_HEIGHT: { MakeInt(ws->height, answer); break; } case A_WIDTH: { MakeInt(ws->width, answer); break; } case A_SIZE: - sprintf(abuf, "%d,%d", ws->width, ws->height); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf, "%d,%d", ws->width, ws->height); + MakeStr(abuf, strlen(abuf), answer); + break; case A_RESIZE: - sprintf(abuf,"%s",(ISRESIZABLE(w)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%s",(ISRESIZABLE(w)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; case A_DISPLAYHEIGHT: - MakeInt(DISPLAYHEIGHT(w), answer); - break; + MakeInt(DISPLAYHEIGHT(w), answer); + break; case A_DISPLAYWIDTH: - MakeInt(DISPLAYWIDTH(w), answer); - break; + MakeInt(DISPLAYWIDTH(w), answer); + break; case A_CURSOR: - sprintf(abuf,"%s",(ISCURSORON(w)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%s",(ISCURSORON(w)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; case A_ECHO: - sprintf(abuf,"%s",(ISECHOON(w)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%s",(ISECHOON(w)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; case A_REVERSE: - sprintf(abuf,"%s",(ISREVERSE(w)?"on":"off")); - MakeStr(abuf, strlen(abuf), answer); - break; + sprintf(abuf,"%s",(ISREVERSE(w)?"on":"off")); + MakeStr(abuf, strlen(abuf), answer); + break; case A_FONT: #ifdef GraphicsGL - if (ws->is_gl) - gl_getfntnam(w, abuf); - else -#endif /* GraphicsGL */ - getfntnam(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getfntnam(w, abuf); + else +#endif /* GraphicsGL */ + getfntnam(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_X: MakeInt(ws->x - wc->dx, answer); break; case A_Y: MakeInt(ws->y - wc->dy, answer); break; case A_DX: MakeInt(wc->dx, answer); break; case A_DY: MakeInt(wc->dy, answer); break; case A_LEADING: MakeInt(LEADING(w), answer); break; case A_POINTERX: { - XPoint xp; + XPoint xp; #ifdef GraphicsGL - if (ws->is_gl) - gl_query_pointer(w, &xp); - else -#endif /* GraphicsGL */ - query_pointer(w, &xp); - MakeInt(xp.x - wc->dx, answer); - break; - } + if (ws->is_gl) + gl_query_pointer(w, &xp); + else +#endif /* GraphicsGL */ + query_pointer(w, &xp); + MakeInt(xp.x - wc->dx, answer); + break; + } case A_POINTERY: { - XPoint xp; + XPoint xp; #ifdef GraphicsGL - if (ws->is_gl) - gl_query_pointer(w, &xp); - else -#endif /* GraphicsGL */ - query_pointer(w, &xp); - MakeInt(xp.y - wc->dy, answer); - break; - } + if (ws->is_gl) + gl_query_pointer(w, &xp); + else +#endif /* GraphicsGL */ + query_pointer(w, &xp); + MakeInt(xp.y - wc->dy, answer); + break; + } case A_POINTER: #ifdef GraphicsGL - if (ws->is_gl) - gl_getpointername(w, abuf); - else -#endif /* GraphicsGL */ - getpointername(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getpointername(w, abuf); + else +#endif /* GraphicsGL */ + getpointername(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_DRAWOP: #ifdef GraphicsGL - if (ws->is_gl) - gl_getdrawop(w, abuf); - else -#endif /* GraphicsGL */ - getdrawop(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getdrawop(w, abuf); + else +#endif /* GraphicsGL */ + getdrawop(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_GEOMETRY: #ifdef GraphicsGL - if (ws->is_gl) + if (ws->is_gl) { if (gl_getpos(w) == Failed) return Failed; } - else -#endif /* GraphicsGL */ - if (getpos(w) == Failed) return Failed; + else +#endif /* GraphicsGL */ + if (getpos(w) == Failed) return Failed; if (ws->win) sprintf(abuf, "%dx%d+%d+%d", - ws->width, ws->height, ws->posx, ws->posy); + ws->width, ws->height, ws->posx, ws->posy); else sprintf(abuf, "%dx%d", ws->pixwidth, ws->pixheight); - MakeStr(abuf, strlen(abuf), answer); - break; + MakeStr(abuf, strlen(abuf), answer); + break; case A_CANVAS: #ifdef GraphicsGL - if (ws->is_gl) - gl_getcanvas(w, abuf); - else -#endif /* GraphicsGL */ - getcanvas(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_getcanvas(w, abuf); + else +#endif /* GraphicsGL */ + getcanvas(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_ICONIC: #ifdef GraphicsGL - if (ws->is_gl) - gl_geticonic(w, abuf); - else -#endif /* GraphicsGL */ - geticonic(w, abuf); - MakeStr(abuf, strlen(abuf), answer); - break; + if (ws->is_gl) + gl_geticonic(w, abuf); + else +#endif /* GraphicsGL */ + geticonic(w, abuf); + MakeStr(abuf, strlen(abuf), answer); + break; case A_ICONIMAGE: - if (ICONFILENAME(w) != NULL) - sprintf(abuf, "%s", ICONFILENAME(w)); - else *abuf = '\0'; - MakeStr(abuf, strlen(abuf), answer); - break; + if (ICONFILENAME(w) != NULL) + sprintf(abuf, "%s", ICONFILENAME(w)); + else *abuf = '\0'; + MakeStr(abuf, strlen(abuf), answer); + break; case A_ICONLABEL: - if (ICONLABEL(w) != NULL) - sprintf(abuf, "%s", ICONLABEL(w)); - else return Failed; - MakeStr(abuf, strlen(abuf), answer); - break; + if (ICONLABEL(w) != NULL) + sprintf(abuf, "%s", ICONLABEL(w)); + else return Failed; + MakeStr(abuf, strlen(abuf), answer); + break; case A_LABEL: case A_WINDOWLABEL: - if (WINDOWLABEL(w) != NULL) - sprintf(abuf,"%s", WINDOWLABEL(w)); - else return Failed; - MakeStr(abuf, strlen(abuf), answer); - break; + if (WINDOWLABEL(w) != NULL) + sprintf(abuf,"%s", WINDOWLABEL(w)); + else return Failed; + MakeStr(abuf, strlen(abuf), answer); + break; case A_ICONPOS: { #ifdef GraphicsGL - if (ws->is_gl) - switch (gl_geticonpos(w,abuf)) { - case Failed: return Failed; - case RunError: return Failed; - } - else -#endif /* GraphicsGL */ - switch (geticonpos(w,abuf)) { - case Failed: return Failed; - case RunError: return Failed; - } - MakeStr(abuf, strlen(abuf), answer); - break; - } + if (ws->is_gl) + switch (gl_geticonpos(w,abuf)) { + case Failed: return Failed; + case RunError: return Failed; + } + else +#endif /* GraphicsGL */ + switch (geticonpos(w,abuf)) { + case Failed: return Failed; + case RunError: return Failed; + } + MakeStr(abuf, strlen(abuf), answer); + break; + } case A_PATTERN: { - s = w->context->patternname; - if (s != NULL) { - strcpy(abuf, s); - MakeStr(abuf, strlen(s), answer); - } - else { - strcpy(abuf, "black"); - MakeStr(abuf, 5, answer); - } - break; - } + s = w->context->patternname; + if (s != NULL) { + strcpy(abuf, s); + MakeStr(abuf, strlen(s), answer); + } + else { + strcpy(abuf, "black"); + MakeStr(abuf, 5, answer); + } + break; + } case A_CLIPX: - if (wc->clipw >= 0) - MakeInt(wc->clipx, answer); - else - *answer = nulldesc; - break; + if (wc->clipw >= 0) + MakeInt(wc->clipx, answer); + else + *answer = nulldesc; + break; case A_CLIPY: - if (wc->clipw >= 0) - MakeInt(wc->clipy, answer); - else - *answer = nulldesc; - break; + if (wc->clipw >= 0) + MakeInt(wc->clipy, answer); + else + *answer = nulldesc; + break; case A_CLIPW: - if (wc->clipw >= 0) - MakeInt(wc->clipw, answer); - else - *answer = nulldesc; - break; + if (wc->clipw >= 0) + MakeInt(wc->clipw, answer); + else + *answer = nulldesc; + break; case A_CLIPH: - if (wc->clipw >= 0) - MakeInt(wc->cliph, answer); - else - *answer = nulldesc; - break; + if (wc->clipw >= 0) + MakeInt(wc->cliph, answer); + else + *answer = nulldesc; + break; default: - ReturnErrNum(145, RunError); - } + ReturnErrNum(145, RunError); + } } #ifdef GraphicsGL if (ws->is_gl) gl_wflush(w); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wflush(w); return Succeeded; } - + /* * rectargs -- interpret rectangle arguments uniformly * @@ -5011,7 +5011,7 @@ C_integer *px, *py, *pw, *ph; return -1; } - + /* * docircles -- draw or file circles. * @@ -5031,13 +5031,13 @@ int fill; dx = w->context->dx; dy = w->context->dy; - for (i = 0; i < argc; i += 5) { /* for each set of five args */ + for (i = 0; i < argc; i += 5) { /* for each set of five args */ /* * Collect arguments. */ if (i + 2 >= argc) - return i + 2; /* missing y or r */ + return i + 2; /* missing y or r */ if (!cnv:C_double(argv[i], x)) return i; if (!cnv:C_double(argv[i + 1], y)) @@ -5056,17 +5056,17 @@ int fill; /* * Put in canonical form: r >= 0, -2*pi <= theta < 0, alpha >= 0. */ - if (r < 0) { /* ensure positive radius */ + if (r < 0) { /* ensure positive radius */ r = -r; theta += Pi; } - if (alpha < 0) { /* ensure positive extent */ + if (alpha < 0) { /* ensure positive extent */ theta += alpha; alpha = -alpha; } theta = fmod(theta, 2 * Pi); - if (theta > 0) /* normalize initial angle */ + if (theta > 0) /* normalize initial angle */ theta -= 2 * Pi; /* @@ -5088,15 +5088,15 @@ int fill; */ #ifdef GraphicsGL if (w->window->is_gl) { - if (fill) + if (fill) gl_fillcircles(w, &arc, 1); - else + else gl_drawcircles(w, &arc, 1); } - else -#endif /* GraphicsGL */ + else +#endif /* GraphicsGL */ { - if (fill) { /* {} required due to form of macros */ + if (fill) { /* {} required due to form of macros */ fillarcs(w, &arc, 1); } else { @@ -5106,7 +5106,7 @@ int fill; } return -1; } - + /* * genCurve - draw a smooth curve through a set of points. Algorithm from @@ -5157,14 +5157,14 @@ void genCurve(wbp w, XPoint *p, int n, void (*helper) (wbp, XPoint [], int)) int tmp2 = abs(p[i-1].y - p[i-2].y); steps = max(tmp1, tmp2) + 10; } -#else /* VMS */ +#else /* VMS */ steps = max(abs(p[i-1].x - p[i-2].x), abs(p[i-1].y - p[i-2].y)) + 10; -#endif /* VMS */ +#endif /* VMS */ if (steps+4 > npoints) { if (thepoints != NULL) free(thepoints); - thepoints = (XPoint *)malloc((steps+4) * sizeof(XPoint)); - npoints = steps+4; + thepoints = (XPoint *)malloc((steps+4) * sizeof(XPoint)); + npoints = steps+4; } stepsize = 1.0/steps; @@ -5183,12 +5183,12 @@ void genCurve(wbp w, XPoint *p, int n, void (*helper) (wbp, XPoint [], int)) /* calculate the points for drawing the curve */ for (j = 0; j < steps; j++) { - x = x + dx; - y = y + dy; - dx = dx + d2x; - dy = dy + d2y; - d2x = d2x + d3x; - d2y = d2y + d3y; + x = x + dx; + y = y + dy; + dx = dx + d2x; + dy = dy + d2y; + d2x = d2x + d3x; + d2y = d2y + d3y; thepoints[j + 1].x = (int)x; thepoints[j + 1].y = (int)y; } @@ -5212,11 +5212,11 @@ void curveLister(wbp w, XPoint *pts, int n) */ for(i=0; iwindow->is_gl) gl_drawlines(w, thepoints, n); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ drawlines(w, thepoints, n); } @@ -5246,7 +5246,7 @@ int n; { genCurve(w, p, n, curveHelper); } - + void waitkey(FILE *w) { @@ -5261,10 +5261,10 @@ void waitkey(FILE *w) #if !NT extern FILE *flog; -#endif /* NT */ +#endif /* NT */ + - /* * Compare two unsigned long values for qsort or qsearch. */ @@ -5288,99 +5288,99 @@ pointer p1, p2; */ stringint attribs[] = { - { 0, NUMATTRIBS}, - {"alpha", A_ALPHA}, - {"ascent", A_ASCENT}, - {"bg", A_BG}, + { 0, NUMATTRIBS}, + {"alpha", A_ALPHA}, + {"ascent", A_ASCENT}, + {"bg", A_BG}, {"buffer", A_BUFFERMODE}, - {"camwidth", A_CAMWIDTH}, - {"canvas", A_CANVAS}, - {"ceol", A_CEOL}, - {"cliph", A_CLIPH}, - {"clipw", A_CLIPW}, - {"clipx", A_CLIPX}, - {"clipy", A_CLIPY}, - {"col", A_COL}, - {"columns", A_COLUMNS}, - {"cursor", A_CURSOR}, - {"depth", A_DEPTH}, - {"descent", A_DESCENT}, - {"dim", A_DIM}, - {"display", A_DISPLAY}, - {"displayheight", A_DISPLAYHEIGHT}, - {"displaywidth", A_DISPLAYWIDTH}, - {"drawop", A_DRAWOP}, - {"dx", A_DX}, - {"dy", A_DY}, - {"echo", A_ECHO}, - {"eye", A_EYE}, - {"eyedir", A_EYEDIR}, - {"eyepos", A_EYEPOS}, - {"eyeup", A_EYEUP}, - {"fg", A_FG}, - {"fheight", A_FHEIGHT}, - {"fillstyle", A_FILLSTYLE}, - {"font", A_FONT}, - {"fovangle", A_FOV}, - {"fwidth", A_FWIDTH}, - {"gamma", A_GAMMA}, - {"geometry", A_GEOMETRY}, - {"glrenderer", A_GLRENDERER}, - {"glvendor", A_GLVENDOR}, - {"glversion", A_GLVERSION}, - {"height", A_HEIGHT}, - {"iconic", A_ICONIC}, - {"iconimage", A_ICONIMAGE}, - {"iconlabel", A_ICONLABEL}, - {"iconpos", A_ICONPOS}, - {"image", A_IMAGE}, - {"inputmask", A_INPUTMASK}, - {"label", A_LABEL}, - {"leading", A_LEADING}, - {"light", A_LIGHT}, - {"light0", A_LIGHT0}, - {"light1", A_LIGHT1}, - {"light2", A_LIGHT2}, - {"light3", A_LIGHT3}, - {"light4", A_LIGHT4}, - {"light5", A_LIGHT5}, - {"light6", A_LIGHT6}, - {"light7", A_LIGHT7}, - {"lines", A_LINES}, - {"linestyle", A_LINESTYLE}, - {"linewidth", A_LINEWIDTH}, - {"meshmode", A_MESHMODE}, - {"normode", A_NORMODE}, - {"pattern", A_PATTERN}, - {"pick", A_PICK}, - {"pointer", A_POINTER}, - {"pointercol", A_POINTERCOL}, - {"pointerrow", A_POINTERROW}, - {"pointerx", A_POINTERX}, - {"pointery", A_POINTERY}, - {"pos", A_POS}, - {"posx", A_POSX}, - {"posy", A_POSY}, - {"projection", A_PROJECTION}, - {"rendermode", A_RENDERMODE}, - {"resize", A_RESIZE}, - {"reverse", A_REVERSE}, - {"rgbmode", A_RGBMODE}, - {"rings", A_RINGS}, - {"row", A_ROW}, - {"rows", A_ROWS}, - {"selection", A_SELECTION}, - {"size", A_SIZE}, - {"slices", A_SLICES}, - {"texcoord", A_TEXCOORD}, - {"texmode", A_TEXMODE}, - {"texture", A_TEXTURE}, - {"titlebar", A_TITLEBAR}, - {"visual", A_VISUAL}, - {"width", A_WIDTH}, - {"windowlabel", A_WINDOWLABEL}, - {"x", A_X}, - {"y", A_Y}, + {"camwidth", A_CAMWIDTH}, + {"canvas", A_CANVAS}, + {"ceol", A_CEOL}, + {"cliph", A_CLIPH}, + {"clipw", A_CLIPW}, + {"clipx", A_CLIPX}, + {"clipy", A_CLIPY}, + {"col", A_COL}, + {"columns", A_COLUMNS}, + {"cursor", A_CURSOR}, + {"depth", A_DEPTH}, + {"descent", A_DESCENT}, + {"dim", A_DIM}, + {"display", A_DISPLAY}, + {"displayheight", A_DISPLAYHEIGHT}, + {"displaywidth", A_DISPLAYWIDTH}, + {"drawop", A_DRAWOP}, + {"dx", A_DX}, + {"dy", A_DY}, + {"echo", A_ECHO}, + {"eye", A_EYE}, + {"eyedir", A_EYEDIR}, + {"eyepos", A_EYEPOS}, + {"eyeup", A_EYEUP}, + {"fg", A_FG}, + {"fheight", A_FHEIGHT}, + {"fillstyle", A_FILLSTYLE}, + {"font", A_FONT}, + {"fovangle", A_FOV}, + {"fwidth", A_FWIDTH}, + {"gamma", A_GAMMA}, + {"geometry", A_GEOMETRY}, + {"glrenderer", A_GLRENDERER}, + {"glvendor", A_GLVENDOR}, + {"glversion", A_GLVERSION}, + {"height", A_HEIGHT}, + {"iconic", A_ICONIC}, + {"iconimage", A_ICONIMAGE}, + {"iconlabel", A_ICONLABEL}, + {"iconpos", A_ICONPOS}, + {"image", A_IMAGE}, + {"inputmask", A_INPUTMASK}, + {"label", A_LABEL}, + {"leading", A_LEADING}, + {"light", A_LIGHT}, + {"light0", A_LIGHT0}, + {"light1", A_LIGHT1}, + {"light2", A_LIGHT2}, + {"light3", A_LIGHT3}, + {"light4", A_LIGHT4}, + {"light5", A_LIGHT5}, + {"light6", A_LIGHT6}, + {"light7", A_LIGHT7}, + {"lines", A_LINES}, + {"linestyle", A_LINESTYLE}, + {"linewidth", A_LINEWIDTH}, + {"meshmode", A_MESHMODE}, + {"normode", A_NORMODE}, + {"pattern", A_PATTERN}, + {"pick", A_PICK}, + {"pointer", A_POINTER}, + {"pointercol", A_POINTERCOL}, + {"pointerrow", A_POINTERROW}, + {"pointerx", A_POINTERX}, + {"pointery", A_POINTERY}, + {"pos", A_POS}, + {"posx", A_POSX}, + {"posy", A_POSY}, + {"projection", A_PROJECTION}, + {"rendermode", A_RENDERMODE}, + {"resize", A_RESIZE}, + {"reverse", A_REVERSE}, + {"rgbmode", A_RGBMODE}, + {"rings", A_RINGS}, + {"row", A_ROW}, + {"rows", A_ROWS}, + {"selection", A_SELECTION}, + {"size", A_SIZE}, + {"slices", A_SLICES}, + {"texcoord", A_TEXCOORD}, + {"texmode", A_TEXMODE}, + {"texture", A_TEXTURE}, + {"titlebar", A_TITLEBAR}, + {"visual", A_VISUAL}, + {"width", A_WIDTH}, + {"windowlabel", A_WINDOWLABEL}, + {"x", A_X}, + {"y", A_Y}, }; void gotorc(wbp w,int r,int c) @@ -5399,7 +5399,7 @@ void gotorc(wbp w,int r,int c) ws->x = GL_COLTOX(w, c); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { ws->y = ROWTOY(w, r); ws->x = COLTOX(w, c); @@ -5442,7 +5442,7 @@ int guicurses_lines(wbp w) if (w->window->is_gl) return GL_YTOROW(w,w->window->height - GL_DESCENT(w)); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ return YTOROW(w,w->window->height - DESCENT(w)); } @@ -5451,7 +5451,7 @@ int guicurses_cols(wbp w) #ifdef GraphicsGL if (w->window->is_gl) return GL_XTOCOL(w,w->window->width - GL_DESCENT(w)); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ return XTOCOL(w,w->window->width - DESCENT(w)); } @@ -5493,25 +5493,25 @@ char * watt(wbp w, char *s) if (len > 4) { if (!strncmp(s, "pos=", 4)) config |= 1; if (len > 5) { - if (!strncmp(s, "posx=", 5)) config |= 1; - if (!strncmp(s, "posy=", 5)) config |= 1; - if (!strncmp(s, "rows=", 5)) config |= 2; - if (!strncmp(s, "size=", 5)) config |= 2; - if (len > 6) { - if (!strncmp(s, "width=", 6)) config |= 2; - if (!strncmp(s, "lines=", 6)) config |= 2; - if (len > 7) { - if (!strncmp(s, "height=", 7)) config |= 2; - if (!strncmp(s, "resize=", 7)) config |= 2; - if (len > 8) { - if (!strncmp(s, "columns=", 8)) config |= 2; - if (len > 9) { - if (!strncmp(s, "geometry=", 9)) config |= 3; - } - } - } - } - } + if (!strncmp(s, "posx=", 5)) config |= 1; + if (!strncmp(s, "posy=", 5)) config |= 1; + if (!strncmp(s, "rows=", 5)) config |= 2; + if (!strncmp(s, "size=", 5)) config |= 2; + if (len > 6) { + if (!strncmp(s, "width=", 6)) config |= 2; + if (!strncmp(s, "lines=", 6)) config |= 2; + if (len > 7) { + if (!strncmp(s, "height=", 7)) config |= 2; + if (!strncmp(s, "resize=", 7)) config |= 2; + if (len > 8) { + if (!strncmp(s, "columns=", 8)) config |= 2; + if (len > 9) { + if (!strncmp(s, "geometry=", 9)) config |= 3; + } + } + } + } + } } if (config) { @@ -5520,14 +5520,14 @@ char * watt(wbp w, char *s) if (gl_do_config(w, config) == Failed) return NULL; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (do_config(w, config) == Failed) return NULL; } if (strchr(s, '=') == NULL) { if (is:integer(throw)) { - sprintf(foo, "%ld", (long)(IntVal(throw))); - } + sprintf(foo, "%ld", (long)(IntVal(throw))); + } else if (!is:string(throw)) return NULL; return strdup(foo); } @@ -5548,35 +5548,35 @@ char child_window_generic(wbp w, wbp wp, int child_window) /* * allocate a window state, and a context */ -#ifdef GraphicsGL +#ifdef GraphicsGL if (wp->window->is_gl || is_3d) { Protect(w->window = gl_alc_winstate(), { free_binding(w); return 0; }); //if (!wp->window->is_gl) w->window->is_gl = 0; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ Protect(w->window = alc_winstate(), { free_binding(w); return 0; }); ws = w->window; ws->display = wd; CLRTITLEBAR(ws); -#ifdef GraphicsGL +#ifdef GraphicsGL if (w->window->is_gl) { Protect(w->context = gl_alc_context(w), { free_binding(w); return 0; }); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ Protect(w->context = alc_context(w), { free_binding(w); return 0; }); wc = w->context; wc->display = wd; -#ifdef GraphicsGL - if (wp->window->is_gl) +#ifdef GraphicsGL + if (wp->window->is_gl) wc->font = wd->glfonts; else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #ifdef XWindows wc->font = wd->fonts; -#endif /* XWindows */ +#endif /* XWindows */ wd->refcount++; ws->listp.dword = D_List; @@ -5610,7 +5610,7 @@ char child_window_generic(wbp w, wbp wp, int child_window) wc->buffermode = IMMEDIATE3D; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { ws->y = 0; ws->x = 0; @@ -5624,17 +5624,17 @@ char child_window_generic(wbp w, wbp wp, int child_window) * There are more, X-specific stringint arrays in ../common/xwindow.c */ -#else /* Graphics */ +#else /* Graphics */ /* * Stubs to prevent dynamic loader from rejecting cfunc library of IPL. */ -int palnum(dptr *d) { return 0; } -char *rgbkey(int p, double r, double g, double b) { return 0; } +int palnum(dptr *d) { return 0; } +char *rgbkey(int p, double r, double g, double b) { return 0; } + +#endif /* Graphics */ -#endif /* Graphics */ - /* * The next section consists of code to deal with string-integer * (stringint) symbols. See rstructs.h. diff --git a/src/runtime/rwinrsc.r b/src/runtime/rwinrsc.r index 71c0f3305..25ac7befa 100644 --- a/src/runtime/rwinrsc.r +++ b/src/runtime/rwinrsc.r @@ -15,14 +15,14 @@ wcp wcntxts = NULL; wsp wstates = NULL; wbp wbndngs = NULL; int win_highwater = -1; - + #ifdef MacGraph #include "rmacrsc.ri" -#endif /* MacGraph */ +#endif /* MacGraph */ #ifdef XWindows #include "rxrsc.ri" -#endif /* XWindows */ +#endif /* XWindows */ /* * allocate a window binding structure @@ -36,7 +36,7 @@ wbp alc_wbinding() GRFX_LINK(w, wbndngs); return w; } - + /* * free a window binding. */ @@ -51,7 +51,7 @@ wbp w; if (w->context) gl_free_context(w->context); } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { if (w->window) free_window(w->window); if (w->context) free_context(w->context); @@ -60,6 +60,6 @@ wbp w; } } -#else /* Graphics */ -/* static char junk; /* avoid empty module */ -#endif /* Graphics */ +#else /* Graphics */ +/* static char junk; /* avoid empty module */ +#endif /* Graphics */ diff --git a/src/runtime/rwinsys.r b/src/runtime/rwinsys.r index bbf14fb98..83686a6eb 100644 --- a/src/runtime/rwinsys.r +++ b/src/runtime/rwinsys.r @@ -8,45 +8,45 @@ void checkpollevent(){ #ifdef Graphics #ifdef KbhitPoll while (!kbhit_ms(133)) { pollevent(); } -#else /* KbhitPoll */ +#else /* KbhitPoll */ while (!kbhit()) { idelay(100); pollevent(); } -#endif /* KbhitPoll */ -#endif /* Graphics */ +#endif /* KbhitPoll */ +#endif /* Graphics */ } #ifdef Graphics #ifdef MacGraph #include "rmac.ri" -#endif /* MacGraph */ +#endif /* MacGraph */ #ifdef XWindows #include "rxwin.ri" -#endif /* XWindows */ +#endif /* XWindows */ #ifdef MSWindows #include "rmswin.ri" #else -#endif /* MSWindows */ +#endif /* MSWindows */ #ifdef Graphics3D #include "rwin3d.ri" #if HAVE_LIBGL #include "ropengl.ri" #include "ropengl2d.ri" -#endif /* HAVE_LIBGL */ +#endif /* HAVE_LIBGL */ #if HAVE_D3D #include "rd3d.ri" -#endif /* HAVE_D3D */ -#endif /* Graphics3D */ +#endif /* HAVE_D3D */ +#endif /* Graphics3D */ -#else /* Graphics */ +#else /* Graphics */ #if NT int iconx(int argc, char **argv); int main(int argc, char *argv[]) { return iconx(argc, argv); } -#endif /* NT */ -/* static char junk; /* avoid empty module */ -#endif /* Graphics */ +#endif /* NT */ +/* static char junk; /* avoid empty module */ +#endif /* Graphics */ diff --git a/src/runtime/rxrsc.ri b/src/runtime/rxrsc.ri index 27560f102..62575fade 100644 --- a/src/runtime/rxrsc.ri +++ b/src/runtime/rxrsc.ri @@ -15,10 +15,10 @@ wfp loadfont(wdp wd, char *s); #ifdef HAVE_XFT static char *convert_spec(char *s); -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ #define DEFAULTFONTNAME "fixed" - + int colorhash(int r, int g, int b) { return (((r * 37) + g) * 37 + b) & 16383; @@ -31,9 +31,9 @@ int bucklookup(wdp wd, int r, int g, int b) wc = wd->buckets[i]; while (wc != -1) { if (r == wd->colors[wc].r && g == wd->colors[wc].g && - b == wd->colors[wc].b) { - return wc; - } + b == wd->colors[wc].b) { + return wc; + } wc = wd->colors[wc].next; } return -1; @@ -93,20 +93,20 @@ int is_iconcolor; if (is_iconcolor) { if (ws->iconColors == NULL) { - ws->iconColors = (short *)calloc(WMAXCOLORS, sizeof(short)); - if (ws->iconColors == NULL) return NULL; - ws->siziColors = WMAXCOLORS; - } + ws->iconColors = (short *)calloc(WMAXCOLORS, sizeof(short)); + if (ws->iconColors == NULL) return NULL; + ws->siziColors = WMAXCOLORS; + } numColors = &(ws->numiColors); sizColors = &(ws->siziColors); theColors = &(ws->iconColors); } else { if (ws->theColors == NULL) { - ws->theColors = (short *)calloc(WMAXCOLORS*2, sizeof(short)); - if (ws->theColors == NULL) return NULL; - ws->sizColors = WMAXCOLORS*2; - } + ws->theColors = (short *)calloc(WMAXCOLORS*2, sizeof(short)); + if (ws->theColors == NULL) return NULL; + ws->sizColors = WMAXCOLORS*2; + } numColors = &(ws->numColors); sizColors = &(ws->sizColors); theColors = &(ws->theColors); @@ -133,19 +133,19 @@ int is_iconcolor; * first verify there is room in window color table. */ if (*numColors >= *sizColors-1) { - if (*numColors >= 2 << DefaultDepth(stddpy, wd->screen)) - return NULL; - (*theColors) = realloc(*theColors, *sizColors * 2 * sizeof(short)); - *sizColors *= 2; - /* - * reallocated color table to *sizColors - */ + if (*numColors >= 2 << DefaultDepth(stddpy, wd->screen)) + return NULL; + (*theColors) = realloc(*theColors, *sizColors * 2 * sizeof(short)); + *sizColors *= 2; + /* + * reallocated color table to *sizColors + */ } if (!XAllocColor(stddpy, wd->cmap, &color)) { - /* try again with a virtual colormap (but not for an icon) */ - if (is_iconcolor || !go_virtual(w) || - !XAllocColor(stddpy, wd->cmap, &color)) + /* try again with a virtual colormap (but not for an icon) */ + if (is_iconcolor || !go_virtual(w) || + !XAllocColor(stddpy, wd->cmap, &color)) return NULL; } j = alc_centry(wd); @@ -172,14 +172,14 @@ int is_iconcolor; if (lastfound && (*theColors)[lastfound] == i) return &(wd->colors[i]); if (lastlastfound && (*theColors)[lastlastfound] == i) - return &(wd->colors[i]); + return &(wd->colors[i]); for(k=*numColors-1; k >= 0; k--){ if ((*theColors)[k] == i) { - /* already there, no further action needed */ - lastlastfound = lastfound; - lastfound = k; - return &(wd->colors[i]); + /* already there, no further action needed */ + lastlastfound = lastfound; + lastfound = k; + return &(wd->colors[i]); } } wd->colors[i].refcount++; @@ -208,11 +208,11 @@ static int highbit(ul) wclrp alc_rgbTrueColor(w,r,g,b) wbp w; unsigned long r,g,b; - { + { XColor color; unsigned long rmask, gmask, bmask; int rshift, gshift, bshift; - Visual *vis = w->window->vis; + Visual *vis = w->window->vis; wdp wd = w->window->display; /* @@ -222,8 +222,8 @@ unsigned long r,g,b; color.green = g; color.blue = b; - /* shift r,g,b so that high bit of 16-bit color specification is - * aligned with high bit of r,g,b-mask in visual, + /* shift r,g,b so that high bit of 16-bit color specification is + * aligned with high bit of r,g,b-mask in visual, * AND each component with its mask, * and OR the three components together */ @@ -266,7 +266,7 @@ unsigned long r,g,b; else b = b << bshift; wd->colors[2].r = r; wd->colors[2].g = g; wd->colors[2].b = b; - + return &(wd->colors[2]);; } @@ -297,10 +297,10 @@ unsigned int r,g,b; return &(wd->colors[1]); if (ws->theColors == NULL) { - ws->theColors = (short *)calloc(WMAXCOLORS*2, sizeof(short)); - if (ws->theColors == NULL) return NULL; - ws->sizColors = WMAXCOLORS*2; - } + ws->theColors = (short *)calloc(WMAXCOLORS*2, sizeof(short)); + if (ws->theColors == NULL) return NULL; + ws->sizColors = WMAXCOLORS*2; + } numColors = &(ws->numColors); sizColors = &(ws->sizColors); theColors = &(ws->theColors); @@ -327,19 +327,19 @@ unsigned int r,g,b; * first verify there is room in window color table. */ if (*numColors >= *sizColors-1) { - if (*numColors >= 2 << DefaultDepth(wd->display, wd->screen)) - return NULL; - (*theColors) = realloc(*theColors, *sizColors * 2 * sizeof(short)); - *sizColors *= 2; - /* - * reallocated color table to *sizColors - */ + if (*numColors >= 2 << DefaultDepth(wd->display, wd->screen)) + return NULL; + (*theColors) = realloc(*theColors, *sizColors * 2 * sizeof(short)); + *sizColors *= 2; + /* + * reallocated color table to *sizColors + */ } if (!XAllocColor(stddpy, wd->cmap, &color)) { - /* try again with a virtual colormap (but not for an icon) */ - if (!go_virtual(w) || - !XAllocColor(stddpy, wd->cmap, &color)) + /* try again with a virtual colormap (but not for an icon) */ + if (!go_virtual(w) || + !XAllocColor(stddpy, wd->cmap, &color)) return NULL; } @@ -376,7 +376,7 @@ wdp wd; for (j = 2; j < wd->sizColors; j++) if (wd->colors[j].refcount == 0) - break; + break; return alc_centry2(wd, j); } @@ -389,12 +389,12 @@ int i; if (j >= wd->sizColors-1) { if (j >= 2 << DefaultDepth(wd->display, wd->screen)) return 0; wd->colors = realloc(wd->colors, - wd->sizColors * 2 * sizeof (struct wcolor)); + wd->sizColors * 2 * sizeof (struct wcolor)); if (wd->colors == NULL) return 0; for(i=wd->sizColors;isizColors*2;i++) { - wd->colors[i].refcount=0; - wd->colors[i].prev = wd->colors[i].next = -1; - } + wd->colors[i].refcount=0; + wd->colors[i].prev = wd->colors[i].next = -1; + } wd->sizColors *= 2; /* * reallocated color table to wd->sizColors @@ -403,7 +403,7 @@ int i; if (j == wd->numColors) wd->numColors++; else if (j > wd->numColors) - return 0; /* internal confusion */ + return 0; /* internal confusion */ wd->colors[j].refcount = 1; wd->colors[j].prev = wd->colors[j].next = -1; @@ -433,7 +433,7 @@ char *s; Protect(rv = alc_rgb(w, s, r, g, b, 0), return 0); return rv; } - + /* * copy color entries to reflect pixel transmission via CopyArea() * (assumes w1 and w2 are on the same display) @@ -448,24 +448,24 @@ wbp w1, w2; for (i1 = 0; i1 < ws1->numColors; i1++) { j = ws1->theColors[i1]; if (wd->colors[j].refcount > 0 && wd->colors[j].type != CLR_MUTABLE) { - for (i2 = 0; i2 < ws2->numColors; i2++) { - if (j == ws2->theColors[i2]) - break; - } - if (i2 >= ws2->numColors) { - /* need to add this color */ - wd->colors[j].refcount++; - if (ws2->numColors < WMAXCOLORS) { - if (ws2->theColors == NULL) - ws2->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); - if (ws2->theColors == NULL) - break; /* unlikely bug; should fail or something */ + for (i2 = 0; i2 < ws2->numColors; i2++) { + if (j == ws2->theColors[i2]) + break; + } + if (i2 >= ws2->numColors) { + /* need to add this color */ + wd->colors[j].refcount++; + if (ws2->numColors < WMAXCOLORS) { + if (ws2->theColors == NULL) + ws2->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); + if (ws2->theColors == NULL) + break; /* unlikely bug; should fail or something */ ws2->sizColors = WMAXCOLORS; - ws2->theColors[ws2->numColors++] = j; - } - /* else cannot record it -- table full */ - } - } + ws2->theColors[ws2->numColors++] = j; + } + /* else cannot record it -- table full */ + } + } } } @@ -488,11 +488,11 @@ unsigned long c; } else { if (--(wd->colors[ws->theColors[i]].refcount) == 0) { - buckdelete(wd, &(wd->colors[ws->theColors[i]])); - XFreeColors(wd->display, wd->cmap, &c, 1, 0); - ws->numColors--; - if (ws->numColors != i) - ws->theColors[i] = ws->theColors[ws->numColors]; + buckdelete(wd, &(wd->colors[ws->theColors[i]])); + XFreeColors(wd->display, wd->cmap, &c, 1, 0); + ws->numColors--; + if (ws->numColors != i) + ws->theColors[i] = ws->theColors[ws->numColors]; } } } @@ -525,17 +525,17 @@ int extent; int j = theColors[i]; - if (j < 2) /* black & white are permanent residents */ - continue; + if (j < 2) /* black & white are permanent residents */ + continue; /* * don't free fg, bg, or mutable color */ if (((extent==0) && (j == w->context->fg)) || - ((extent==0) && (j == w->context->bg)) || - (wd->colors[j].type == CLR_MUTABLE)) { - theColors[numSaved++] = j; - continue; - } + ((extent==0) && (j == w->context->bg)) || + (wd->colors[j].type == CLR_MUTABLE)) { + theColors[numSaved++] = j; + continue; + } #ifndef NoFreeColorFix /* @@ -544,24 +544,24 @@ int extent; { wcp wc; int numhits = 0; for(wc=wcntxts; wc; wc=wc->next) { - if ((wc->fg == j) || (wc->bg == j)) { - if (numhits == 0) - theColors[numSaved++] = j; - numhits++; - } - } + if ((wc->fg == j) || (wc->bg == j)) { + if (numhits == 0) + theColors[numSaved++] = j; + numhits++; + } + } if (numhits) { - if (numhits > wd->colors[j].refcount) - wd->colors[j].refcount = numhits; - continue; - } + if (numhits > wd->colors[j].refcount) + wd->colors[j].refcount = numhits; + continue; + } } -#endif /* NoFreeColorFix */ +#endif /* NoFreeColorFix */ if (--(wd->colors[j].refcount) == 0) { - toFree[freed++] = wd->colors[j].c; - /* unlink it from the link list */ - buckdelete(wd, &(wd->colors[j])); + toFree[freed++] = wd->colors[j].c; + /* unlink it from the link list */ + buckdelete(wd, &(wd->colors[j])); } } if (freed>0) @@ -614,7 +614,7 @@ char *s; for(wd = wdsplys; wd; wd = wd->next) if (!strcmp(wd->name,s)) { wd->refcount++; - return wd; + return wd; } GRFX_ALLOC(wd, _wdisplay); @@ -640,11 +640,11 @@ char *s; #ifdef GraphicsGL { int query; - int fbparms[] = {GLX_RENDER_TYPE, GLX_RGBA_BIT, - GLX_DOUBLEBUFFER, True, - GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT, - GLX_DEPTH_SIZE, 16, - GLX_STENCIL_SIZE, 3, None}; + int fbparms[] = {GLX_RENDER_TYPE, GLX_RGBA_BIT, + GLX_DOUBLEBUFFER, True, + GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT, + GLX_DEPTH_SIZE, 16, + GLX_STENCIL_SIZE, 3, None}; /* Check for GLX */ if (!glXQueryExtension(wd->display, &query, &query)) { @@ -655,7 +655,7 @@ char *s; /* * Try to get a GLXFBConfig for GLXWindows and GLXPixmaps */ - wd->configs = glXChooseFBConfig(wd->display, wd->screen, fbparms, + wd->configs = glXChooseFBConfig(wd->display, wd->screen, fbparms, &(wd->nConfigs)); if (wd->configs == NULL) { fprintf(stderr, "failed to get fbconfig\n"); @@ -684,7 +684,7 @@ char *s; } } } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ /* * Color slots 0 and 1 are permanently reserved for black and white @@ -726,7 +726,7 @@ char *s; if (XParseColor(wd->display, wd->cmap, "RGBi:.5/.5/.5", &color)) { g = .299 * color.red + .587 * color.green + .114 * color.blue; g /= 65535; - if (g >= 0.1 && g <= 0.9) /* sanity check */ + if (g >= 0.1 && g <= 0.9) /* sanity check */ wd->gamma = log(0.5) / log(g); } @@ -736,9 +736,9 @@ char *s; wd->numFonts = 1; #ifdef HAVE_XFT wd->fonts = loadfont(wd, convert_spec(DEFAULTFONTNAME)); -#else /* HAVE_XFT */ +#else /* HAVE_XFT */ wd->fonts = loadfont(wd, DEFAULTFONTNAME); -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ if (wd->fonts == NULL) { free(wd); return NULL; @@ -747,16 +747,16 @@ char *s; wd->fonts->next = wd->fonts->previous = NULL; #ifdef HAVE_XFT wd->xfont = XLoadQueryFont(wd->display, "fixed"); -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ { XGCValues gcv; Display *stddpy = wd->display; #ifdef HAVE_XFT gcv.font = wd->xfont->fid; -#else /* HAVE_XFT */ +#else /* HAVE_XFT */ gcv.font = wd->fonts->fsp->fid; -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ gcv.foreground = wd->colors[0].c; gcv.background = wd->colors[1].c; gcv.fill_style = FillSolid; @@ -772,14 +772,14 @@ char *s; GRFX_LINK(wd, wdsplys); return wd; } - + #ifdef HAVE_XFT /* * Convert a given font spec, which may or may not be in icon font spec format, * into fontconfig (used by Xft) style format. The result is never null. - * + * * To avoid ambiguity, a spec can start with "fc:" to indicate it's in * fontconfig format; otherwise parsefont is called to decide the format. */ @@ -920,7 +920,7 @@ char **s; */ rv = findfont(w, family, size, flags); } - + if (rv != NULL) return rv; } @@ -940,7 +940,7 @@ int i; { int j = 0; while (j < i) { - if (*s == '\0') return ""; /* if no such field */ + if (*s == '\0') return ""; /* if no such field */ if (*s++ == '-') j++; } return s; @@ -1025,7 +1025,7 @@ int size, flags; if (flags & FONTFLAG_PROPORTIONAL) spacing = "p"; else - spacing = "*"; /* can't specify {m or c} to X */ + spacing = "*"; /* can't specify {m or c} to X */ sprintf(fontspec, "-*-%s-%s-%s-%s-*-*-*-*-*-%s-*-*-*", family, weight, slant, width, spacing); @@ -1039,9 +1039,9 @@ int size, flags; champ++; if (champ >= n) { XFreeFontNames(fontlist); - return NULL; /* nothing acceptable */ + return NULL; /* nothing acceptable */ } - for (challenger = champ + 1; challenger < n; challenger++) + for (challenger = champ + 1; challenger < n; challenger++) if (okfont(fontlist[challenger], size, flags) && fontcmp(fontlist[challenger], fontlist[champ], bestsize, flags) < 0) champ = challenger; @@ -1070,9 +1070,9 @@ char *spec; int size, flags; { if (size > 0 && xlfd_size(spec, size) != size) - return 0; /* can't match explicit size request */ + return 0; /* can't match explicit size request */ if ((flags & FONTFLAG_MONO) && xlfd_field(spec, XLFD_Spacing)[0] == 'p') - return 0; /* requested mono, but this isn't */ + return 0; /* requested mono, but this isn't */ return 1; } @@ -1089,7 +1089,7 @@ int field; len = strlen(value); r1 = (strncmp(xlfd_field(font1, field), value, len) == 0); r2 = (strncmp(xlfd_field(font2, field), value, len) == 0); - return r2 - r1; /* -1, 0, or 1 */ + return r2 - r1; /* -1, 0, or 1 */ } /* @@ -1137,13 +1137,13 @@ do { int r = fieldcmp(font1, font2, s, n); if (r != 0) return -r; } while (0) * prefer normal values for other fields. These only have an effect * for fields that were wildcarded when requesting the font list. */ - PREFER("r", XLFD_Slant); /* prefer roman slant */ - PREFER("medium", XLFD_Weight); /* prefer medium weight */ - SPURN("demi", XLFD_Weight); /* prefer non-demi if no medium */ - PREFER("normal", XLFD_SetWidth); /* prefer normal width */ - PREFER("iso8859", XLFD_CharSet); /* prefer font of ASCII chars */ - SPURN("0", XLFD_PointSize); /* prefer tuned font to scaled */ - PREFER("adobe", XLFD_Foundry); /* these look better than others */ + PREFER("r", XLFD_Slant); /* prefer roman slant */ + PREFER("medium", XLFD_Weight); /* prefer medium weight */ + SPURN("demi", XLFD_Weight); /* prefer non-demi if no medium */ + PREFER("normal", XLFD_SetWidth); /* prefer normal width */ + PREFER("iso8859", XLFD_CharSet); /* prefer font of ASCII chars */ + SPURN("0", XLFD_PointSize); /* prefer tuned font to scaled */ + PREFER("adobe", XLFD_Foundry); /* these look better than others */ /* no significant difference */ return 0; @@ -1203,9 +1203,9 @@ char *s; if (rv->name == NULL) ReturnErrNum(305, NULL); #ifdef HAVE_XFT rv->fsp = XftFontOpenName(wd->display, wd->screen, rv->name); -#else /* HAVE_XFT */ +#else /* HAVE_XFT */ rv->fsp = XLoadQueryFont(wd->display, rv->name); -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ if (rv->fsp == NULL){ free(rv->name); free(rv); @@ -1214,7 +1214,7 @@ char *s; #ifdef HAVE_XFT { - XGlyphInfo extents; + XGlyphInfo extents; char s[256]; int i; @@ -1238,7 +1238,7 @@ char *s; return rv; } - + /* * allocate a context. Can't be called until w has a display and window. */ @@ -1254,9 +1254,9 @@ wbp w; wc->display = wd; wd->refcount++; -#ifdef OpenGL2D - if (!w->window->is_gl) -#endif /* OpenGL2D */ +#ifdef OpenGL2D + if (!w->window->is_gl) +#endif /* OpenGL2D */ { wd->colors[0].refcount++; wc->fg = 0; @@ -1275,7 +1275,7 @@ wbp w; GRFX_LINK(wc, wcntxts); return wc; } - + /* * allocate a context, cloning attributes from an existing context */ @@ -1288,7 +1288,7 @@ wbp w; XGCValues gcv; XRectangle rec; unsigned long gcmask = GCFont | GCForeground | GCBackground | - GCFillStyle | GCCapStyle | GCLineWidth | GCLineStyle; + GCFillStyle | GCCapStyle | GCLineWidth | GCLineStyle; wc = w->context; wd = w->context->display; @@ -1315,7 +1315,7 @@ wbp w; #ifdef Graphics3D copy_3dcontext(wc, rv); -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (ISXORREVERSE(w)) gcv.foreground = wd->colors[rv->fg].c ^ wd->colors[rv->bg].c; @@ -1324,9 +1324,9 @@ wbp w; gcv.background = wd->colors[rv->bg].c; #ifdef HAVE_XFT gcv.font = wd->xfont->fid; -#else /* HAVE_XFT */ +#else /* HAVE_XFT */ gcv.font = rv->font->fsp->fid; -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ gcv.line_style = rv->linestyle; gcv.line_width = rv->linewidth; if (rv->linewidth > 1) { @@ -1349,7 +1349,7 @@ wbp w; } return rv; } - + /* * allocate a window state structure */ @@ -1359,21 +1359,21 @@ wsp alc_winstate() CURTSTATE(); GRFX_ALLOC(ws, _wstate); ws->serial = ++canvas_serial; - ws->bits = 1024; /* echo ON; others OFF */ + ws->bits = 1024; /* echo ON; others OFF */ ws->filep = nulldesc; ws->listp = nulldesc; ws->theCursor = si_s2i(cursorsyms, "left ptr") >> 1; SETTITLEBAR(ws); ws->inputmask = ExposureMask | KeyPressMask | - ButtonPressMask | ButtonReleaseMask | ButtonMotionMask | - StructureNotifyMask; + ButtonPressMask | ButtonReleaseMask | ButtonMotionMask | + StructureNotifyMask; ws->iconic = NormalState; ws->posx = ws->posy = -(MaxInt); ws->minwidth = ws->minheight = 0; #ifdef HAVE_XFT ws->pixDraw = ws->winDraw = NULL; -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ GRFX_LINK(ws, wstates); return ws; @@ -1387,7 +1387,7 @@ wsp ws; { ws->refcount--; if(ws->refcount == 0) { - ws->bits |= 1; /* SETZOMBIE */ + ws->bits |= 1; /* SETZOMBIE */ #ifdef HAVE_XFT if (ws->winDraw) { XftDrawDestroy(ws->winDraw); @@ -1397,7 +1397,7 @@ wsp ws; XftDrawDestroy(ws->pixDraw); ws->pixDraw = NULL; } -#endif /* HAVE_XFT */ +#endif /* HAVE_XFT */ #ifdef GraphicsGL if (ws->ctx != (GLXContext) NULL) { ws->redraw_flag = 0; @@ -1410,13 +1410,13 @@ wsp ws; glXDestroyPbuffer(ws->display->display, ws->pbuf); ws->pbuf = (GLXPbuffer) NULL; } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (ws->win != (Window) NULL) { - XDestroyWindow(ws->display->display, ws->win); - XFlush(ws->display->display); - while (ws->win != (Window) NULL) - if (pollevent() == -1) return -1; - } + XDestroyWindow(ws->display->display, ws->win); + XFlush(ws->display->display); + while (ws->win != (Window) NULL) + if (pollevent() == -1) return -1; + } else { /* * There was no XDestroyWindow, so it is necessary @@ -1449,7 +1449,7 @@ wcp wc; wc->refcount--; if(wc->refcount == 0) { if (wc->gc != NULL) - XFreeGC(wc->display->display, wc->gc); + XFreeGC(wc->display->display, wc->gc); free_display(wc->display); GRFX_UNLINK(wc, wcntxts); } @@ -1478,16 +1478,16 @@ wdp wd; glXDestroyContext(wd->display, wd->sharedCtx); wd->sharedCtx = NULL; } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ wf = wd->fonts; while (wf) { /* free fonts */ tmp = wf; - wf = wf->next; + wf = wf->next; free(tmp->name); free(tmp); } if (wd->cmap != DefaultColormap(wd->display, wd->screen)) - XFreeColormap(wd->display, wd->cmap); + XFreeColormap(wd->display, wd->cmap); XCloseDisplay(wd->display); if (wd->previous) wd->previous->next = wd->next; else wdsplys = wd->next; diff --git a/src/runtime/rxwin.ri b/src/runtime/rxwin.ri index 3ba27954d..1b8426ed4 100644 --- a/src/runtime/rxwin.ri +++ b/src/runtime/rxwin.ri @@ -18,17 +18,17 @@ XSizeHints size_hints; #define TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(red_mask, green_mask, blue_mask) \ unsigned long rshift=0, rbits=0, gshift=0, gbits=0, bshift=0, bbits=0; \ - do { \ + do { \ unsigned long rmask = red_mask, gmask = green_mask, bmask = blue_mask; \ - while (!(rmask & 1)) { rshift++; rmask >>= 1; } \ - while (rmask & 1) { rbits++; rmask >>= 1; } \ - if (rbits>8) { rshift += rbits-8; rbits = 8; } \ - while (!(gmask & 1)) { gshift++; gmask >>= 1; } \ - while (gmask & 1) { gbits++; gmask >>= 1; } \ - if (gbits>8) { gshift += gbits-8; gbits = 8;} \ - while (!(bmask & 1)) { bshift++; bmask >>= 1; } \ - while (bmask & 1) { bbits++; bmask >>= 1; } \ - if (bbits>8) { bshift += bbits-8; bbits = 8; } \ + while (!(rmask & 1)) { rshift++; rmask >>= 1; } \ + while (rmask & 1) { rbits++; rmask >>= 1; } \ + if (rbits>8) { rshift += rbits-8; rbits = 8; } \ + while (!(gmask & 1)) { gshift++; gmask >>= 1; } \ + while (gmask & 1) { gbits++; gmask >>= 1; } \ + if (gbits>8) { gshift += gbits-8; gbits = 8;} \ + while (!(bmask & 1)) { bshift++; bmask >>= 1; } \ + while (bmask & 1) { bbits++; bmask >>= 1; } \ + if (bbits>8) { bshift += bbits-8; bbits = 8; } \ } while (0) #define TRUECOLOR_GET_RGB_BYTE(c, cshifts, cbits) (((c >> cshift) & ((1 << cbits)-1)) << (8-cbits)) @@ -40,23 +40,23 @@ XSizeHints size_hints; * function prototypes */ int seticonicstate (wbp w, char *s); -int seticonpos (wbp w, char *s); -int handle_misc (wdp display, wbp w); -static int handle_config (wbp w, XConfigureEvent *event); +int seticonpos (wbp w, char *s); +int handle_misc (wdp display, wbp w); +static int handle_config (wbp w, XConfigureEvent *event); static int handle_exposures (wbp w, XExposeEvent *event); static void handle_mouse (wbp w, XButtonEvent *event); static void handle_keypress (wbp w, XKeyEvent *event); - void postcursor (wbp w); - void scrubcursor (wbp w); -static XImage * getximage (wbp w, int x, int y, - int width, int height, int init); + void postcursor (wbp w); + void scrubcursor (wbp w); +static XImage * getximage (wbp w, int x, int y, + int width, int height, int init); void moveWindow (wbp w, int x, int y); int setdisplay (wbp w, char *s); void makeIcon (wbp w, int x, int y); -int wmap (wbp w); -Pixmap loadimage (wbp w, char *filename, unsigned int *height, unsigned int *width, int atorigin, int *status); +int wmap (wbp w); +Pixmap loadimage (wbp w, char *filename, unsigned int *height, unsigned int *width, int atorigin, int *status); void unsetclip (wbp w); - + /* * write some text to both the window and the pixmap @@ -78,7 +78,7 @@ int n; ws->x += delta_x; } - + /* * Routines to convert property data into text strings. @@ -106,20 +106,20 @@ char* atom_names[NUMBER_ATOMS]= { static Atom atom_array[NUMBER_ATOMS]; /* Macros to access elements in atom_names array. */ -#define CHARACTER_POSITION 0 -#define CLIENT_WINDOW 1 -#define CLIPBOARD 2 -#define HOST_NAME 3 -#define HOSTNAME 4 -#define LENGTH 5 -#define LIST_LENGTH 6 -#define NAME 7 -#define OWNER_OS 8 -#define SPAN 9 -#define STRING 10 -#define TARGETS 11 -#define TIMESTAMP 12 -#define USER 13 +#define CHARACTER_POSITION 0 +#define CLIENT_WINDOW 1 +#define CLIPBOARD 2 +#define HOST_NAME 3 +#define HOSTNAME 4 +#define LENGTH 5 +#define LIST_LENGTH 6 +#define NAME 7 +#define OWNER_OS 8 +#define SPAN 9 +#define STRING 10 +#define TARGETS 11 +#define TIMESTAMP 12 +#define USER 13 static int InternAtoms(Display* display) @@ -132,19 +132,19 @@ static int InternAtoms(Display* display) */ return XInternAtoms(display, atom_names, NUMBER_ATOMS, False, atom_array); -#else /* R5 and below. */ +#else /* R5 and below. */ for (i = 0; i < NUMBER_ATOMS; i++) { atom_array[i] = XInternAtom(display, atom_names[i], False); if (atom_array[i] == None) { - return 0; - } + return 0; + } } return 1; -#endif /* R5 and below. */ +#endif /* R5 and below. */ } /* TODO: move this into a field on the display structure */ @@ -212,20 +212,20 @@ char* PropertyToString(Display* display, Atom target, int number_items, /* Convert to atom names. */ for (i = 0; i < number_items; i++) { - atom_name = XGetAtomName(display, long_array[i] ); - - if (atom_name != NULL) { - - /* Check that space is available. */ - length -= strlen(atom_name); - - if (length > 1) { - strcat(string, atom_name); - strcat(string, "\n"); - } - XFree(atom_name); + atom_name = XGetAtomName(display, long_array[i] ); + + if (atom_name != NULL) { + + /* Check that space is available. */ + length -= strlen(atom_name); + + if (length > 1) { + strcat(string, atom_name); + strcat(string, "\n"); + } + XFree(atom_name); } - } + } } else if (new_target == XA_STRING) { string = (char*) malloc(number_items + 1); @@ -242,14 +242,14 @@ char* PropertyToString(Display* display, Atom target, int number_items, string[0] = '\0'; for (i = 0; i < number_items; i++) { - sprintf(temp, "%d ", int_array[i]); + sprintf(temp, "%d ", int_array[i]); - /* Check that space is available. */ - length -= strlen(temp); - if (length > 0) { - strcat(string, temp); + /* Check that space is available. */ + length -= strlen(temp); + if (length > 0) { + strcat(string, temp); } - } + } } else if (new_target == XA_WINDOW) { @@ -260,9 +260,9 @@ char* PropertyToString(Display* display, Atom target, int number_items, string[0] = '\0'; for (i = 0; i < number_items; i++) { - sprintf(temp, "0x%8.8ld ", long_array[i]); - strcat(string, temp); - } + sprintf(temp, "0x%8.8ld ", long_array[i]); + strcat(string, temp); + } } else { @@ -279,7 +279,7 @@ XSelectionEvent *getselectionnotify(wsp ws) { bar = NULL; XSelectInput(ws->display->display, ws->win, - XMasks(ws->inputmask | PropertyChangeMask)); + XMasks(ws->inputmask | PropertyChangeMask)); XFlush(ws->display->display); while(bar == NULL) { handle_misc(ws->display, NULL); @@ -300,7 +300,7 @@ char *copyselection(wsp ws, char* s, int *ip) { Display *display = ws->display->display; Window window = ws->win; - Time timestamp = (Time) ws->timestamp; + Time timestamp = (Time) ws->timestamp; XSelectionEvent* event; int status; unsigned char* data; @@ -315,7 +315,7 @@ char *copyselection(wsp ws, char* s, int *ip) target = atom_array[STRING]; XConvertSelection(display, XA_PRIMARY, XA_STRING, target, - window, timestamp); + window, timestamp); timestmp = timestamp; requestor = window; XFlush(display); @@ -325,7 +325,7 @@ char *copyselection(wsp ws, char* s, int *ip) /* Check that property is not NULL. */ if ((event->property == (Atom) None) || ((event->selection != XA_PRIMARY) && - (event->selection != atom_array[CLIPBOARD])) || + (event->selection != atom_array[CLIPBOARD])) || (event->requestor == (Window) None) ) { /* printf("Owning program failed to convert data."); */ @@ -356,16 +356,16 @@ char *copyselection(wsp ws, char* s, int *ip) /* Convert data to text string. */ string = PropertyToString(display, - new_target, number_items, (char*) data); + new_target, number_items, (char*) data); if (string != NULL) { - str_len = strlen(string); - if (str_len > 4000) s = strdup(string); - else strcpy(s, string); - XFree(string); - } + str_len = strlen(string); + if (str_len > 4000) s = strdup(string); + else strcpy(s, string); + XFree(string); + } if (data) - XFree( data ); + XFree( data ); } *ip = str_len; return s; @@ -417,7 +417,7 @@ char* ErrorCodes[ NUMBER_ERRORS ] = { static void ErrorHandler(Display* display, XErrorEvent* error_event) -{ +{ char string[BUFSIZE + 1]; ErrorFlag = True; @@ -427,65 +427,65 @@ static void ErrorHandler(Display* display, XErrorEvent* error_event) XGetErrorText(display, error_event->error_code, string, BUFSIZE); fprintf(stderr, "X Error on display %s.i\nResource %ld: ", - DisplayString( display ), error_event->resourceid ); + DisplayString( display ), error_event->resourceid ); - if ((error_event->error_code > 0 ) && + if ((error_event->error_code > 0 ) && (error_event->error_code < NUMBER_ERRORS ) ) { fprintf( stderr, "%s (%s).\n", string, - ErrorCodes[ error_event->error_code ] ); + ErrorCodes[ error_event->error_code ] ); } else { fprintf( stderr, "%s.\n", string ); } fprintf(stderr, "Op code %d.%d, Error code %d\n", error_event->request_code, - error_event->minor_code, error_event->error_code ); + error_event->minor_code, error_event->error_code ); } int CheckErrorFlag() -{ +{ return ErrorFlag; -} +} void ResetErrorFlag() -{ +{ ErrorFlag = False; LastError = None; } void SetErrorHandler() -{ +{ (void) XSetErrorHandler((XErrorHandler) ErrorHandler); } int AppendProperty(Display* display, Window window, - Atom property, /* you should pass "property" */ - Atom target, /* XA_STRING */ - int format, /* 8 */ - unsigned char* data, /* data to append */ - int number_items) /* length of data to append */ -{ - SetErrorHandler(); /* the error handler is set up. */ + Atom property, /* you should pass "property" */ + Atom target, /* XA_STRING */ + int format, /* 8 */ + unsigned char* data, /* data to append */ + int number_items) /* length of data to append */ +{ + SetErrorHandler(); /* the error handler is set up. */ ResetErrorFlag(); if (target != XA_STRING) { /* fprintf(stderr, "target %x XA_STRING %x\n", target, XA_STRING); */ } if (number_items > 0) { - XChangeProperty(display, window, property, target, format, - PropModeReplace, data, number_items); + XChangeProperty(display, window, property, target, format, + PropModeReplace, data, number_items); XSync(display, False); if (CheckErrorFlag()) { - return False; - } + return False; + } } return True; -} +} int ownselection(Display* display,Window window,Atom selection, Time timestamp) -{ +{ Window owner; if ((window == (Window) None ) || (selection == (Atom) None ) ) { /* printf("No selection was selected"); */ @@ -529,25 +529,25 @@ wbp w; case '\n': { if (ISCEOLON(w)) { /* - * Clear the rest of the line, like a terminal would. - * Its arguable whether this should clear to the window - * background or the current context background. If you - * change it to use the context background you have to - * change the XClearArea call to another XFillRectangle - * (cf. eraseArea()). - */ - if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy); - XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); - XClearArea(stddpy, stdwin, - ws->x, ws->y-wc->font->fsp->max_bounds.ascent, - width-ws->x, lh, False); - XFillRectangle(stddpy, stdpix, stdgc, - ws->x, ws->y - wc->font->fsp->max_bounds.ascent, - width - ws->x, lh); - XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c^(ISXORREVERSE(w)? - wd->colors[wc->bg].c:0)); - if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); + * Clear the rest of the line, like a terminal would. + * Its arguable whether this should clear to the window + * background or the current context background. If you + * change it to use the context background you have to + * change the XClearArea call to another XFillRectangle + * (cf. eraseArea()). + */ + if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy); + XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); + XClearArea(stddpy, stdwin, + ws->x, ws->y-wc->font->fsp->max_bounds.ascent, + width-ws->x, lh, False); + XFillRectangle(stddpy, stdpix, stdgc, + ws->x, ws->y - wc->font->fsp->max_bounds.ascent, + width - ws->x, lh); + XSetForeground(stddpy, stdgc, + wd->colors[wc->fg].c^(ISXORREVERSE(w)? + wd->colors[wc->bg].c:0)); + if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); } ws->y += lh; ws->x = wc->dx; @@ -557,21 +557,21 @@ wbp w; */ over = ws->y + wc->font->fsp->max_bounds.descent - height; if (over > 0) { - ws->y -= over; - - if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy); - XCopyArea(stddpy, stdpix, stdpix, stdgc, - 0, over, /* x, y */ - width, height - over, /* w, h */ - 0, 0); /* dstx,dsty */ - XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); - XFillRectangle(stddpy, stdpix, stdgc, - 0, height - over, width, over); - XSetForeground(stddpy, stdgc,wd->colors[wc->fg].c^(ISXORREVERSE(w)? - wd->colors[wc->bg].c:0)); - if (stdwin) - XCopyArea(stddpy, stdpix, stdwin, stdgc, 0, 0, width, height, 0,0); - if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); + ws->y -= over; + + if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy); + XCopyArea(stddpy, stdpix, stdpix, stdgc, + 0, over, /* x, y */ + width, height - over, /* w, h */ + 0, 0); /* dstx,dsty */ + XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); + XFillRectangle(stddpy, stdpix, stdgc, + 0, height - over, width, over); + XSetForeground(stddpy, stdgc,wd->colors[wc->fg].c^(ISXORREVERSE(w)? + wd->colors[wc->bg].c:0)); + if (stdwin) + XCopyArea(stddpy, stdpix, stdwin, stdgc, 0, 0, width, height, 0,0); + if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); } break; } @@ -650,251 +650,251 @@ int handle_misc(wdp wd, wbp w) /* could avoid doing this search every event by handling 1 window at a time */ for (wb = wbndngs; wb; wb=wb->next) { - ws = wb->window; + ws = wb->window; - if (ws->display == wd) { - if (ws->win == evwin) break; - if (ws->iconwin == evwin) break; - if (ws->pix == evwin) break; - if (ws->initialPix == evwin) break; - } + if (ws->display == wd) { + if (ws->win == evwin) break; + if (ws->iconwin == evwin) break; + if (ws->pix == evwin) break; + if (ws->initialPix == evwin) break; + } } if (!wb) continue; if (evwin == ws->iconwin) { switch (event.type) { - case Expose: + case Expose: if (ws->iconpix) - XCopyArea(wd->display, ws->iconpix, ws->iconwin, - wd->icongc, 0, 0, ws->iconw, ws->iconh, 3, 3); - else + XCopyArea(wd->display, ws->iconpix, ws->iconwin, + wd->icongc, 0, 0, ws->iconw, ws->iconh, 3, 3); + else #ifdef GraphicsGL if (!ws->is_gl) -#endif /* GraphicsGL */ - XDrawString(wd->display, evwin, wd->icongc, 4, - ws->display->fonts->fsp->max_bounds.ascent + 2, - ws->iconlabel, strlen(ws->iconlabel)); - if (ws->iconic == IconicState) - SETEXPOSED(wb); - break; - case KeyRelease: { - if (ws->inputmask & KeyReleaseMask) { - handle_keypress(wb, (XKeyEvent *)&event); - } - break; - } - case KeyPress: - handle_keypress(wb, (XKeyEvent *)&event); - break; - case ButtonPress: - if (ws->iconic == IconicState) - XMapWindow(ws->display->display, ws->win); - ws->iconic = NormalState; /* set the current state */ - break; - case ConfigureNotify: - ws->iconx = ((XConfigureEvent *)&event)->x; - ws->icony = ((XConfigureEvent *)&event)->y; - break; - } - } +#endif /* GraphicsGL */ + XDrawString(wd->display, evwin, wd->icongc, 4, + ws->display->fonts->fsp->max_bounds.ascent + 2, + ws->iconlabel, strlen(ws->iconlabel)); + if (ws->iconic == IconicState) + SETEXPOSED(wb); + break; + case KeyRelease: { + if (ws->inputmask & KeyReleaseMask) { + handle_keypress(wb, (XKeyEvent *)&event); + } + break; + } + case KeyPress: + handle_keypress(wb, (XKeyEvent *)&event); + break; + case ButtonPress: + if (ws->iconic == IconicState) + XMapWindow(ws->display->display, ws->win); + ws->iconic = NormalState; /* set the current state */ + break; + case ConfigureNotify: + ws->iconx = ((XConfigureEvent *)&event)->x; + ws->icony = ((XConfigureEvent *)&event)->y; + break; + } + } else { switch (event.type) { case SelectionRequest: { - XEvent theevent; - - /* Ensure that our atoms are interned. */ - if (intern_status == 0) - intern_status = InternAtoms(ws->display->display); - - if ((event.xselectionrequest.selection != XA_PRIMARY) && - (event.xselectionrequest.selection != atom_array[CLIPBOARD])) { - fprintf(stderr, "unknown selectionrequest\n"); - } - - if (event.xselectionrequest.target == atom_array[TARGETS]) { - Atom xastring = XA_STRING; - XChangeProperty(ws->display->display, - event.xselectionrequest.requestor, - event.xselectionrequest.property, - XA_ATOM, 32, PropModeReplace, - (unsigned char *)&xastring, 1); - goto sendevent; - } - else if (event.xselectionrequest.target != XA_STRING) { - Atom ct, cs, ut, mu; - ct = XInternAtom(ws->display->display, "COMPOUND_TEXT", False); - cs = XInternAtom(ws->display->display, "COMPOUND_STRING", False); - ut = XInternAtom(ws->display->display, "UTF8_STRING", False); - mu = XInternAtom(ws->display->display, "MULTIPLE", False); - if (event.xselectionrequest.target == cs) - fprintf(stderr, "compoundstring\n"); - else if (event.xselectionrequest.target == ut) - fprintf(stderr, "UTF8\n"); - else if (event.xselectionrequest.target == mu) - fprintf(stderr, "MULTIPLE\n"); - else if (event.xselectionrequest.target == ct) - fprintf(stderr, "unlikely\n"); - else - fprintf(stderr, "idk\n"); - } + XEvent theevent; + + /* Ensure that our atoms are interned. */ + if (intern_status == 0) + intern_status = InternAtoms(ws->display->display); + + if ((event.xselectionrequest.selection != XA_PRIMARY) && + (event.xselectionrequest.selection != atom_array[CLIPBOARD])) { + fprintf(stderr, "unknown selectionrequest\n"); + } + + if (event.xselectionrequest.target == atom_array[TARGETS]) { + Atom xastring = XA_STRING; + XChangeProperty(ws->display->display, + event.xselectionrequest.requestor, + event.xselectionrequest.property, + XA_ATOM, 32, PropModeReplace, + (unsigned char *)&xastring, 1); + goto sendevent; + } + else if (event.xselectionrequest.target != XA_STRING) { + Atom ct, cs, ut, mu; + ct = XInternAtom(ws->display->display, "COMPOUND_TEXT", False); + cs = XInternAtom(ws->display->display, "COMPOUND_STRING", False); + ut = XInternAtom(ws->display->display, "UTF8_STRING", False); + mu = XInternAtom(ws->display->display, "MULTIPLE", False); + if (event.xselectionrequest.target == cs) + fprintf(stderr, "compoundstring\n"); + else if (event.xselectionrequest.target == ut) + fprintf(stderr, "UTF8\n"); + else if (event.xselectionrequest.target == mu) + fprintf(stderr, "MULTIPLE\n"); + else if (event.xselectionrequest.target == ct) + fprintf(stderr, "unlikely\n"); + else + fprintf(stderr, "idk\n"); + } /* TODO: check timestamp to verify that we owned selection at that time. */ - if (ws->selectiondata != NULL) { - if (AppendProperty(ws->display->display, - event.xselectionrequest.requestor, - event.xselectionrequest.property, XA_STRING, 8, - (unsigned char *)ws->selectiondata, - strlen(ws->selectiondata)) == False) { - fprintf(stderr, "selection property error\n"); - } + if (ws->selectiondata != NULL) { + if (AppendProperty(ws->display->display, + event.xselectionrequest.requestor, + event.xselectionrequest.property, XA_STRING, 8, + (unsigned char *)ws->selectiondata, + strlen(ws->selectiondata)) == False) { + fprintf(stderr, "selection property error\n"); + } sendevent: - memset(&theevent, 0, sizeof(theevent)); - theevent.type = SelectionNotify; - theevent.xselection.property = event.xselectionrequest.property; - theevent.xselection.serial = event.xselectionrequest.serial; - theevent.xselection.send_event = False;/* Was True. Why? */ - theevent.xselection.display = event.xselectionrequest.display; - theevent.xselection.requestor = event.xselectionrequest.requestor; - theevent.xselection.selection = event.xselectionrequest.selection; - theevent.xselection.target = event.xselectionrequest.target; - theevent.xselection.time = event.xselectionrequest.time; - XSendEvent(ws->display->display, - event.xselectionrequest.requestor, - False, 0, &theevent); - XSync(ws->display->display, False); - } - } - break; - case SelectionClear: - /* printf("selectionclear\n"); */ - ws->inputmask &= ~(PropertyChangeMask); - if (ws->selectiondata) { - free(ws->selectiondata); - ws->selectiondata = 0; - } - break; + memset(&theevent, 0, sizeof(theevent)); + theevent.type = SelectionNotify; + theevent.xselection.property = event.xselectionrequest.property; + theevent.xselection.serial = event.xselectionrequest.serial; + theevent.xselection.send_event = False;/* Was True. Why? */ + theevent.xselection.display = event.xselectionrequest.display; + theevent.xselection.requestor = event.xselectionrequest.requestor; + theevent.xselection.selection = event.xselectionrequest.selection; + theevent.xselection.target = event.xselectionrequest.target; + theevent.xselection.time = event.xselectionrequest.time; + XSendEvent(ws->display->display, + event.xselectionrequest.requestor, + False, 0, &theevent); + XSync(ws->display->display, False); + } + } + break; + case SelectionClear: + /* printf("selectionclear\n"); */ + ws->inputmask &= ~(PropertyChangeMask); + if (ws->selectiondata) { + free(ws->selectiondata); + ws->selectiondata = 0; + } + break; case SelectionNotify: - if ((event.xselection.selection == XA_PRIMARY) && - (event.xselection.time == timestmp) && - (event.xselection.requestor == requestor) && - (event.xselection.target == target) - ) { - selectfoo = event; - bar = &selectfoo; - } - break; - case KeyRelease: { - if (ws->inputmask & KeyReleaseMask) { - handle_keypress(wb, (XKeyEvent *)&event); - } - break; - } - case KeyPress: - handle_keypress(wb, (XKeyEvent *)&event); - break; - case ButtonPress: - presscount++; - handle_mouse(wb, (XButtonEvent *)&event); + if ((event.xselection.selection == XA_PRIMARY) && + (event.xselection.time == timestmp) && + (event.xselection.requestor == requestor) && + (event.xselection.target == target) + ) { + selectfoo = event; + bar = &selectfoo; + } + break; + case KeyRelease: { + if (ws->inputmask & KeyReleaseMask) { + handle_keypress(wb, (XKeyEvent *)&event); + } + break; + } + case KeyPress: + handle_keypress(wb, (XKeyEvent *)&event); + break; + case ButtonPress: + presscount++; + handle_mouse(wb, (XButtonEvent *)&event); #ifdef Graphics3D - if (wb->window->is_3D && wb->context->app_use_selection3D) { - wb->context->selectionrendermode = 1; - redraw3D(wb); - wb->context->selectionrendermode = 0; - } -#endif /* Graphics3D */ - break; - case ButtonRelease: - if (--presscount < 0) presscount = 0; - handle_mouse(wb, (XButtonEvent *)&event); - break; - case MotionNotify: - if (presscount || wb->window->inputmask) - handle_mouse(wb, (XButtonEvent *)&event); - break; + if (wb->window->is_3D && wb->context->app_use_selection3D) { + wb->context->selectionrendermode = 1; + redraw3D(wb); + wb->context->selectionrendermode = 0; + } +#endif /* Graphics3D */ + break; + case ButtonRelease: + if (--presscount < 0) presscount = 0; + handle_mouse(wb, (XButtonEvent *)&event); + break; + case MotionNotify: + if (presscount || wb->window->inputmask) + handle_mouse(wb, (XButtonEvent *)&event); + break; case NoExpose: - break; - case Expose: - if (!handle_exposures(wb, (XExposeEvent *)&event)) - return 1; - continue; + break; + case Expose: + if (!handle_exposures(wb, (XExposeEvent *)&event)) + return 1; + continue; case UnmapNotify: - wb->window->iconic = IconicState; + wb->window->iconic = IconicState; continue; - case MapNotify: - if ((ws->width != DisplayWidth(wd->display, wd->screen)) || - (ws->height != DisplayHeight(wd->display, wd->screen))) - ws->iconic = NormalState; - else - ws->iconic = MaximizedState; - continue; - case ConfigureNotify: - if (!handle_config(wb, (XConfigureEvent *)&event)) { - return 0; + case MapNotify: + if ((ws->width != DisplayWidth(wd->display, wd->screen)) || + (ws->height != DisplayHeight(wd->display, wd->screen))) + ws->iconic = NormalState; + else + ws->iconic = MaximizedState; + continue; + case ConfigureNotify: + if (!handle_config(wb, (XConfigureEvent *)&event)) { + return 0; } - break; - case ClientMessage: { - /* - * only client message we handle at present are destroy requests - */ - struct descrip d; - int ret = 0; - if (w && (evwin == w->window->win)) ret = 1; + break; + case ClientMessage: { + /* + * only client message we handle at present are destroy requests + */ + struct descrip d; + int ret = 0; + if (w && (evwin == w->window->win)) ret = 1; if (ws->inputmask & WindowClosureMask) { - MakeInt(WINDOWCLOSED, &d); + MakeInt(WINDOWCLOSED, &d); qevent(wb->window, &d, 0, 0, 0, 0); return 1; } - SETCLOSED((wbp)wb); - wclose(wb); - MakeInt(WINDOWCLOSED, &d); - qevent(wb->window, &d, 0, 0, 0, 0); - BlkD(lastEventWin,File)->status &= ~(Fs_Write); - if (ret) return 1; - break; - } - case DestroyNotify: - if (!ISZOMBIE(wb)) return -1; /* error #141 */ - - /* - * first of all, we are done with this window - */ - ws->win = (Window) NULL; - - /* - * if there are no more references, we are done with the pixmap - * too. Free it and the colors allocated for this canvas. - */ - if (ws->refcount == 0) { - if (wb->window->pix) { - Display *d = ws->display->display; - XSync(d, False); - if (ws->pix) - XFreePixmap(d, ws->pix); - ws->pix = (Pixmap) NULL; - } - if (ws->initialPix != (Pixmap) NULL) { - Display *d = ws->display->display; - XSync(d, False); - XFreePixmap(d, ws->initialPix); - ws->initialPix = (Pixmap) NULL; - } + SETCLOSED((wbp)wb); + wclose(wb); + MakeInt(WINDOWCLOSED, &d); + qevent(wb->window, &d, 0, 0, 0, 0); + BlkD(lastEventWin,File)->status &= ~(Fs_Write); + if (ret) return 1; + break; + } + case DestroyNotify: + if (!ISZOMBIE(wb)) return -1; /* error #141 */ + + /* + * first of all, we are done with this window + */ + ws->win = (Window) NULL; + + /* + * if there are no more references, we are done with the pixmap + * too. Free it and the colors allocated for this canvas. + */ + if (ws->refcount == 0) { + if (wb->window->pix) { + Display *d = ws->display->display; + XSync(d, False); + if (ws->pix) + XFreePixmap(d, ws->pix); + ws->pix = (Pixmap) NULL; + } + if (ws->initialPix != (Pixmap) NULL) { + Display *d = ws->display->display; + XSync(d, False); + XFreePixmap(d, ws->initialPix); + ws->initialPix = (Pixmap) NULL; + } free_xcolors(wb, 2); /* free regular colors */ free_xcolors(wb, 1); /* free icon colors */ - } - break; - default: - continue; - } + } + break; + default: + continue; + } if ((w != NULL) && - ((evwin == w->window->win) || (evwin == w->window->iconwin))) { - return 1; + ((evwin == w->window->win) || (evwin == w->window->iconwin))) { + return 1; } } } return 1; } - + /* * poll for available events on all opened displays. * this is where the interpreter calls into the X interface. @@ -907,18 +907,18 @@ int helper_thread_pollevent(){ int hm; for (wd = wdsplys; wd; wd = wd->next) { if ((hm = handle_misc(wd, NULL)) < 1) { - if (hm == -1){ - return -1; - } - else if (hm == 0) { - /* how to handle failure? */ - } + if (hm == -1){ + return -1; + } + else if (hm == 0) { + /* how to handle failure? */ + } } } return POLL_INTERVAL; } -#endif /* HELPER_THREAD */ +#endif /* HELPER_THREAD */ int pollevent() { @@ -928,7 +928,7 @@ int pollevent() #ifdef GraphicsGL wbp wb; static int gpx_poll = FLUSH_POLL_INTERVAL; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ #ifdef Concurrent int isbusy; /* CURTSTATE(); @@ -937,7 +937,7 @@ int pollevent() MUTEX_TRYLOCKID(MTX_POLLEVENT, isbusy); if (isbusy) return POLL_INTERVAL; -#endif /* Concurrent */ +#endif /* Concurrent */ #ifdef GraphicsGL if (gpx_poll) gpx_poll--; @@ -958,21 +958,21 @@ int pollevent() } gpx_poll = FLUSH_POLL_INTERVAL; } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ for (wd = wdsplys; wd; wd = wd->next) { if ((hm = handle_misc(wd, NULL)) < 1) { - if (hm == -1){ - MUTEX_UNLOCKID(MTX_POLLEVENT); - return -1; - } - else if (hm == 0) { - /* how to handle failure? */ - } + if (hm == -1){ + MUTEX_UNLOCKID(MTX_POLLEVENT); + return -1; + } + else if (hm == 0) { + /* how to handle failure? */ + } } } MUTEX_UNLOCKID(MTX_POLLEVENT); -#endif /* HELPER_THREAD */ +#endif /* HELPER_THREAD */ return POLL_INTERVAL; } @@ -989,14 +989,14 @@ int t; while (1) { wdp wd = w->window->display; /* leave inside loop; ws->pix can change! */ - + if (!EVQUEEMPTY(w)) { - EVQUEGET(w,*res); - if (posted) + EVQUEGET(w,*res); + if (posted) scrubcursor(w); - return 1; + return 1; } - postcursor(w); /* post every time in case resize erased it */ + postcursor(w); /* post every time in case resize erased it */ posted = 1; /* If we need a timeout, we select right here so we know an event will be available when XNextEvent is called by handle_misc */ @@ -1004,10 +1004,10 @@ int t; /* timer expired */ return -2; if (handle_misc(wd, w) == -1) { - if (posted) + if (posted) scrubcursor(w); - return -1; - } + return -1; + } } } @@ -1020,7 +1020,7 @@ void postcursor(wbp w) wsp ws = w->window; wdp wd = ws->display; Display *stddpy = wd->display; - + if (!ISCURSORON(w) || !ws->win) return; if (wc->drawop != GXcopy) XSetFunction(stddpy, wc->gc, GXcopy); if (ISXORREVERSE(w)) XSetForeground(stddpy, wc->gc, wd->colors[wc->fg].c); @@ -1036,14 +1036,14 @@ void scrubcursor(wbp w) if (!ISCURSORON(w) || !stdwin) return; - XCopyArea(stddpy, stdpix, stdwin, stdgc, /* restore window from pixmap */ + XCopyArea(stddpy, stdpix, stdwin, stdgc, /* restore window from pixmap */ ws->x, ws->y, FWIDTH(w), DESCENT(w), ws->x, ws->y); if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); if (ISXORREVERSE(w)) XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c ^ wd->colors[wc->bg].c); + wd->colors[wc->fg].c ^ wd->colors[wc->bg].c); } - + /* * wclose - close a window. If is a real on-screen window, * wait for a DestroyNotify event from the server before returning. @@ -1069,8 +1069,8 @@ wbp w; wbl = ws->children; #ifdef Graphics3D if(tmp_wb->window->is_3D) - release_3d_resources(tmp_wb); -#endif /* Graphics3D */ + release_3d_resources(tmp_wb); +#endif /* Graphics3D */ ws->children = ws->children->next; ws->display->refcount--; tmp_wb->refcount--; @@ -1087,19 +1087,19 @@ wbp w; t = p->window->children; b = NULL; while (t) { - if (t->child->window == w->window) { - if (b==NULL) + if (t->child->window == w->window) { + if (b==NULL) p->window->children = t->next; - else b->next = t->next; - t->next = NULL; - t->child = NULL; - free(t); - w->refcount--; - break; - } - b=t; - t = t->next; - } + else b->next = t->next; + t->next = NULL; + t->child = NULL; + free(t); + w->refcount--; + break; + } + b=t; + t = t->next; + } ws->parent=NULL; p->refcount--; } @@ -1107,8 +1107,8 @@ wbp w; #ifdef Graphics3D if (w->window->is_3D) release_3d_resources(w); -#endif /* Graphics3D */ - +#endif /* Graphics3D */ + if (ws->win && ws->refcount > 1) { SETZOMBIE(w); #ifdef GraphicsGL @@ -1120,18 +1120,18 @@ wbp w; XFlush(stddpy); ws->refcount--; while (ws->win) - if (pollevent() == -1) return -1; - ws->win = (Window) NULL; + if (pollevent() == -1) return -1; + ws->win = (Window) NULL; ws->busy_flag = 0; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { XDestroyWindow(stddpy, ws->win); XFlush(stddpy); ws->refcount--; while (ws->win) - if (pollevent() == -1) return -1; + if (pollevent() == -1) return -1; } } /* @@ -1143,10 +1143,10 @@ wbp w; /* free_window(ws); */ free_binding(w); } - + return 0; } - + /* * flush a window */ @@ -1155,7 +1155,7 @@ wbp w; { XFlush(w->window->display->display); } - + /* * flush all windows */ @@ -1166,7 +1166,7 @@ void wflushall() XFlush(wd->display); } } - + /* * sync all the servers */ @@ -1176,8 +1176,8 @@ wbp w; wdp wd; if (w == NULL) { for (wd = wdsplys; wd != NULL; wd = wd->next) { - XSync(wd->display, False); - } + XSync(wd->display, False); + } } else XSync(w->window->display->display, False); @@ -1208,11 +1208,11 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int tlp = lp; for(i=0;i8) && - !strncmp("display=",StrLoc(attr[i]),8)) { + (StrLen(attr[i])>8) && + !strncmp("display=",StrLoc(attr[i]),8)) { strncpy(dispchrs,StrLoc(attr[i])+8,StrLen(attr[i])-8); - dispchrs[StrLen(attr[i]) - 8] = '\0'; - display = dispchrs; + dispchrs[StrLen(attr[i]) - 8] = '\0'; + display = dispchrs; } } @@ -1235,7 +1235,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int } } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { if ((ws = w->window = alc_winstate()) == NULL) { *err_index = -2; @@ -1249,7 +1249,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int set_errortext(145); /* maybe out of memory, probably bad DISPLAY var. */ return NULL; } - ws->vis = DefaultVisual(ws->display->display, ws->display->screen); + ws->vis = DefaultVisual(ws->display->display, ws->display->screen); } @@ -1262,7 +1262,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int /* * some attributes of the display and window are used in the context */ - + #ifdef GraphicsGL if (is_gl) { if ((wc = w->context = gl_alc_context(w)) == NULL) { @@ -1272,13 +1272,13 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int } } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if ((wc = w->context = alc_context(w)) == NULL) { *err_index = -2; free_binding(w); return NULL; } - + /* * some attributes of the context determine window defaults */ @@ -1289,7 +1289,7 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int ws->y = wc->font->height; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { ws->width = wc->font->fsp->max_bounds.width * 80; ws->y = wc->font->fsp->max_bounds.ascent; @@ -1307,25 +1307,25 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int if (create_display_list(w, 40000) == Failed) { *err_index = -2; return NULL; - } - } + } + } if (create_display_list2d(w, 40000) == Failed) { *err_index = -2; return NULL; } /* - * Need to determine a way to initialize the default context for a + * Need to determine a way to initialize the default context for a * window without adding items to the display list. */ if (!ws->initAttrs) ws->initAttrs = 1; else { - glprintf("gl_wopen(): need a mutex lock\n"); + glprintf("gl_wopen(): need a mutex lock\n"); return NULL; } } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ /* * Loop through any remaining arguments. @@ -1336,25 +1336,25 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int * except "display=" attribute, which is done earlier */ if((StrLen(attr[i])<9)||strncmp(StrLoc(attr[i]),"display=",8)) { - switch (wattrib((wbp) w, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt, - answer)) { - case RunError: - *err_index = i; - return NULL; - case Failed: - free_binding((wbp)w); - *err_index = -1; - set_errortext(145); - return NULL; - } - } + switch (wattrib((wbp) w, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt, + answer)) { + case RunError: + *err_index = i; + return NULL; + case Failed: + free_binding((wbp)w); + *err_index = -1; + set_errortext(145); + return NULL; + } + } } if (ws->windowlabel == NULL) { ws->windowlabel = salloc(name); if (ws->windowlabel == NULL) { /* out of memory */ - *err_index = -2; - return NULL; - } + *err_index = -2; + return NULL; + } } #ifdef GraphicsGL @@ -1362,30 +1362,30 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int if (ws->initAttrs) ws->initAttrs = 0; else { - glprintf("gl_wopen(): need a mutex unlock\n"); + glprintf("gl_wopen(): need a mutex unlock\n"); return NULL; } if ((i = gl_wmap(w)) != Succeeded) { if (i == Failed) { - /* why would wmap() fail? either 144 or 145; have it say which */ - *err_index = -1; - } + /* why would wmap() fail? either 144 or 145; have it say which */ + *err_index = -1; + } else *err_index = 0; return NULL; } } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if ((i = wmap(w)) != Succeeded) { if (i == Failed) { - /* why would wmap() fail? either 144 or 145; have it say which */ - *err_index = -1; - } + /* why would wmap() fail? either 144 or 145; have it say which */ + *err_index = -1; + } else *err_index = 0; return NULL; } - + if (ws->win) { Atom WMDeleteWindow = XInternAtom(ws->display->display, "WM_DELETE_WINDOW", True); XSetWMProtocols(ws->display->display, ws->win, &WMDeleteWindow, 1); @@ -1398,32 +1398,32 @@ FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_index, int */ void makeIcon(w, x, y) wbp w; -int x, y; /* current mouse position */ +int x, y; /* current mouse position */ { int status; wcp wc = w->context; wsp ws = w->window; wdp wd = ws->display; Display *stddpy = wd->display; - + /* if a pixmap image has been specified, load it */ if (ws->initicon.width) { ws->iconpix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), - ws->iconw, ws->iconh, - DefaultDepth(stddpy,wd->screen)); + ws->iconw, ws->iconh, + DefaultDepth(stddpy,wd->screen)); } else if (ws->iconimage && strcmp(ws->iconimage, "")) { ws->iconpix = loadimage(w, ws->iconimage, &(ws->iconh), &(ws->iconw), - 0, &status); + 0, &status); ws->iconh += 6; ws->iconw += 6; } else { /* determine the size of the icon window */ ws->iconh = wd->fonts->fsp->max_bounds.ascent + - wd->fonts->fsp->max_bounds.descent + 5; + wd->fonts->fsp->max_bounds.descent + 5; if (ws->iconlabel == NULL) ws->iconlabel = ""; ws->iconw = XTextWidth(wd->fonts->fsp, ws->iconlabel, - strlen(ws->iconlabel)) + 6; + strlen(ws->iconlabel)) + 6; } /* if icon position hint exists, get it */ @@ -1434,14 +1434,14 @@ int x, y; /* current mouse position */ /* create the icon window */ ws->iconwin = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), x, y, - ws->iconw, ws->iconh, 2, - wd->colors[wc->fg].c, - wd->colors[wc->bg].c); + ws->iconw, ws->iconh, 2, + wd->colors[wc->fg].c, + wd->colors[wc->bg].c); /* select events for the icon window */ XSelectInput(stddpy, ws->iconwin, - ExposureMask | KeyPressMask | ButtonPressMask | - StructureNotifyMask); + ExposureMask | KeyPressMask | ButtonPressMask | + StructureNotifyMask); } @@ -1458,14 +1458,14 @@ static void setclasshints(wbp w) XClassHint clhints; wsp ws = w->window; wdp wd = ws->display; - + clhints.res_name = sbuf; clhints.res_class = "IconProg"; if (getenv_r("RESOURCE_NAME", sbuf, 256) == -1) { p = StrLoc(kywd_prog); s = p + StrLen(kywd_prog); while (s > p && s[-1] != '/') - s--; /* find tail of prog_name */ + s--; /* find tail of prog_name */ for (i=0; s < p+StrLen(kywd_prog); ) clhints.res_name[i++] = *s++; clhints.res_name[i] = '\0'; } @@ -1492,15 +1492,15 @@ int wmap(wbp w) Window stdwin = (Window) NULL; Window rootwin; - wsp ws = w->window; + wsp ws = w->window; wdp wd; - wcp wc = w->context; + wcp wc = w->context; wbp wp = ws->parent; CURTSTATE(); - /* - * Initialize glX and X11 resources. OpenGL does not use backing store + /* + * Initialize glX and X11 resources. OpenGL does not use backing store * (Pixmap), only a (Window). */ @@ -1512,7 +1512,7 @@ int wmap(wbp w) if (wp == NULL) { rootwin = RootWindow(wd->display, wd->vis->screen); } - else { + else { rootwin = wp->window->win ? wp->window->win : RootWindow(wd->display, wd->vis->screen); } @@ -1543,7 +1543,7 @@ int wmap(wbp w) /* allocate bg */ GetColorUS(w, wc->glbg, r, g, b, a); color = alc_rgb(w, buf, r, g, b, 0); - if (!color) + if (!color) return RunError; wc->glbg.c = color->c; } @@ -1552,12 +1552,12 @@ int wmap(wbp w) /* allocate fg */ GetColorUS(w, wc->glfg, r, g, b, a); color = alc_rgb(w, buf, r, g, b, 0); - if (!color) + if (!color) return RunError; wc->glfg.c = color->c; (void) a; /* silence "not used" compiler warning */ } - } + } attr.background_pixmap = None; attr.background_pixel = wc->glbg.c; @@ -1569,17 +1569,17 @@ int wmap(wbp w) return Failed; } - /* + /* * Create X Window and GLX Window */ ws->win = ((ws->iconic == RootState) ? rootwin : XCreateWindow (stddpy, rootwin, - ws->posx < 0 ? 0 : ws->posx, - ws->posy < 0 ? 0 : ws->posy, - ws->width, ws->height, 0, - wd->vis->depth, InputOutput, - wd->vis->visual, - CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); + ws->posx < 0 ? 0 : ws->posx, + ws->posy < 0 ? 0 : ws->posy, + ws->width, ws->height, 0, + wd->vis->depth, InputOutput, + wd->vis->visual, + CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); if (ws->win == (Window) NULL) { /* consider freeing window binding/resources */ set_errortext(144); @@ -1595,9 +1595,9 @@ int wmap(wbp w) */ if (wc->rendermode == UGL2D) { int pbufattrs[] = {GLX_PBUFFER_WIDTH, DisplayWidth(stddpy, wd->screen), - GLX_PBUFFER_HEIGHT, DisplayHeight(stddpy, wd->screen), - GLX_PRESERVED_CONTENTS, True, - None}; + GLX_PBUFFER_HEIGHT, DisplayHeight(stddpy, wd->screen), + GLX_PRESERVED_CONTENTS, True, + None}; ws->pbuf = glXCreatePbuffer(stddpy, wd->configs[0],pbufattrs); if (ws->pbuf == (GLXPixmap)NULL) { /* consider freeing window binding/resources */ @@ -1612,7 +1612,7 @@ int wmap(wbp w) MakeCurrent(w); /* - * Initialize OpenGL states + * Initialize OpenGL states */ if (init_canvas(w) == Failed) return Failed; @@ -1645,13 +1645,13 @@ int wmap(wbp w) r = gl_strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, imd->data, (word)imd->width * (word)imd->height, 0); if (imd->paltbl) - free((pointer)imd->paltbl); + free((pointer)imd->paltbl); free((pointer)imd->data); imd->width = 0; if (r < 0) { - set_errortext(145); - return Failed; - } + set_errortext(145); + return Failed; + } } imd = &ws->initicon; @@ -1662,15 +1662,15 @@ int wmap(wbp w) free((pointer)imd->data); imd->width = 0; if (r < 0) { - set_errortext(145); - return Failed; - } + set_errortext(145); + return Failed; + } wmhints.icon_window = ws->iconwin; ws->wmhintflags |= IconWindowHint; } - /* - * Set X hints if not RootState or Icon. + /* + * Set X hints if not RootState or Icon. */ if (ws->iconic != RootState) { size_hints.flags = PSize | PMinSize | PMaxSize; @@ -1683,24 +1683,24 @@ int wmap(wbp w) size_hints.x = ws->posx; size_hints.y = ws->posy; if (ISRESIZABLE(w)) { - size_hints.min_width = 0; - size_hints.min_height = 0; - size_hints.max_width = DisplayWidth(stddpy, wd->screen); - size_hints.max_height = DisplayHeight(stddpy, wd->screen); - } + size_hints.min_width = 0; + size_hints.min_height = 0; + size_hints.max_width = DisplayWidth(stddpy, wd->screen); + size_hints.max_height = DisplayHeight(stddpy, wd->screen); + } else { - size_hints.min_width = size_hints.max_width = ws->width; - size_hints.min_height = size_hints.max_height = ws->height; - } + size_hints.min_width = size_hints.max_width = ws->width; + size_hints.min_height = size_hints.max_height = ws->height; + } if (ws->windowlabel == NULL) { ws->windowlabel = salloc(wp->window->windowlabel); } if (ws->iconlabel == NULL) { - if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) - ReturnErrNum(305, RunError); - } + if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) + ReturnErrNum(305, RunError); + } XSetStandardProperties(stddpy, stdwin, ws->windowlabel, ws->iconlabel, - 0,0,0, &size_hints); + 0,0,0, &size_hints); XSelectInput(stddpy, stdwin, XMasks(ws->inputmask)); } @@ -1708,9 +1708,9 @@ int wmap(wbp w) wmhints.flags = InputHint; if (ws->iconic != RootState) { if (ws->iconimage != NULL) { - makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); - wmhints.icon_window = ws->iconwin; - ws->wmhintflags |= IconWindowHint; + makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); + wmhints.icon_window = ws->iconwin; + ws->wmhintflags |= IconWindowHint; } wmhints.flags |= (ws->wmhintflags | StateHint); wmhints.initial_state = ws->iconic; @@ -1743,7 +1743,7 @@ int wmap(wbp w) ws->height = attrs.height; - /* + /* * Set a cursor */ if (stdwin) { @@ -1757,26 +1757,26 @@ int wmap(wbp w) * busy loop for an expose event, unless of course we are starting out * in an iconic state. Does not execute if hidden window * - * Note: Subwindows seem to hang on XNextEvent() in handle_misc(), so + * Note: Subwindows seem to hang on XNextEvent() in handle_misc(), so * prevent subwindows from waiting for an event that won't come. */ CLRZOMBIE(w); if (ws->iconic != HiddenState && !wp) { int hm; while (!ISEXPOSED(w) && (ws->iconic != IconicState || ws->iconwin)) { - if ((hm = handle_misc(wd, w)) < 1) { - if (hm == -1) return RunError; - else if (hm == 0) { - /* how to handle failure? */ - } - } + if ((hm = handle_misc(wd, w)) < 1) { + if (hm == -1) return RunError; + else if (hm == 0) { + /* how to handle failure? */ + } + } } } XSync(stddpy, False); } else /* if (!ws->is_gl) */ -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { XGCValues gcv; unsigned long gcmask = @@ -1786,29 +1786,29 @@ int wmap(wbp w) STDLOCALS(w); #ifdef Graphics3D /*wc->maxstex=16; - wc->stex = (struct _savetexture *) + wc->stex = (struct _savetexture *) malloc(wc->maxstex*sizeof(struct _savetexture)); - */ -#endif /* Graphics3D */ - + */ +#endif /* Graphics3D */ + /* * Create a pixmap for this canvas if there isn't one already. */ if (ws->pix == (Pixmap) NULL) { if (ws->initialPix) { - ws->pix = ws->initialPix; - ws->initialPix = (Pixmap) NULL; - ws->pixwidth = ws->width; - ws->pixheight = ws->height; - } + ws->pix = ws->initialPix; + ws->initialPix = (Pixmap) NULL; + ws->pixwidth = ws->width; + ws->pixheight = ws->height; + } else { - ws->pix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), - ws->width, ws->height, - DefaultDepth(stddpy,wd->screen)); - ws->pixwidth = ws->width; - ws->pixheight = ws->height; - new_pixmap = 1; - } + ws->pix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), + ws->width, ws->height, + DefaultDepth(stddpy,wd->screen)); + ws->pixwidth = ws->width; + ws->pixheight = ws->height; + new_pixmap = 1; + } stdpix = ws->pix; } @@ -1823,59 +1823,59 @@ int wmap(wbp w) attr.background_pixel = wd->colors[wc->bg].c; attr.border_pixel = wd->colors[wc->fg].c; attr.event_mask = StructureNotifyMask | ExposureMask; - -#ifdef Graphics3D + +#ifdef Graphics3D if (ws->is_3D) { - attr.colormap = - XCreateColormap(wd->display, - RootWindow(wd->display, wd->vis->screen), - wd->vis->visual, AllocNone); + attr.colormap = + XCreateColormap(wd->display, + RootWindow(wd->display, wd->vis->screen), + wd->vis->visual, AllocNone); ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(stddpy) : - XCreateWindow (stddpy, DefaultRootWindow(stddpy), - ws->posx < 0 ? 0 : ws->posx, - ws->posy < 0 ? 0 : ws->posy, - ws->width, ws->height, 0, - wd->vis->depth, InputOutput, - wd->vis->visual, - CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); - } + XCreateWindow (stddpy, DefaultRootWindow(stddpy), + ws->posx < 0 ? 0 : ws->posx, + ws->posy < 0 ? 0 : ws->posy, + ws->width, ws->height, 0, + wd->vis->depth, InputOutput, + wd->vis->visual, + CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); + } else -#endif /* Graphics3D */ - ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(stddpy) : - XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), - ws->posx < 0 ? 0 : ws->posx, - ws->posy < 0 ? 0 : ws->posy, ws->width, - ws->height, 1, - wd->colors[wc->fg].c, - wd->colors[wc->bg].c)); +#endif /* Graphics3D */ + ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(stddpy) : + XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), + ws->posx < 0 ? 0 : ws->posx, + ws->posy < 0 ? 0 : ws->posy, ws->width, + ws->height, 1, + wd->colors[wc->fg].c, + wd->colors[wc->bg].c)); if (ws->win == (Window) NULL) { - /* consider freeing window binding/resources */ - set_errortext(144); - return Failed; - } + /* consider freeing window binding/resources */ + set_errortext(144); + return Failed; + } stdwin = ws->win; XClearWindow(stddpy, stdwin); if (!ISTITLEBAR(ws)) { - /* - * Disable title bar. Code allegedly from GLUT via tonyobryan.com. - */ - struct { - unsigned long flags; - unsigned long functions; - unsigned long decorations; - long inputMode; - unsigned long status; - } hints; - Atom property; - hints.flags = 2; - hints.decorations = 0; - if ((property = XInternAtom(stddpy, "_MOTIF_WM_HINTS",True))) { - XChangeProperty(stddpy, ws->win, property, property, 32, - PropModeReplace, (unsigned char *)&hints, 5); - } - } + /* + * Disable title bar. Code allegedly from GLUT via tonyobryan.com. + */ + struct { + unsigned long flags; + unsigned long functions; + unsigned long decorations; + long inputMode; + unsigned long status; + } hints; + Atom property; + hints.flags = 2; + hints.decorations = 0; + if ((property = XInternAtom(stddpy, "_MOTIF_WM_HINTS",True))) { + XChangeProperty(stddpy, ws->win, property, property, 32, + PropModeReplace, (unsigned char *)&hints, 5); + } + } } /* @@ -1910,10 +1910,10 @@ int wmap(wbp w) wc->gc = XCreateGC(stddpy, stdpix, gcmask, &gcv); stdgc = wc->gc; if (stdgc == NULL) { - /* consider freeing window resources */ - set_errortext(144); - return Failed; - } + /* consider freeing window resources */ + set_errortext(144); + return Failed; + } } else XChangeGC(stddpy, stdgc, gcmask, &gcv); @@ -1921,11 +1921,11 @@ int wmap(wbp w) #ifdef Graphics3D if (wc->rendermode == UGL3D) { if (create3Dcontext(w) == Failed) { - set_errortext(144); - return Failed; - } + set_errortext(144); + return Failed; + } } -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (wc->clipw >= 0) setclip(w); @@ -1934,7 +1934,7 @@ int wmap(wbp w) XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); XFillRectangle(stddpy, ws->pix, stdgc, 0, 0, ws->width, ws->height); XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c ^(ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); + wd->colors[wc->fg].c ^(ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); } imd = &ws->initimage; @@ -1942,13 +1942,13 @@ int wmap(wbp w) r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl, imd->data, (word)imd->width * (word)imd->height, 0); if (imd->paltbl) - free((pointer)imd->paltbl); + free((pointer)imd->paltbl); free((pointer)imd->data); imd->width = 0; if (r < 0) { - set_errortext(145); - return Failed; - } + set_errortext(145); + return Failed; + } } imd = &ws->initicon; @@ -1959,18 +1959,18 @@ int wmap(wbp w) free((pointer)imd->data); imd->width = 0; if (r < 0) { - set_errortext(145); - return Failed; - } + set_errortext(145); + return Failed; + } wmhints.icon_window = ws->iconwin; ws->wmhintflags |= IconWindowHint; } if (wc->patternname != NULL) { if (SetPattern(w, wc->patternname, strlen(wc->patternname)) != Succeeded) { - set_errortext(145); - return Failed; - } + set_errortext(145); + return Failed; + } } /* @@ -1989,21 +1989,21 @@ int wmap(wbp w) size_hints.x = ws->posx; size_hints.y = ws->posy; if (ISRESIZABLE(w)) { - size_hints.min_width = 0; - size_hints.min_height = 0; - size_hints.max_width = DisplayWidth(stddpy, wd->screen); - size_hints.max_height = DisplayHeight(stddpy, wd->screen); - } + size_hints.min_width = 0; + size_hints.min_height = 0; + size_hints.max_width = DisplayWidth(stddpy, wd->screen); + size_hints.max_height = DisplayHeight(stddpy, wd->screen); + } else { - size_hints.min_width = size_hints.max_width = ws->width; - size_hints.min_height = size_hints.max_height = ws->height; - } + size_hints.min_width = size_hints.max_width = ws->width; + size_hints.min_height = size_hints.max_height = ws->height; + } if (ws->iconlabel == NULL) { - if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) - ReturnErrNum(305, RunError); - } + if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) + ReturnErrNum(305, RunError); + } XSetStandardProperties(stddpy, stdwin, ws->windowlabel, ws->iconlabel, - 0,0,0, &size_hints); + 0,0,0, &size_hints); XSelectInput(stddpy, stdwin, XMasks(ws->inputmask)); } @@ -2011,9 +2011,9 @@ int wmap(wbp w) wmhints.flags = InputHint; if (ws->iconic != RootState) { if (ws->iconimage != NULL) { - makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); - wmhints.icon_window = ws->iconwin; - ws->wmhintflags |= IconWindowHint; + makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); + wmhints.icon_window = ws->iconwin; + ws->wmhintflags |= IconWindowHint; } wmhints.flags |= (ws->wmhintflags | StateHint); wmhints.initial_state = ws->iconic; @@ -2058,12 +2058,12 @@ int wmap(wbp w) if (ws->win != (Window) NULL) { int hm; while (!ISEXPOSED(w) && (ws->iconic != IconicState || ws->iconwin)) { - if ((hm = handle_misc(wd, w)) < 1) { - if (hm == -1) return RunError; - else if (hm == 0) { - /* how to handle failure? */ - } - } + if ((hm = handle_misc(wd, w)) < 1) { + if (hm == -1) return RunError; + else if (hm == 0) { + /* how to handle failure? */ + } + } } } @@ -2092,23 +2092,23 @@ int status; XSync(wd->display, False); pollevent(); if (status == 1) - moveWindow(w, posx, posy); + moveWindow(w, posx, posy); else { - if (status == 2) - posx = posy = -MaxInt; - if (moveResizeWindow(w, posx, posy, wid, ht) == Failed) - return Failed; - } + if (status == 2) + posx = posy = -MaxInt; + if (moveResizeWindow(w, posx, posy, wid, ht) == Failed) + return Failed; + } /* XSync is not enough because the window manager gets involved here. */ - XFlush(wd->display); /* force out request */ + XFlush(wd->display); /* force out request */ XGetWMName(wd->display, ws->win, &textprop); /* force WM round trip */ - XSync(wd->display, False); /* NOW sync */ + XSync(wd->display, False); /* NOW sync */ -#ifdef GraphicsGL +#ifdef GraphicsGL if (ws->is_gl && (status & 2)) redraw3D(w); -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ } return Succeeded; } @@ -2120,9 +2120,9 @@ SHORT new_height; wsp ws = w->window; if (new_height < 0) return Failed; #ifdef GraphicsGL - if (ws->is_gl && ws->height != new_height) + if (ws->is_gl && ws->height != new_height) ws->resize = 1; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ws->height = size_hints.height = new_height; return Succeeded; } @@ -2134,9 +2134,9 @@ SHORT new_width; wsp ws = w->window; if (new_width < 0) return Failed; #ifdef GraphicsGL - if (ws->is_gl && ws->width != new_width) + if (ws->is_gl && ws->width != new_width) ws->resize = 1; -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ws->width = size_hints.width = new_width; return Succeeded; } @@ -2157,7 +2157,7 @@ char *geo; if (ws->is_gl && (ws->width != width || ws->height != height)) { ws->resize = 1; } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { ws->width = size_hints.width = width; ws->height = size_hints.height = height; @@ -2213,22 +2213,22 @@ char *val; if (ws->iconlabel != NULL) free(ws->iconlabel); if ((ws->iconlabel = salloc(val)) == NULL) ReturnErrNum(305, RunError); - + if (wd->display && ws->win) { XSetIconName(wd->display, ws->win, ws->iconlabel); if (ws->iconic == IconicState && !ws->iconpix && ws->iconwin) { - XClearWindow(wd->display, ws->iconwin); + XClearWindow(wd->display, ws->iconwin); #ifdef GraphicsGL if (!ws->is_gl) -#endif /* GraphicsGL */ - XDrawString(wd->display, ws->iconwin, wd->icongc, 4, - wd->fonts->fsp->max_bounds.ascent + 2, - ws->iconlabel, strlen(ws->iconlabel)); - } +#endif /* GraphicsGL */ + XDrawString(wd->display, ws->iconwin, wd->icongc, 4, + wd->fonts->fsp->max_bounds.ascent + 2, + ws->iconlabel, strlen(ws->iconlabel)); + } } return Succeeded; } - + /* * setwindowlabel */ @@ -2243,7 +2243,7 @@ char *s; ReturnErrNum(305, RunError); if (ws->display && ws->display->display && ws->win) XStoreName(ws->display->display, ws->win, - *ws->windowlabel ? ws->windowlabel : " "); /* empty string fails */ + *ws->windowlabel ? ws->windowlabel : " "); /* empty string fails */ return Succeeded; } @@ -2261,7 +2261,7 @@ int on; return Succeeded; } - + /* * setpointer() - define a mouse pointer shape */ @@ -2272,7 +2272,7 @@ char *val; int i = si_s2i(cursorsyms,val) >> 1; wsp ws = w->window; wdp wd = ws->display; - + if (i < 0 || i >= NUMCURSORSYMS) return Failed; ws->theCursor = i; @@ -2292,23 +2292,23 @@ char *val; { wcp wc = w->context; wdp wd = w->window->display; - + XSync(wd->display, False); if (!strcmp(val,"reverse")) { if (!ISXORREVERSE(w)) { - SETXORREVERSE(w); - wc->drawop = GXxor; - if (wc->gc) - XSetForeground(wd->display, wc->gc, - wd->colors[wc->fg].c ^ wd->colors[wc->bg].c); - } + SETXORREVERSE(w); + wc->drawop = GXxor; + if (wc->gc) + XSetForeground(wd->display, wc->gc, + wd->colors[wc->fg].c ^ wd->colors[wc->bg].c); + } } else { if (ISXORREVERSE(w)) { - CLRXORREVERSE(w); - if (wc->gc) - XSetForeground(wd->display, wc->gc, wd->colors[wc->fg].c); - } + CLRXORREVERSE(w); + if (wc->gc) + XSetForeground(wd->display, wc->gc, wd->colors[wc->fg].c); + } wc->drawop = si_s2i(drawops,val); if (wc->drawop == -1) { wc->drawop = GXcopy; return RunError; } } @@ -2359,28 +2359,28 @@ char *s; #ifdef GraphicsGL if (w->window->is_gl) sprintf(s, "???"); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ sprintf(s, "hidden"); } else switch (w->window->iconic) { case RootState: - sprintf(s, "root"); - break; + sprintf(s, "root"); + break; case NormalState: - sprintf(s, "normal"); - break; + sprintf(s, "normal"); + break; case IconicState: - sprintf(s, "iconic"); - break; + sprintf(s, "iconic"); + break; case MaximizedState: - sprintf(s, "maximal"); - break; + sprintf(s, "maximal"); + break; case HiddenState: - sprintf(s, "hidden"); - break; + sprintf(s, "hidden"); + break; default: - sprintf(s, "???"); + sprintf(s, "???"); } } @@ -2393,9 +2393,9 @@ int setselection(wbp w, dptr val) if (intern_status == 0) intern_status = InternAtoms(ws->display->display); i = ownselection(ws->display->display, ws->win, XA_PRIMARY, - (Time) ws->timestamp); + (Time) ws->timestamp); j = ownselection(ws->display->display, ws->win, atom_array[CLIPBOARD], - (Time) ws->timestamp); + (Time) ws->timestamp); ws->selectiondata = malloc(StrLen(*val)+1); if (ws->selectiondata == NULL) return Failed; strncpy(ws->selectiondata, StrLoc(*val), StrLen(*val)); @@ -2464,249 +2464,249 @@ char *s; if (!strcmp(s, "iconic")) { /* uninitialized */ if (stdwin == (Window) NULL) { - ws->wmhintflags |= StateHint; - ws->iconic = IconicState; - } + ws->wmhintflags |= StateHint; + ws->iconic = IconicState; + } else { - if (ws->iconic != IconicState) { + if (ws->iconic != IconicState) { #ifdef Iconify - XIconifyWindow(ws->display->display, stdwin, ws->display->screen); - XSync(stddpy, False); - while (ws->iconic != IconicState) - if ((hm = handle_misc(wd, NULL)) < 1) { - if (hm == -1) return RunError; - else if (hm == 0) { - return Failed; - } - } -#else /* Iconify */ - return Failed; -#endif /* Iconify */ - } - } + XIconifyWindow(ws->display->display, stdwin, ws->display->screen); + XSync(stddpy, False); + while (ws->iconic != IconicState) + if ((hm = handle_misc(wd, NULL)) < 1) { + if (hm == -1) return RunError; + else if (hm == 0) { + return Failed; + } + } +#else /* Iconify */ + return Failed; +#endif /* Iconify */ + } + } } else if (!strcmp(s, "normal")) { /* uninitialized */ if (stdwin == (Window) NULL) { - ws->wmhintflags |= StateHint; - ws->iconic = NormalState; - } + ws->wmhintflags |= StateHint; + ws->iconic = NormalState; + } else { - if (ws->iconic == IconicState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == IconicState) - pollevent(); - } - else if (ws->iconic == MaximizedState) { - moveResizeWindow(w, ws->normalx, ws->normaly, - ws->normalw, ws->normalh); - ws->iconic = NormalState; - } - else if (ws->iconic == HiddenState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == HiddenState) - pollevent(); + if (ws->iconic == IconicState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == IconicState) + pollevent(); + } + else if (ws->iconic == MaximizedState) { + moveResizeWindow(w, ws->normalx, ws->normaly, + ws->normalw, ws->normalh); + ws->iconic = NormalState; + } + else if (ws->iconic == HiddenState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == HiddenState) + pollevent(); } - } + } } else if (!strcmp(s, "maximal")) { if (ws->iconic != MaximizedState) { - int expect_config= (ws->width != DisplayWidth(stddpy, wd->screen)) || - (ws->height != DisplayHeight(stddpy, wd->screen)); - ws->normalx = ws->posx; - ws->normaly = ws->posy; - ws->normalw = ws->width; - ws->normalh = ws->height; - ws->width = DisplayWidth(stddpy, wd->screen); - ws->height= DisplayHeight(stddpy, wd->screen); - - if (stdwin != (Window) NULL) { - if (ws->iconic == IconicState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == IconicState) - pollevent(); - } - else if (ws->iconic == HiddenState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == HiddenState) - pollevent(); - } - else if (expect_config) { - moveResizeWindow(w, 0, 0, ws->width, ws->height); - /* XSync is not enough because the window manager gets involved here. */ - XFlush(wd->display); /* force out request */ - XGetWMName(wd->display, ws->win, &textprop); /* force WM round trip */ - XSync(wd->display, False); /* NOW sync */ - if (pollevent() == -1) return RunError; - moveWindow(w, -ws->posx, -ws->posy); - XFlush(wd->display); /* force out request */ - XGetWMName(wd->display, stdwin, &textprop); /* force WM round trip */ - XSync(wd->display, False); /* NOW sync */ - } - } - ws->iconic = MaximizedState; - } + int expect_config= (ws->width != DisplayWidth(stddpy, wd->screen)) || + (ws->height != DisplayHeight(stddpy, wd->screen)); + ws->normalx = ws->posx; + ws->normaly = ws->posy; + ws->normalw = ws->width; + ws->normalh = ws->height; + ws->width = DisplayWidth(stddpy, wd->screen); + ws->height= DisplayHeight(stddpy, wd->screen); + + if (stdwin != (Window) NULL) { + if (ws->iconic == IconicState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == IconicState) + pollevent(); + } + else if (ws->iconic == HiddenState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == HiddenState) + pollevent(); + } + else if (expect_config) { + moveResizeWindow(w, 0, 0, ws->width, ws->height); + /* XSync is not enough because the window manager gets involved here. */ + XFlush(wd->display); /* force out request */ + XGetWMName(wd->display, ws->win, &textprop); /* force WM round trip */ + XSync(wd->display, False); /* NOW sync */ + if (pollevent() == -1) return RunError; + moveWindow(w, -ws->posx, -ws->posy); + XFlush(wd->display); /* force out request */ + XGetWMName(wd->display, stdwin, &textprop); /* force WM round trip */ + XSync(wd->display, False); /* NOW sync */ + } + } + ws->iconic = MaximizedState; + } } else if (!strcmp(s, "hidden")) { /* Window initialized and not hidden */ if (stdwin != (Window) NULL && ws->iconic != HiddenState) { //XUnmapWindow(stddpy, stdwin); /* what's the difference? */ XWithdrawWindow(stddpy, stdwin, wd->vis->screen); - XSync(stddpy, False); - while (ws->iconic != IconicState) /* Wait for UnmapNotify event */ - pollevent(); - } + XSync(stddpy, False); + while (ws->iconic != IconicState) /* Wait for UnmapNotify event */ + pollevent(); + } ws->iconic = HiddenState; } else return RunError; } /* end if (ws->is_gl) */ else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { if (!strcmp(s, "iconic")) { if (ws->pix == (Pixmap) NULL) { - ws->wmhintflags |= StateHint; - ws->iconic = IconicState; - } + ws->wmhintflags |= StateHint; + ws->iconic = IconicState; + } else { - if (ws->iconic != IconicState) { + if (ws->iconic != IconicState) { #ifdef Iconify - if (stdwin == (Window) NULL) { - wmap(w); - } - XIconifyWindow(ws->display->display, stdwin, ws->display->screen); - XSync(stddpy, False); - while (ws->iconic != IconicState) - if ((hm = handle_misc(wd, NULL)) < 1) { - if (hm == -1) return RunError; - else if (hm == 0) { - return Failed; - } - } -#else /* Iconify */ - return Failed; -#endif /* Iconify */ - } - } + if (stdwin == (Window) NULL) { + wmap(w); + } + XIconifyWindow(ws->display->display, stdwin, ws->display->screen); + XSync(stddpy, False); + while (ws->iconic != IconicState) + if ((hm = handle_misc(wd, NULL)) < 1) { + if (hm == -1) return RunError; + else if (hm == 0) { + return Failed; + } + } +#else /* Iconify */ + return Failed; +#endif /* Iconify */ + } + } } else if (!strcmp(s, "normal")) { if (ws->pix == (Pixmap) NULL) { - ws->iconic = NormalState; - } + ws->iconic = NormalState; + } else { - if (stdwin == (Window) NULL) { - ws->iconic = NormalState; - ws->initialPix = ws->pix; - ws->pix = (Window) NULL; - if (ws->parent) { + if (stdwin == (Window) NULL) { + ws->iconic = NormalState; + ws->initialPix = ws->pix; + ws->pix = (Window) NULL; + if (ws->parent) { #ifdef GraphicsGL - gl_wmap(w); - if (w->window->is_3D) redraw3D(w); -#else /* GraphicsGL */ - my_wmap(w); -#endif /* GraphicsGL */ + gl_wmap(w); + if (w->window->is_3D) redraw3D(w); +#else /* GraphicsGL */ + my_wmap(w); +#endif /* GraphicsGL */ + } + else wmap(w); + } + else if (ws->iconic == IconicState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == IconicState) + pollevent(); } - else wmap(w); - } - else if (ws->iconic == IconicState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == IconicState) - pollevent(); - } - else if (ws->iconic == MaximizedState) { - moveResizeWindow(w, ws->normalx, ws->normaly, - ws->normalw, ws->normalh); - ws->iconic = NormalState; - } - else { - /* - * Going normal from presumed hidden/offscreen state. - * Restore posx/posy from saved values. - */ - ws->posx = ws->real_posx; - ws->posy = ws->real_posy; - do_config(w, 1); + else if (ws->iconic == MaximizedState) { + moveResizeWindow(w, ws->normalx, ws->normaly, + ws->normalw, ws->normalh); + ws->iconic = NormalState; + } + else { + /* + * Going normal from presumed hidden/offscreen state. + * Restore posx/posy from saved values. + */ + ws->posx = ws->real_posx; + ws->posy = ws->real_posy; + do_config(w, 1); #ifdef Graphics3D - if (ws->is_3D) redraw3D(w); -#endif /* Graphics3D */ + if (ws->is_3D) redraw3D(w); +#endif /* Graphics3D */ } - } + } } else if (!strcmp(s, "maximal")) { if (ws->iconic != MaximizedState) { - int expect_config= (ws->width != DisplayWidth(stddpy, wd->screen)) || - (ws->height != DisplayHeight(stddpy, wd->screen)); - ws->normalx = ws->posx; - ws->normaly = ws->posy; - ws->normalw = ws->width; - ws->normalh = ws->height; - ws->width = DisplayWidth(stddpy, wd->screen); - ws->height= DisplayHeight(stddpy, wd->screen); - if (ws->pix != (Pixmap) NULL) { - if (stdwin == (Window) NULL) { - ws->iconic = MaximizedState; - ws->initialPix = ws->pix; - ws->pix = (Window) NULL; - wmap(w); - } - else if (ws->iconic == IconicState) { - XMapWindow(stddpy, stdwin); - XSync(stddpy, False); - while (ws->iconic == IconicState) - pollevent(); - } - else if (expect_config) { - moveResizeWindow(w, 0, 0, ws->width, ws->height); - /* XSync is not enough because the window manager gets involved here. */ - XFlush(wd->display); /* force out request */ - XGetWMName(wd->display, ws->win, &textprop); /* force WM round trip */ - XSync(wd->display, False); /* NOW sync */ - if (pollevent() == -1) return RunError; - moveWindow(w, -ws->posx, -ws->posy); - XFlush(wd->display); /* force out request */ - XGetWMName(wd->display, stdwin, &textprop); /* force WM round trip */ - XSync(wd->display, False); /* NOW sync */ - } - } - ws->iconic = MaximizedState; - } + int expect_config= (ws->width != DisplayWidth(stddpy, wd->screen)) || + (ws->height != DisplayHeight(stddpy, wd->screen)); + ws->normalx = ws->posx; + ws->normaly = ws->posy; + ws->normalw = ws->width; + ws->normalh = ws->height; + ws->width = DisplayWidth(stddpy, wd->screen); + ws->height= DisplayHeight(stddpy, wd->screen); + if (ws->pix != (Pixmap) NULL) { + if (stdwin == (Window) NULL) { + ws->iconic = MaximizedState; + ws->initialPix = ws->pix; + ws->pix = (Window) NULL; + wmap(w); + } + else if (ws->iconic == IconicState) { + XMapWindow(stddpy, stdwin); + XSync(stddpy, False); + while (ws->iconic == IconicState) + pollevent(); + } + else if (expect_config) { + moveResizeWindow(w, 0, 0, ws->width, ws->height); + /* XSync is not enough because the window manager gets involved here. */ + XFlush(wd->display); /* force out request */ + XGetWMName(wd->display, ws->win, &textprop); /* force WM round trip */ + XSync(wd->display, False); /* NOW sync */ + if (pollevent() == -1) return RunError; + moveWindow(w, -ws->posx, -ws->posy); + XFlush(wd->display); /* force out request */ + XGetWMName(wd->display, stdwin, &textprop); /* force WM round trip */ + XSync(wd->display, False); /* NOW sync */ + } + } + ws->iconic = MaximizedState; + } } else if (!strcmp(s, "hidden")) { if (ws->pix == (Pixmap)NULL) { - ws->iconic = HiddenState; - } + ws->iconic = HiddenState; + } else { - if (stdwin != (Window) NULL) { - if (ws->iconic == MaximizedState) { - ws->posx = ws->normalx; - ws->posy = ws->normaly; - ws->width = ws->normalw; - ws->height = ws->normalh; - ws->iconic = NormalState; - } - if (ws->iconic != IconicState) { - /* - * Going hidden used to be this nice clean, kill-the-window - * affair. Some complications are now avoided by not killing - * the window but instead, moving it off-screen. - */ - ws->real_posx=ws->posx; - ws->real_posy=ws->posy; - ws->posx=8192; - ws->posy=0; - do_config(w, 1); - XFlush(stddpy); - } - } - } + if (stdwin != (Window) NULL) { + if (ws->iconic == MaximizedState) { + ws->posx = ws->normalx; + ws->posy = ws->normaly; + ws->width = ws->normalw; + ws->height = ws->normalh; + ws->iconic = NormalState; + } + if (ws->iconic != IconicState) { + /* + * Going hidden used to be this nice clean, kill-the-window + * affair. Some complications are now avoided by not killing + * the window but instead, moving it off-screen. + */ + ws->real_posx=ws->posx; + ws->real_posy=ws->posy; + ws->posx=8192; + ws->posy=0; + do_config(w, 1); + XFlush(stddpy); + } + } + } } else return RunError; } @@ -2723,29 +2723,29 @@ char *s; if (!strcmp(s, "icon")) { if (ws->pix == (Pixmap) NULL) { - ws->wmhintflags |= StateHint; - ws->iconic = IconicState; - } + ws->wmhintflags |= StateHint; + ws->iconic = IconicState; + } else { - if (ws->iconic != IconicState) { + if (ws->iconic != IconicState) { #ifdef Iconify - XIconifyWindow(ws->display->display, ws->win, ws->display->screen); -#else /* Iconify */ - return Failed; -#endif /* Iconify */ - } - } + XIconifyWindow(ws->display->display, ws->win, ws->display->screen); +#else /* Iconify */ + return Failed; +#endif /* Iconify */ + } + } } else if (!strcmp(s, "window")) { if (ws->win != (Window) NULL) { - if (ws->iconic == IconicState) { - XMapWindow(ws->display->display, ws->win); - } - } + if (ws->iconic == IconicState) { + XMapWindow(ws->display->display, ws->win); + } + } } else if (!strcmp(s, "root")) { if (ws->win == (Window) NULL) - ws->iconic = RootState; + ws->iconic = RootState; else return Failed; } else return RunError; @@ -2770,10 +2770,10 @@ char *s; if (ws->win) { if (ws->iconwin == (Window) NULL) - makeIcon(w, ws->iconx, ws->icony); + makeIcon(w, ws->iconx, ws->icony); #ifdef GraphicsGL if (!ws->is_gl) -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ if (remap(w, ws->iconx, ws->icony) == -1) return RunError; } return Succeeded; @@ -2787,7 +2787,7 @@ char *s; sprintf(s,"%d,%d", ws->iconx, ws->icony); return Succeeded; } - + /* * if the window exists and is visible, set its position to (x,y) @@ -2833,14 +2833,14 @@ int x, y, width, height; if (ws->win != (Window) NULL) { if (x == -MaxInt && y == -MaxInt) - XResizeWindow(wd->display, ws->win, width, height); + XResizeWindow(wd->display, ws->win, width, height); else XMoveResizeWindow(wd->display, ws->win, x, y, width, height); XSync(wd->display, False); } return Succeeded; } - + /* * Set the context's fill style by name. */ @@ -2854,7 +2854,7 @@ char *s; wc->fillstyle = FillSolid; } else if (!strcmp(s, "masked") - || !strcmp(s, "stippled") || !strcmp(s, "patterned")) { + || !strcmp(s, "stippled") || !strcmp(s, "patterned")) { wc->fillstyle = FillStippled; } else if (!strcmp(s, "textured") @@ -2876,7 +2876,7 @@ wbp w; char *s; { wcp wc = w->context; - + if (!strcmp(s, "solid")) { wc->linestyle = LineSolid; } @@ -2889,7 +2889,7 @@ char *s; else return RunError; if (w->window->pix) { XSetLineAttributes(w->window->display->display, wc->gc, - wc->linewidth, wc->linestyle, CapProjecting, JoinMiter); + wc->linewidth, wc->linestyle, CapProjecting, JoinMiter); } return Succeeded; } @@ -2913,13 +2913,13 @@ LONG linewid; if (linewid > 1) gcv.dashes = 3 * wc->linewidth; else - gcv.dashes = 4; + gcv.dashes = 4; gcmask = GCLineWidth | GCLineStyle | GCDashList; XChangeGC(w->window->display->display, wc->gc, gcmask, &gcv); } return Succeeded; } - + /* * Reset the context's foreground color to whatever it is supposed to be. */ @@ -2930,7 +2930,7 @@ wbp w; wdp wd = wc->display; if (wc->gc != NULL) XSetForeground(wc->display->display, wc->gc, - wd->colors[wc->fg].c ^ (ISXORREVERSE(w) ? wd->colors[wc->bg].c : 0)); + wd->colors[wc->fg].c ^ (ISXORREVERSE(w) ? wd->colors[wc->bg].c : 0)); return Succeeded; } @@ -2967,7 +2967,7 @@ int fg; { int i, r, g, b; wdp wd = w->window->display; - + if (fg >= 0) { b = fg & 255; fg >>= 8; @@ -2978,7 +2978,7 @@ int fg; } for (i = 2; i < DMAXCOLORS; i++) if (wd->colors[i].type == CLR_MUTABLE && wd->colors[i].c == -fg - 1) - break; + break; if (i == DMAXCOLORS) return Failed; w->context->fg = i; return resetfg(w); @@ -3033,7 +3033,7 @@ int bg; } for (i = 2; i < DMAXCOLORS; i++) if (wd->colors[i].type == CLR_MUTABLE && wd->colors[i].c == -bg - 1) - break; + break; if (i == DMAXCOLORS) return Failed; wc->bg = i; if (wc->gc != NULL) @@ -3051,11 +3051,11 @@ double gamma; wcp wc = w->context; wdp wd = w->window->display; wc->gamma = gamma; - setfg(w, wd->colors[wc->fg].name); /* reinterpret current Fg/Bg spec */ + setfg(w, wd->colors[wc->fg].name); /* reinterpret current Fg/Bg spec */ setbg(w, wd->colors[wc->bg].name); return Succeeded; } - + /* * Set the display by name. Really should cache answers as per fonts below; * for now just open a new display each time. Note that this can only be @@ -3092,7 +3092,7 @@ char *s; wc->glbg.id = 0; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { /* can't change display for mapped window! */ if (w->window->pix != (Pixmap) NULL) @@ -3107,7 +3107,7 @@ char *s; wc->font = d->fonts; return Succeeded; } - + int setleading(w, i) wbp w; int i; @@ -3123,7 +3123,7 @@ char *val; wsp ws = w->window; int status; ws->initialPix = loadimage(w, val, &(ws->height), &(ws->width), - 0, &status); + 0, &status); if (ws->initialPix == (Pixmap) NULL) return Failed; return Succeeded; } @@ -3140,7 +3140,7 @@ wbp w; wc->bg = tmp; if (w->window->pix) { XSetForeground(wd->display, wc->gc, - wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); + wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); XSetBackground(wd->display, wc->gc, wd->colors[wc->bg].c); } } @@ -3152,7 +3152,7 @@ char *answer; wdp wd = w->window->display; if (!strcmp(wd->name, "")) { if (getenv_r("DISPLAY", answer, 256) == -1) - *answer = '\0'; + *answer = '\0'; } else sprintf(answer, "%s", wd->name); } @@ -3176,7 +3176,7 @@ wbp w; int root_x, root_y, win_x, win_y; unsigned int key_buttons; wsp ws = w->window; - + if (!ws->win) return Failed; /* * This call is made because it is guaranteed to generate @@ -3184,7 +3184,7 @@ wbp w; * what the window position was last it knew. */ if (XQueryPointer(ws->display->display, ws->win, &garbage1, &garbage2, - &root_x, &root_y, &win_x, &win_y, &key_buttons) == + &root_x, &root_y, &win_x, &win_y, &key_buttons) == False) { return Failed; } @@ -3213,8 +3213,8 @@ char *answer; { wcp wc = w->context; sprintf(answer,"%s", - (wc->linestyle==LineSolid)?"solid": - ((wc->linestyle==LineOnOffDash)?"dashed":"striped")); + (wc->linestyle==LineSolid)?"solid": + ((wc->linestyle==LineOnOffDash)?"dashed":"striped")); } void getfntnam(w, answer) @@ -3223,14 +3223,14 @@ char *answer; { sprintf(answer,"%s", w->context->font->name); } - + void getpointername(w, answer) wbp w; char *answer; { strcpy(answer, si_i2s(cursorsyms, 2 * w->window->theCursor)); } - + void getdrawop(w, answer) wbp w; char *answer; @@ -3241,7 +3241,7 @@ char *answer; if (s) sprintf(answer, "%s", s); else strcpy(answer, "copy"); } - + void geticonic(w, answer) wbp w; char *answer; @@ -3260,7 +3260,7 @@ char *answer; sprintf(answer, "???"); } } - + /* * Set the window's font by name. */ @@ -3277,7 +3277,7 @@ char **s; mkfont(*s, 1); return Succeeded; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ /* could free up previously allocated font here */ @@ -3308,28 +3308,28 @@ XExposeEvent *event; returnval = ISEXPOSED(w); SETEXPOSED(w); if (stdwin && !ISZOMBIE(w)) { -#ifdef GraphicsGL +#ifdef GraphicsGL if (ws->is_gl) { /* - * Go ahead and redraw. Messing with the event queue might + * Go ahead and redraw. Messing with the event queue might * de-sync ConfigureNotify events with exposures, resulting * in undefined behavior */ - redraw3D(w); - } + redraw3D(w); + } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { if (wc->drawop != GXcopy) - XSetFunction(stddpy, stdgc, GXcopy); + XSetFunction(stddpy, stdgc, GXcopy); if (wc->clipw >= 0) - unsetclip(w); + unsetclip(w); XCopyArea(stddpy, stdpix, stdwin, stdgc, event->x,event->y, - event->width,event->height, event->x,event->y); + event->width,event->height, event->x,event->y); if (wc->clipw >= 0) - setclip(w); + setclip(w); if (wc->drawop != GXcopy) - XSetFunction(stddpy,stdgc,wc->drawop); + XSetFunction(stddpy,stdgc,wc->drawop); } } return returnval; @@ -3362,9 +3362,9 @@ int height; ws->pixheight = max(ws->pixheight, height); ws->pixwidth = max(ws->pixwidth, width); p = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), ws->pixwidth, - ws->pixheight, DefaultDepth(stddpy,wd->screen)); + ws->pixheight, DefaultDepth(stddpy,wd->screen)); if (p == (Pixmap) NULL) - return 0; + return 0; /* * This staggering amount of redudancy manages to make sure the new @@ -3373,33 +3373,33 @@ int height; */ XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); if (wc->drawop != GXcopy) - XSetFunction(stddpy, stdgc, GXcopy); + XSetFunction(stddpy, stdgc, GXcopy); if (wc->fillstyle != FillSolid) - XSetFillStyle(stddpy, stdgc, FillSolid); + XSetFillStyle(stddpy, stdgc, FillSolid); if (wc->clipw >= 0) - unsetclip(w); - + unsetclip(w); + if (width > x) { - XFillRectangle(stddpy, p, stdgc, x, 0, width-x, ws->pixheight); - if (stdwin != (Window) NULL) - XFillRectangle(stddpy,stdwin,stdgc, x, 0, width-x, ws->pixheight); + XFillRectangle(stddpy, p, stdgc, x, 0, width-x, ws->pixheight); + if (stdwin != (Window) NULL) + XFillRectangle(stddpy,stdwin,stdgc, x, 0, width-x, ws->pixheight); } if (height > y) { - XFillRectangle(stddpy, p, stdgc, 0, y, x, height - y); - if (stdwin != (Window) NULL) - XFillRectangle(stddpy, stdwin, stdgc, 0, y, x, height - y); + XFillRectangle(stddpy, p, stdgc, 0, y, x, height - y); + if (stdwin != (Window) NULL) + XFillRectangle(stddpy, stdwin, stdgc, 0, y, x, height - y); } XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); + wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); XCopyArea(stddpy, stdpix, p, stdgc, 0, 0, x, y, 0, 0); if (wc->drawop != GXcopy) - XSetFunction(stddpy,stdgc,wc->drawop); + XSetFunction(stddpy,stdgc,wc->drawop); if (wc->fillstyle != FillSolid) - XSetFillStyle(stddpy, stdgc, wc->fillstyle); + XSetFillStyle(stddpy, stdgc, wc->fillstyle); if (wc->clipw >= 0) - setclip(w); + setclip(w); - XFreePixmap(stddpy, stdpix); /* free old pixmap */ + XFreePixmap(stddpy, stdpix); /* free old pixmap */ ws->pix = p; } return 1; @@ -3416,7 +3416,7 @@ XConfigureEvent *event; { struct descrip d; wsp ws = w->window; - + /* * Update X-Icon's information about the window's configuration */ @@ -3424,7 +3424,7 @@ XConfigureEvent *event; if (ws->is_gl) ws->x = min(ws->x, event->width - GL_FWIDTH(w)); else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ ws->x = min(ws->x, event->width - FWIDTH(w)); ws->y = min(ws->y, event->height); @@ -3448,12 +3448,12 @@ XConfigureEvent *event; ws->resize = 1; redraw3D(w); } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ /* * The initial configure event generates no Icon-level "events" * - * Commenting this for the ui initial window size bug breaks + * Commenting this for the ui initial window size bug breaks * the integrated cve demo.. */ if (!ISEXPOSED(w)) @@ -3486,22 +3486,22 @@ XKeyEvent *event; if (event->type == KeyRelease) k = -k - 128; MakeInt(k, &d); qevent(w->window, &d, event->x, event->y, - (uword)event->time, event->state); + (uword)event->time, event->state); break; default: StrLen(d) = 1; for (j = 0; j < i; j++) { - if (event->type == KeyRelease) { - MakeInt(-(FromAscii(s[j]) & 0xFF)-128, &d); - qevent(w->window, &d, event->x, event->y, - (uword)event->time, event->state); - } - else { - StrLoc(d) = (char *)&allchars[FromAscii(s[j]) & 0xFF]; - qevent(w->window, &d, event->x, event->y, - (uword)event->time, event->state); - } - } + if (event->type == KeyRelease) { + MakeInt(-(FromAscii(s[j]) & 0xFF)-128, &d); + qevent(w->window, &d, event->x, event->y, + (uword)event->time, event->state); + } + else { + StrLoc(d) = (char *)&allchars[FromAscii(s[j]) & 0xFF]; + qevent(w->window, &d, event->x, event->y, + (uword)event->time, event->state); + } + } } } @@ -3525,7 +3525,7 @@ XButtonEvent *event; if (event->type == MotionNotify) { if (event->state & buttonorder[0]) { if (buttonorder[0] == Button1Mask) - eventcode = MOUSELEFTDRAG; + eventcode = MOUSELEFTDRAG; else if (buttonorder[0] == Button2Mask) eventcode = MOUSEMIDDRAG; else @@ -3533,7 +3533,7 @@ XButtonEvent *event; } else if (event->state & buttonorder[1]) { if (buttonorder[1] == Button1Mask) - eventcode = MOUSELEFTDRAG; + eventcode = MOUSELEFTDRAG; else if (buttonorder[1] == Button2Mask) eventcode = MOUSEMIDDRAG; else @@ -3541,56 +3541,56 @@ XButtonEvent *event; } else if (event->state & buttonorder[2]) { if (buttonorder[2] == Button1Mask) - eventcode = MOUSELEFTDRAG; + eventcode = MOUSELEFTDRAG; else if (buttonorder[2] == Button2Mask) eventcode = MOUSEMIDDRAG; else eventcode = MOUSERIGHTDRAG; } else { - eventcode = MOUSEMOVED; - } + eventcode = MOUSEMOVED; + } } else switch (event->button) { case Button1: { - eventcode = MOUSELEFT; - if (buttonorder[2] == Button1Mask) - swap(buttonorder[1],buttonorder[2]); - if (buttonorder[1] == Button1Mask) - swap(buttonorder[0],buttonorder[1]); - break; + eventcode = MOUSELEFT; + if (buttonorder[2] == Button1Mask) + swap(buttonorder[1],buttonorder[2]); + if (buttonorder[1] == Button1Mask) + swap(buttonorder[0],buttonorder[1]); + break; } case Button2: { - eventcode = MOUSEMID; - if (buttonorder[2] == Button2Mask) - swap(buttonorder[1],buttonorder[2]); - if (buttonorder[1] == Button2Mask) - swap(buttonorder[0],buttonorder[1]); - break; + eventcode = MOUSEMID; + if (buttonorder[2] == Button2Mask) + swap(buttonorder[1],buttonorder[2]); + if (buttonorder[1] == Button2Mask) + swap(buttonorder[0],buttonorder[1]); + break; } case Button3: { - eventcode = MOUSERIGHT; - if (buttonorder[2] == Button3Mask) - swap(buttonorder[1],buttonorder[2]); - if (buttonorder[1] == Button3Mask) - swap(buttonorder[0],buttonorder[1]); - break; + eventcode = MOUSERIGHT; + if (buttonorder[2] == Button3Mask) + swap(buttonorder[1],buttonorder[2]); + if (buttonorder[1] == Button3Mask) + swap(buttonorder[0],buttonorder[1]); + break; } case Button4: { - eventcode = SCROLLUP; - break; + eventcode = SCROLLUP; + break; } case Button5: { - eventcode = SCROLLDOWN; - break; + eventcode = SCROLLDOWN; + break; } } if (event->type == ButtonRelease) { if (eventcode >= MOUSERIGHT) { - eventcode -= (MOUSELEFT - MOUSELEFTUP); - swap(buttonorder[0],buttonorder[1]); - swap(buttonorder[1],buttonorder[2]); - } + eventcode -= (MOUSELEFT - MOUSELEFTUP); + swap(buttonorder[0],buttonorder[1]); + swap(buttonorder[1],buttonorder[2]); + } else return; /* drop scroll wheel release events silently for now */ } @@ -3601,7 +3601,7 @@ XButtonEvent *event; qevent(w->window, &d, event->x, event->y, (uword)event->time, event->state); } - + /* * fill a series of rectangles */ @@ -3618,10 +3618,10 @@ int nrecs; if (!RECX(*recs) && !RECY(*recs) && RECWIDTH(*recs) >= ws->width && RECHEIGHT(*recs) >= ws->height && nrecs == 1 && wc->drawop == GXcopy && wc->fillstyle != FillStippled && wc->clipw < 0) { - RECWIDTH(*recs) = ws->pixwidth; /* fill hidden part */ - RECHEIGHT(*recs) = ws->pixheight; - free_xcolors(w, 0); /* free old colors */ - } + RECWIDTH(*recs) = ws->pixwidth; /* fill hidden part */ + RECHEIGHT(*recs) = ws->pixheight; + free_xcolors(w, 0); /* free old colors */ + } RENDER2(XFillRectangles, recs, nrecs); } @@ -3649,7 +3649,7 @@ int x, y, width, height; if (wc->fillstyle != FillSolid) XSetFillStyle(stddpy, stdgc, FillSolid); RENDER4(XFillRectangle, x, y, width, height); XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); + wd->colors[wc->fg].c ^ (ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); if (wc->fillstyle != FillSolid) XSetFillStyle(stddpy, stdgc, wc->fillstyle); @@ -3687,45 +3687,45 @@ int x, y, width, height, x2, y2; * Copying is between windows on two different displays. */ if (x<0 || y<0 || x+width > ws1->pixwidth || y+height > ws1->pixheight) - return Failed; /*#%#%# BOGUS, NEEDS FIXING */ + return Failed; /*#%#%# BOGUS, NEEDS FIXING */ xim = XGetImage(d1, ws1->pix, x, y, width, height, - (1<screen))-1,XYPixmap); + (1<screen))-1,XYPixmap); XSetFunction(stddpy, stdgc, GXcopy); for (i=0; i < width; i++) { - for (j=0; j < height; j++) { - clr.pixel = XGetPixel(xim, i, j); - if (cp2 != NULL && c == clr.pixel) { - XSetForeground(stddpy, stdgc, cp2->c); - RENDER2(XDrawPoint, i + x2, j + y2); - continue; - } - c = clr.pixel; - cp2 = NULL; - for ( cp = wd1->colors; cp < wd->colors + wd->numColors; cp++) { - if (cp->c == c) { - if (cp->name[0]=='\0') { - XQueryColor(d1, wd1->cmap, &clr); - cp->r = clr.red; - cp->g = clr.green; - cp->b = clr.blue; - sprintf(cp->name,"%d,%d,%d",cp->r,cp->g,cp->b); - } - cp2 = alc_rgb(w2, cp->name, cp->r, cp->g, cp->b, 0); - if (cp2 == NULL) return Failed; - break; - } - } - if (cp2 == NULL) { - XQueryColor(d1, wd1->cmap, &clr); - cp2 = alc_rgb(w2, "unknown", clr.red, clr.green, clr.blue, 0); - } - if (cp2 == NULL) return Failed; - XSetForeground(stddpy, stdgc, cp2->c); - RENDER2(XDrawPoint, i + x2, j + y2); - } - } + for (j=0; j < height; j++) { + clr.pixel = XGetPixel(xim, i, j); + if (cp2 != NULL && c == clr.pixel) { + XSetForeground(stddpy, stdgc, cp2->c); + RENDER2(XDrawPoint, i + x2, j + y2); + continue; + } + c = clr.pixel; + cp2 = NULL; + for ( cp = wd1->colors; cp < wd->colors + wd->numColors; cp++) { + if (cp->c == c) { + if (cp->name[0]=='\0') { + XQueryColor(d1, wd1->cmap, &clr); + cp->r = clr.red; + cp->g = clr.green; + cp->b = clr.blue; + sprintf(cp->name,"%d,%d,%d",cp->r,cp->g,cp->b); + } + cp2 = alc_rgb(w2, cp->name, cp->r, cp->g, cp->b, 0); + if (cp2 == NULL) return Failed; + break; + } + } + if (cp2 == NULL) { + XQueryColor(d1, wd1->cmap, &clr); + cp2 = alc_rgb(w2, "unknown", clr.red, clr.green, clr.blue, 0); + } + if (cp2 == NULL) return Failed; + XSetForeground(stddpy, stdgc, cp2->c); + RENDER2(XDrawPoint, i + x2, j + y2); + } + } XSetForeground(stddpy, stdgc, - wd->colors[wc->fg].c ^ (ISXORREVERSE(w2) ? wd->colors[wc->bg].c : 0)); + wd->colors[wc->fg].c ^ (ISXORREVERSE(w2) ? wd->colors[wc->bg].c : 0)); XSetFunction(stddpy, stdgc, wc->drawop); XSync(stddpy,False); XDestroyImage(xim); @@ -3736,29 +3736,29 @@ int x, y, width, height, x2, y2; */ src = ws1->pix; if (src != stdpix) { - /* copying between different windows; handle color bookkeeping */ + /* copying between different windows; handle color bookkeeping */ if (!x2 && !y2 && ((width >= ws2->pixwidth) || !width) && ((height >= ws2->pixheight) || !height) && w2->context->clipw < 0){ - free_xcolors(w2, 0); - } - copy_colors(w, w2); - } + free_xcolors(w2, 0); + } + copy_colors(w, w2); + } XSetForeground(stddpy, stdgc, wd->colors[wc->bg].c); XSetFunction(stddpy, stdgc, GXcopy); if (x+width<0 || y+height<0 || x>=ws1->pixwidth || y>=ws1->pixheight) { - /* source is entirely offscreen */ + /* source is entirely offscreen */ RENDER4(XFillRectangle, x2, y2, width, height); } else { - /* - * Check for source partially offscreen, but copy first and - * fill later in case the source and destination overlap. - */ - lpad = rpad = tpad = bpad = 0; - if (x < 0) { /* source extends past left edge */ - lpad = -x; + /* + * Check for source partially offscreen, but copy first and + * fill later in case the source and destination overlap. + */ + lpad = rpad = tpad = bpad = 0; + if (x < 0) { /* source extends past left edge */ + lpad = -x; width -= lpad; x2 += lpad; x = 0; @@ -3767,8 +3767,8 @@ int x, y, width, height, x2, y2; rpad = x + width - ws1->pixwidth; width -= rpad; } - if (y < 0) { /* source extends above top edge */ - tpad = -y; + if (y < 0) { /* source extends above top edge */ + tpad = -y; height -= tpad; y2 += tpad; y = 0; @@ -3777,32 +3777,32 @@ int x, y, width, height, x2, y2; bpad = y + height - ws1->pixheight; height -= bpad; } - /* - * Copy the area. - */ + /* + * Copy the area. + */ if (stdwin) XCopyArea(stddpy, src, stdwin, stdgc, x, y, width, height, x2, y2); XCopyArea(stddpy, src, stdpix, stdgc, x, y, width, height, x2, y2); - /* - * Fill any edges not provided by source. - */ - if (lpad > 0) + /* + * Fill any edges not provided by source. + */ + if (lpad > 0) RENDER4(XFillRectangle, x2-lpad, y2-tpad, lpad, tpad+height+bpad); - if (rpad > 0) + if (rpad > 0) RENDER4(XFillRectangle, x2+width, y2-tpad, rpad, tpad+height+bpad); - if (tpad > 0) - RENDER4(XFillRectangle, x2, y2-tpad, width, tpad); - if (bpad > 0) - RENDER4(XFillRectangle, x2, y2+height, width, bpad); - } + if (tpad > 0) + RENDER4(XFillRectangle, x2, y2-tpad, width, tpad); + if (bpad > 0) + RENDER4(XFillRectangle, x2, y2+height, width, bpad); + } XSetForeground(stddpy,stdgc, - wd->colors[wc->fg].c^(ISXORREVERSE(w2) ? wd->colors[wc->bg].c :0)); + wd->colors[wc->fg].c^(ISXORREVERSE(w2) ? wd->colors[wc->bg].c :0)); XSetFunction(stddpy, stdgc, wc->drawop); } return Succeeded; } - + wbp sprite; int tics; @@ -3825,25 +3825,25 @@ int n; * by the new image being drawn */ if (lastx >= 0) { - int dx = p[i].x - lastx, dy = p[i].y - lasty; + int dx = p[i].x - lastx, dy = p[i].y - lasty; if (dx > 0) XCopyArea(stddpy,stdpix,stdwin,stdgc, lastx, lasty, - dx, animheight, lastx, lasty); - else if (dx < 0) - XCopyArea(stddpy,stdpix,stdwin,stdgc, lastx+animwidth+dx, lasty, - -dx, animheight, lastx+animwidth+dx, lasty); + dx, animheight, lastx, lasty); + else if (dx < 0) + XCopyArea(stddpy,stdpix,stdwin,stdgc, lastx+animwidth+dx, lasty, + -dx, animheight, lastx+animwidth+dx, lasty); if (dy > 0) XCopyArea(stddpy, stdpix, stdwin, stdgc, lastx, lasty, - animwidth, dy, lastx, lasty); - else if (dy < 0) - XCopyArea(stddpy,stdpix,stdwin,stdgc, lastx, lasty+animheight+dy, - animwidth, -dy, lastx, lasty+animheight+dy); + animwidth, dy, lastx, lasty); + else if (dy < 0) + XCopyArea(stddpy,stdpix,stdwin,stdgc, lastx, lasty+animheight+dy, + animwidth, -dy, lastx, lasty+animheight+dy); } XCopyArea(stddpy, sprite->window->pix, stdwin, stdgc, - 0, 0, animwidth, animheight, p[i].x, p[i].y); + 0, 0, animwidth, animheight, p[i].x, p[i].y); XFlush(stddpy); for (j = 0; j < tics; j++); -/* +/* * erase the whole box approach: * XCopyArea(stddpy, stdpix, stdwin, stdgc, * 0, 0, animwidth, animheight, p[i].x, p[i].y); @@ -3862,7 +3862,7 @@ int n, delay; { wbp w2 = BlkD(*pixs,File)->fd.wb; wsp ws = w->window; - + sprite = w2; animheight = sprite->window->height; animwidth = sprite->window->width; @@ -3870,7 +3870,7 @@ int n, delay; lastx = lasty = -1; genCurve(w, p, n, animHelper); XCopyArea(ws->display->display, ws->pix, ws->win, w->context->gc, lastx, lasty, - animwidth, animheight, lastx, lasty); + animwidth, animheight, lastx, lasty); } int getdefault(w, prog, opt, answer) @@ -3878,7 +3878,7 @@ wbp w; char *prog, *opt, *answer; { char *p; - + if ((p = XGetDefault(w->window->display->display, prog, opt)) == NULL) return Failed; strcpy(answer, p); @@ -3921,8 +3921,8 @@ int *retval; * try again with a virtual colormap */ if (!go_virtual(w) || - !XAllocColorCells(stddpy,wd->cmap,False,plane_masks,0,pixels,1)) - return Failed; /* cannot allocate an entry */ + !XAllocColorCells(stddpy,wd->cmap,False,plane_masks,0,pixels,1)) + return Failed; /* cannot allocate an entry */ } /* @@ -3937,16 +3937,16 @@ int *retval; /* save color index as "name", followed by a null string for value */ colorname = wd->colors[i].name; - sprintf(colorname, "%ld", -pixels[0] - 1); /* index is name */ + sprintf(colorname, "%ld", -pixels[0] - 1); /* index is name */ colorname = colorname + strlen(colorname) + 1; - *colorname = '\0'; /* value unknown */ + *colorname = '\0'; /* value unknown */ if (ws->numColors < WMAXCOLORS) { if (ws->theColors == NULL) { - ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); - if (ws->theColors == NULL) - return RunError; - } + ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); + if (ws->theColors == NULL) + return RunError; + } ws->theColors[ws->numColors++] = i; } @@ -3956,24 +3956,24 @@ int *retval; * old-style check for C integer */ else if (argv[0].dword == D_Integer) {/* check for color cell */ - if (IntVal(argv[0]) >= 0) - return Failed; /* must be negative */ - colorcell.pixel = -IntVal(argv[0]) - 1; - XQueryColor(stddpy, wd->cmap, &colorcell); + if (IntVal(argv[0]) >= 0) + return Failed; /* must be negative */ + colorcell.pixel = -IntVal(argv[0]) - 1; + XQueryColor(stddpy, wd->cmap, &colorcell); clr = lcolor(w, colorcell); sprintf(colorname, "%ld,%ld,%ld", clr.red, clr.green, clr.blue); - } + } else { - if (!cnv:C_string(argv[0],str)) { - ReturnErrVal(103,argv[0], RunError); - } + if (!cnv:C_string(argv[0],str)) { + ReturnErrVal(103,argv[0], RunError); + } if (parsecolor(w, str, &clr.red, &clr.green, &clr.blue, &alpha) != Succeeded) { free_xcolor(w, pixels[0]); - return Failed; /* invalid color specification */ - } - strcpy(colorname, str); + return Failed; /* invalid color specification */ + } + strcpy(colorname, str); colorcell = xcolor(w, clr); - } + } colorcell.pixel = pixels[0]; XStoreColor(stddpy, wd->cmap, &colorcell); } @@ -3995,11 +3995,11 @@ int mute_index; for (i = 2; i < DMAXCOLORS; i++) if (dp->colors[i].type == CLR_MUTABLE && dp->colors[i].c == -mute_index-1) - break; + break; if (i == DMAXCOLORS) return NULL; - colorname = dp->colors[i].name; /* color name field */ - colorname = colorname + strlen(colorname) + 1; /* set value follows */ + colorname = dp->colors[i].name; /* color name field */ + colorname = colorname + strlen(colorname) + 1; /* set value follows */ return colorname; } @@ -4034,7 +4034,7 @@ int mute_index; if (dp->colors[i].type == CLR_MUTABLE && dp->colors[i].c == -mute_index-1) break; if (i != DMAXCOLORS) - free_xcolor(w, dp->colors[i].c); + free_xcolor(w, dp->colors[i].c); } @@ -4089,7 +4089,7 @@ word len; if (m == 0) msk1 = 8; else - msk1 = 1 << (m - 1); /* mask for first byte of row */ + msk1 = 1 << (m - 1); /* mask for first byte of row */ fg = wd->colors[wc->fg].c; bg = wd->colors[wc->bg].c; @@ -4097,18 +4097,18 @@ word len; iy = 0; m = msk1; while (len--) { - if (isxdigit(c = *s++)) { /* if hexadecimal character */ - if (!isdigit(c)) /* fix bottom 4 bits if necessary */ + if (isxdigit(c = *s++)) { /* if hexadecimal character */ + if (!isdigit(c)) /* fix bottom 4 bits if necessary */ c += 9; - while (m > 0) { /* set (usually) 4 pixel values */ - --ix; - if (c & m) - XPutPixel(im, ix, iy, fg); - else if (ch != TCH1) /* if zeroes aren't transparent */ - XPutPixel(im, ix, iy, bg); + while (m > 0) { /* set (usually) 4 pixel values */ + --ix; + if (c & m) + XPutPixel(im, ix, iy, fg); + else if (ch != TCH1) /* if zeroes aren't transparent */ + XPutPixel(im, ix, iy, bg); m >>= 1; } - if (ix == 0) { /* if end of row */ + if (ix == 0) { /* if end of row */ ix = width; iy++; m = msk1; @@ -4117,7 +4117,7 @@ word len; m = 8; } } - if (ix > 0) /* pad final row if incomplete */ + if (ix > 0) /* pad final row if incomplete */ while (ix < width) XPutPixel(im, ix++, iy, bg); @@ -4159,7 +4159,7 @@ int on_icon; * Get an XImage structure and free the old color set if possible. */ for (c = 0; c < 256; c++) - trans |= e[c].used && e[c].transpt; + trans |= e[c].used && e[c].transpt; } im = getximage(w, x, y, width, height, trans); if (im == NULL) @@ -4194,16 +4194,16 @@ int on_icon; while (len--) { c = *s++; v = e[c].valid; - if (v) /* put char if valid */ + if (v) /* put char if valid */ XPutPixel(im, ix, iy, wd->colors[ciarray[c]].c); - if (v || e[c].transpt) { /* advance if valid or transparent */ + if (v || e[c].transpt) { /* advance if valid or transparent */ if (++ix >= width) { - ix = 0; /* reset for new row */ + ix = 0; /* reset for new row */ iy++; } } } - if (ix > 0) { /* pad final row if incomplete */ + if (ix > 0) { /* pad final row if incomplete */ while (ix < width) XPutPixel(im, ix++, iy, wd->colors[wc->bg].c); } @@ -4216,43 +4216,43 @@ int on_icon; /* * test for availability of true color display * otherwise allocate new colors - */ - - if (ws->vis->class == TrueColor) - while (iy < height) { - ix = 0; - while (ix < width) { - int r = *s++ * 257; - int g = *s++ * 257; - int b = *s++ * 257; - if (r==lastr && g == lastg && b == lastb){ - count++; - } - else{ - cp = (wclrp) alc_rgbTrueColor(w, r, g, b); - lastr = r; lastg = g; lastb = b; - } - XPutPixel(im, ix++, iy, cp->c); - } - iy++; - } - else - while (iy < height) { - ix = 0; - while (ix < width) { - int r = *s++ * 257; - int g = *s++ * 257; - int b = *s++ * 257; - if (r==lastr && g == lastg && b == lastb){ - count++; - } - else - cp = alc_rgb2(w,"anon", r, g, b); - XPutPixel(im, ix++, iy, cp->c); - lastr = r; lastg = g; lastb = b; - } - iy++; - } + */ + + if (ws->vis->class == TrueColor) + while (iy < height) { + ix = 0; + while (ix < width) { + int r = *s++ * 257; + int g = *s++ * 257; + int b = *s++ * 257; + if (r==lastr && g == lastg && b == lastb){ + count++; + } + else{ + cp = (wclrp) alc_rgbTrueColor(w, r, g, b); + lastr = r; lastg = g; lastb = b; + } + XPutPixel(im, ix++, iy, cp->c); + } + iy++; + } + else + while (iy < height) { + ix = 0; + while (ix < width) { + int r = *s++ * 257; + int g = *s++ * 257; + int b = *s++ * 257; + if (r==lastr && g == lastg && b == lastb){ + count++; + } + else + cp = alc_rgb2(w,"anon", r, g, b); + XPutPixel(im, ix++, iy, cp->c); + lastr = r; lastg = g; lastb = b; + } + iy++; + } } /* * Put it on the screen. @@ -4266,13 +4266,13 @@ int on_icon; else { XPutImage(stddpy, ws->pix, stdgc, im, 0, 0, x, y, width, height); if (ws->win) - XCopyArea(stddpy, ws->pix, ws->win, stdgc, x, y, width, height, x, y); + XCopyArea(stddpy, ws->pix, ws->win, stdgc, x, y, width, height, x, y); } XDestroyImage(im); if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop); return ret; } - + /* * getimstr(w, x, y, width, height, paltbl, data) -- get image as a string. @@ -4290,7 +4290,7 @@ int on_icon; */ #passthru #if (DMAXCOLORS > 256) #passthru Deliberate Syntax error -#passthru #endif /* DMAXCOLORS */ +#passthru #endif /* DMAXCOLORS */ int getimstr(w, x, y, width, height, paltbl, data) wbp w; @@ -4313,7 +4313,7 @@ unsigned char *data; im = getximage(w, x, y, width, height, 1); if (!im) return 0; - + if (im->depth <= 8) { /* @@ -4350,7 +4350,7 @@ unsigned char *data; if (lp) i = lp - clist; else - i = 0; /* use black if not found */ + i = 0; /* use black if not found */ *data++ = i; paltbl[i].used = 1; } @@ -4389,7 +4389,7 @@ unsigned char *data; wsp ws = w->window; wdp wd = ws->display; Display *stddpy = wd->display; - + /* * Get an XImage structure containing window pixel values. */ @@ -4399,26 +4399,26 @@ unsigned char *data; if(ws->vis->class == TrueColor){ unsigned long c; - TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(ws->vis->red_mask, - ws->vis->green_mask, ws->vis->blue_mask); + TRUECOLOR_DECLARE_AND_INIT_RGB_VARS(ws->vis->red_mask, + ws->vis->green_mask, ws->vis->blue_mask); for(y=0; y < height; y++){ for(x=0; x < width; x++) { c = XGetPixel(im, x, y); *data++ = TRUECOLOR_GET_RGB_RED(c); *data++ = TRUECOLOR_GET_RGB_GREEN(c); *data++ = TRUECOLOR_GET_RGB_BLUE(c); - } + } } } else{ for (y = 0; y < height; y++) { for (x = 0; x < width; x++) { - px.pixel = XGetPixel(im, x, y); - XQueryColor(stddpy, wd->cmap, &px); - *data++ = px.red >> 8; - *data++ = px.green >> 8; - *data++ = px.blue >> 8; - } + px.pixel = XGetPixel(im, x, y); + XQueryColor(stddpy, wd->cmap, &px); + *data++ = px.red >> 8; + *data++ = px.green >> 8; + *data++ = px.blue >> 8; + } } } XDestroyImage(im); @@ -4454,9 +4454,9 @@ int x, y, width, height, init; if (!init) { if (x <= 0 && y <= 0 && x + width >= ws->pixwidth && - y + height >= ws->pixheight && wc->clipw < 0) { + y + height >= ws->pixheight && wc->clipw < 0) { free_xcolors(w, 0); - } + } return im; } @@ -4504,7 +4504,7 @@ int x, y, *status; XFreePixmap(stddpy, p); return Succeeded; } - + /* * Initialize client for producing pixels from a window @@ -4520,9 +4520,9 @@ struct imgmem *imem; return Succeeded; } imem->im = XGetImage(wd->display, w->window->pix, - imem->x, imem->y, imem->width, imem->height, - (1 << DefaultDepth(wd->display, wd->screen))-1, XYPixmap); - + imem->x, imem->y, imem->width, imem->height, + (1 << DefaultDepth(wd->display, wd->screen))-1, XYPixmap); + if (imem->im == NULL) return Failed; return Succeeded; } @@ -4555,7 +4555,7 @@ struct imgmem *imem; unsigned long c; wcp wc = w->context; wdp wd = w->window->display; - Display *stddpy = wd->display; + Display *stddpy = wd->display; if (x < imem->x || x >= imem->x + imem->width || y < imem->y || y >= imem->y + imem->height) @@ -4568,20 +4568,20 @@ struct imgmem *imem; else for (cp = wd->colors ; cp < wd->colors + wd->numColors; cp++) { if (cp->c == c) { - lastcp = cp; + lastcp = cp; foundc: - if (cp->type == CLR_MUTABLE) - *rv = -c - 1; - else { + if (cp->type == CLR_MUTABLE) + *rv = -c - 1; + else { *rv = 1; colorcell.red = cp->r; colorcell.green = cp->g; colorcell.blue = cp->b; clr = lcolor(w, colorcell); sprintf(s, "%ld,%ld,%ld", clr.red, clr.green, clr.blue); - } - break; - } + } + break; + } } if (*rv == 0xff000000) { XQueryColor(stddpy, wd->cmap, &colorcell); @@ -4608,7 +4608,7 @@ XPoint *pp; if (theWindow == (Window) NULL) return Failed; XQueryPointer(theDisplay, theWindow, &garbage1, &garbage2, - &root_x, &root_y, &win_x, &win_y, &key_buttons); + &root_x, &root_y, &win_x, &win_y, &key_buttons); pp->x = w->window->pointerx = win_x; pp->y = w->window->pointery = win_y; return Succeeded; @@ -4638,7 +4638,7 @@ XPoint *pp; theWindow = DefaultRootWindow(wd->display); } XQueryPointer(theDisplay, theWindow, &garbage1, &garbage2, - &root_x, &root_y, &win_x, &win_y, &key_buttons); + &root_x, &root_y, &win_x, &win_y, &key_buttons); pp->x = root_x; pp->y = root_y; return Succeeded; @@ -4670,23 +4670,23 @@ int patbits[] = { * pattern symbols */ stringint siPatternSyms[] = { - {0, 16}, - { "black", 0}, - { "checkers", 12}, - { "darkgray", 2}, - { "diagonal", 8}, - { "grains", 13}, - { "gray", 3}, - { "grid", 10}, + {0, 16}, + { "black", 0}, + { "checkers", 12}, + { "darkgray", 2}, + { "diagonal", 8}, + { "grains", 13}, + { "gray", 3}, + { "grid", 10}, { "horizontal",9}, { "lightgray", 4}, - { "scales", 14}, - { "trellis", 11}, - { "vertical", 7}, - { "verydark", 1}, + { "scales", 14}, + { "trellis", 11}, + { "vertical", 7}, + { "verydark", 1}, { "verylight", 5}, - { "waves", 15}, - { "white", 6}, + { "waves", 15}, + { "white", 6}, }; /* @@ -4714,7 +4714,7 @@ int len; if (wc->patternname == NULL) ReturnErrNum(305, RunError); strncpy(wc->patternname, name, len); wc->patternname[len] = '\0'; - + /* * If the pattern starts with a number it is a width , bits encoding */ @@ -4722,10 +4722,10 @@ int len; nbits = MAXXOBJS; switch (parsepattern(name, len, &width, &nbits, bits)) { case Failed: - return Failed; + return Failed; case RunError: - ReturnErrNum(145, RunError); - } + ReturnErrNum(145, RunError); + } if (!wc->gc) return Succeeded; return SetPatternBits(w, width, bits, nbits); } @@ -4736,9 +4736,9 @@ int len; if ((symbol = si_s2i(siPatternSyms, wc->patternname)) >= 0) { if (!wc->gc) return Succeeded; for(i = 0; i < 8; i++) { - v = patbits[symbol * 8 + i]; - *buf++ = v; - } + v = patbits[symbol * 8 + i]; + *buf++ = v; + } p = XCreateBitmapFromData(stddpy, w->window->pix, data, 8, 8); XSetStipple(stddpy, wc->gc, p); XSync(stddpy, False); @@ -4764,9 +4764,9 @@ int nbits; for(i = 0; i < nbits; i++) { v = bits[i]; for(j=0; j>= 8; - } + *buf++ = v; + v >>= 8; + } } p = XCreateBitmapFromData(stddpy, w->window->pix, data, width, nbits); @@ -4776,7 +4776,7 @@ int nbits; return Succeeded; } - + /* * remap a window ... this time with an iconwin @@ -4803,20 +4803,20 @@ int x,y; XDestroyWindow(stddpy, stdwin); ws->win = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), - ws->posx, ws->posy, ws->width, - ws->height, 4, - wd->colors[wc->fg].c, wd->colors[wc->bg].c); + ws->posx, ws->posy, ws->width, + ws->height, 4, + wd->colors[wc->fg].c, wd->colors[wc->bg].c); XSetStandardProperties(stddpy, ws->win, ws->windowlabel, - ws->iconlabel, 0, 0, 0, &size_hints); + ws->iconlabel, 0, 0, 0, &size_hints); XSelectInput(stddpy, ws->win, XMasks(ws->inputmask)); ws->iconwin = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), - ws->iconx, ws->icony, ws->iconw, - ws->iconh, 2, - wd->colors[wc->fg].c, - wd->colors[wc->bg].c); + ws->iconx, ws->icony, ws->iconw, + ws->iconh, 2, + wd->colors[wc->fg].c, + wd->colors[wc->bg].c); XSelectInput(stddpy, ws->iconwin, - ExposureMask | KeyPressMask | ButtonPressMask); + ExposureMask | KeyPressMask | ButtonPressMask); wmhints->flags |= IconPositionHint; wmhints->icon_x = x; @@ -4838,7 +4838,7 @@ int x,y; return 1; } - + int seticonimage(w, dp) wbp w; dptr dp; @@ -4850,69 +4850,69 @@ dptr dp; wsp ws = w->window; wdp wd = ws->display; Display *stddpy = wd->display; - + /* * get the preloaded (in another window value) pixmap image */ if (is:file(*dp) && (BlkD(*dp,File)->status & Fs_Window)) { wbp x = BlkLoc(*dp)->File.fd.wb; if ((ws->iconimage = salloc(x->window->windowlabel)) == NULL) - ReturnErrNum(305, RunError); + ReturnErrNum(305, RunError); pix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), - x->window->width, x->window->height, - DefaultDepth(stddpy,wd->screen)); + x->window->width, x->window->height, + DefaultDepth(stddpy,wd->screen)); XCopyArea(stddpy, x->window->pix, pix, wd->icongc, 0, 0, - x->window->width, x->window->height, 0, 0); + x->window->width, x->window->height, 0, 0); if (ws->iconpix) { - XSync(stddpy, False); - XFreePixmap(stddpy, ws->iconpix); - } + XSync(stddpy, False); + XFreePixmap(stddpy, ws->iconpix); + } ws->iconpix = pix; ws->iconw = x->window->width; ws->iconh = x->window->height; if (!ws->iconx && !ws->icony) { - ws->iconx = ws->x; - ws->icony = ws->y; - } + ws->iconx = ws->x; + ws->icony = ws->y; + } if (remap(w,ws->iconx,ws->icony) == -1) - ReturnErrNum(144, RunError); + ReturnErrNum(144, RunError); } /* get the pixmap file named by x */ else if (is:string(*dp)) { unsigned int height, width; if (!cnv:C_string(*dp,tmp)) - ReturnErrVal(103, *dp, RunError); + ReturnErrVal(103, *dp, RunError); if ((ws->iconimage != NULL) && strcmp(ws->iconimage, "")) - free(ws->iconimage); + free(ws->iconimage); if ((ws->iconimage = salloc(tmp)) == NULL) - ReturnErrNum(305, RunError); + ReturnErrNum(305, RunError); if (ws->iconwin == (Window) NULL) makeIcon(w,0,0); else { - pix = loadimage(w, ws->iconimage, &height, &width, 0, &status); - if (pix == (Pixmap) NULL) - return Failed; - XCopyArea(stddpy, pix, ws->iconwin, wd->icongc, - 0, 0, width, height, 0, 0); - if (ws->iconpix) { - XSync(stddpy, False); - XFreePixmap(stddpy, ws->iconpix); - } - ws->iconpix = pix; - ws->iconw = width; - ws->iconh = height; - if (remap(w,ws->iconx,ws->icony) == -1) - ReturnErrNum(144, RunError); - } + pix = loadimage(w, ws->iconimage, &height, &width, 0, &status); + if (pix == (Pixmap) NULL) + return Failed; + XCopyArea(stddpy, pix, ws->iconwin, wd->icongc, + 0, 0, width, height, 0, 0); + if (ws->iconpix) { + XSync(stddpy, False); + XFreePixmap(stddpy, ws->iconpix); + } + ws->iconpix = pix; + ws->iconw = width; + ws->iconh = height; + if (remap(w,ws->iconx,ws->icony) == -1) + ReturnErrNum(144, RunError); + } } else return Failed; return Succeeded; } } - + /* * dumpimage -- write an image to a disk file in an X format. @@ -4949,51 +4949,51 @@ unsigned int x, y, height, width; if (DefaultDepth(stddpy,wd->screen) != 1) { unsigned long bw = BlackPixel(stddpy,wd->screen) ^ WhitePixel(stddpy,wd->screen); - Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), - width, height, 1); - XGCValues xgc; - GC thinGC; - int i; - /* - * pick out the bitplane on which Black and White differ - */ - for(i=0;!((1<screen); - xgc.background = WhitePixel(stddpy,wd->screen); - thinGC = XCreateGC(stddpy,p1,GCForeground|GCBackground,&xgc); - - if (i>DefaultDepth(stddpy,wd->screen)) return Failed; - XCopyPlane(stddpy,stdpix,p1,thinGC,x,y,width,height,0,0,bw); - status= XWriteBitmapFile(stddpy, filename, p1, width, height, -1, -1); - - XSync(stddpy, False); - XFreePixmap(stddpy, p1); - XFreeGC(stddpy,thinGC); - if (status != BitmapSuccess) return Failed; + Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), + width, height, 1); + XGCValues xgc; + GC thinGC; + int i; + /* + * pick out the bitplane on which Black and White differ + */ + for(i=0;!((1<screen); + xgc.background = WhitePixel(stddpy,wd->screen); + thinGC = XCreateGC(stddpy,p1,GCForeground|GCBackground,&xgc); + + if (i>DefaultDepth(stddpy,wd->screen)) return Failed; + XCopyPlane(stddpy,stdpix,p1,thinGC,x,y,width,height,0,0,bw); + status= XWriteBitmapFile(stddpy, filename, p1, width, height, -1, -1); + + XSync(stddpy, False); + XFreePixmap(stddpy, p1); + XFreeGC(stddpy,thinGC); + if (status != BitmapSuccess) return Failed; } else { - if(x || y) { - Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), width, - height, DefaultDepth(stddpy,wd->screen)); + if(x || y) { + Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), width, + height, DefaultDepth(stddpy,wd->screen)); - XCopyArea(stddpy, stdpix, p1, stdgc, x, y, width, height, 0, 0); - XSync(stddpy, False); + XCopyArea(stddpy, stdpix, p1, stdgc, x, y, width, height, 0, 0); + XSync(stddpy, False); - status = XWriteBitmapFile(stddpy, filename, p1, width, height, -1, -1); + status = XWriteBitmapFile(stddpy, filename, p1, width, height, -1, -1); - XSync(stddpy, False); - XFreePixmap(stddpy, p1); + XSync(stddpy, False); + XFreePixmap(stddpy, p1); - if (status != BitmapSuccess) return Failed; + if (status != BitmapSuccess) return Failed; - } - else if (XWriteBitmapFile(stddpy, filename, stdpix, - width, height, -1, -1) != BitmapSuccess) - return Failed; + } + else if (XWriteBitmapFile(stddpy, filename, stdpix, + width, height, -1, -1) != BitmapSuccess) + return Failed; } return Succeeded; @@ -5002,34 +5002,34 @@ unsigned int x, y, height, width; * Check for XPM (color X PixMap) format. */ else if (((slen > 4) && - (!strcmp(".xpm", filename + slen - 4) || - !strcmp(".XPM", filename + slen - 4))) || - ((slen > 6) && !strcmp(".xpm.Z", filename + slen - 6))) { + (!strcmp(".xpm", filename + slen - 4) || + !strcmp(".XPM", filename + slen - 4))) || + ((slen > 6) && !strcmp(".xpm.Z", filename + slen - 6))) { #ifdef HAVE_LIBXPM /* * Could optimize by calling XpmWriteFileFromPixmap directly on the * stdpix... */ Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), width, - height, DefaultDepth(stddpy,wd->screen)); + height, DefaultDepth(stddpy,wd->screen)); XCopyArea(stddpy, stdpix, p1, stdgc, x, y, width, height, 0, 0); XSync(stddpy, False); status = XpmWriteFileFromPixmap(stddpy, filename, p1, - (Pixmap) NULL, NULL); + (Pixmap) NULL, NULL); XSync(stddpy, False); XFreePixmap(stddpy, p1); if (status == XpmSuccess) return Succeeded; -#endif /* HAVE_LIBXPM */ +#endif /* HAVE_LIBXPM */ return Failed; } else - return NoCvt; /* not an X format -- write GIF instead */ + return NoCvt; /* not an X format -- write GIF instead */ } - + /* * Load an image, in any format we can figure out. */ @@ -5054,7 +5054,7 @@ int *status; if (!strcmp(".xbm", filename + strlen(filename) - 4)) isxbm = 1; else if (!strcmp(".xpm", filename + strlen(filename) - 4) || - !strcmp(".xpm.Z", filename + strlen(filename) - 6)) + !strcmp(".xpm.Z", filename + strlen(filename) - 6)) isxbm = 0; else { /* @@ -5067,29 +5067,29 @@ int *status; int i; if (!ftemp) { - return (Pixmap) NULL; + return (Pixmap) NULL; } if ((long)fread(s,1,6,ftemp) < (long)6) { - fclose(ftemp); - return (Pixmap) NULL; + fclose(ftemp); + return (Pixmap) NULL; } fclose(ftemp); /* check s for XPM string */ isxbm = 1; /* default to xbm */ for (i = 0; i <= 3; i++) - if (!strncmp(&s[i], "XPM", 3)) - isxbm = 0; + if (!strncmp(&s[i], "XPM", 3)) + isxbm = 0; } if (isxbm) { /* isxbm = 1 => .xbm file */ if (XReadBitmapFile(stddpy, DefaultRootWindow(stddpy), filename, - width, height, &p1, &xhot, &yhot) != BitmapSuccess) - return (Pixmap) NULL; + width, height, &p1, &xhot, &yhot) != BitmapSuccess) + return (Pixmap) NULL; else *status = 0; p2 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), *width, *height, - DefaultDepth(stddpy,DefaultScreen(stddpy))); + DefaultDepth(stddpy,DefaultScreen(stddpy))); } - else { /* isxbm == 0 => .xpm file */ + else { /* isxbm == 0 => .xpm file */ #ifdef HAVE_LIBXPM XpmAttributes a; XColor color; @@ -5098,24 +5098,24 @@ int *status; a.npixels = 0; a.colormap = wd->cmap; a.valuemask = XpmReturnPixels | XpmColormap; - + *status = XpmReadFileToPixmap(stddpy, DefaultRootWindow(stddpy), - filename, &p2, &dummy, &a); + filename, &p2, &dummy, &a); if (*status == XpmColorFailed && go_virtual(w)) { - /* try again with a virtual colormap */ - a.npixels = 0; - a.colormap = wd->cmap; - a.valuemask = XpmReturnPixels | XpmColormap; + /* try again with a virtual colormap */ + a.npixels = 0; + a.colormap = wd->cmap; + a.valuemask = XpmReturnPixels | XpmColormap; *status = XpmReadFileToPixmap(stddpy, DefaultRootWindow(stddpy), - filename, &p2, &dummy, &a); - } + filename, &p2, &dummy, &a); + } if (*status != XpmSuccess) { if (*status == XpmColorFailed) - *status = 1; - else - return (Pixmap) NULL; + *status = 1; + else + return (Pixmap) NULL; } else *status = 0; *height = a.height; @@ -5126,49 +5126,49 @@ int *status; * currently in use by the window */ if (atorigin && *width >= ws->pixwidth && *height >= ws->pixheight - && wc->clipw < 0) { + && wc->clipw < 0) { free_xcolors(w, 0); - } + } /* * OK, now register all the allocated colors with the display * and window in which we are residing. */ for (i = 0; i < a.npixels; i++) { - for (j = 2; j < DMAXCOLORS; j++) - if (wd->colors[j].refcount == 0) break; - if (j == DMAXCOLORS) { - return (Pixmap) NULL; - } - if (j == wd->numColors) wd->numColors++; + for (j = 2; j < DMAXCOLORS; j++) + if (wd->colors[j].refcount == 0) break; + if (j == DMAXCOLORS) { + return (Pixmap) NULL; + } + if (j == wd->numColors) wd->numColors++; else if (j > wd->numColors) { - wd->numColors = j+1; - } - wd->colors[j].refcount = 1; - /* - * Store their allocated pixel (r,g,b) values. - */ - color.pixel = wd->colors[j].c = a.pixels[i]; - XQueryColor(stddpy, wd->cmap, &color); - wd->colors[j].r = color.red; - wd->colors[j].g = color.green; - wd->colors[j].b = color.blue; + wd->numColors = j+1; + } + wd->colors[j].refcount = 1; + /* + * Store their allocated pixel (r,g,b) values. + */ + color.pixel = wd->colors[j].c = a.pixels[i]; + XQueryColor(stddpy, wd->cmap, &color); + wd->colors[j].r = color.red; + wd->colors[j].g = color.green; + wd->colors[j].b = color.blue; clr = lcolor(w, color); sprintf(wd->colors[j].name,"%ld,%ld,%ld",clr.red,clr.green,clr.blue); - if (ws->numColors == WMAXCOLORS) - ; - else { - if (ws->theColors == NULL) { - ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); - if (ws->theColors == NULL) - return (Pixmap) NULL; - } - ws->theColors[ws->numColors++] = j; - } - } -#else /* HAVE_LIBXPM */ + if (ws->numColors == WMAXCOLORS) + ; + else { + if (ws->theColors == NULL) { + ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short)); + if (ws->theColors == NULL) + return (Pixmap) NULL; + } + ws->theColors[ws->numColors++] = j; + } + } +#else /* HAVE_LIBXPM */ return NULL; -#endif /* HAVE_LIBXPM */ +#endif /* HAVE_LIBXPM */ } if (p2 == (Pixmap) NULL) { @@ -5190,7 +5190,7 @@ int *status; } return p2; } - + /* * Interpret a platform-specific color name s. * Under X, we can do this only if there is a window. @@ -5205,12 +5205,12 @@ long *r, *g, *b; wsp ws; wdp wd; - if (!w) /* if no window, give up */ + if (!w) /* if no window, give up */ return 0; ws = w->window; wd = ws->display; if (!XParseColor(wd->display, wd->cmap, s, &colorcell)) - return 0; /* if unknown to X */ + return 0; /* if unknown to X */ clr = lcolor(w, colorcell); *r = clr.red; *g = clr.green; @@ -5250,7 +5250,7 @@ LinearColor c; x.flags = DoRed | DoGreen | DoBlue; return x; } - + int raiseWindow(w) wbp w; @@ -5271,11 +5271,11 @@ wbp w; return Succeeded; } -int walert(w, volume) +int walert(w, volume) wbp w; int volume; { - XBell(w->window->display->display, volume); + XBell(w->window->display->display, volume); XFlush(w->window->display->display); return Succeeded; } @@ -5318,18 +5318,18 @@ wbp w; XFlush(stddpy); ws->refcount--; while (ws->win) - if (pollevent() == -1) return -1; - ws->win = (Window) NULL; + if (pollevent() == -1) return -1; + ws->win = (Window) NULL; ws->busy_flag = 0; } else -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ { XDestroyWindow(stddpy, ws->win); XFlush(stddpy); ws->refcount--; while (ws->win) - if (pollevent() == -1) return -1; + if (pollevent() == -1) return -1; } } /* @@ -5350,7 +5350,7 @@ wbp w; int setglXVisual(wdp wd){ #ifdef GraphicsGL int query; - int visualparms[] = {GLX_RGBA, GLX_DOUBLEBUFFER, GLX_DEPTH_SIZE, 16, GLX_STENCIL_SIZE, 2, None}; + int visualparms[] = {GLX_RGBA, GLX_DOUBLEBUFFER, GLX_DEPTH_SIZE, 16, GLX_STENCIL_SIZE, 2, None}; if (!glXQueryExtension(wd->display, &query, &query)) { return 0; } @@ -5359,8 +5359,8 @@ int setglXVisual(wdp wd){ return 0; } return 1; -#endif /* GraphicsGL */ - return 0; +#endif /* GraphicsGL */ + return 0; } /* @@ -5370,9 +5370,9 @@ char child_window_stuff(wbp w, wbp wp, int child_window) { if (child_window_generic(w, wp, child_window) == 0) return 0; -#ifdef GraphicsGL - if (!w->window->is_gl) -#endif /* GraphicsGL */ +#ifdef GraphicsGL + if (!w->window->is_gl) +#endif /* GraphicsGL */ w->window->vis = DefaultVisual(w->window->display->display, w->window->display->screen); return 1; } @@ -5398,32 +5398,32 @@ char my_wmap(wbp w) if (ws->is_3D) { child_window = CHILD_WIN3D; if (setglXVisual(wd) == 0) - return 0; + return 0; } else if (ws->type >= CHILD_WIN3D) - child_window = CHILD_WIN3D; -#endif /* Graphics3D */ + child_window = CHILD_WIN3D; +#endif /* Graphics3D */ wp = ws->parent; /* * Create a pixmap for this canvas if there isn't one already. */ if (ws->pix == (Pixmap) NULL) { if (ws->initialPix) { - ws->pix = ws->initialPix; - ws->initialPix = (Pixmap) NULL; - ws->pixwidth = ws->width; - ws->pixheight = ws->height; - } + ws->pix = ws->initialPix; + ws->initialPix = (Pixmap) NULL; + ws->pixwidth = ws->width; + ws->pixheight = ws->height; + } else { - ws->pix = XCreatePixmap(wd->display, /* RootWindow(wd->display, wd->vis->screen) */ + ws->pix = XCreatePixmap(wd->display, /* RootWindow(wd->display, wd->vis->screen) */ wp->window->win ? wp->window->win : wp->window->pix, - ws->width, ws->height, - DefaultDepth(wd->display, wd->screen)); - ws->pixwidth = ws->width; - ws->pixheight = ws->height; - new_pixmap = 1; - } + ws->width, ws->height, + DefaultDepth(wd->display, wd->screen)); + ws->pixwidth = ws->width; + ws->pixheight = ws->height; + new_pixmap = 1; + } /* stdpix = ws->pix; */ } @@ -5437,35 +5437,35 @@ char my_wmap(wbp w) attr.background_pixmap = None; attr.background_pixel = wd->colors[wc->bg].c; attr.border_pixel = wd->colors[wc->fg].c; - attr.event_mask = StructureNotifyMask | ExposureMask; - -#ifdef Graphics3D + attr.event_mask = StructureNotifyMask | ExposureMask; + +#ifdef Graphics3D if (ws->is_3D) { - attr.colormap = - XCreateColormap(wd->display, - wp->window->win?wp->window->win:wp->window->pix, - wd->vis->visual, AllocNone); + attr.colormap = + XCreateColormap(wd->display, + wp->window->win?wp->window->win:wp->window->pix, + wd->vis->visual, AllocNone); ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(wd->display): - XCreateWindow (wd->display, (wp->window->win?wp->window->win:wp->window->pix), /*DefaultRootWindow(wd->display), */ - ws->posx < 0 ? 0 : ws->posx, - ws->posy < 0 ? 0 : ws->posy, - ws->width, ws->height, 0, - wd->vis->depth, InputOutput, wd->vis->visual, - CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); - } - else -#endif /* Graphics3D */ + XCreateWindow (wd->display, (wp->window->win?wp->window->win:wp->window->pix), /*DefaultRootWindow(wd->display), */ + ws->posx < 0 ? 0 : ws->posx, + ws->posy < 0 ? 0 : ws->posy, + ws->width, ws->height, 0, + wd->vis->depth, InputOutput, wd->vis->visual, + CWBackPixel|CWBorderPixel|CWColormap|CWEventMask, &attr)); + } + else +#endif /* Graphics3D */ ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(wd->display) : - XCreateSimpleWindow(wd->display, (wp->window->win?wp->window->win:wp->window->pix), /*DefaultRootWindow(stddpy), */ - ws->posx < 0 ? 0 : ws->posx, - ws->posy < 0 ? 0 : ws->posy, ws->width, - ws->height, 1, - wd->colors[wc->fg].c, - wd->colors[wc->bg].c)); + XCreateSimpleWindow(wd->display, (wp->window->win?wp->window->win:wp->window->pix), /*DefaultRootWindow(stddpy), */ + ws->posx < 0 ? 0 : ws->posx, + ws->posy < 0 ? 0 : ws->posy, ws->width, + ws->height, 1, + wd->colors[wc->fg].c, + wd->colors[wc->bg].c)); if (ws->win == (Window) NULL) - return 0; + return 0; /* stdwin = ws->win; */ XClearWindow(wd->display, ws->win); @@ -5510,13 +5510,13 @@ char my_wmap(wbp w) if (ws->is_3D) { #if HAVE_LIBGL ws->ctx = glXCreateContext(wd->display, wd->vis, None, GL_TRUE); - if (ws->ctx == NULL) - return 0; + if (ws->ctx == NULL) + return 0; if (w->window->win) - glXMakeCurrent(wd->display, w->window->win, ws->ctx); -#endif /* HAVE_LIBGL */ + glXMakeCurrent(wd->display, w->window->win, ws->ctx); +#endif /* HAVE_LIBGL */ } -#endif /* Graphics3D */ +#endif /* Graphics3D */ if (wc->clipw >= 0) setclip(w); @@ -5525,7 +5525,7 @@ char my_wmap(wbp w) XSetForeground(wd->display, wc->gc, wd->colors[wc->bg].c); XFillRectangle(wd->display, ws->pix, wc->gc, 0, 0, ws->width, ws->height); XSetForeground(wd->display, wc->gc, - wd->colors[wc->fg].c ^(ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); + wd->colors[wc->fg].c ^(ISXORREVERSE(w)?wd->colors[wc->bg].c:0)); } imd = &ws->initimage; @@ -5554,7 +5554,7 @@ char my_wmap(wbp w) if (wc->patternname != NULL) { if (SetPattern(w, wc->patternname, strlen(wc->patternname)) != Succeeded) - return 0; + return 0; } /* @@ -5573,23 +5573,23 @@ char my_wmap(wbp w) size_hints.x = ws->posx; size_hints.y = ws->posy; if (ISRESIZABLE(w)) { - size_hints.min_width = 0; - size_hints.min_height = 0; - size_hints.max_width = DisplayWidth(wd->display, wd->screen); - size_hints.max_height = DisplayHeight(wd->display, wd->screen); - } + size_hints.min_width = 0; + size_hints.min_height = 0; + size_hints.max_width = DisplayWidth(wd->display, wd->screen); + size_hints.max_height = DisplayHeight(wd->display, wd->screen); + } else { - size_hints.min_width = size_hints.max_width = ws->width; - size_hints.min_height = size_hints.max_height = ws->height; - } + size_hints.min_width = size_hints.max_width = ws->width; + size_hints.min_height = size_hints.max_height = ws->height; + } /* if (ws->iconlabel == NULL) { - if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) - ReturnErrNum(305, RunError); - } + if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL) + ReturnErrNum(305, RunError); + } */ XSetStandardProperties(wd->display, ws->win, ws->windowlabel, ws->iconlabel, - 0,0,0, &size_hints); + 0,0,0, &size_hints); XSelectInput(wd->display, ws->win, XMasks(ws->inputmask)); } @@ -5598,9 +5598,9 @@ char my_wmap(wbp w) /* if (ws->iconic != RootState) { if (ws->iconimage != NULL) { - makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); - wmhints.icon_window = ws->iconwin; - ws->wmhintflags |= IconWindowHint; + makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy); + wmhints.icon_window = ws->iconwin; + ws->wmhintflags |= IconWindowHint; } wmhints.flags |= (ws->wmhintflags | StateHint); wmhints.initial_state = ws->iconic; @@ -5619,7 +5619,7 @@ char my_wmap(wbp w) */ XSync(wd->display, False); - + if (ws->iconic != RootState) { CLREXPOSED(w); XMapWindow(wd->display, ws->win); @@ -5646,12 +5646,12 @@ char my_wmap(wbp w) if (ws->win != (Window) NULL) { int hm; while (!ISEXPOSED(w) && (ws->iconic != IconicState || ws->iconwin)) { - if ((hm = handle_misc(wd, w)) < 1) { - if (hm == -1) return 0; - else if (hm == 0) { - /* how to handle failure? */ - } - } + if ((hm = handle_misc(wd, w)) < 1) { + if (hm == -1) return 0; + else if (hm == 0) { + /* how to handle failure? */ + } + } } } @@ -5667,9 +5667,9 @@ char my_wmap(wbp w) /* set up the appropriate opengl states */ if (child_window == CHILD_WIN3D){ if (init_3dcanvas(w) == Failed) - return 0; + return 0; } -#endif /* Graphics3D */ +#endif /* Graphics3D */ return 1; } @@ -5684,7 +5684,7 @@ void makecurrent(wbp w) if (glXGetCurrentContext() != ws->ctx) { glXMakeCurrent(ws->display->display, ws->win, ws->ctx); } -#endif /* GraphicsGL */ +#endif /* GraphicsGL */ } void mkfont(char *s, char is_3D) @@ -5699,74 +5699,74 @@ void mkfont(char *s, char is_3D) * Check first for special "standard" family names. */ if (!strcmp(family, "mono")) { - stdfam = "Lucida Console"; - flags |= FONTFLAG_MONO + FONTFLAG_SANS; - } + stdfam = "Lucida Console"; + flags |= FONTFLAG_MONO + FONTFLAG_SANS; + } else if ( !strcmp(family, "fixed")) { - stdfam = "Lucida Sans"; - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; - } + stdfam = "Lucida Sans"; + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; + } else if (!strcmp(family, "typewriter")) { - stdfam = "Courier New"; /* was "courier" */ - flags |= FONTFLAG_MONO + FONTFLAG_SERIF; - } + stdfam = "Courier New"; /* was "courier" */ + flags |= FONTFLAG_MONO + FONTFLAG_SERIF; + } else if (!strcmp(family, "sans")) { - stdfam = "Arial"; /* was "swiss" */ - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; - } + stdfam = "Arial"; /* was "swiss" */ + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS; + } else if (!strcmp(family, "serif")) { - stdfam = "Times New Roman"; - flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF; - } + stdfam = "Times New Roman"; + flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF; + } else stdfam = NULL; if (is_3D) { - if (stdfam) { - if (strcmp(stdfam, "Arial")==0) { - strcpy(fn,"nimbu" /* "arial" */); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "17" /* "b"*/); - else if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_NORMAL))) - strcat(fn,"15" /* "b" */); - else if (flags & FONTFLAG_BOLD) strcat(fn, "15" /* "bd" */); - else if (flags & FONTFLAG_ITALIC) strcat(fn, "16" /* "i" */); - else strcat(fn, "14"); - } - else if (strcmp(stdfam, "Times New Roman")==0) { - strcpy(fn,"nimbu" /* "times" */); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "25" /* "b" */); - else if (flags & FONTFLAG_BOLD) strcat(fn, "23" /*"bd"*/); - else if (flags & FONTFLAG_ITALIC) strcat(fn, "24"/*"i"*/); - else strcat(fn, "22"); + if (stdfam) { + if (strcmp(stdfam, "Arial")==0) { + strcpy(fn,"nimbu" /* "arial" */); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "17" /* "b"*/); + else if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_NORMAL))) + strcat(fn,"15" /* "b" */); + else if (flags & FONTFLAG_BOLD) strcat(fn, "15" /* "bd" */); + else if (flags & FONTFLAG_ITALIC) strcat(fn, "16" /* "i" */); + else strcat(fn, "14"); } - else if ((strcmp(stdfam, "Courier New")==0) || - (strcmp(stdfam, "Lucida Sans")==0) - ) { - strcpy(fn,"nimbu" /* "cour" */); - if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) - strcat(fn, "29" /* "b" */); - else if (flags & FONTFLAG_BOLD) strcat(fn, "27" /* "bd" */); - else if (flags & FONTFLAG_ITALIC) strcat(fn, "28" /* "i" */); - else strcat(fn, "26"); + else if (strcmp(stdfam, "Times New Roman")==0) { + strcpy(fn,"nimbu" /* "times" */); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "25" /* "b" */); + else if (flags & FONTFLAG_BOLD) strcat(fn, "23" /*"bd"*/); + else if (flags & FONTFLAG_ITALIC) strcat(fn, "24"/*"i"*/); + else strcat(fn, "22"); } - strcat(fn, ".ttf"); - } - else { - strcpy(fn,family); - if (flags & (FONTFLAG_BOLD+FONTFLAG_ITALIC)) strcat(fn, "BI"); - else if (flags & FONTFLAG_BOLD) strcat(fn, "BD"); - else if (flags & FONTFLAG_ITALIC) strcat(fn, "I"); - strcat(fn, ".TTF"); + else if ((strcmp(stdfam, "Courier New")==0) || + (strcmp(stdfam, "Lucida Sans")==0) + ) { + strcpy(fn,"nimbu" /* "cour" */); + if ((flags & FONTFLAG_BOLD) && (flags & (FONTFLAG_ITALIC))) + strcat(fn, "29" /* "b" */); + else if (flags & FONTFLAG_BOLD) strcat(fn, "27" /* "bd" */); + else if (flags & FONTFLAG_ITALIC) strcat(fn, "28" /* "i" */); + else strcat(fn, "26"); + } + strcat(fn, ".ttf"); + } + else { + strcpy(fn,family); + if (flags & (FONTFLAG_BOLD+FONTFLAG_ITALIC)) strcat(fn, "BI"); + else if (flags & FONTFLAG_BOLD) strcat(fn, "BD"); + else if (flags & FONTFLAG_ITALIC) strcat(fn, "I"); + strcat(fn, ".TTF"); } curr_font = srch_3dfont(fn, size, tp); - if (!curr_font) { - add_3dfont(fn, size, tp); - curr_font = end_font; + if (!curr_font) { + add_3dfont(fn, size, tp); + curr_font = end_font; } } } } -#endif /* Graphics3D */ +#endif /* Graphics3D */ #passthru #undef drawlines void drawlines(wbp w, XPoint *points, int npoints) @@ -5786,6 +5786,6 @@ void fillpolygon(wbp w, XPoint *points, int npoints) } } -#else /* Graphics */ -/* static char junk; /* avoid empty module */ -#endif /* Graphics */ +#else /* Graphics */ +/* static char junk; /* avoid empty module */ +#endif /* Graphics */ diff --git a/uni/unicon/cfy.icn b/uni/unicon/cfy.icn index eb2c3716c..f21b7154c 100644 --- a/uni/unicon/cfy.icn +++ b/uni/unicon/cfy.icn @@ -22,30 +22,30 @@ procedure cfy(ifname, ofname) } while s := read(fi) do { if not (cfy_match_nonws(s, "record"||(" "|"\t"))) then { - write(fo, s) - next - } + write(fo, s) + next + } else if trim(s,,0) == "record" then { - write(&errout, "cfy: needs a better parser for multiline record decls") - close(fi); close(fo) - fail - } + write(&errout, "cfy: needs a better parser for multiline record decls") + close(fi); close(fo) + fail + } if not (r1 := cfy_recdecl_parse(s)) then { - write(&errout, "cfy: can't parse (state vector expected): ", image(s)) - close(fi); close(fo) - fail - } + write(&errout, "cfy: can't parse (state vector expected): ", image(s)) + close(fi); close(fo) + fail + } if not (cfy_is_classrec(r1)) then { - write(fo, s) - next - } + write(fo, s) + next + } # have __state; read __methods. s := read(fi) if not (r2 := cfy_recdecl_parse(s)) then { - write(&errout, "cfy: can't parse (methods vector expected): ",image(s)) - close(fi); close(fo) - fail - } + write(&errout, "cfy: can't parse (methods vector expected): ",image(s)) + close(fi); close(fo) + fail + } stem := r1.name[1:-7] # pop var __s off of r1.flds pop(r1.flds) @@ -54,13 +54,13 @@ procedure cfy(ifname, ofname) # get the number of methods in this class methodc := *r2.flds if \dbg then { - write(fo, "# ", stem, "_mdw_inst_mdw: varc: ", varc) - every i := 1 to varc do - write(fo, "# var ", i-1, ": ", r1.flds[i]) - write(fo, "# ", stem, "_mdw_inst_mdw: methodc: ", methodc) - every i := 1 to methodc do - write(fo, "# method ", i-1, ": ", r2.flds[i]) - } + write(fo, "# ", stem, "_mdw_inst_mdw: varc: ", varc) + every i := 1 to varc do + write(fo, "# var ", i-1, ": ", r1.flds[i]) + write(fo, "# ", stem, "_mdw_inst_mdw: methodc: ", methodc) + every i := 1 to methodc do + write(fo, "# method ", i-1, ": ", r2.flds[i]) + } # # merge __state and __methods recs into r1 @@ -69,7 +69,7 @@ procedure cfy(ifname, ofname) pop(r1.flds) # discard __s nvars := *r1.flds every i := 1 to *r2.flds do - put(r1.flds, pop(r2.flds)) + put(r1.flds, pop(r2.flds)) # # emit the xxx_methods rec-decl so that the # xxxinitialize method can use it to init xxx_oprec. @@ -79,13 +79,13 @@ procedure cfy(ifname, ofname) # emit xformed instance rec-decl # if \dbg then - write(fo, "# ", stem, "_mdw_inst_mdw: *r1.flds: ", *r1.flds) + write(fo, "# ", stem, "_mdw_inst_mdw: *r1.flds: ", *r1.flds) writes(fo, "record " || r1.xform || "(") every i := 1 to *r1.flds do { - writes(fo, r1.flds[i]) - if i < *r1.flds then - writes(fo, ",") - } + writes(fo, r1.flds[i]) + if i < *r1.flds then + writes(fo, ",") + } write(fo, ")") # @@ -97,10 +97,10 @@ procedure cfy(ifname, ofname) # get the ctor signature # while ctor := read(fi) do { - if i := cfy_match_nonws(ctor, "procedure ") then - break - write(fo, ctor) - } + if i := cfy_match_nonws(ctor, "procedure ") then + break + write(fo, ctor) + } write(fo, ctor); # emit untainted ctor signature ctor := ctor[find("(", ctor)+1:-1] # peel off what we need @@ -110,13 +110,13 @@ procedure cfy(ifname, ofname) s := ctor; ctorargc := 0 while i := find(",", s) do { - ctorargc +:= 1 - s := s[i+1:0] - } + ctorargc +:= 1 + s := s[i+1:0] + } if (ctorargc > 0) | (*ctor > 1) then - ctorargc +:= 1 + ctorargc +:= 1 if \dbg then - write(fo, "# ", stem, "_mdw_inst_mdw: ctor-argc: ", ctorargc) + write(fo, "# ", stem, "_mdw_inst_mdw: ctor-argc: ", ctorargc) # # read, save, and emit all ctor lines appearing @@ -124,15 +124,15 @@ procedure cfy(ifname, ofname) # ctorinitlines := list() while s := read(fi) do { - put(ctorinitlines, s) - write(fo, s) - if cfy_match_nonws(s, "}") then - break - } + put(ctorinitlines, s) + write(fo, s) + if cfy_match_nonws(s, "}") then + break + } if \dbg then - write(fo, "# ", stem, "_mdw_inst_mdw: varc: ", varc, " nvars: ", nvars, - " r1.flds: ", *r1.flds) + write(fo, "# ", stem, "_mdw_inst_mdw: varc: ", varc, " nvars: ", nvars, + " r1.flds: ", *r1.flds) # # read all ctor lines (past initial clause) and save them @@ -140,9 +140,9 @@ procedure cfy(ifname, ofname) ctorlines := list() while s := read(fi) do { if cfy_match_nonws(s, "end") then - break - put(ctorlines, s) - } + break + put(ctorlines, s) + } put(ctorlines, s) # @@ -151,9 +151,9 @@ procedure cfy(ifname, ofname) initlines := list() while s := read(fi) do { if cfy_match_nonws(s, "end") then - break - put(initlines, s) - } + break + put(initlines, s) + } put(initlines, s) # @@ -161,31 +161,31 @@ procedure cfy(ifname, ofname) # bcinits := cfy_baseclass_inits_get(cfy_classname(r1), ctorinitlines) if \dbg then - write(fo, "# class ", cfy_classname(r1), " has ", *bcinits, - " bc-inits.") + write(fo, "# class ", cfy_classname(r1), " has ", *bcinits, + " bc-inits.") # # xform "self := xxx_state(...)" - # + # s := ctorlines[1] m := find("__state", s) writes(fo, s[1:m], "__mdw_inst_mdw(") # use state-rec ctor to init inst-rec ctor vars... numargs := 0 if m := find("__oprec,", s) then { - # count num args in the state-rec ctor - numargs := cfy_numargs(s[m+8:-1]) - # emit the vars from the state-rec ctor - writes(fo, s[m+8:-1]) - } + # count num args in the state-rec ctor + numargs := cfy_numargs(s[m+8:-1]) + # emit the vars from the state-rec ctor + writes(fo, s[m+8:-1]) + } every i := numargs to varc-1 do - writes(fo, ",") + writes(fo, ",") # get the methods to init the inst-rec ctor # from the xxxinitialize() call... s := initlines[3] m := find("(", s) if numargs >= 1 then - writes(fo, ",") + writes(fo, ",") write(fo, s[m+1:0]) write(fo, "# numargs: ", numargs, " varc: ", varc); @@ -193,9 +193,9 @@ procedure cfy(ifname, ofname) # initialize any baseclass instance vars found # every i := 1 to *bcinits do { - s := bcinits[i] - write(fo, " self." || s || " := " || s || "__oprec") - } + s := bcinits[i] + write(fo, " self." || s || " := " || s || "__oprec") + } # # xform "self.__m.initially()..." @@ -215,7 +215,7 @@ procedure cfy(ifname, ofname) # emit untainted xxxinitialize() # every i := 1 to *initlines do - write(fo, initlines[i]) + write(fo, initlines[i]) } close(fi) close(fo) @@ -229,12 +229,12 @@ procedure cfy_baseclass_inits_get(clsnm, lines) every i := 1 to *lines do { s := lines[i] s ? { - tab(many(" \t")) - if n := match(clsnm || "__oprec.") then { - t := s[find(".")+1 : find(":=")] - put(rslt, trim(t)) - } - } + tab(many(" \t")) + if n := match(clsnm || "__oprec.") then { + t := s[find(".")+1 : find(":=")] + put(rslt, trim(t)) + } + } } return rslt end @@ -249,7 +249,7 @@ end procedure cfy_ctor_has_initially(lines) every i := 1 to *lines do { if cfy_match_nonws(lines[i], "self.__m.initially(", lines[i]) then - return + return } end @@ -277,9 +277,9 @@ procedure cfy_numargs(s) while *s > 0 do { if member(&letters, s[1]) then { - rslt +:= 1 - break - } + rslt +:= 1 + break + } pop(s) } return rslt diff --git a/uni/unicon/idol.icn b/uni/unicon/idol.icn index 1fed5a5cf..edd924ab0 100644 --- a/uni/unicon/idol.icn +++ b/uni/unicon/idol.icn @@ -25,7 +25,7 @@ procedure reinitialize() imported_classes := table() thePackage := &null end - + # classspec database (DBM) entry record db_entry(dir, entry) @@ -37,7 +37,7 @@ class declaration(name,fields,tag,lptoken,rptoken) method name() return self.name end - + method setname(s) self.name := s end @@ -84,7 +84,7 @@ if / (self.tag) then { initially tmpcount := 0 end - + global imported procedure import_class(node) @@ -97,26 +97,26 @@ procedure import_class(node) else if node.tok = IDENT then { tempp := Package(node.s) if /tempp.dir then { - uni_error("Unable to import (1) package " || image(node.s)) - } + uni_error("Unable to import (1) package " || image(node.s)) + } tempp.add_imported() } else if node.tok = STRINGLIT then { node.s ? { - move(1) - pack := "" - while pack ||:= tab(upto('/\\')) do pack ||:= move(1) - if pack ||:= tab(find(".")) then { - move(1) - s := tab(-1) - } - else pack ||:= tab(-1) + move(1) + pack := "" + while pack ||:= tab(upto('/\\')) do pack ||:= move(1) + if pack ||:= tab(find(".")) then { + move(1) + s := tab(-1) + } + else pack ||:= tab(-1) } tempp := Package(pack) if /tempp.dir then { - uni_error("Unable to import (2) package " || image(pack)) - } + uni_error("Unable to import (2) package " || image(pack)) + } tempp.add_imported(s) } end @@ -138,9 +138,9 @@ class Package : declaration(files, dir, classes) local s, f if /dir then return - + f := open(dir || "/uniclass", "dr") | - stop("Couldn't re-open uniclass db in " || dir) + stop("Couldn't re-open uniclass db in " || dir) every s := (if \sym then sym else fields.foreach()) do { if member(imported, s) then put(imported[s], self.name) @@ -205,11 +205,11 @@ initially(name) name := name[2:-1] self.name := "" name ? { - if upto('/\\') then { - while self.name ||:= tab(upto('/\\')) do self.name ||:= move(1) - } - self.name ||:= tab(find(".")|0) - } + if upto('/\\') then { + while self.name ||:= tab(upto('/\\')) do self.name ||:= move(1) + } + self.name ||:= tab(find(".")|0) + } } else { self.name := name @@ -221,7 +221,7 @@ initially(name) /tag := "package" /fields := classFields() end - + # imethods and ifields are all lists of these: record classident(Class,ident) @@ -229,15 +229,15 @@ record classident(Class,ident) # Attributes and operations of classes # class Class : declaration (supers, - methods, - text, - imethods, - ifields, - glob, - linkfile, - dir, - unmangled_name, - supers_node) + methods, + text, + imethods, + ifields, + glob, + linkfile, + dir, + unmangled_name, + supers_node) method ismethod(id) if \ (self.methods$lookup(id)) | (!\self.imethods).ident == id then @@ -259,35 +259,35 @@ class Class : declaration (supers, method ReadBody(depth,L) while line := pop(L) do { line ? { - tab(many(white)) - if ="initially" then { - (cf := classFields())$parse("") - decl := Method(self.name,self.text,,cf,"method") - decl$setname("initially") - self.methods$insert(decl, "initially") - } else if ="method" then { - decl := Method(self.name) - decl$Read(line,phase) - self.methods$insert(decl,decl$name()) - } else if ="end" & pos(0) then { - # "end" is tossed here. see "initially" above - return - } else if ="procedure" then { - decl := Method("") - decl$Read(line,phase) - /self.glob := [] - put(self.glob,decl) - } else if ="global" then { - /self.glob := [] - put(self.glob,vardecl(line)) - } else if ="record" then { - /self.glob := [] - put(self.glob,declaration(line)) - } else if upto(nonwhite) then { - decl := Method(self.name) - decl$Read("method " || line || "()", phase) - self.methods$insert(decl,decl$name()) - } + tab(many(white)) + if ="initially" then { + (cf := classFields())$parse("") + decl := Method(self.name,self.text,,cf,"method") + decl$setname("initially") + self.methods$insert(decl, "initially") + } else if ="method" then { + decl := Method(self.name) + decl$Read(line,phase) + self.methods$insert(decl,decl$name()) + } else if ="end" & pos(0) then { + # "end" is tossed here. see "initially" above + return + } else if ="procedure" then { + decl := Method("") + decl$Read(line,phase) + /self.glob := [] + put(self.glob,decl) + } else if ="global" then { + /self.glob := [] + put(self.glob,vardecl(line)) + } else if ="record" then { + /self.glob := [] + put(self.glob,declaration(line)) + } else if upto(nonwhite) then { + decl := Method(self.name) + decl$Read("method " || line || "()", phase) + self.methods$insert(decl,decl$name()) + } } } if depth = 0 then @@ -318,19 +318,19 @@ class Class : declaration (supers, method transitive_closure() count := supers$size() while count > 0 do { - added := taque() - every sc := supers$foreach() do { - if /(super := classes$lookup(sc)) then - halt("class/transitive_closure: couldn't find superclass ",sc) - every supersuper := super$foreachsuper() do { - if / self.supers$lookup(supersuper) & - /added$lookup(supersuper) then { - added$insert(supersuper) - } - } - } - count := added$size() - every self.supers$insert(added$foreach()) + added := taque() + every sc := supers$foreach() do { + if /(super := classes$lookup(sc)) then + halt("class/transitive_closure: couldn't find superclass ",sc) + every supersuper := super$foreachsuper() do { + if / self.supers$lookup(supersuper) & + /added$lookup(supersuper) then { + added$insert(supersuper) + } + } + } + count := added$size() + every self.supers$insert(added$foreach()) } end # @@ -340,7 +340,7 @@ class Class : declaration (supers, method writedecl(f,s) writes(f, s," ",self.name) if s=="class" & ( *(superstr := self.supers$String()) > 0 ) then - writes(f," : ",superstr) + writes(f," : ",superstr) writes(f,"(") if s~=="class" & @@ -354,24 +354,24 @@ class Class : declaration (supers, else { rv := self.fields$String(s) if *rv > 0 then rv ||:= "," - if s~=="class" & *(\self.ifields)>0 then { # inherited fields - every l := !self.ifields do { - lid := l.ident - if type(lid) == "string" then - rv := rv || lid || "," - else if type(lid)=="treenode" & lid.label == "arg3" then { - rv := rv || (lid.children[1].s) - if s=="class" then { - rv := rv || ":" || lid.children[3].s - } - rv := rv || "," - } - else stop("Write(): can't handle ", type(ifi)) - } - # resolve the last field in order to see if it is a vararg - if /(superclass := classes$lookup(l.Class)) then - halt("class/resolve: couldn't find superclass ",sc) - if superclass$isvarg(l.ident) then rv := rv[1:-1]||"[]," + if s~=="class" & *(\self.ifields)>0 then { # inherited fields + every l := !self.ifields do { + lid := l.ident + if type(lid) == "string" then + rv := rv || lid || "," + else if type(lid)=="treenode" & lid.label == "arg3" then { + rv := rv || (lid.children[1].s) + if s=="class" then { + rv := rv || ":" || lid.children[3].s + } + rv := rv || "," + } + else stop("Write(): can't handle ", type(ifi)) + } + # resolve the last field in order to see if it is a vararg + if /(superclass := classes$lookup(l.Class)) then + halt("class/resolve: couldn't find superclass ",sc) + if superclass$isvarg(l.ident) then rv := rv[1:-1]||"[]," } writes(f,rv[1:-1]) } @@ -381,7 +381,7 @@ class Class : declaration (supers, if \iconc_import then return # Do not write anything during the iconc import phase f := open(env,"d") | { write(&errout, "can't open class database ", image(env), - " to write spec for ",self.name) + " to write spec for ",self.name) fail } @@ -414,7 +414,7 @@ class Class : declaration (supers, s := fetch(f, nam) | stop("fetch(", image(nam),") fails") close(f) end - + # # write out the Icon code for this class' explicit methods # and its "nested global" declarations (procedures, records, etc.) @@ -424,10 +424,10 @@ class Class : declaration (supers, every (methods$foreach())$Write(f) if \self.glob & *self.glob>0 then { - write(f,"#\n# globals declared within the class\n#") - every i := 1 to *self.glob do - yyprint(glob[i]) - write(f) + write(f,"#\n# globals declared within the class\n#") + every i := 1 to *self.glob do + yyprint(glob[i]) + write(f) } end @@ -450,15 +450,15 @@ class Class : declaration (supers, write(f,"#line 1 \"__faux.icn\"") writes(f,"record ",nam,"__state(__s,__m") # reserved fields rv := "," - rv ||:= self.fields$idTaque.String() # my fields + rv ||:= self.fields$idTaque.String() # my fields if rv[-1] ~== "," then rv ||:= "," every ifi := (!self.ifields).ident do { if type(ifi) == "string" then rv := rv || ifi || "," # inherited fields else if type(ifi) == "treenode" & ifi.label == "arg3" then { - rv := rv || (ifi.children[1].s) || "," - } + rv := rv || (ifi.children[1].s) || "," + } else stop("Write(): can't handle ", type(ifi)) } @@ -469,13 +469,13 @@ class Class : declaration (supers, # writes(f,"record ",nam,"__methods(") rv := "" - every s := (((methods$foreach())$name()) | # my explicit methods - (!self.imethods).ident | # my inherited methods - supers$foreach() - ) # super.method fields - do rv := rv || s || "," + every s := (((methods$foreach())$name()) | # my explicit methods + (!self.imethods).ident | # my inherited methods + supers$foreach() + ) # super.method fields + do rv := rv || s || "," - if *rv>0 then rv[-1] := "" # trim trailling , + if *rv>0 then rv[-1] := "" # trim trailling , yyprint(rv||")\n") # @@ -485,7 +485,7 @@ class Class : declaration (supers, writes(f,"global ",nam,"__oprec") every writes(f,", ", supers$foreach(),"__oprec") yyprint("\n") - + # # write the constructor procedure. # This is a long involved process starting with writing the declaration. @@ -498,9 +498,9 @@ class Class : declaration (supers, # yyprint("initial {\n if /"||nam||"__oprec then "||nam||"initialize()\n") if supers$size() > 0 then - every (super <- supers$foreach()) ~== nam do - yyprint(" if /"||super||"__oprec then "||super||"initialize()\n"|| - " "||nam||"__oprec."||super||" := "|| super||"__oprec\n") + every (super <- supers$foreach()) ~== nam do + yyprint(" if /"||super||"__oprec then "||super||"initialize()\n"|| + " "||nam||"__oprec."||super||" := "|| super||"__oprec\n") yyprint(" }\n") @@ -508,18 +508,18 @@ class Class : declaration (supers, # If the class field list has or inherits defaults, write them out. # every fld := fields$foreach() do { - if type(fld) == "treenode" & fld.label == "arg3" then { - writes(f,"/",fld.children[1].s, " := ") - yyprint(fld.children[3]) - yyprint("\n") - } - } + if type(fld) == "treenode" & fld.label == "arg3" then { + writes(f,"/",fld.children[1].s, " := ") + yyprint(fld.children[3]) + yyprint("\n") + } + } every ifi := (!(self.ifields)).ident do { if type(ifi) == "treenode" & ifi.label == "arg3" then { - writes(f,"/",ifi.children[1].s, " := ") - yyprint(ifi.children[3]) - yyprint("\n") - } + writes(f,"/",ifi.children[1].s, " := ") + yyprint(ifi.children[3]) + yyprint("\n") + } } @@ -537,19 +537,19 @@ class Class : declaration (supers, yyprint(")\n self.__s := self\n") if \ (m.fields.varg) then { m.fields.String()[1:-2] ? { - if find(",") then { + if find(",") then { writes(f," self.__m.initially!([self,") while writes(f,tab(find(","))) do { - move(1) # if last was nonfinal write it - if find(",") then writes(f,",") - } - write(f, "]|||", tab(0),") | fail") + move(1) # if last was nonfinal write it + if find(",") then writes(f,",") + } + write(f, "]|||", tab(0),") | fail") } else { - write(f," self.__m.initially!(push(", tab(0), ",self)) | fail") + write(f," self.__m.initially!(push(", tab(0), ",self)) | fail") } - } - } + } + } else { writes(f," self.__m.initially(self,") yyprint(m.fields) @@ -558,23 +558,23 @@ class Class : declaration (supers, } else { every fld := fields$foreach() do { - if type(fld) == "treenode" then writes(f,",",fld.children[1].s) - else - writes(f,",",fld) - } + if type(fld) == "treenode" then writes(f,",",fld.children[1].s) + else + writes(f,",",fld) + } if \self.ifields then every ifi := (!self.ifields).ident do { - if type(ifi) == "string" then writes(f,",",ifi) - else if type(ifi) == "treenode" & ifi.label == "arg3" then { - writes(f, ",", ifi.children[1].s) - } - else { - write(&errout, "unicon: system error inheriting ", type(ifi)) - } - } + if type(ifi) == "string" then writes(f,",",ifi) + else if type(ifi) == "treenode" & ifi.label == "arg3" then { + writes(f, ",", ifi.children[1].s) + } + else { + write(&errout, "unicon: system error inheriting ", type(ifi)) + } + } yyprint(")\n self.__s := self\n") if ((methods$foreach())$name()| (!self.imethods).ident) == "initially" then - yyprint(" self.__m.initially(self) | fail\n") + yyprint(" self.__m.initially(self) | fail\n") } # @@ -591,25 +591,25 @@ class Class : declaration (supers, if \strict then yyprint(" return idol_object(self,"||self.name||"__oprec)\nend\n\n") else yyprint(" return self\nend\n\n") - - + + # # write out class initializer procedure to initialize my operation record # yyprint("procedure "||nam||"initialize()\n") writes(f," initial ",nam,"__oprec := ",nam,"__methods") rv := "(" - every s := (methods$foreach())$name() do { # explicit methods + every s := (methods$foreach())$name() do { # explicit methods if *rv>1 then rv ||:= "," rv := rv || nam || "_" || s } - every l := !self.imethods do { # inherited methods + every l := !self.imethods do { # inherited methods if *rv>1 then rv ||:= "," rv := rv || l.Class || "_" || l.ident } yyprint(rv||")\nend\n") end - + # # resolve -- primary inheritance resolution utility # @@ -623,35 +623,35 @@ class Class : declaration (supers, addedfields := table() addedmethods := table() every sc := supers$foreach() do { - if /(superclass := classes$lookup(sc)) then - halt("class/resolve: couldn't find superclass ",sc) - every superclassfield := superclass$foreachfield() do { - if /self.fields$lookup(superclassfield) & - /addedfields[superclassfield] then { - addedfields[superclassfield] := superclassfield - put ( self.ifields , classident(sc,superclassfield) ) - if superclass$ispublic(superclassfield) then - put( ipublics, classident(sc,superclassfield) ) - } else if \strict then { - warn("class/resolve: '",sc,"' field '",superclassfield, - "' is redeclared in subclass ",self.name) - } - } - every superclassmethod := (superclass$foreachmethod())$name() do { - if /self.methods$lookup(superclassmethod) & - /addedmethods[superclassmethod] then { - addedmethods[superclassmethod] := superclassmethod - put ( self.imethods, classident(sc,superclassmethod) ) - } - } - every public := (!ipublics) do { - if public.Class == sc then - put (self.imethods, classident(sc,public.ident)) - } + if /(superclass := classes$lookup(sc)) then + halt("class/resolve: couldn't find superclass ",sc) + every superclassfield := superclass$foreachfield() do { + if /self.fields$lookup(superclassfield) & + /addedfields[superclassfield] then { + addedfields[superclassfield] := superclassfield + put ( self.ifields , classident(sc,superclassfield) ) + if superclass$ispublic(superclassfield) then + put( ipublics, classident(sc,superclassfield) ) + } else if \strict then { + warn("class/resolve: '",sc,"' field '",superclassfield, + "' is redeclared in subclass ",self.name) + } + } + every superclassmethod := (superclass$foreachmethod())$name() do { + if /self.methods$lookup(superclassmethod) & + /addedmethods[superclassmethod] then { + addedmethods[superclassmethod] := superclassmethod + put ( self.imethods, classident(sc,superclassmethod) ) + } + } + every public := (!ipublics) do { + if public.Class == sc then + put (self.imethods, classident(sc,public.ident)) + } } end end - + # # a class defining operations on methods and procedures # @@ -665,12 +665,12 @@ class Method : declaration (Class, locals, initl, procbody, abstract_flag, first decl ?:= tab(find("(")) # if s == "method" then decl[1:upto(white,decl)] := "method" # else { -# decl[1:upto(white,decl)] := "procedure" -# if *(self.Class)>0 then { -# decl[upto(white,decl)] ||:= self.Class||"_" -# i := find("(",decl) -# decl[i] ||:= "self" || (((decl[i+1] ~== ")"), ",") | "") -# } +# decl[1:upto(white,decl)] := "procedure" +# if *(self.Class)>0 then { +# decl[upto(white,decl)] ||:= self.Class||"_" +# i := find("(",decl) +# decl[i] ||:= "self" || (((decl[i+1] ~== ")"), ",") | "") +# } # } return decl || "\n" end @@ -679,21 +679,21 @@ class Method : declaration (Class, locals, initl, procbody, abstract_flag, first if x := \ (self.fields$lookup(id)) then return x return isloco( \ (self.locals), id) # if x := \ (self.text.vars) then -# return x$lookup(id) +# return x$lookup(id) end method Write(f, nam) yyprint("\n") if \firsttoken then { - if outfilename ~== firsttoken.filename | - outline ~= firsttoken.line then { - write(yyout,"\n#line ", firsttoken.line-1," \"", - firsttoken.filename,"\"") - outline := firsttoken.line - outcol := 1 - outfilename := firsttoken.filename - } - } + if outfilename ~== firsttoken.filename | + outline ~= firsttoken.line then { + write(yyout,"\n#line ", firsttoken.line-1," \"", + firsttoken.filename,"\"") + outline := firsttoken.line + outcol := 1 + outfilename := firsttoken.filename + } + } writes(f, "procedure ") writes(f, self.Class$name(), "_") @@ -707,13 +707,13 @@ class Method : declaration (Class, locals, initl, procbody, abstract_flag, first if /abstract_flag then { yyprint(locals) if exists_statlists(locals) then { - yyprint("\ninitial {") + yyprint("\ninitial {") if initl ~=== &null then { # append into existing initial - yyprint(initl.children[2]) - yyprint(";\n") - } + yyprint(initl.children[2]) + yyprint(";\n") + } yystalists(locals) - yyprint("\n}\n") + yyprint("\n}\n") } else yyprint(initl) @@ -727,7 +727,7 @@ class Method : declaration (Class, locals, initl, procbody, abstract_flag, first yyprint("\nend\n") end end - + # # a class corresponding to an Icon table, with special treatment of empties # @@ -752,36 +752,36 @@ end procedure methodstaque(node, cl, taq) /taq := taque() case type(node) of { - "treenode": { - if (node.label ~=== "global") & (node.label ~=== "record") then { - if *node.children > 0 then - every methodstaque(!node.children, cl, taq) - else write("leaf ", node.label) - } - else { - /(cl.glob) := [] - put(cl.glob, node) - } - } + "treenode": { + if (node.label ~=== "global") & (node.label ~=== "record") then { + if *node.children > 0 then + every methodstaque(!node.children, cl, taq) + else write("leaf ", node.label) + } + else { + /(cl.glob) := [] + put(cl.glob, node) + } + } "Method__state": { - node.Class := cl - if not (taq$insert(node, node$name())) then { - uni_error("method " || node$name() || - " redeclared in " || cl.name) - } - } - "null": { } - "token": { - write("token ", tokenstr(node.tok), " line ", node.line, " file ", node.filename) - } + node.Class := cl + if not (taq$insert(node, node$name())) then { + uni_error("method " || node$name() || + " redeclared in " || cl.name) + } + } + "null": { } + "token": { + write("token ", tokenstr(node.tok), " line ", node.line, " file ", node.filename) + } "declaration__state" : { # Record declaration. /(cl.glob) := [] put(cl.glob, node) } - default: { - write("methods Taque on ", type(node), " : ", image(node)) - } + default: { + write("methods Taque on ", type(node), " : ", image(node)) + } } return taq end @@ -822,7 +822,7 @@ class taque : Table (l) suspend self$Table.foreach() end end - + # # support for taques found as lists of ids separated by punctuation # constructor called with (separation char, source string) @@ -833,13 +833,13 @@ class idTaque : taque(punc) s ? { tab(many(white)) while name := tab(find(self.punc)) do { - self$insert(trim(name,white)) - move(1) - tab(many(white)) + self$insert(trim(name,white)) + move(1) + tab(many(white)) } if any(nonwhite) then { - self$insert(trim(tab(0),white)) - } + self$insert(trim(tab(0),white)) + } } return end @@ -851,59 +851,59 @@ class idTaque : taque(punc) # method traverse(nod, isClassLocal) case type(nod) of { - "treenode": { - if *nod.children > 0 then { - if nod.label == ("arg" || (2 to 8)) then { - if /isClassLocal then - insert(nod, nod.children[1].s) - else { - insert(nod.children[1].s) - } - } - else if nod.label == "varlist2" then { - if /isClassLocal then + "treenode": { + if *nod.children > 0 then { + if nod.label == ("arg" || (2 to 8)) then { + if /isClassLocal then insert(nod, nod.children[1].s) - else { + else { insert(nod.children[1].s) - nod := copy(nod) - nod.label := "assign" - return nod - } - } - else if nod.label==("varlist3"|"varlist4") then { - traverse(nod.children[1], isClassLocal) - if /isClassLocal then - insert(nod, nod.children[3].s) - else { - insert(nod.children[3].s) - } - } - else { - accum := [] - every \(x := traverse(!nod.children, isClassLocal)) do { - put(accum, x) - } - accumtree := &null - while x := pull(accum) do - accumtree := node("procbody", x, ";", accumtree) - return accumtree - } - } - else write("leaf ", nod.label) - } - "token": { - if nod.tok = IDENT then - insert(nod.s) - } - "string": { - if (nod ~== self.punc) & (nod ~== ";") then - write("idTaque on ", type(nod), " : ", image(nod), " (punc was ",image(punc),")") - } - "null": { } - default: { - write("idTaque on ", type(nod), " : ", image(nod)) - } - } + } + } + else if nod.label == "varlist2" then { + if /isClassLocal then + insert(nod, nod.children[1].s) + else { + insert(nod.children[1].s) + nod := copy(nod) + nod.label := "assign" + return nod + } + } + else if nod.label==("varlist3"|"varlist4") then { + traverse(nod.children[1], isClassLocal) + if /isClassLocal then + insert(nod, nod.children[3].s) + else { + insert(nod.children[3].s) + } + } + else { + accum := [] + every \(x := traverse(!nod.children, isClassLocal)) do { + put(accum, x) + } + accumtree := &null + while x := pull(accum) do + accumtree := node("procbody", x, ";", accumtree) + return accumtree + } + } + else write("leaf ", nod.label) + } + "token": { + if nod.tok = IDENT then + insert(nod.s) + } + "string": { + if (nod ~== self.punc) & (nod ~== ";") then + write("idTaque on ", type(nod), " : ", image(nod), " (punc was ",image(punc),")") + } + "null": { } + default: { + write("idTaque on ", type(nod), " : ", image(nod)) + } + } return end method String() @@ -920,12 +920,12 @@ initially argtree := l l := [] if type(argtree) == "token" then - insert(argtree.s) + insert(argtree.s) else - traverse(argtree) + traverse(argtree) } end - + # # parameter lists in which the final argument may have a trailing [] # The "[]" varg parameter is passed in by the parser if it is present. @@ -941,56 +941,56 @@ class argList : idTaque(varg) local first every x := !\l do if type(x) == "treenode" then { - if /first := 1 then write(yyout) - v := x.children[1].s - if x.label == ("arg3" | "arg4") then { - writes(yyout, "/", v, " := ", x.children[-1].s) - yyprint("\n") + if /first := 1 then write(yyout) + v := x.children[1].s + if x.label == ("arg3" | "arg4") then { + writes(yyout, "/", v, " := ", x.children[-1].s) + yyprint("\n") } - else if x.label == ("arg5" | "arg6") then { - writes(yyout, "/", v, " := &", x.children[-1].children[-1].s) - yyprint("\n") + else if x.label == ("arg5" | "arg6") then { + writes(yyout, "/", v, " := &", x.children[-1].children[-1].s) + yyprint("\n") } - else if x.label == ("arg7" | "arg8") then { - writes(yyout, "/", v, " := []") - yyprint("\n") - } - if x.label == ("arg2" | "arg4" | "arg6") then { - case x.children[3].s of { - "integer"|"string"|"numeric"|"cset"|"real": { - writes(yyout, v, " := ", x.children[3].s, "(", v, ") |") - } - default: { - writes(yyout, "(type(",v,")==\"",x.children[3].s,"\") |") - } - } - writes(yyout, " runerr(") - writes(yyout, case x.children[3].s of { - "integer": 101 - "numeric": 102 - "string": 103 - "cset": 104 - "file": 105 - "list": 108 - "set": 119 - "table": 124 - "window": 140 - default: 123 - }) - writes(yyout,", ", v, ")") + else if x.label == ("arg7" | "arg8") then { + writes(yyout, "/", v, " := []") + yyprint("\n") + } + if x.label == ("arg2" | "arg4" | "arg6") then { + case x.children[3].s of { + "integer"|"string"|"numeric"|"cset"|"real": { + writes(yyout, v, " := ", x.children[3].s, "(", v, ") |") + } + default: { + writes(yyout, "(type(",v,")==\"",x.children[3].s,"\") |") + } + } + writes(yyout, " runerr(") + writes(yyout, case x.children[3].s of { + "integer": 101 + "numeric": 102 + "string": 103 + "cset": 104 + "file": 105 + "list": 108 + "set": 119 + "table": 124 + "window": 140 + default: 123 + }) + writes(yyout,", ", v, ")") yyprint("\n") - } - } + } + } # if any coercions happened, emit a #line directive if \first then { if lm := leftmost_token(\x) then { - if outline ~=== lm.line then { - write(yyout,"\n#line ", lm.line-1," \"", lm.filename,"\"") - outline := lm.line - outcol := 1 - if lm.column > 1 then writes(yyout, repl(" ",lm.column-1)) - outfilename := lm.filename - } + if outline ~=== lm.line then { + write(yyout,"\n#line ", lm.line-1," \"", lm.filename,"\"") + outline := lm.line + outcol := 1 + if lm.column > 1 then writes(yyout, repl(" ",lm.column-1)) + outfilename := lm.filename + } } else { write(yyout, "\n# no leftmost lineno, line directive omitted") @@ -1005,7 +1005,7 @@ class argList : idTaque(varg) end initially self.punc := "," - self$idTaque.initially() + self$idTaque.initially() end # @@ -1028,15 +1028,15 @@ class classFields : argList(publics) method insert(s) s ? { if ="public" & tab(many(white)) then { - s := tab(0) - /self.publics := [] - put(self.publics,s) + s := tab(0) + /self.publics := [] + put(self.publics,s) } } return self$argList.insert(s) end end - + # # find a class specification, along the IPATH if necessary # @@ -1045,27 +1045,27 @@ procedure fetchspec(name) local basedir := "." name ? { while basedir ||:= tab(upto('\\/')) do { - basedir ||:= move(1) - } + basedir ||:= move(1) + } name := tab(0) # throw away initial "." and trailing "/" if basedir[-1] == ("\\"|"/") then basedir := basedir[2:-1] } if f := open(basedir || "/" || env,"dr") then { if s := fetch(f, name) then { - close(f) -# if s[1] == "\^z" then { # need to decompress s -# f2 := open("gzip.out", "pw") -# writes(f2, s[2:0]) -# close(f2) -# f2 := open("gzip -d -c gzip.out") -# s := reads(f2, 100000) -## write(&errout, "decompressed to ", *s, " bytes") -# close(f2) -# remove("gzip.out") -# } - return db_entry(basedir, s) - } + close(f) +# if s[1] == "\^z" then { # need to decompress s +# f2 := open("gzip.out", "pw") +# writes(f2, s[2:0]) +# close(f2) +# f2 := open("gzip -d -c gzip.out") +# s := reads(f2, 100000) +## write(&errout, "decompressed to ", *s, " bytes") +# close(f2) +# remove("gzip.out") +# } + return db_entry(basedir, s) + } close(f) } @@ -1107,83 +1107,83 @@ procedure readspec(name) fromfile := pop(L) while line := pop(L) do { line ? { - tab(many(white)) - if ="class" then { - decl := Class() + tab(many(white)) + if ="class" then { + decl := Class() decl.dir := dbe.dir - decl.linkfile := fromfile - decl$Read(line,L) - #insert into table for lookup, but not into list for generation - classes$insert_t(decl,decl$name()) - } - else if ="procedure" then { - if comp = 0 then comp := 1 - decl := Method("") - decl$Read(line) - decl$Write(fout,"") - } - else if ="record" then { - if comp = 0 then comp := 1 - decl := declaration(line) - decl$Write(fout,"") - } - else if =("global"|"link") then { - if comp = 0 then comp := 1 - tab(many(white)) - if pos(0) then line ||:= readln("wrap") - decl := vardecl(line) - decl$Write(fout,"") - } - else if ="const" then { - ct$append ( constdcl(line) ) - } - else if ="method" then { - halt("readinput: method outside class") - } - else if upto(nonwhite) then { - halt("expected declaration on: ",line) - } - } + decl.linkfile := fromfile + decl$Read(line,L) + #insert into table for lookup, but not into list for generation + classes$insert_t(decl,decl$name()) + } + else if ="procedure" then { + if comp = 0 then comp := 1 + decl := Method("") + decl$Read(line) + decl$Write(fout,"") + } + else if ="record" then { + if comp = 0 then comp := 1 + decl := declaration(line) + decl$Write(fout,"") + } + else if =("global"|"link") then { + if comp = 0 then comp := 1 + tab(many(white)) + if pos(0) then line ||:= readln("wrap") + decl := vardecl(line) + decl$Write(fout,"") + } + else if ="const" then { + ct$append ( constdcl(line) ) + } + else if ="method" then { + halt("readinput: method outside class") + } + else if upto(nonwhite) then { + halt("expected declaration on: ",line) + } + } if pos(0) then break } end - + # -# finds series of high-precedence expressions +# finds series of high-precedence expressions # preceding a $ # procedure get_invoker() local id, rv rv := "" while any(alpha) | match(")"|"]"|"}") do { - if id := tab(many(alpha)) then { - if find(" "||id||" ", reserved) then { - move(-*id) - break - } - rv ||:= id - if not ((tab(many(white))|"") & (rv ||:= =".")) then break - } - else { - case &subject[&pos] of { - ")": { - if not (rv ||:= tab(&pos": line[x+:2] := "]" - # - # $. used to be a syntax shorthand for self. - # - ".": line[x] := "self" + # + # $. used to be a syntax shorthand for self. + # + ".": line[x] := "self" # # Invocation operators $! $* $@ $? (for $$ see below) # "!"|"*"|"@"|"?": { z ? { - move(1) - tab(many(white)) - if not (id := tab(many(alphadot))) then { - if not match("(") then halt("readln can't parse ",line) - if not (id := tab(&pos=(x+methlen+1))|0)\1)] := - front || methodname || back || c - } + # + # get the invoking object. + # + reverse(line[1:x])||" " ? { + tab(many(white)) + id := get_invoker() + if *id = 0 then halt("readln: no invoking object precedes $") + objlen := &pos-1 + } + + if many(alpha, id) = *id + 1 then { + front := id||".__m." + back := id + } + else { + tmpcount +:= 1 + back := "__"||tmpcount + front := "("||back||" := "||id||").__m." + } + if \strict then back ||:= ".__s" + # + # get the method name + # + z ? { + ="$" + tab(many(white)) + if not (methodname := tab(many(alphadot))) then + halt("readln: expected a method name after $") + tab(many(white)) + methodname ||:= "(" + if ="(" then { + tab(many(white)) + afterlp := &subject[&pos] + } + else { + afterlp := ")" + back ||:= ")" + } + methlen := &pos-1 + } + if line[x+1] == "$" then { + c := if afterlp[1] ~== ")" then "" else "[]" + methodname[-1] := "!(" + back := "["||back||"]|||" + } else { + c := if (\afterlp)[1] == ")" then "" else "," + } + line[x-objlen : (((*line>=(x+methlen+1))|0)\1)] := + front || methodname || back || c + } } # case } # while there's a $ to process if /wrap | (prefix==line=="") then finished := line else { - prefix := prefix || line || " " # " " is for bal() - prefix ? { - # we are done if the line is balanced wrt parens and - # doesn't end in a continuation character (currently just ,) - if ((*prefix = bal()) & (not find(",",prefix[-2]))) then { - # add another condition or 3: we aren't done if we have - # a class|method|procedure declaration with no parens yet - if (tab(many(white)) | "") & - =("class"|"method"|"procedure"|"

"|"

") & - not find("(") & - not find("
") - then { } - else { - finished := prefix[1:-1] - } - } - } + prefix := prefix || line || " " # " " is for bal() + prefix ? { + # we are done if the line is balanced wrt parens and + # doesn't end in a continuation character (currently just ,) + if ((*prefix = bal()) & (not find(",",prefix[-2]))) then { + # add another condition or 3: we aren't done if we have + # a class|method|procedure declaration with no parens yet + if (tab(many(white)) | "") & + =("class"|"method"|"procedure"|"

"|"

") & + not find("(") & + not find("
") + then { } + else { + finished := prefix[1:-1] + } + } + } } } # while / finished return ct$expand(finished) @@ -1351,17 +1351,17 @@ end # suspend all the HTML (4.0, at the moment) tags procedure htmltags() suspend ("EM"|"STRONG"|"BLOCKQUOTE"|"Q"|"SUP"|"SUB"| - "H1"|"H2"|"H3"|"H4"|"H5"|"H6"| - "BR"|"PRE"|"INS"|"DEL"|"UL"|"OL"|"DL"|"DT"|"DD"| - "DIR"|"MENU"|"TABLE"|"CAPTION"|"THEAD"|"TFOOT"|"TBODY"| - "COLGROUP"|"COL"|"TR"|"TH"|"TD"|"LINK"| - "IMG"|"OBJECT"|"PARAM"|"APPLET"|"MAP"|"AREA"|"STYLE"| - "TT"|"BIG"|"SMALL"|"STRIKE"|"U"|"FONT"| - "HTML"|"HEAD"|"META"|"BODY"| - "BASEFONT"|"HR"|"FRAMESET"|"FRAME"|"NOFRAMES"|"IFRAME"| - "FORM"|"INPUT"|"BUTTON"|"SELECT"|"OPTGROUP"|"OPTION"| - "TEXTAREA"|"ISINDEX"|"LABEL"|"FIELDSET"|"LEGEND"| - "SCRIPT"|"NOSCRIPT"|"P"|"B"|"LI"|"A"|"BASE"|"I"|"S") + "H1"|"H2"|"H3"|"H4"|"H5"|"H6"| + "BR"|"PRE"|"INS"|"DEL"|"UL"|"OL"|"DL"|"DT"|"DD"| + "DIR"|"MENU"|"TABLE"|"CAPTION"|"THEAD"|"TFOOT"|"TBODY"| + "COLGROUP"|"COL"|"TR"|"TH"|"TD"|"LINK"| + "IMG"|"OBJECT"|"PARAM"|"APPLET"|"MAP"|"AREA"|"STYLE"| + "TT"|"BIG"|"SMALL"|"STRIKE"|"U"|"FONT"| + "HTML"|"HEAD"|"META"|"BODY"| + "BASEFONT"|"HR"|"FRAMESET"|"FRAME"|"NOFRAMES"|"IFRAME"| + "FORM"|"INPUT"|"BUTTON"|"SELECT"|"OPTGROUP"|"OPTION"| + "TEXTAREA"|"ISINDEX"|"LABEL"|"FIELDSET"|"LEGEND"| + "SCRIPT"|"NOSCRIPT"|"P"|"B"|"LI"|"A"|"BASE"|"I"|"S") end # @@ -1377,11 +1377,11 @@ procedure dehtml(line) while line[1(x<-find(" ", line), notquote(line[1:x])) +: 6] := "" line ? { while rv ||:= tab(find("<")) do { - if notquote(line[1:&pos]) then { - tmps := move(1) - tmps ||:= ="/" - if tag := =(htmltags() | map(htmltags())) then { - if (attrs := tab(find(">")) & notquote(line[1:&pos])) then { + if notquote(line[1:&pos]) then { + tmps := move(1) + tmps ||:= ="/" + if tag := =(htmltags() | map(htmltags())) then { + if (attrs := tab(find(">")) & notquote(line[1:&pos])) then { move(1) # throw away > attrs ? { if tab(find("idol=")+5) then { @@ -1389,17 +1389,17 @@ procedure dehtml(line) else rv ||:= " " || tab(upto(white)|0) || " " } } - } - else { - rv ||:= tmps - rv ||:= tag - } - } - else { - rv ||:= tmps # not a tag, move on - } - } - else rv ||:= move(1) + } + else { + rv ||:= tmps + rv ||:= tag + } + } + else { + rv ||:= tmps # not a tag, move on + } + } + else rv ||:= move(1) } rv ||:= tab(0) } diff --git a/uni/unicon/lump.icn b/uni/unicon/lump.icn index 8a71e8efa..09773f40b 100644 --- a/uni/unicon/lump.icn +++ b/uni/unicon/lump.icn @@ -1,12 +1,12 @@ ############################################################################ # -# Name: lump.icn +# Name: lump.icn # -# Title: Lump separately-compiled Icon sources +# Title: Lump separately-compiled Icon sources # -# Author: Clinton L. Jeffery +# Author: Clinton L. Jeffery # -# Date: September 8, 1990 +# Date: September 8, 1990 # ############################################################################ # @@ -22,20 +22,20 @@ procedure main(args) fout := open("LUMP.icn","w") | stop("can't open LUMP") if *args=0 then lump(&input) else { - every i := 1 to *args do { - fin := open(args[i],"r") | stop("can't open ",args[i]) - lump(fin) - close(fin) - } + every i := 1 to *args do { + fin := open(args[i],"r") | stop("can't open ",args[i]) + lump(fin) + close(fin) + } } close(fout) end procedure lump(f) every line := !f do { - if match("link",line) then { - source(line[5:0]) - } else write(fout,line) + if match("link",line) then { + source(line[5:0]) + } else write(fout,line) } end diff --git a/uni/unicon/merr.icn b/uni/unicon/merr.icn index 6dc109024..e1de43218 100644 --- a/uni/unicon/merr.icn +++ b/uni/unicon/merr.icn @@ -1,15 +1,15 @@ # -# merr.icn 2.0 alpha, an error message generator program. +# merr.icn 2.0 alpha, an error message generator program. # -# Clinton Jeffery, jeffery@cs.uidaho.edu -# Sudarshan Gaikaiwari, sudarshan@acm.org +# Clinton Jeffery, jeffery@cs.uidaho.edu +# Sudarshan Gaikaiwari, sudarshan@acm.org # -# 1/22/2006 +# 1/22/2006 # -# Maintains the mapping from parse states to error messages. -# See http://unicon.org/merr/ +# Maintains the mapping from parse states to error messages. +# See http://unicon.org/merr/ # -# To do: add a command line option for an alternative message format. +# To do: add a command line option for an alternative message format. # global C, att, bison, byacc, make, compile, ofile, target, yyfn, yyln, yytxt @@ -23,7 +23,7 @@ procedure main(argv) if *argv=0 then stop("usage: merr [-yYBG] [-W writefn] [-F filenm] [-s make] [-o msgfl]", - "compiler [target] [-N MaxIterations] [-phase1] [-phase2] ") + "compiler [target] [-N MaxIterations] [-phase1] [-phase2] ") ofile := "yyerror.icn" yamfile := "meta.err" yyfn := "yyfilename" @@ -33,49 +33,49 @@ procedure main(argv) inclfile := "y.tab.h" i := 1 while i <= *argv do { - case argv[i] of { - "-u": { update := [] } - "-y": { C := byacc := 1 } - "-Y": { C := att := "yy_state" } - "-B": { C := bison := "yystate" } - "-W": { i +:= 1; yywritefn := argv[i] } - "-F": { i +:= 1; yyfn := argv[i] } - "--F": { i +:= 1; yyfn := &null } - "-s": { i +:= 1; make := argv[i] } - "-o": { i +:= 1; ofile := argv[i] } - "-C": { i +:= 1; calloc := argv[i] } - # - # -H is where to read token info from in phase 1, while - # -I is what file to write an include for within yyerror.h - # - "-H": { i +:= 1; ytabh := argv[i] } - "-I": { i +:= 1; inclfile := argv[i] } - "--F": { i +:= 1; yyfn := &null } - "-F": { i +:= 1; yyfn := argv[i] } - "-W": { i +:= 1; yywritefn := argv[i] } - "-L": { i +:= 1; yyln := argv[i] } - "-T": { i +:= 1; yytxt := argv[i] } - "-o": { i +:= 1; ofile := argv[i] } - "-G": { genfrag := 1 } - "-N": { i +:= 1; maxiter := argv[i]; write(maxiter) } - "-phase1":{phase := 1} - "-phase2":{phase := 2} - default: { - if /compile := argv[i] then { - if \C then target := "m_err.c" else target := "m_err.icn" - } - else { - target := argv[i] - } - } - } - i+:= 1 + case argv[i] of { + "-u": { update := [] } + "-y": { C := byacc := 1 } + "-Y": { C := att := "yy_state" } + "-B": { C := bison := "yystate" } + "-W": { i +:= 1; yywritefn := argv[i] } + "-F": { i +:= 1; yyfn := argv[i] } + "--F": { i +:= 1; yyfn := &null } + "-s": { i +:= 1; make := argv[i] } + "-o": { i +:= 1; ofile := argv[i] } + "-C": { i +:= 1; calloc := argv[i] } + # + # -H is where to read token info from in phase 1, while + # -I is what file to write an include for within yyerror.h + # + "-H": { i +:= 1; ytabh := argv[i] } + "-I": { i +:= 1; inclfile := argv[i] } + "--F": { i +:= 1; yyfn := &null } + "-F": { i +:= 1; yyfn := argv[i] } + "-W": { i +:= 1; yywritefn := argv[i] } + "-L": { i +:= 1; yyln := argv[i] } + "-T": { i +:= 1; yytxt := argv[i] } + "-o": { i +:= 1; ofile := argv[i] } + "-G": { genfrag := 1 } + "-N": { i +:= 1; maxiter := argv[i]; write(maxiter) } + "-phase1":{phase := 1} + "-phase2":{phase := 2} + default: { + if /compile := argv[i] then { + if \C then target := "m_err.c" else target := "m_err.icn" + } + else { + target := argv[i] + } + } + } + i+:= 1 } if \update then { if \C then stop("update only supported on Unicon, so far") if fin := open(ofile) then { - while put(update, read(fin)) - } + while put(update, read(fin)) + } else stop("merr update: can't open ", image(ofile), " for reading") } if (\genfrag = 1) | \phase=1 then { @@ -99,143 +99,143 @@ $endif fin := open(yamfile) | stop("no ", yamfile) # skip down to a %% if there is one; otherwise reset to beginning while line := read(fin) do { - if line == "%%" then break + if line == "%%" then break } if line ~=== "%%" then { - close(fin) - fin := open(yamfile) | stop("can't reopen ", yamfile) + close(fin) + fin := open(yamfile) | stop("can't reopen ", yamfile) } while line := read(fin) do { - prog := [] - while not (i := find(":::",line)) do { - put(prog,line) - line := read(fin) | break break - } - if i>1 then put(prog,line[1:i]) - msg := line[i+3:0] - msg ?:= (tab(many(' \t')), tab(0)) - write(msg) - generr(t, prog, msg) - } + prog := [] + while not (i := find(":::",line)) do { + put(prog,line) + line := read(fin) | break break + } + if i>1 then put(prog,line[1:i]) + msg := line[i+3:0] + msg ?:= (tab(many(' \t')), tab(0)) + write(msg) + generr(t, prog, msg) + } gen(t) } if \update then { if resultf := open(ofile) then { - result := [] - while put(result, read(resultf)) - close(resultf) - if not (resultf := open(ofile, "w")) then - stop("can't update/write ", image(ofile)) - while line := pop(update) do { - write(resultf, line) - if line == "initial {" then break - } - if line ~== "initial {" then - stop("can't update, initial ", image(ofile), " had no initial {") - line := &null - while line := pop(result) do { - if line == "initial {" then break - } - if line ~== "initial {" then - stop("can't update, result ", image(ofile), " had no initial {") - while line := pop(result) do { - write(resultf, line) - if line == " }" then break - } - if line ~== " }" then - stop("can't update, result ", image(ofile), " had no ending }") - line := &null - while line := pop(update) do { - if line == " }" then break - } - if line ~== " }" then - stop("can't update, initial ", image(ofile), " had no ending }") - line := &null - while line := pop(update) do write(resultf, line) - close(resultf) - write("updated ", image(ofile)) - } + result := [] + while put(result, read(resultf)) + close(resultf) + if not (resultf := open(ofile, "w")) then + stop("can't update/write ", image(ofile)) + while line := pop(update) do { + write(resultf, line) + if line == "initial {" then break + } + if line ~== "initial {" then + stop("can't update, initial ", image(ofile), " had no initial {") + line := &null + while line := pop(result) do { + if line == "initial {" then break + } + if line ~== "initial {" then + stop("can't update, result ", image(ofile), " had no initial {") + while line := pop(result) do { + write(resultf, line) + if line == " }" then break + } + if line ~== " }" then + stop("can't update, result ", image(ofile), " had no ending }") + line := &null + while line := pop(update) do { + if line == " }" then break + } + if line ~== " }" then + stop("can't update, initial ", image(ofile), " had no ending }") + line := &null + while line := pop(update) do write(resultf, line) + close(resultf) + write("updated ", image(ofile)) + } } end procedure gen(t) f := open(ofile, "w") | stop("can't write ", image(ofile)) if \C then { - if /byacc then { - if find("/", ofile) then { - every i := find("/", ofile) - f2 := open(ofile[1:i+1] || "yyerror.h", "w") - } - else - f2 := open("yyerror.h", "w") - write(f2, "extern int _yyerror(char *, int);") - write(f2, "#define yyerror(s) _yyerror(s, ", \att | bison, ")") - close(f2) - } - maxstate := -1 - every maxstate <:= key(\t) - write(f,"#include \n") - write(f,"int yyerror_isinitialized, yymaxstate = ",maxstate,";") - write(f,"struct errtable {\n", - " int i;\n", - " union {\n", - " char *msg;\n", - " struct errtable *p;\n", - " } u;\n", - " } errtab[", if maxstate<0 then 1 else maxstate+1, "];") - - write(f, "void yyerror_init()\n{") - - every k := key(\t) do { - write(f, " errtab[",k,"].i = ", *t[k], ";") - if *t[k] > 1 then { - write(f, " errtab[",k,"].u.p = (struct errtable *)",calloc, - "(1,",*t[k]+1," * sizeof(struct errtable));") - write(f, " errtab[",k,"].u.p[0].u.msg = ", - image(t[k,10000000000]),";") - j := 1 - every k2 := key(t[k]) do { - write(f, " errtab[", k, "].u.p[", j, "].i = ", k2, ";") - write(f, " errtab[", k, "].u.p[", j, "].u.msg = ", - image(t[k,k2]), ";") - j +:= 1 - } - } - else - write(f," errtab[",k,"].u.msg = ",image(t[k,10000000000]), - ";") - } + if /byacc then { + if find("/", ofile) then { + every i := find("/", ofile) + f2 := open(ofile[1:i+1] || "yyerror.h", "w") + } + else + f2 := open("yyerror.h", "w") + write(f2, "extern int _yyerror(char *, int);") + write(f2, "#define yyerror(s) _yyerror(s, ", \att | bison, ")") + close(f2) + } + maxstate := -1 + every maxstate <:= key(\t) + write(f,"#include \n") + write(f,"int yyerror_isinitialized, yymaxstate = ",maxstate,";") + write(f,"struct errtable {\n", + " int i;\n", + " union {\n", + " char *msg;\n", + " struct errtable *p;\n", + " } u;\n", + " } errtab[", if maxstate<0 then 1 else maxstate+1, "];") + + write(f, "void yyerror_init()\n{") + + every k := key(\t) do { + write(f, " errtab[",k,"].i = ", *t[k], ";") + if *t[k] > 1 then { + write(f, " errtab[",k,"].u.p = (struct errtable *)",calloc, + "(1,",*t[k]+1," * sizeof(struct errtable));") + write(f, " errtab[",k,"].u.p[0].u.msg = ", + image(t[k,10000000000]),";") + j := 1 + every k2 := key(t[k]) do { + write(f, " errtab[", k, "].u.p[", j, "].i = ", k2, ";") + write(f, " errtab[", k, "].u.p[", j, "].u.msg = ", + image(t[k,k2]), ";") + j +:= 1 + } + } + else + write(f," errtab[",k,"].u.msg = ",image(t[k,10000000000]), + ";") + } write(f, "}\n") write(f,"int __merr_errors;\nextern int yychar;") if find("yylval", yyln) then - write(f, "#include \"",inclfile,"\"") + write(f, "#include \"",inclfile,"\"") else - write(f,"extern int ",yyln,";\n") + write(f,"extern int ",yyln,";\n") if \yyfn=="yyfilename" then write(f,"extern char *yyfilename;\n") # Berkeley and/or AT&T probably need extern char yytext[]; need to check if yytxt=="yytext" then write(f,"extern char *yytext;\n") if \byacc then write(f, "extern short *yyssp;\n\n", - "int yyerror(char *s)\n{\n int state = *yyssp;") + "int yyerror(char *s)\n{\n int state = *yyssp;") else write(f, "int _yyerror(char *s, int state)\n{") write(f, " int i;\n", - " char sbuf[128];") + " char sbuf[128];") write(f, " if (! yyerror_isinitialized++) yyerror_init();\n", " if (strstr(s, \"stack\")) return 0;") write(f, " if (__merr_errors++ > 10) {\n", - " ", yywritefn, - "(stderr, \"too many errors, aborting\");\n", - " exit(__merr_errors); }") + " ", yywritefn, + "(stderr, \"too many errors, aborting\");\n", + " exit(__merr_errors); }") write(f, " if (",\yyfn,") ",yywritefn,"(stderr, \"%s:\", ",\yyfn,");") write(f, " if ((!strcmp(s, \"syntax error\") || ", - "!strcmp(s,\"parse error\"))&&") + "!strcmp(s,\"parse error\"))&&") write(f," (state>=0 && state<=yymaxstate)) {") write(f," if (errtab[state].i==1)") write(f, " s = errtab[state].u.msg;") @@ -249,28 +249,28 @@ procedure gen(t) write(f," }") write(f, " if (!strcmp(s, \"syntax error\") || ", - "!strcmp(s,\"parse error\")){") + "!strcmp(s,\"parse error\")){") write(f, " sprintf(sbuf,\"%s (%d;%d)\", s, state, yychar);") write(f, " s=sbuf;\n }") write(f, " ",yywritefn,"(stderr, \"%d: # \\\"%s\\\": %s\\n\", ", - yyln,", ",yytxt,", s);") + yyln,", ",yytxt,", s);") write(f, " return 0;") write(f, "}") } else { write(f,"procedure yyerror(s)\n", - "static t, __merr_errors\n", - "initial {\n", - " t := table(table(\"syntax error\"))") + "static t, __merr_errors\n", + "initial {\n", + " t := table(table(\"syntax error\"))") every k := key(\t) do { - if *t[k] > 1 then { - write(f, " t[",k,"] := table(",image(t[k,10000000000]),")") - every k2 := key(t[k]) do { - write(f, " t[", k, ",", k2, "] := ", image(t[k,k2])) - } - } - else - write(f," t[",k,"] := table(",image(t[k,10000000000]),")") + if *t[k] > 1 then { + write(f, " t[",k,"] := table(",image(t[k,10000000000]),")") + every k2 := key(t[k]) do { + write(f, " t[", k, ",", k2, "] := ", image(t[k,k2])) + } + } + else + write(f," t[",k,"] := table(",image(t[k,10000000000]),")") } write(f, " __merr_errors := 0") write(f, " }\n") @@ -282,7 +282,7 @@ procedure gen(t) write(f, " if __merr_errors = 0 then ",yywritefn,"(&errout)") write(f, " else if map(s)== \"stack underflow. aborting...\" ", - "then return") + "then return") write(f, " __merr_errors +:= 1") write(f, " if __merr_errors > 10 then") write(f, " ",yywritefn,"(\"too many errors, aborting\") & stop()") @@ -290,10 +290,10 @@ procedure gen(t) write(f, " s := t[(\\statestk)[1], yychar]") write(f, " if s == \"syntax error\" then {") write(f, " s ||:= \" (\" || (\\statestk)[1] ||\";\"|| ", - "yychar || \")\"") + "yychar || \")\"") write(f, " }") write(f, " ",yywritefn,"(&errout, (\\yyfilename|\"lambda.icn\"), \":\",",yyln, - ", \": # \\\"\", yytext, \"\\\": \", s)") + ", \": # \\\"\", yytext, \"\\\": \", s)") write(f, " return") write(f, "end") } @@ -309,7 +309,7 @@ procedure generr(t, prog, msg) efile := \target | "err.icn" f := open(efile,"w") | stop("can't open ", image(efile)) - every write(f, !prog) + every write(f, !prog) close(f) $ifdef _MS_WINDOWS_NT system("command /C type " || target) @@ -329,27 +329,27 @@ $endif f := open("err.out") | stop("can't open err.out") while ((line := read(f)) & - (not (line ? (tab(find("(")+1), tab(many(&digits)), - =";", tab(many(&digits)), =")")))) + (not (line ? (tab(find("(")+1), tab(many(&digits)), + =";", tab(many(&digits)), =")")))) if (not (\line ? (tab(find("(")+1), tab(many(&digits)), - =";", tab(many(&digits)), =")"))) then { + =";", tab(many(&digits)), =")"))) then { write("having trouble looking for line in ", image(&subject)) - close(f) - fail - } + close(f) + fail + } line2 := line while line ?:= (tab(find(":")+1) & tab(0)) if *trim(line) = 0 then stop("bad line ", image(line)) line ? { - tab(find("(")+1) | { unknownstate(line2); fail } - state := integer(tab(many(&digits))) | { - unknownstate(line2); fail } - =";" - token := integer(tab(many(&digits))) | { - unknownstate(line2); fail } - =")" + tab(find("(")+1) | { unknownstate(line2); fail } + state := integer(tab(many(&digits))) | { + unknownstate(line2); fail } + =";" + token := integer(tab(many(&digits))) | { + unknownstate(line2); fail } + =")" } close(f) @@ -390,17 +390,17 @@ local tabhs if phase = 1 then { if \C then { if \bison then { - tabhs := [] - dir := open(".") - while dirn := read(dir) do - if dirn[-6:0] == ".tab.h" then put(tabhs, dirn) - if *tabhs > 1 then { - write("merr: not sure which .tab.h to use out of:\n\t") - every writes(!tabhs, " ") - stop("... aborting.") - } - else if (*tabhs = 0) & /ytabh then stop("merr: no .tab.h for phase1") - /ytabh := tabhs[1] + tabhs := [] + dir := open(".") + while dirn := read(dir) do + if dirn[-6:0] == ".tab.h" then put(tabhs, dirn) + if *tabhs > 1 then { + write("merr: not sure which .tab.h to use out of:\n\t") + every writes(!tabhs, " ") + stop("... aborting.") + } + else if (*tabhs = 0) & /ytabh then stop("merr: no .tab.h for phase1") + /ytabh := tabhs[1] } /ytabh := "y.tab.h" } @@ -412,11 +412,11 @@ if phase = 1 then { identchars := &letters++&digits++'_' while line := read(f) do { line ? { - if tab(any('#$')) & ((tab(many(' \t'))|"")\1) & - ="define " & (tok:=tab(many(identchars))) then { - write(f2, tok, " = ",map(tok)) + if tab(any('#$')) & ((tab(many(' \t'))|"")\1) & + ="define " & (tok:=tab(many(identchars))) then { + write(f2, tok, " = ",map(tok)) } - } + } } close(f) close(f2) @@ -428,16 +428,16 @@ else if phase = 2 then { stop("# Merr2 token samples expected") L := [] while line := read(f) do { -# write(line) - line ? { - # write("size " || *line) - if ="%%" then break - if tab(find("= ")+2) & &pos <= *&subject then - { - # write(&pos || " " || tab(0)) - put(L, tab(0)) - } - } +# write(line) + line ? { + # write("size " || *line) + if ="%%" then break + if tab(find("= ")+2) & &pos <= *&subject then + { + # write(&pos || " " || tab(0)) + put(L, tab(0)) + } + } } # write ("**************Test********************") # every write(generrs(L,1)) @@ -448,15 +448,15 @@ else if phase = 2 then { foundsome := 0 iteration := 1 repeat { - curfoundsome := foundsome - write(repl("*",69)) - generate_errs(L, iteration) - legalprefixes := newlegalprefixes + curfoundsome := foundsome + write(repl("*",69)) + generate_errs(L, iteration) + legalprefixes := newlegalprefixes write("iteration ", iteration, " complete, found ", foundsome, - " prefixes ", *legalprefixes) - write(repl("*",69)) - iteration +:= 1 - if \maxiter & maxiter < iteration then break + " prefixes ", *legalprefixes) + write(repl("*",69)) + iteration +:= 1 + if \maxiter & maxiter < iteration then break if foundsome = curfoundsome & iteration > 2 then break } } @@ -479,45 +479,45 @@ initial statesserved := set() f3 := open("err.foo") Lmsgs := [] while(msgline := read(f3)) do { - write(msgline) - put(Lmsgs, msgline) + write(msgline) + put(Lmsgs, msgline) } close(f3) # smg to modify if find("unexpected end of file"|"No errors"|" \"\":", msgline) then { - write("Legal Prefix : " || msgline) - addprefix(newlegalprefixes, err, msgline) + write("Legal Prefix : " || msgline) + addprefix(newlegalprefixes, err, msgline) } else if i = 1 then { - write(err, " not deemed a legal prefix:") - every write("\t", !Lmsgs) + write(err, " not deemed a legal prefix:") + every write("\t", !Lmsgs) } if find("syntax error", msgline) then { - msgline ? { - tab(find("syntax error")) - ="syntax error" - if =" (" & stt := integer(tab(many(&digits))) then { - if not member(statesserved, stt) then { - insert(statesserved, stt) - every write(!Lmsgs) - write("Found error ", err , "In state ", image(stt)) - f2 := open("meta.err2", "a") - write(f2, err) - write(f2, "::: syntax error") - close(f2) - foundsome +:= 1 - } - } - } - } - } + msgline ? { + tab(find("syntax error")) + ="syntax error" + if =" (" & stt := integer(tab(many(&digits))) then { + if not member(statesserved, stt) then { + insert(statesserved, stt) + every write(!Lmsgs) + write("Found error ", err , "In state ", image(stt)) + f2 := open("meta.err2", "a") + write(f2, err) + write(f2, "::: syntax error") + close(f2) + foundsome +:= 1 + } + } + } + } + } end procedure addprefix(newlegalprefixes, err, msg) msg ? { - tab(find("(") + 1) & stt := integer(tab(many(&digits))) - write("In state : ", stt, "Legal prefix = ", err ); + tab(find("(") + 1) & stt := integer(tab(many(&digits))) + write("In state : ", stt, "Legal prefix = ", err ); } if newlegalprefixes[stt] == 0 then { newlegalprefixes[stt] := err diff --git a/uni/unicon/meta.err b/uni/unicon/meta.err index 5b72e7eb9..3a5ed7413 100644 --- a/uni/unicon/meta.err +++ b/uni/unicon/meta.err @@ -154,7 +154,7 @@ hello end ::: unclosed parenthesis procedure main(); { - | x) + | x) } end ::: missing operator or unbalanced parenthesis/bracket @@ -170,14 +170,14 @@ end procedure main() case x of { y: - f(); g() + f(); g() } end ::: malformed case expression procedure main() case x of { case y: - f() + f() } end ::: missing "of" in case expression @@ -277,7 +277,7 @@ procedure a(); static c end procedure a(); initial {} end ::: missing semi-colon or operator procedure action_12() -yyval := +yyval := end ::: Assignment is missing right operand value. procedure main() diff --git a/uni/unicon/preproce.icn b/uni/unicon/preproce.icn index f38e54575..6cf7dfc70 100644 --- a/uni/unicon/preproce.icn +++ b/uni/unicon/preproce.icn @@ -10,7 +10,7 @@ # fname - the filename to preprocess # # predefined_syms - (optional) a table of symbols & definitions to -# serve as preprocessor "predefined" symbols +# serve as preprocessor "predefined" symbols # # This preprocessor comes to Unicon courtesy of Bob Alexander, its author. @@ -32,61 +32,61 @@ procedure predefs() # reverse engineer the predefined symbols list from our predefined symbols t["_V9"] := 1 - if comp === -1 then - t["_NOLINK"] := 1 - else - t["_LINK"] := 1 + if comp === -1 then + t["_NOLINK"] := 1 + else + t["_LINK"] := 1 every s := &features do { - t[case s of { + t[case s of { # _CMS # gone - "CMS": "_CMS" - "MacOS":"_MACOS" - "MS Windows NT":"_MS_WINDOWS_NT" - "MS-DOS":"_MSDOS" - "MVS":"_MVS" -# _PORT # in use - "PORT":"_PORT" - "UNIX":"_UNIX" - "Solaris":"_SOLARIS" - "POSIX":"_POSIX" - "DBM":"_DBM" - "VMS":"_VMS" - "ASCII":"_ASCII" - "EBCDIC":"_EBCDIC" - "co-expressions":"_CO_EXPRESSIONS" - "native coswitch":"_NATIVECOSWITCH" - "concurrent threads":"_CONCURRENT" + "CMS": "_CMS" + "MacOS":"_MACOS" + "MS Windows NT":"_MS_WINDOWS_NT" + "MS-DOS":"_MSDOS" + "MVS":"_MVS" +# _PORT # in use + "PORT":"_PORT" + "UNIX":"_UNIX" + "Solaris":"_SOLARIS" + "POSIX":"_POSIX" + "DBM":"_DBM" + "VMS":"_VMS" + "ASCII":"_ASCII" + "EBCDIC":"_EBCDIC" + "co-expressions":"_CO_EXPRESSIONS" + "native coswitch":"_NATIVECOSWITCH" + "concurrent threads":"_CONCURRENT" "concurrent threads, compiler subset":"_CONCURRENT" - "console window":"_CONSOLE_WINDOW" - "dynamic loading":"_DYNAMIC_LOADING" + "console window":"_CONSOLE_WINDOW" + "dynamic loading":"_DYNAMIC_LOADING" # "" environment variables - "event monitoring":"_EVENT_MONITOR" - "external functions":"_EXTERNAL_FUNCTIONS" - "keyboard functions":"_KEYBOARD_FUNCTIONS" - "large integers":"_LARGE_INTEGERS" - "multiple programs":"_MULTITASKING" - "pattern type":"_PATTERNS" - "pipes":"_PIPES" - "pseudo terminals":"_PTY" - "system function":"_SYSTEM_FUNCTION" - "messaging":"_MESSAGING" - "graphics":"_GRAPHICS" - "3D graphics":"_3D_GRAPHICS" - "X Windows":"_X_WINDOW_SYSTEM" - "MS Windows":"_MS_WINDOWS" - "Win32":"_WIN32" - "MS-DOS extensions":"_DOS_FUNCTIONS" - "libz file compression":"_LIBZ_COMPRESSION" - "JPEG images":"_JPEG" - "PNG images":"_PNG" - "SQL via ODBC":"_SQL" - "secure sockets layer encryption":"_SSL" - "Audio":"_AUDIO" - "Voice Over IP":"_VOIP" - "operator overloading":"_OVLD" - "developer mode":"_DEVMODE" - }] := "1" + "event monitoring":"_EVENT_MONITOR" + "external functions":"_EXTERNAL_FUNCTIONS" + "keyboard functions":"_KEYBOARD_FUNCTIONS" + "large integers":"_LARGE_INTEGERS" + "multiple programs":"_MULTITASKING" + "pattern type":"_PATTERNS" + "pipes":"_PIPES" + "pseudo terminals":"_PTY" + "system function":"_SYSTEM_FUNCTION" + "messaging":"_MESSAGING" + "graphics":"_GRAPHICS" + "3D graphics":"_3D_GRAPHICS" + "X Windows":"_X_WINDOW_SYSTEM" + "MS Windows":"_MS_WINDOWS" + "Win32":"_WIN32" + "MS-DOS extensions":"_DOS_FUNCTIONS" + "libz file compression":"_LIBZ_COMPRESSION" + "JPEG images":"_JPEG" + "PNG images":"_PNG" + "SQL via ODBC":"_SQL" + "secure sockets layer encryption":"_SSL" + "Audio":"_AUDIO" + "Voice Over IP":"_VOIP" + "operator overloading":"_OVLD" + "developer mode":"_DEVMODE" + }] := "1" } # there is no predefn for "environment variables" feature @@ -125,12 +125,12 @@ procedure preprocessor(fname,predefined_syms) } preproc_new(fname,predefined_syms) - + while line := preproc_read() do line ? { preproc_space() if (preproc_dollar_or_pound := ="#") & - tmppos := &pos & ="line" & tab(any(' \t')) then { - &pos := tmppos + tmppos := &pos & ="line" & tab(any(' \t')) then { + &pos := tmppos suspend preproc_scan_directive() } if (preproc_dollar_or_pound := ="$") & any(nonpunctuation) then { @@ -158,11 +158,11 @@ procedure preproc_new(fname,predefined_syms) } else { if fname == "_stdin.icn" then - preproc_file := &input + preproc_file := &input else # Normal file execution preproc_file := open(fname) | - stop(&progname, ": cannot open ", image(fname)) + stop(&progname, ": cannot open ", image(fname)) preproc_include_set := set([fname]) preproc_filename := preproc_include_name := fname @@ -199,27 +199,27 @@ procedure preproc_scan_directive() preproc_command := preproc_word() if \preproc_if_state then { if match("if",preproc_command) then { - preproc_command := "$if" - } + preproc_command := "$if" + } } preproc_space() case preproc_command of { "define": { - if /preproc_if_state then { - if sym := preproc_word() then { - if value := preproc_scan_define_value() then { - if \(old := preproc_sym_table[sym]) ~=== value then { - preproc_error("redefinition of " || sym || " = " || - old) - } - else { - preproc_sym_table[sym] := value - } - } + if /preproc_if_state then { + if sym := preproc_word() then { + if value := preproc_scan_define_value() then { + if \(old := preproc_sym_table[sym]) ~=== value then { + preproc_error("redefinition of " || sym || " = " || + old) + } + else { + preproc_sym_table[sym] := value + } + } + } + else { + preproc_error() } - else { - preproc_error() - } } } "undef": { @@ -324,13 +324,13 @@ procedure preproc_scan_directive() preproc_filename := \new_filename preproc_line := new_line } else { - if \preproc_dollar_or_pound == "$" then { - if /new_line then - preproc_error("$line: expected a line number.") - else preproc_error("$line: expected only \"file\" after line number.") - } - else # it was just a comment beginning with #line - tab(find("\n") | 0) + if \preproc_dollar_or_pound == "$" then { + if /new_line then + preproc_error("$line: expected a line number.") + else preproc_error("$line: expected only \"file\" after line number.") + } + else # it was just a comment beginning with #line + tab(find("\n") | 0) } #} } @@ -350,20 +350,20 @@ procedure preproc_scan_directive() } } } - "C":{ + "C":{ if /preproc_if_state then { cincludes := "" - while line := preproc_read() do { - if match("$Cend", line) then {Cend := "yes"; break} - cincludes ||:= line - } - if /Cend then { - preproc_error("unfinished C code block") - } - stub := CIncludesParser(cincludes) - # write("------ stub ------"); write(stub); write(repl("-",19)) - return stub - } + while line := preproc_read() do { + if match("$Cend", line) then {Cend := "yes"; break} + cincludes ||:= line + } + if /Cend then { + preproc_error("unfinished C code block") + } + stub := CIncludesParser(cincludes) + # write("------ stub ------"); write(stub); write(repl("-",19)) + return stub + } } default: { if /preproc_if_state then { @@ -399,12 +399,12 @@ procedure preproc_scan_text(done_set) while tab(upto(interesting_in_quotes)) do { case move(1) of { "\\": { - # backslash can eat multiple chars; - # may need more than this - case move(1) of { - "^": move(1) - } - } + # backslash can eat multiple chars; + # may need more than this + case move(1) of { + "^": move(1) + } + } default: { break break } @@ -467,13 +467,13 @@ procedure preproc_read() local result until result := preproc_read_result() do { if *preproc_if_stack ~= preproc_nest_level then { - preproc_error("$if(s) without $endif(s): " || - *preproc_if_stack - preproc_nest_level) - until *preproc_if_stack <= preproc_nest_level do - preproc_if_state := pop(preproc_if_stack) - } + preproc_error("$if(s) without $endif(s): " || + *preproc_if_stack - preproc_nest_level) + until *preproc_if_stack <= preproc_nest_level do + preproc_if_state := pop(preproc_if_stack) + } if type(preproc_file) ~== "list" & preproc_file ~=== &input then - close(preproc_file) + close(preproc_file) delete(preproc_include_set,preproc_include_name) (preproc_nest_level := pop(preproc_file_stack) & preproc_line := pop(preproc_file_stack) & @@ -547,7 +547,7 @@ procedure preproc_scan_define_value() } } } - preproc_error("unterminated string in $define") + preproc_error("unterminated string in $define") fail # end of line inside quotes!! } } diff --git a/uni/unicon/tree.icn b/uni/unicon/tree.icn index 819d6e62f..82abdd14a 100644 --- a/uni/unicon/tree.icn +++ b/uni/unicon/tree.icn @@ -19,20 +19,20 @@ global thePackage procedure yyvarlists(node) case type(node) of { "treenode" : { - if node.label == "varlist2" then { + if node.label == "varlist2" then { yyprint("\n") - every yyprint(node.children[1 to 3]) - } - else if node.label == "varlist4" then { + every yyprint(node.children[1 to 3]) + } + else if node.label == "varlist4" then { yyvarlists(node.children[1]) yyprint("\n") - every yyprint(node.children[3 to 5]) - } - else if *node.children > 0 then { + every yyprint(node.children[3 to 5]) + } + else if *node.children > 0 then { every yyvarlists(!node.children) - } - else if node.label === "error" then fail - else write("leaf, ", node.label) + } + else if node.label === "error" then fail + else write("leaf, ", node.label) } } end @@ -40,10 +40,10 @@ end procedure exists_statlists(node) case type(node) of { "treenode" : { - if node.label == ("stalist2"|"stalist4") then return - else if *node.children > 0 then { + if node.label == ("stalist2"|"stalist4") then return + else if *node.children > 0 then { return exists_statlists(!node.children) - } + } } } end @@ -51,20 +51,20 @@ end procedure yystalists(node) case type(node) of { "treenode" : { - if node.label == "stalist2" then { + if node.label == "stalist2" then { yyprint("\n") - every yyprint(node.children[1 to 3]) - } - else if node.label == "stalist4" then { + every yyprint(node.children[1 to 3]) + } + else if node.label == "stalist4" then { yystalists(node.children[1]) yyprint("\n") - every yyprint(node.children[3 to 5]) - } - else if *node.children > 0 then { + every yyprint(node.children[3 to 5]) + } + else if *node.children > 0 then { every yystalists(!node.children) - } - else if node.label === "error" then fail - else write("leaf, ", node.label) + } + else if node.label === "error" then fail + else write("leaf, ", node.label) } } end @@ -79,19 +79,19 @@ procedure writes_faux_for_uneval(L, brackets) writes(yyout,brackets[1]) every temp := L[i:=1 to *L] do { if type(temp) == "list" then { - writes(yyout,";") - writes_faux_for_uneval(temp, "") - } + writes(yyout,";") + writes_faux_for_uneval(temp, "") + } else { - if i = 1 then { - writes(yyout, temp, "(") - every j := 2 to *L do { - if j>2 then writes(yyout,",") - writes(yyout,"(0|0.0|\"\"|''|&input)") - } - writes(yyout,")") - } - } + if i = 1 then { + writes(yyout, temp, "(") + every j := 2 to *L do { + if j>2 then writes(yyout,",") + writes(yyout,"(0|0.0|\"\"|''|&input)") + } + writes(yyout,")") + } + } } writes(yyout,brackets[2]) end @@ -101,19 +101,19 @@ local i writes(yyout, "[") every temp := L[i := 1 to *L] do { if type(temp) == "list" then { - writes_code_for_uneval(temp) - } + writes_code_for_uneval(temp) + } else { - writes(yyout, image(temp)) - if i = 1 then { - /list_of_invocables := [] - if not (!list_of_invocables == temp) then - put(list_of_invocables, temp) - } - if i < *L then { - writes(yyout, ", ") - } - } + writes(yyout, image(temp)) + if i = 1 then { + /list_of_invocables := [] + if not (!list_of_invocables == temp) then + put(list_of_invocables, temp) + } + if i < *L then { + writes(yyout, ", ") + } + } } writes(yyout, "]") return @@ -123,14 +123,14 @@ procedure make_list_for_uneval(L, word) while tab(upto(word)) do { temp := tab(many(word)) if proc(temp) | move(1) === "." then { - L1 := [] - put(L1, temp) - L1 := make_list_for_uneval(L1, word) - put(L, L1) - } + L1 := [] + put(L1, temp) + L1 := make_list_for_uneval(L1, word) + put(L, L1) + } else { - put(L, temp) - } + put(L, temp) + } } return L end @@ -181,44 +181,44 @@ end procedure process_uneval(node) emit_line_directive_if_needed(node) case type(node.s) of { - "string": { - if node.s[1:3] === "``" then { - node.s ? { - if find(".") & find ("(") then { - return emit_code_for_uneval("pattern_stringmethodcall") - } - else if find ("(") then { - return emit_code_for_uneval("pattern_stringfunccall") - } - else - yyerror("`` must enclose function call", node) - } - } - else { - node.s ? { - if find(".") & find ("(") then { - return emit_code_for_uneval("pattern_boolmethodcall") - } - else if find ("(") then { - return emit_code_for_uneval("pattern_boolfunccall") - } - else if find(".") then { - return emit_code_for_uneval("pattern_unevalvar") - } - else { - tab(upto(&letters++'_')) - temp := tab(many(&letters++'_'++&digits)) - # emit (x,pattern_unevalvar("x")) so that var x is declared - writes(yyout,"(",temp,",pattern_unevalvar( ") - writes(yyout, "\"", temp, "\"") - writes(yyout, "))") - return - } - } - } - } + "string": { + if node.s[1:3] === "``" then { + node.s ? { + if find(".") & find ("(") then { + return emit_code_for_uneval("pattern_stringmethodcall") + } + else if find ("(") then { + return emit_code_for_uneval("pattern_stringfunccall") + } + else + yyerror("`` must enclose function call", node) + } + } + else { + node.s ? { + if find(".") & find ("(") then { + return emit_code_for_uneval("pattern_boolmethodcall") + } + else if find ("(") then { + return emit_code_for_uneval("pattern_boolfunccall") + } + else if find(".") then { + return emit_code_for_uneval("pattern_unevalvar") + } + else { + tab(upto(&letters++'_')) + temp := tab(many(&letters++'_'++&digits)) + # emit (x,pattern_unevalvar("x")) so that var x is declared + writes(yyout,"(",temp,",pattern_unevalvar( ") + writes(yyout, "\"", temp, "\"") + writes(yyout, "))") + return + } + } + } + } default : - write("Error string expected but got ", type(node)) + write("Error string expected but got ", type(node)) } end @@ -229,312 +229,312 @@ end procedure emit_assign_code(node) case type(node) of { "treenode": { - if node.label == "BPuneval" then { - node := node.children[1] - if type(node) == "token" & node.s[1]==node.s[-1]=="`" then { - yyprint("\"" || node.s[2:-1] || "\"") - } - return - } - if node.label ~== "field" then { - # set yylineno before calling yyerror() to report a - # semantic error. - yylineno := leftmost_token(node).line - yyerror("In-pattern assignment must be to field, not a " || - image(node.label)) - return - } - if type(node.children[1]) ~== "token" then { - yyerror("Multiple references not supported") - return - } - writes(yyout,"[",node.children[1].s,",\"", - node.children[3].s,"\"]") - return - } + if node.label == "BPuneval" then { + node := node.children[1] + if type(node) == "token" & node.s[1]==node.s[-1]=="`" then { + yyprint("\"" || node.s[2:-1] || "\"") + } + return + } + if node.label ~== "field" then { + # set yylineno before calling yyerror() to report a + # semantic error. + yylineno := leftmost_token(node).line + yyerror("In-pattern assignment must be to field, not a " || + image(node.label)) + return + } + if type(node.children[1]) ~== "token" then { + yyerror("Multiple references not supported") + return + } + writes(yyout,"[",node.children[1].s,",\"", + node.children[3].s,"\"]") + return + } "token": { - node.s ? { - rec := tab(upto('.')) - if \rec then &pos +:= 1; # jump over the . - var := tab(0) - - # In order to print out with correct newline if needed, - # create a fake token with var as a string name. Might - # need to apply this technique to the treenode cases above. - faketok := copy(node) - faketok.tok := STRINGLIT - faketok.s := "\"" || var || "\"" - - if \rec then { - writes(yyout,"[",rec,",") - yyprint(faketok) - writes(yyout,"]") - } - else yyprint(faketok) - } - } + node.s ? { + rec := tab(upto('.')) + if \rec then &pos +:= 1; # jump over the . + var := tab(0) + + # In order to print out with correct newline if needed, + # create a fake token with var as a string name. Might + # need to apply this technique to the treenode cases above. + faketok := copy(node) + faketok.tok := STRINGLIT + faketok.s := "\"" || var || "\"" + + if \rec then { + writes(yyout,"[",rec,",") + yyprint(faketok) + writes(yyout,"]") + } + else yyprint(faketok) + } + } } end procedure yyprint(node) static lasttok local inode, lm - repeat # allows us to suppress tail recursion + repeat # allows us to suppress tail recursion case type(node) of { "treenode" : { - if node.label == "package" then { - # noop - fail - } - else if node.label == "import" then { - yyprint("\n") - print_imports(node.children[2]) - - inode := node.children[1] - if (outfilename ~== (inode.filename))|(outline > inode.line) then { - write(yyout,"\n#line ", inode.line-1," \"", inode.filename,"\"") - outline := inode.line - outcol := 1 - outfilename := inode.filename - } - else while outline < inode.line do { - write(yyout); outline +:= 1; outcol := 1 - } - - fail - } + if node.label == "package" then { + # noop + fail + } + else if node.label == "import" then { + yyprint("\n") + print_imports(node.children[2]) + + inode := node.children[1] + if (outfilename ~== (inode.filename))|(outline > inode.line) then { + write(yyout,"\n#line ", inode.line-1," \"", inode.filename,"\"") + outline := inode.line + outcol := 1 + outfilename := inode.filename + } + else while outline < inode.line do { + write(yyout); outline +:= 1; outcol := 1 + } + + fail + } else if node.label == "packageref" then { - if *node.children = 2 then - yyprint(node.children[2]) # ::ident - else { # ident :: ident - yyprint(node.children[1]) - writes(yyout, "__") - outcol +:= ((* writes(yyout, node.children[3].s)) + 2) - } - fail - } + if *node.children = 2 then + yyprint(node.children[2]) # ::ident + else { # ident :: ident + yyprint(node.children[1]) + writes(yyout, "__") + outcol +:= ((* writes(yyout, node.children[3].s)) + 2) + } + fail + } else if node.label == "global" then { - yyprint(node.children[1]) - node := node.children[2] - next - } + yyprint(node.children[1]) + node := node.children[2] + next + } else if node.label == "BPand" then { - iconc_fd := 1 + iconc_fd := 1 writes(yyout, " pattern_concat( ") - yyprint(node.children[1]) - writes(yyout, ",") - yyprint(node.children[3]) - writes(yyout, " ) ") + yyprint(node.children[1]) + writes(yyout, ",") + yyprint(node.children[3]) + writes(yyout, " ) ") fail - } + } else if node.label == "BPor" then { - iconc_fd := 1 - writes(yyout, " pattern_alternate( ") - yyprint(node.children[1]) - writes(yyout, ",") - yyprint(node.children[3]) - writes(yyout, " ) ") + iconc_fd := 1 + writes(yyout, " pattern_alternate( ") + yyprint(node.children[1]) + writes(yyout, ",") + yyprint(node.children[3]) + writes(yyout, " ) ") fail - } + } else if node.label == "BPmatch" then { - iconc_fd := 1 - - # Get the leftmost token. Use it to emit a #line directive if needed. - if lm := leftmost_token(node) then { - if outline ~=== lm.line then { - write(yyout,"\n#line ", lm.line-1," \"", lm.filename,"\"") - outline := lm.line - outcol := 1 - if lm.column > 1 then writes(yyout, repl(" ",lm.column-1)) - outfilename := lm.filename - } - } - else { - write(yyout, "\n# no leftmost lineno, line directive omitted") - } - - writes(yyout, "( \"\" ? pattern_match(") - yyprint(node.children[1]) - writes(yyout, ",") - yyprint(node.children[3]) - writes(yyout, ")) ") + iconc_fd := 1 + + # Get the leftmost token. Use it to emit a #line directive if needed. + if lm := leftmost_token(node) then { + if outline ~=== lm.line then { + write(yyout,"\n#line ", lm.line-1," \"", lm.filename,"\"") + outline := lm.line + outcol := 1 + if lm.column > 1 then writes(yyout, repl(" ",lm.column-1)) + outfilename := lm.filename + } + } + else { + write(yyout, "\n# no leftmost lineno, line directive omitted") + } + + writes(yyout, "( \"\" ? pattern_match(") + yyprint(node.children[1]) + writes(yyout, ",") + yyprint(node.children[3]) + writes(yyout, ")) ") fail - } + } else if node.label == "BPiam" then { - iconc_fd := 1 - if iconc===1 then { - writes(yyout, "(if getenv(\"NONSENSE\") then ") - yyprint(node.children[3]) - writes(yyout," := \"\" else ") - } - writes(yyout, " pattern_assign_immediate( ") - yyprint(node.children[1]) - writes(yyout, ",") - emit_assign_code(node.children[3]) - # generate spurious extra parameter so that the variable is - # guaranteed to be declared: pattern_assign_immediate(p,"var",var) - writes(yyout, ",") - yyprint(node.children[3]) - writes(yyout, " ) ") - if iconc===1 then writes(yyout, ")") + iconc_fd := 1 + if iconc===1 then { + writes(yyout, "(if getenv(\"NONSENSE\") then ") + yyprint(node.children[3]) + writes(yyout," := \"\" else ") + } + writes(yyout, " pattern_assign_immediate( ") + yyprint(node.children[1]) + writes(yyout, ",") + emit_assign_code(node.children[3]) + # generate spurious extra parameter so that the variable is + # guaranteed to be declared: pattern_assign_immediate(p,"var",var) + writes(yyout, ",") + yyprint(node.children[3]) + writes(yyout, " ) ") + if iconc===1 then writes(yyout, ")") fail - } + } else if node.label == "BPaom" then { - iconc_fd := 1 - if iconc===1 then { - writes(yyout, "(if getenv(\"NONSENSE\") then ") - yyprint(node.children[3]) - writes(yyout," := \"\" else ") - } - writes(yyout, " pattern_assign_onmatch( ") - yyprint(node.children[1]) - writes(yyout, ",") - emit_assign_code(node.children[3]) - # generate spurious extra parameter so that the variable is - # guaranteed to be declared: pattern_setcur("var",var) - writes(yyout, ",") - yyprint(node.children[3]) - writes(yyout, " ) ") - if iconc===1 then writes(yyout, ")") + iconc_fd := 1 + if iconc===1 then { + writes(yyout, "(if getenv(\"NONSENSE\") then ") + yyprint(node.children[3]) + writes(yyout," := \"\" else ") + } + writes(yyout, " pattern_assign_onmatch( ") + yyprint(node.children[1]) + writes(yyout, ",") + emit_assign_code(node.children[3]) + # generate spurious extra parameter so that the variable is + # guaranteed to be declared: pattern_setcur("var",var) + writes(yyout, ",") + yyprint(node.children[3]) + writes(yyout, " ) ") + if iconc===1 then writes(yyout, ")") fail - } + } else if node.label == "upsetcur" then { - iconc_fd := 1 - if iconc===1 then { - writes(yyout, "(if getenv(\"NONSENSE\") then ") - yyprint(node.children[2]) - writes(yyout," := 1 else ") - } - - writes(yyout, "pattern_setcur( ") - emit_assign_code(node.children[2]) - # generate spurious extra parameter so that the variable is - # guaranteed to be declared: pattern_setcur("var",var) - writes(yyout, ",") - yyprint(node.children[2]) - writes(yyout, " ) ") - if iconc===1 then writes(yyout,")") + iconc_fd := 1 + if iconc===1 then { + writes(yyout, "(if getenv(\"NONSENSE\") then ") + yyprint(node.children[2]) + writes(yyout," := 1 else ") + } + + writes(yyout, "pattern_setcur( ") + emit_assign_code(node.children[2]) + # generate spurious extra parameter so that the variable is + # guaranteed to be declared: pattern_setcur("var",var) + writes(yyout, ",") + yyprint(node.children[2]) + writes(yyout, " ) ") + if iconc===1 then writes(yyout,")") fail - } + } else if node.label == "BPuneval" then { - iconc_fd := 1 - process_uneval(node.children[1]) - fail + iconc_fd := 1 + process_uneval(node.children[1]) + fail } - else if node.label == ("varlist2"|"stalist2") then { - yyprint(node.children[1]) - fail - } - else if node.label == ("varlist4"|"stalist4") then { - yyprint(node.children[1]) - yyprint(node.children[2]) - node := node.children[3] - next - } - else if node.label == "proc" then { - yyprint(node.children[1]) - every yyprint(node.children[2 to 3]) - if exists_statlists(node.children[3]) then { - ini := node.children[4] - yyprint("\ninitial {") - yystalists(node.children[3]) + else if node.label == ("varlist2"|"stalist2") then { + yyprint(node.children[1]) + fail + } + else if node.label == ("varlist4"|"stalist4") then { + yyprint(node.children[1]) + yyprint(node.children[2]) + node := node.children[3] + next + } + else if node.label == "proc" then { + yyprint(node.children[1]) + every yyprint(node.children[2 to 3]) + if exists_statlists(node.children[3]) then { + ini := node.children[4] + yyprint("\ninitial {") + yystalists(node.children[3]) if ini ~=== &null then { # existing initial - yyprint(";\n") - yyprint(ini.children[2]) - } - yyprint("\n}\n") - } - else - every yyprint(node.children[4]) - (node.children[1].fields).coercions() + yyprint(";\n") + yyprint(ini.children[2]) + } + yyprint("\n}\n") + } + else + every yyprint(node.children[4]) + (node.children[1].fields).coercions() yyvarlists(node.children[3]) - yyprint(node.children[5]) - yyprint(node.children[6]) - fail - } - else if node.label == "critical" then { - while outline < node.children[1].line do { - write(yyout); outline +:= 1; outcol := 1 - } - while outcol < node.children[1].column do { - writes(yyout, " "); outcol +:= 1 - } - yyprint("{ lock(") - yyprint(node.children[2]) - yyprint("); ") - yyprint(node.children[4]) - yyprint("; unlock(") - yyprint(node.children[2]) - yyprint(") } ") - fail - } - else if *node.children > 0 then { + yyprint(node.children[5]) + yyprint(node.children[6]) + fail + } + else if node.label == "critical" then { + while outline < node.children[1].line do { + write(yyout); outline +:= 1; outcol := 1 + } + while outcol < node.children[1].column do { + writes(yyout, " "); outcol +:= 1 + } + yyprint("{ lock(") + yyprint(node.children[2]) + yyprint("); ") + yyprint(node.children[4]) + yyprint("; unlock(") + yyprint(node.children[2]) + yyprint(") } ") + fail + } + else if *node.children > 0 then { every yyprint(node.children[1 to *node.children-1]) - node := node.children[-1] - next - } - else if node.label === "error" then fail - else { write("leaf, ", node.label); fail } - } + node := node.children[-1] + next + } + else if node.label === "error" then fail + else { write("leaf, ", node.label); fail } + } "integer": { - writes(yyout, node); outcol +:= *string(node) - fail - } + writes(yyout, node); outcol +:= *string(node) + fail + } "string": { node ? { - while writes(yyout, tab(find("\n")+1)) do { - outline+:=1; outcol:=1; - } - node := tab(0) - } - writes(yyout, node); outcol +:= *node - fail + while writes(yyout, tab(find("\n")+1)) do { + outline+:=1; outcol:=1; + } + node := tab(0) + } + writes(yyout, node); outcol +:= *node + fail } "token": { - if \outfilename ~== \ (node.filename) | - (outline > node.line) then { - write(yyout,"\n#line ", node.line-1," \"", node.filename,"\"") - outline := node.line - outcol := 1 - outfilename := node.filename - } - - while outline < node.line do { - write(yyout); outline +:= 1; outcol := 1 - } - if outcol >= node.column then { + if \outfilename ~== \ (node.filename) | + (outline > node.line) then { + write(yyout,"\n#line ", node.line-1," \"", node.filename,"\"") + outline := node.line + outcol := 1 + outfilename := node.filename + } + + while outline < node.line do { + write(yyout); outline +:= 1; outcol := 1 + } + if outcol >= node.column then { # force space between idents and reserved words, and other # deadly combinations (need to add some more) if ((\lasttok).tok = (IDENT|INTLIT|REALLIT) & reswords[node.s][2]~=IDENT)| - (((\lasttok).tok = NMLT) & (node.tok = MINUS)) | - ((\lasttok).tok = node.tok = PLUS) | - ((\lasttok).tok = node.tok = MINUS) | - ((reswords[(\lasttok).s][2]~=IDENT) & (node.tok=(IDENT|INTLIT|REALLIT)))| - ((reswords[(\lasttok).s][2]~=IDENT) & (reswords[node.s][2]~=IDENT)) - then - writes(yyout, " ") - } - else - while outcol < node.column do { writes(yyout, " "); outcol +:= 1 } - - writes(yyout, node.s) - outcol +:= *node.s - lasttok := node - fail - } + (((\lasttok).tok = NMLT) & (node.tok = MINUS)) | + ((\lasttok).tok = node.tok = PLUS) | + ((\lasttok).tok = node.tok = MINUS) | + ((reswords[(\lasttok).s][2]~=IDENT) & (node.tok=(IDENT|INTLIT|REALLIT)))| + ((reswords[(\lasttok).s][2]~=IDENT) & (reswords[node.s][2]~=IDENT)) + then + writes(yyout, " ") + } + else + while outcol < node.column do { writes(yyout, " "); outcol +:= 1 } + + writes(yyout, node.s) + outcol +:= *node.s + lasttok := node + fail + } "null": { fail } "declaration__state": { - node.Write(yyout) - fail - } + node.Write(yyout) + fail + } "Class__state": { - node.Write(yyout) - fail - } + node.Write(yyout) + fail + } "argList__state": { - node.Write(yyout) - fail - } + node.Write(yyout) + fail + } default: { write("its a ", type(node)); fail } } end @@ -548,10 +548,10 @@ procedure print_imports(node) else if node.tok = (IDENT|STRINGLIT) then { tempp := Package(node.s) every fn := (\tempp.files).foreach() do { - if map(fn)[-4:0]==".icn" then fn[-4:0] := "" - writelink(tempp.dir, fn) - outcol := 1 - } + if map(fn)[-4:0]==".icn" then fn[-4:0] := "" + writelink(tempp.dir, fn) + outcol := 1 + } } end @@ -847,27 +847,27 @@ procedure scopecheck_locals(n, localvars, selfvars) if /n then fail if type(n) == "treenode" then { case n.label of { - "locals2": { # locals LOCAL varlist - scopecheck_locals(n.children[1], localvars, selfvars) - scopecheck_locals(n.children[3], localvars, selfvars) - } - "locals3": { # locals STATIC varlist - scopecheck_locals(n.children[1], localvars, selfvars) - # need different rules for static initializers, if we - # ever decide to allow them - # scopecheck_locals(n.children[3], localvars, selfvars) - } - "varlist2": { - scopecheck_expr(n.children[3], localvars, selfvars) - } - "varlist3": { - scopecheck_locals(n.children[1], localvars, selfvars) - } - "varlist4": { - scopecheck_locals(n.children[1], localvars, selfvars) - scopecheck_expr(n.children[5], localvars, selfvars) - } - } + "locals2": { # locals LOCAL varlist + scopecheck_locals(n.children[1], localvars, selfvars) + scopecheck_locals(n.children[3], localvars, selfvars) + } + "locals3": { # locals STATIC varlist + scopecheck_locals(n.children[1], localvars, selfvars) + # need different rules for static initializers, if we + # ever decide to allow them + # scopecheck_locals(n.children[3], localvars, selfvars) + } + "varlist2": { + scopecheck_expr(n.children[3], localvars, selfvars) + } + "varlist3": { + scopecheck_locals(n.children[1], localvars, selfvars) + } + "varlist4": { + scopecheck_locals(n.children[1], localvars, selfvars) + scopecheck_expr(n.children[5], localvars, selfvars) + } + } } else if type(n) ~== "token" then stop("locals ", image(n), " is not a treenode or a token") @@ -894,17 +894,17 @@ procedure scopecheck_expr(node, local_vars, self_vars) fail else if node.label == "field" then { scopecheck_field(node, local_vars, self_vars) - } - else if node.label == ("swap"|"assign"|"revswap"|"revasgn"| - "augcat"|"auglcat"|"Bdiffa"|"Buniona"| - "Bplusa"|"Bminusa"|"Bstara"|"Bintera"| - "Bslasha"|"Bmoda"|"Bcareta"|"Baugeq"| - "Baugeqv"|"Baugge"|"Bauggt"|"Baugle"| - "Bauglt"|"Baugne"|"Baugneqv"|"Baugseq"| - "Baugsge"|"Baugsgt"|"Baugsle"|"Baugslt"| - "Baugsne"|"Baugques"|"Baugamper"|"Baugact"|"BPand") then { + } + else if node.label == ("swap"|"assign"|"revswap"|"revasgn"| + "augcat"|"auglcat"|"Bdiffa"|"Buniona"| + "Bplusa"|"Bminusa"|"Bstara"|"Bintera"| + "Bslasha"|"Bmoda"|"Bcareta"|"Baugeq"| + "Baugeqv"|"Baugge"|"Bauggt"|"Baugle"| + "Bauglt"|"Baugne"|"Baugneqv"|"Baugseq"| + "Baugsge"|"Baugsgt"|"Baugsle"|"Baugslt"| + "Baugsne"|"Baugques"|"Baugamper"|"Baugact"|"BPand") then { every scopecheck_expr(!node.children, local_vars, self_vars) - ckfnasgn(node.children[1], local_vars, self_vars) + ckfnasgn(node.children[1], local_vars, self_vars) } else every scopecheck_expr(!node.children, local_vars, self_vars) } @@ -929,8 +929,8 @@ end procedure classfield_member(fields, s) if member(fields, s) then return if (x:=!fields) & type(x)=="treenode" & - x.label=="arg3" & x.children[1].s==s then { - return + x.label=="arg3" & x.children[1].s==s then { + return } end @@ -943,8 +943,8 @@ procedure scopecheck_field(node, local_vars, self_vars) if type(lhs) == "token" & lhs.s === "self" then { # # A special case; the rhs of a self. expression; the token - # should be mangled if it is not in self_vars; it could be in - # the form self.super.tok; 'super' must be mangled. + # should be mangled if it is not in self_vars; it could be in + # the form self.super.tok; 'super' must be mangled. # if not member(\self_vars, rhs.s) then rhs.s := mangle_class_sym(rhs.s) @@ -972,7 +972,7 @@ procedure extract_identifiers(node, res) else if node.label == ("varlist4" | "stalist4") then { extract_identifiers(node.children[1], res) extract_identifiers(node.children[3], res) - } + } else every extract_identifiers(!node.children, res) } @@ -1111,36 +1111,36 @@ end procedure node_isconst(n) if type(n)=="token" then { if token_isconst(n) then { - # token is a constant whose value is get_constantvalue(n) - return token_isconst(n) + # token is a constant whose value is get_constantvalue(n) + return token_isconst(n) } } else if type(n) == "treenode" then { case n.label of { - "keyword": { - if n.children[2].s == - ("digits","e","lcase","letters","pi","ucase") then { - # constant keywords; list appears incomplete? - return "const" - } - } - "Bplus" | "Bdiff" | "Bunion" | "Bminus" | "Bstar" : { - if node_isconst(n.children[1]) then { - if node_isconst(n.children[3]) then { - # n is a constant with value get_constantvalue(n), - # it should be folded. - return "const" - } - } - else { # whole expr is not const, but check subtree - node_isconst(n.children[3]) - } - - } - default: { - # know nothing; check whole tree - every i := 1 to *n.children do node_isconst(n.children[i]) - } + "keyword": { + if n.children[2].s == + ("digits","e","lcase","letters","pi","ucase") then { + # constant keywords; list appears incomplete? + return "const" + } + } + "Bplus" | "Bdiff" | "Bunion" | "Bminus" | "Bstar" : { + if node_isconst(n.children[1]) then { + if node_isconst(n.children[3]) then { + # n is a constant with value get_constantvalue(n), + # it should be folded. + return "const" + } + } + else { # whole expr is not const, but check subtree + node_isconst(n.children[3]) + } + + } + default: { + # know nothing; check whole tree + every i := 1 to *n.children do node_isconst(n.children[i]) + } } } end @@ -1151,20 +1151,20 @@ end procedure get_constantvalue(n) if type(n)=="token" then { case n.tok of { - INTLIT : return integer(n.s) - REALLIT : return real(n.s) - STRINGLIT : return string(n.s[2:-1]) - CSETLIT : return cset(n.s[2:-1]) + INTLIT : return integer(n.s) + REALLIT : return real(n.s) + STRINGLIT : return string(n.s[2:-1]) + CSETLIT : return cset(n.s[2:-1]) } } else if type(n) == "treenode" then { case n.label of { - "Bstar" : { - constval := get_constantvalue(n.children[1]) * - get_constantvalue(n.children[3]) + "Bstar" : { + constval := get_constantvalue(n.children[1]) * + get_constantvalue(n.children[3]) - return constval - } + return constval + } } } end @@ -1184,166 +1184,166 @@ end procedure regexp(n) case type(n) of { "token": { - case n.tok of { - IDENT: { - return "\"" || n.s || "\"" - } - STRINGLIT | CSETLIT: { - return n - } - DOT: { - return "NotAny('\\n')" - } - default: { - write(&errout, "unknown regex token ", image(n.tok)) - } - } - return "regexp" - } + case n.tok of { + IDENT: { + return "\"" || n.s || "\"" + } + STRINGLIT | CSETLIT: { + return n + } + DOT: { + return "NotAny('\\n')" + } + default: { + write(&errout, "unknown regex token ", image(n.tok)) + } + } + return "regexp" + } "treenode": { - case n.label of { - "kleene": { - # arbno child[1], but recognize *'s precedence - case type(n.children[1]) of { - "token": { - case n.children[1].tok of { - IDENT: { - if *n.children[1].s > 1 then { - return "(\"" || n.children[1].s[1:-1] || - "\"||Arbno(\"" || n.children[1].s[-1]|| - "\"))" - } - else return "(Arbno(\"" || n.children[1].s|| "\"))" - } - CSETLIT | - STRINGLIT: return "(Arbno(" || n.children[1].s|| "))" - default: { - write("system error in regex, * operand ", - (image(n.children[1].tok)|"no tok")) - } - } - } - "treenode": { - case n.children[1].label of { - "acset": { - return "(Arbno(\'" || csetify(n.children[1]) || "\'))" - } - "Paren": { - return node("arbno", "Arbno(",regexp(n.children[1].children[2]),")") - } - "regexconcat": { } # use default rule - default: { # cross fingers - write("* operand label is ", n.children[1].label) - } - } - return node("arbno", "Arbno(",regexp(n.children[1]),")") - } - default: { - write("system error in regex, * operand type ", - (type(n.children[1])|"no child")) - } - } - } - "oneormore": { - # + , but recognize +'s precedence - case type(n.children[1]) of { - "token": { - case n.children[1].tok of { - IDENT: { - # repeat whole ident, plus 0 or more repeats of - # last letter. Precedence of abc+ is (ab)c+. - return "(\"" || n.children[1].s || "\"||" || - "Arbno(\"" || n.children[1].s[-1]||"\"))" - } - STRINGLIT: { - return "(" || n.children[1].s || - " || Arbno(" || n.children[1].s || "))" - } - DOT: { - return "(NotAny('\\n') || Arbno(NotAny('\\n')))" - } - default: { - stop("regex error: + not supported on '", - image(n.children[1].tok),"'") - } - } - } - default: { - nclone := copy(n) - nclone.label := "kleene" - return node("concat", "((", regexp(n.children[1]),")||(", - regexp(nclone), "))") - } - } - } - "optional": { - # ?, but recognize ?'s precedence - case type(n.children[1]) of { - "token": { - case n.children[1].tok of { - IDENT: { - if *n.children[1].s > 1 then { - return "(\"" || n.children[1].s[1:-1] || - "\"||pattern_alternate(\"" || - n.children[1].s[-1] || "\",\"\"))" - } - } - STRINGLIT: { - # build a tree node with lexical information from - # the string, but with the "or nothing" alternate + case n.label of { + "kleene": { + # arbno child[1], but recognize *'s precedence + case type(n.children[1]) of { + "token": { + case n.children[1].tok of { + IDENT: { + if *n.children[1].s > 1 then { + return "(\"" || n.children[1].s[1:-1] || + "\"||Arbno(\"" || n.children[1].s[-1]|| + "\"))" + } + else return "(Arbno(\"" || n.children[1].s|| "\"))" + } + CSETLIT | + STRINGLIT: return "(Arbno(" || n.children[1].s|| "))" + default: { + write("system error in regex, * operand ", + (image(n.children[1].tok)|"no tok")) + } + } + } + "treenode": { + case n.children[1].label of { + "acset": { + return "(Arbno(\'" || csetify(n.children[1]) || "\'))" + } + "Paren": { + return node("arbno", "Arbno(",regexp(n.children[1].children[2]),")") + } + "regexconcat": { } # use default rule + default: { # cross fingers + write("* operand label is ", n.children[1].label) + } + } + return node("arbno", "Arbno(",regexp(n.children[1]),")") + } + default: { + write("system error in regex, * operand type ", + (type(n.children[1])|"no child")) + } + } + } + "oneormore": { + # + , but recognize +'s precedence + case type(n.children[1]) of { + "token": { + case n.children[1].tok of { + IDENT: { + # repeat whole ident, plus 0 or more repeats of + # last letter. Precedence of abc+ is (ab)c+. + return "(\"" || n.children[1].s || "\"||" || + "Arbno(\"" || n.children[1].s[-1]||"\"))" + } + STRINGLIT: { + return "(" || n.children[1].s || + " || Arbno(" || n.children[1].s || "))" + } + DOT: { + return "(NotAny('\\n') || Arbno(NotAny('\\n')))" + } + default: { + stop("regex error: + not supported on '", + image(n.children[1].tok),"'") + } + } + } + default: { + nclone := copy(n) + nclone.label := "kleene" + return node("concat", "((", regexp(n.children[1]),")||(", + regexp(nclone), "))") + } + } + } + "optional": { + # ?, but recognize ?'s precedence + case type(n.children[1]) of { + "token": { + case n.children[1].tok of { + IDENT: { + if *n.children[1].s > 1 then { + return "(\"" || n.children[1].s[1:-1] || + "\"||pattern_alternate(\"" || + n.children[1].s[-1] || "\",\"\"))" + } + } + STRINGLIT: { + # build a tree node with lexical information from + # the string, but with the "or nothing" alternate newt := copy(n.children[1]) - newt.tok := LPAREN - newt.s := "(" - return node("concat", newt, - "pattern_alternate("|| n.children[1].s ||",\"\"))") - } - default: stop("regex error: surprise token ", - image(n.children[1].s)) - } - } - "treenode": { - return node("alt", " pattern_alternate(", - regexp(n.children[1]),", \"\")") - } - default: { - stop("regex error: operand to ? supported") - } - } - } - "regexconcat": { - return node("concat", " pattern_concat(", regexp(n.children[1]), - ", ", regexp(n.children[2]),")") - } - "regexbar": { - return node("alt", " pattern_alternate(", regexp(n.children[1]), - ",", regexp(n.children[3]),")") - } - "acset": { - return node("cset", "Any('" || csetify(n) || "')") - } - "notany": { - return node("cset", "NotAny('" || csetify(n) || "')") - } - "brackchars": { - return csetify(n) - } - "Paren": { - return regexp( n.children[2] ) - } - # these have recursively regexp'ed their kids already. noops. - "alt" | "concat" | "arbno" | "cset": { - return n - } - default: { - write("treenode label ", image(n.label)) - } - } - } + newt.tok := LPAREN + newt.s := "(" + return node("concat", newt, + "pattern_alternate("|| n.children[1].s ||",\"\"))") + } + default: stop("regex error: surprise token ", + image(n.children[1].s)) + } + } + "treenode": { + return node("alt", " pattern_alternate(", + regexp(n.children[1]),", \"\")") + } + default: { + stop("regex error: operand to ? supported") + } + } + } + "regexconcat": { + return node("concat", " pattern_concat(", regexp(n.children[1]), + ", ", regexp(n.children[2]),")") + } + "regexbar": { + return node("alt", " pattern_alternate(", regexp(n.children[1]), + ",", regexp(n.children[3]),")") + } + "acset": { + return node("cset", "Any('" || csetify(n) || "')") + } + "notany": { + return node("cset", "NotAny('" || csetify(n) || "')") + } + "brackchars": { + return csetify(n) + } + "Paren": { + return regexp( n.children[2] ) + } + # these have recursively regexp'ed their kids already. noops. + "alt" | "concat" | "arbno" | "cset": { + return n + } + default: { + write("treenode label ", image(n.label)) + } + } + } "string": return n default: { - write("type of regexp is ", type(n), " : ", image(n)) - return "regexp" - } + write("type of regexp is ", type(n), " : ", image(n)) + return "regexp" + } } end @@ -1351,46 +1351,46 @@ end procedure csetify(n) if type(n) ~== "treenode" then { if type(n) == "token" then { - case n.tok of { - # The two cases handled, leave as a string in order to - # preserve escapes. Calling code will append ' ' around it. - IDENT: { - return n.s - } - INTLIT: { - return n.s - } - default: { - stop("csetify ", image(n.tok)) - } - } - } + case n.tok of { + # The two cases handled, leave as a string in order to + # preserve escapes. Calling code will append ' ' around it. + IDENT: { + return n.s + } + INTLIT: { + return n.s + } + default: { + stop("csetify ", image(n.tok)) + } + } + } stop("csetify ", type(n),"?") } case n.label of { "brackchars": { - write(type(n.children[1], " vs. ", n.children[3])) - } + write(type(n.children[1], " vs. ", n.children[3])) + } "acset": { - n := n.children[2] - } + n := n.children[2] + } "notany": { - n := n.children[3] - } + n := n.children[3] + } default: { - stop("csetify ", image(n.label), " kids ", *n.children) - } + stop("csetify ", image(n.label), " kids ", *n.children) + } } if type(n) == "treenode" & n.label == "brackchars" then { # only way you get this node is you are a range. What about two ranges? cs1 := csetify(n.children[1]) | stop("can't csetify ",image(n.children[1])) cs2 := csetify(n.children[3]) | stop("can't csetify ",image(n.children[3])) lo1 := lastofcset(n.children[1]) | - stop("can't lastofcset ", image(n.children[1])) + stop("can't lastofcset ", image(n.children[1])) fo2 := firstofcset(n.children[3]) | - stop("can't firstofcset ", image(n.children[3])) + stop("can't firstofcset ", image(n.children[3])) csr := csetrange(lo1, fo2) | - stop("can't csetrange ", image(lo1), " and ", image(fo2)) + stop("can't csetrange ", image(lo1), " and ", image(fo2)) cs := cs1 ++ cs2 ++ csr return cs } @@ -1439,16 +1439,16 @@ procedure class_from_parts(head, clocals, methods, initiallysection) rv.methods := methodstaque(methods, rv) if \ (ini := rv.methods.lookup("initially")) then { if not (type(ini) == ("Method"|"Method__state")) then - yyerror("unexpected initially situation on " || type(ini)) + yyerror("unexpected initially situation on " || type(ini)) # splice in any class local initializers into initially procbody if clocals ~=== &null then { - ini.procbody := splicein(\classinitializers, ini.procbody) - } + ini.procbody := splicein(\classinitializers, ini.procbody) + } } else { if clocals ~=== &null then { - write("what, no initially? but I have to stick these somewhere?") - } + write("what, no initially? but I have to stick these somewhere?") + } } return rv end diff --git a/uni/unicon/tstfld.icn b/uni/unicon/tstfld.icn index d8de16262..30db79d2b 100644 --- a/uni/unicon/tstfld.icn +++ b/uni/unicon/tstfld.icn @@ -3,9 +3,9 @@ record declaration__methods(initially,name,setname,Read,Write,String) record classident(Class,ident) record Class__state(__s,__m,supers,methods,text,imethods,ifields,glob,linkfile,name,fields,tag,lptoken,rptoken) record Class__methods(ismethod,isfield,Read,ReadBody,has_initially,ispublic, - foreachmethod, foreachsuper, foreachfield, isvarg, scopeck, - transitive_closure,writedecl,writeSpec,writemethods,Write,resolve, - initially,name,setname,String,declaration) + foreachmethod, foreachsuper, foreachfield, isvarg, scopeck, + transitive_closure,writedecl,writeSpec,writemethods,Write,resolve, + initially,name,setname,String,declaration) procedure main() r := Class__methods(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) diff --git a/uni/unicon/unicon.icn b/uni/unicon/unicon.icn index 489f87ee0..f605648af 100644 --- a/uni/unicon/unicon.icn +++ b/uni/unicon/unicon.icn @@ -44,7 +44,7 @@ global warnings # global iconc, iconc_links, iconc_parsed, iconc_imports global iconc_posixloc, iconc_parsed_posix, iconc_perifile_idx -global iconc_fd # if iconc is used, add the -fd option (off by default) +global iconc_fd # if iconc is used, add the -fd option (off by default) global no_iconc_fs # don't add -fs by default, if iconc is used global iconc_import # suppress writing to uniclass files if \iconc_import link basename, io, paths @@ -76,7 +76,7 @@ procedure iwrite(args[]) } if \flog then { if args[1] === &errout then - pop(args) + pop(args) push(args, flog) write ! args } @@ -91,7 +91,7 @@ procedure iwrites(args[]) if \flog then { if args[1] === &errout then - pop(args) + pop(args) push(args, flog) writes ! args } @@ -108,11 +108,11 @@ procedure iconc_make_exename_opt(args) while i <= *args do { arg := args[i] if arg == "-v" then { - i +:= 2 - next - } + i +:= 2 + next + } else if arg[1] == "-" then { - i +:= 1 + i +:= 1 next } cmpnts := suffix(arg) @@ -288,8 +288,8 @@ procedure iconc_yyparse(fname, tmplist) yyin ||:= "\n" if preproc_err_count > 0 then { every pe := !parsingErrors do { - write(&errout, pe.errorMessage) - } + write(&errout, pe.errorMessage) + } stop() # force error exit (abruptly) } yylex_reinit() @@ -371,7 +371,7 @@ procedure unicon_usage(continue_flag) local f, msg if \continue_flag then f := iwrite else f := istop msg := "Usage: unicon [-cBCstuEGyZMhRK] [-Dsym=val] [-f[adelns]...] [-o ofile]\n _ - [-nofs] [-help] [-version] [-features] [-v i] file... [-x args]" + [-nofs] [-help] [-version] [-features] [-v i] file... [-x args]" f(msg) end @@ -429,7 +429,7 @@ procedure handle_C(arg) if comp === -1 then { istop("conflicting requests for -c and -C") } - + iconc := 1 if *arg > 2 then tmpopt := "-U" || arg[3:0] || " " @@ -491,7 +491,7 @@ procedure unicon(argv) cmd, wilog, flog2, locallinks, localimports, k, files, n, local_name, v, mw_tmpname, rv, pe - fset:='s' # doing -fs by default now + fset:='s' # doing -fs by default now # before initialize, set global option vars: comp := 0 every !argv ? @@ -527,15 +527,15 @@ procedure unicon(argv) skip := &null next } - + if argv[i][1] == "-" & *argv[i]>1 then { - if match("-D", argv[i]) then # symbols + if match("-D", argv[i]) then # symbols handle_D(argv[i]) else if match ("-C", argv[i]) then{ # iconc handle_C(argv[i]) parseonly := 1 - } - else + } + else case argv[i] of { "-c" : { sysok := &null @@ -572,16 +572,16 @@ procedure unicon(argv) return 0 } "-x" : { xec := i; break } # exit the every loop - # - # Really, -e should redirect *our* stderr output, and then - # tell the icont invocation to append its stderr output. - # - "-e" : { - if (i=1) | (argv[i-1]) ~=== "-e" then { - icontopt ||:= "-e " || quotes(argv[i+1]) - argv[i+1] := "-e" - } - } + # + # Really, -e should redirect *our* stderr output, and then + # tell the icont invocation to append its stderr output. + # + "-e" : { + if (i=1) | (argv[i-1]) ~=== "-e" then { + icontopt ||:= "-e " || quotes(argv[i+1]) + argv[i+1] := "-e" + } + } "-o" : { if (i=1) | (argv[i-1] ~=== "-o") then { exename := " -o " || quotes(argv[i+1]) || " " @@ -591,7 +591,7 @@ procedure unicon(argv) "-O": optimize := 1 # -I and -L: add argv[i+1] to LPATH or IPATH, respectively "-I"|"-L": { - if argv[i] == "-I" then thepath := "LPATH" else thepath := "IPATH" + if argv[i] == "-I" then thepath := "LPATH" else thepath := "IPATH" if (i=1) | (argv[i-1] ~=== argv[i]) then { tmp_s := argv[i+1] argv[i+1] := argv[i] @@ -606,12 +606,12 @@ procedure unicon(argv) if i = *argv then stop("missing verbosity value after -v") - varg := (integer(argv[i+1]) || " ") | - stop("bad verbosity value: ", image(argv[i+1])) + varg := (integer(argv[i+1]) || " ") | + stop("bad verbosity value: ", image(argv[i+1])) + + icontopt ||:= argv[i] || varg + ilinkopt ||:= argv[i] || varg - icontopt ||:= argv[i] || varg - ilinkopt ||:= argv[i] || varg - if integer(argv[i+1]) = 0 then silent := 1 @@ -624,10 +624,10 @@ procedure unicon(argv) } "-v1"|"-v2"|"-v3" : { ilinkopt ||:= argv[i] || " " - icontopt ||:= argv[i] || " " + icontopt ||:= argv[i] || " " } - - "-nofs": no_iconc_fs := 1 + + "-nofs": no_iconc_fs := 1 "-M" : merrflag := 1 "-r" : returnErrorsFlag := 1 "-h" | "-help" | "--help" | "-?": unicon_help() @@ -635,90 +635,90 @@ procedure unicon(argv) } # case } else { #the argument isn't an option - yyfilename := argv[i] | stop("usage: unicon file") - if yyfilename == "-" then yyfilename := "_stdin.icn" + yyfilename := argv[i] | stop("usage: unicon file") + if yyfilename == "-" then yyfilename := "_stdin.icn" - if not (map(yyfilename[find(".", yyfilename)+1 : 0])== ("icn"|"u"|"u1"|"u2")) then - yyfilename ||:= ".icn" + if not (map(yyfilename[find(".", yyfilename)+1 : 0])== ("icn"|"u"|"u1"|"u2")) then + yyfilename ||:= ".icn" - # do not translate .u files - if map(yyfilename[find(".", yyfilename)+1 : 0]) == ("u"|"u1"|"u2") then { - linkline ||:= " " || quotes(yyfilename) + # do not translate .u files + if map(yyfilename[find(".", yyfilename)+1 : 0]) == ("u"|"u1"|"u2") then { + linkline ||:= " " || quotes(yyfilename) if \iconc then { insert(iconc_links, yyfilename) } - next - } - else { - # we are gonna translate, and if we link, we remove the .u - ucodefile := basename(yyfilename, ".icn") || ".u" - linkline ||:= " " || quotes(ucodefile) - /translateducode := [] - put(translateducode, ucodefile) - } + next + } + else { + # we are gonna translate, and if we link, we remove the .u + ucodefile := basename(yyfilename, ".icn") || ".u" + linkline ||:= " " || quotes(ucodefile) + /translateducode := [] + put(translateducode, ucodefile) + } if \iconc then { # mark this file as parsed insert(iconc_parsed, get_abs_file_name(yyfilename)) - } - - outfilename := yyfilename - yyin := "" - every yyin ||:= preprocessor(yyfilename, uni_predefs) do yyin ||:= "\n" - if preproc_err_count > 0 then { - every pe := !parsingErrors do { - write(&errout, pe.errorMessage) - } - stop() # force error exit (abruptly) - } - yylex_reinit() - cmd := selecticont() + } + + outfilename := yyfilename + yyin := "" + every yyin ||:= preprocessor(yyfilename, uni_predefs) do yyin ||:= "\n" + if preproc_err_count > 0 then { + every pe := !parsingErrors do { + write(&errout, pe.errorMessage) + } + stop() # force error exit (abruptly) + } + yylex_reinit() + cmd := selecticont() if &features=="MS Windows NT" & &features=="console window" then{ wilog := tempname("uni",".tmp",,) - cmd ||:= " -l "|| wilog - } - cmd ||:= " -c "||icontopt||" -O "|| quotes(yyfilename) ||" " - if /yydbg then { - tmpname := tempname("uni",,,5) - yyout := open(tmpname, "w") | - stop("can't open temporary file ",tmpname," for writing") + cmd ||:= " -l "|| wilog + } + cmd ||:= " -c "||icontopt||" -O "|| quotes(yyfilename) ||" " + if /yydbg then { + tmpname := tempname("uni",,,5) + yyout := open(tmpname, "w") | + stop("can't open temporary file ",tmpname," for writing") put(tmpfnames, tmpname) - ca_assoc(yyfilename, tmpname) - } - else yyout := &output - - write(yyout, "#line 0 \"", yyfilename, "\"") - iwrites(&errout, "Parsing ", yyfilename ,": ") - rv := yyparse() - if not (*\parsingErrors > 0) then iwrite(&errout) - else { - every pe := !parsingErrors do { - iwrite(&errout, pe.errorMessage) - } - } - if /yydbg then - close(yyout) - if (rv = errors = 0) & (not (*\parsingErrors > 0)) & /parseonly then { - rv := mysystem(cmd || tmpname) - if rv ~=== 0 then yynerrs +:= 1 - if &features=="MS Windows NT" & &features=="console window" then { - # copy icont log to our console - every 1 to 5 do { - if flog2 := open(wilog) then { - while iwrite(&errout, read(flog2)) - close(flog2) - /keeptmp & remove(wilog) | write(&errout, wilog, " - wilog B not removed.") - break - } - delay(1000) - } - } - } + ca_assoc(yyfilename, tmpname) + } + else yyout := &output + + write(yyout, "#line 0 \"", yyfilename, "\"") + iwrites(&errout, "Parsing ", yyfilename ,": ") + rv := yyparse() + if not (*\parsingErrors > 0) then iwrite(&errout) + else { + every pe := !parsingErrors do { + iwrite(&errout, pe.errorMessage) + } + } + if /yydbg then + close(yyout) + if (rv = errors = 0) & (not (*\parsingErrors > 0)) & /parseonly then { + rv := mysystem(cmd || tmpname) + if rv ~=== 0 then yynerrs +:= 1 + if &features=="MS Windows NT" & &features=="console window" then { + # copy icont log to our console + every 1 to 5 do { + if flog2 := open(wilog) then { + while iwrite(&errout, read(flog2)) + close(flog2) + /keeptmp & remove(wilog) | write(&errout, wilog, " - wilog B not removed.") + break + } + delay(1000) + } + } + } if /iconc then { /keeptmp & /tmpname | remove(tmpname) | - iwrite(&errout,"remove ", image(tmpname), " fails") + iwrite(&errout,"remove ", image(tmpname), " fails") } - reinitialize() + reinitialize() } # the argument doesn't start with "-" } # every argument @@ -727,7 +727,7 @@ procedure unicon(argv) unicon_usage() } - + # # If this output is intended for consumption by iconc, suck in # all files associated with link-refs and import-refs, and yyparse @@ -858,14 +858,14 @@ procedure unicon(argv) errors +:= 1 if errors = 0 & \xec then { - if cmd := \exename then { - if match("-o ", cmd) then cmd[1:4] := "" - if not (any('/\\', cmd) | (cmd[any(&letters,cmd)]==":")) then - cmd := "./" || cmd - every cmd ||:= " " || argv[xec+1 to *argv] - rv := system(cmd) - } - } + if cmd := \exename then { + if match("-o ", cmd) then cmd[1:4] := "" + if not (any('/\\', cmd) | (cmd[any(&letters,cmd)]==":")) then + cmd := "./" || cmd + every cmd ||:= " " || argv[xec+1 to *argv] + rv := system(cmd) + } + } } else @@ -983,7 +983,7 @@ end procedure writelink(dir, s) if \iconc then { - # do not generate linkrefs in + # do not generate linkrefs in # code that will be sent to iconc... return } @@ -1041,7 +1041,7 @@ local cmd, dash_s # # if we find binaries via path search, use them; otherwise # try for binaries directory via &progname. Won't be very - # successful + # successful # cmd := ((&features ? (="Binaries at " & tab(0))) | (&progname ? tab(find("unicon"))) | "") diff --git a/uni/unicon/unigram.icn b/uni/unicon/unigram.icn index 6ba4d963e..dd75f0202 100644 --- a/uni/unicon/unigram.icn +++ b/uni/unicon/unigram.icn @@ -7,17 +7,17 @@ procedure Keyword(x1,x2) static keywords initial { keywords := set(["allocated","clock","collections","column","current", - "date","now","dateline","digits","e","error", - "errornumber","errortext","errorvalue","errout","fail", - "eventcode","eventsource","eventvalue","features", - "file","host","input","lcase","letters","level", - "line","main","null","output","phi","pi","pick","pos", - "progname","random","regions","source","storage", - "subject","time","trace","dump","ucase","version", - "errno","window","col","row","x","y","interval", - "control","shift","meta","lpress","mpress","rpress", - "lrelease","mrelease","rrelease","ldrag","mdrag", - "rdrag","resize","ascii","cset"]) + "date","now","dateline","digits","e","error", + "errornumber","errortext","errorvalue","errout","fail", + "eventcode","eventsource","eventvalue","features", + "file","host","input","lcase","letters","level", + "line","main","null","output","phi","pi","pick","pos", + "progname","random","regions","source","storage", + "subject","time","trace","dump","ucase","version", + "errno","window","col","row","x","y","interval", + "control","shift","meta","lpress","mpress","rpress", + "lrelease","mrelease","rrelease","ldrag","mdrag", + "rdrag","resize","ascii","cset"]) } # verify that x2 is a valid keyword @@ -33,9 +33,9 @@ initial { set_of_all_fields := set(); dummyrecno := 1 } if \iconc then { if type(x3) == "token" then { - insert(set_of_all_fields, x3.s) -# write(&errout, "field ", image(x3.s)) - } + insert(set_of_all_fields, x3.s) +# write(&errout, "field ", image(x3.s)) + } } return node("field",x1,x2,x3) @@ -45,8 +45,8 @@ procedure Clone1stToken(n) case type(n) of { "token": return copy(n) "treenode": { - return Clone1stToken(!n.children) - } + return Clone1stToken(!n.children) + } } end @@ -56,10 +56,10 @@ procedure Progend(x1) if *\parsingErrors > 0 then { every pe := !parsingErrors do { - write(&errout, pe.errorMessage) - } + write(&errout, pe.errorMessage) + } istop(*\parsingErrors || " error" || - (if *\parsingErrors > 1 then "s" else "")) + (if *\parsingErrors > 1 then "s" else "")) } if /x1 then istop("error: empty file") @@ -86,12 +86,12 @@ procedure Progend(x1) added := 0 every super := ((classes.foreach_t()).foreachsuper() | !imports) do { if /classes.lookup(super) then { - added := 1 - readspec(super) - cl := classes.lookup(super) - if /cl then halt("can't inherit class '",super,"'") - iwrite(" inherits ", super, " from ", cl.linkfile) - writelink(cl.dir, cl.linkfile) + added := 1 + readspec(super) + cl := classes.lookup(super) + if /cl then halt("can't inherit class '",super,"'") + iwrite(" inherits ", super, " from ", cl.linkfile) + writelink(cl.dir, cl.linkfile) } } if added = 0 then break @@ -125,16 +125,16 @@ $ifndef NoPatternIntegration if (*\list_of_invocables)>0 then { writes(yyout, "invocable ") every temp := list_of_invocables[i := 1 to *list_of_invocables] do { - writes(yyout, image(temp)) - if i < *list_of_invocables then writes(yyout, ",") + writes(yyout, image(temp)) + if i < *list_of_invocables then writes(yyout, ",") } write(yyout) } -$endif # NoPatternIntegration +$endif # NoPatternIntegration if \iconc & (type(set_of_all_fields) == "set") & - (*set_of_all_fields > 0) then { - arandomfield := !set_of_all_fields + (*set_of_all_fields > 0) then { + arandomfield := !set_of_all_fields writes(yyout, "record __dummyrecord",dummyrecno,"(",arandomfield) delete(set_of_all_fields, arandomfield) every writes(yyout, ",", !set_of_all_fields) @@ -277,7 +277,7 @@ $define SNDBK 386 $define RCV 387 $define RCVBK 388 $define YYERRCODE 256 -procedure init() +procedure init() yylhs := [ -1, 0, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 11, 11, 11, 16, 16, 10, 17, 20, 20, @@ -2625,8 +2625,8 @@ procedure init_stacks() local i statestk := [] valstk := [] - yyval := 0 - yylval := 0 + yyval := 0 + yylval := 0 action := list(1000, action_null) # remove hard coded 1000 later every i := 1 to 1000 do action[i] := proc("action_" || i) end @@ -2680,31 +2680,31 @@ procedure InvocationNode(args[]) else { n1 := node("Paren","(",node("assign","__"||tmpcount,":=",args[1]),")") if lparen := Clone1stToken(args[1]) then { - lparen.tok := LPAREN - lparen.s := "(" + lparen.tok := LPAREN + lparen.s := "(" } else lparen := "(" } if *args = 6 then { return node("Paren",lparen,node("invoke", - # iconc uses no __m business - (if /iconc then Field(Field(n1, ".", "__m"), "." , args[3]) - else Field(n1, ".", args[3])), - - args[4], node("exprlist", - if n1 === args[1] then args[1] else "__"||tmpcount, - if args[5] === &null then &null else ",",args[5]),args[6]) - ,")") + # iconc uses no __m business + (if /iconc then Field(Field(n1, ".", "__m"), "." , args[3]) + else Field(n1, ".", args[3])), + + args[4], node("exprlist", + if n1 === args[1] then args[1] else "__"||tmpcount, + if args[5] === &null then &null else ",",args[5]),args[6]) + ,")") } else { if /iconc then - return node("Paren",lparen,node("invoke",Field(Field( - Field(n1,".", "__m"), - "." , args[3]),".",args[5]), - args[6], node("exprlist", - if n1 === args[1] then args[1] else "__"||tmpcount, - if args[7] === &null then &null else ",",args[7]),args[8]) - ,")") + return node("Paren",lparen,node("invoke",Field(Field( + Field(n1,".", "__m"), + "." , args[3]),".",args[5]), + args[6], node("exprlist", + if n1 === args[1] then args[1] else "__"||tmpcount, + if args[7] === &null then &null else ",",args[7]),args[8]) + ,")") else return SuperMethodInvok ! args } end @@ -2792,14 +2792,14 @@ procedure buildtab_from_cclause(n, args) case n.label of { "cclause0": { if *args.children > 0 then push(args.children, comma) - push(args.children, n.children[3]) - } + push(args.children, n.children[3]) + } "cclause1": { if *args.children > 0 then push(args.children, comma) - push(args.children, n.children[3]) - push(args.children, comma) - push(args.children, n.children[1]) - } + push(args.children, n.children[3]) + push(args.children, comma) + push(args.children, n.children[1]) + } } end @@ -2813,9 +2813,9 @@ procedure ListComp(expr) tmpcount +:= 1 tmp := "__" || tmpcount return node("ListComp", - "{", string(tmp), " :=[]; every put(" || tmp || ", ", - expr, - "); if *" || tmp || ">0 then " || tmp || "}") + "{", string(tmp), " :=[]; every put(" || tmp || ", ", + expr, + "); if *" || tmp || ">0 then " || tmp || "}") end # @@ -2829,21 +2829,21 @@ procedure AppendListCompTemps(lcls, body) if *\(ltmps := ListCompTemps(body)) > 0 then { # make a varlist containing ltmps if *ltmps > 1 then { - vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") - every i := 2 to *ltmps do - vl := node("varlist3", vl, ",", - token(IDENT, ltmps[i], 0, 0, "lambda.icn")) - } + vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") + every i := 2 to *ltmps do + vl := node("varlist3", vl, ",", + token(IDENT, ltmps[i], 0, 0, "lambda.icn")) + } else { - # the varlist will just be an IDENT - vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") - } + # the varlist will just be an IDENT + vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") + } if (lcls === &null) | - (type(lcls)==="treenode" & lcls.label==("locals2"|"locals3")) then { - return node("locals2", lcls, "local", vl, ";") - } + (type(lcls)==="treenode" & lcls.label==("locals2"|"locals3")) then { + return node("locals2", lcls, "local", vl, ";") + } else - write(&errout, "don't know what to do with ", image(lcls)) + write(&errout, "don't know what to do with ", image(lcls)) } end @@ -2855,16 +2855,16 @@ procedure ListCompTemps(n) local LCT if type(n) == "treenode" then { if n.label=="ListComp" then { - LCT := [n.children[2]] - LCT |||:= ListCompTemps(n.children[4]) - return LCT - } + LCT := [n.children[2]] + LCT |||:= ListCompTemps(n.children[4]) + return LCT + } else if LCT := ListCompTemps(n.children[k := 1 to *(n.children)]) then { - every kk := k+1 to *(n.children) do { - LCT |||:= ListCompTemps(n.children[kk]) - } - return LCT - } + every kk := k+1 to *(n.children) do { + LCT |||:= ListCompTemps(n.children[kk]) + } + return LCT + } } end @@ -2901,19 +2901,19 @@ procedure yyparse() local doaction # set to 1 if there need to execute action local token # current token - if /yytable then init() - init_stacks() - yynerrs := 0 - yyerrflag := 0 + if /yytable then init() + init_stacks() + yynerrs := 0 + yyerrflag := 0 yychar := -1 # impossible char forces a read yystate := 0 # initial state push(statestk, yystate) # save it repeat { # until parsing is done, either correctly, or w/error - doaction := 1 + doaction := 1 ##### NEXT ACTION (from reduction table) - yyn := yydefred[yystate+1] + yyn := yydefred[yystate+1] while yyn = 0 do { @@ -2922,15 +2922,15 @@ procedure yyparse() ##### ERROR CHECK #### if yychar < 0 then { # it it didn't work/error yychar := 0 # change it to default string (no -1!) - if \yydebug = 1 then yylexdebug(yystate, yychar) + if \yydebug = 1 then yylexdebug(yystate, yychar) } } # yychar < 0 - + yyn := yysindex[yystate+1] # get amount to shift by (shift index) - if (yyn ~= 0) & ((yyn +:= yychar) >= 0) & + if (yyn ~= 0) & ((yyn +:= yychar) >= 0) & (yyn <= YYTABLESIZE) & (yycheck[yyn+1] = yychar) then { - + ##### NEXT STATE #### yystate := yytable[yyn+1] # we are in a new state push(statestk, yystate) # save it @@ -2947,38 +2947,38 @@ procedure yyparse() if (yyn ~= 0) & ((yyn +:= yychar) >= 0) & (yyn <= YYTABLESIZE) & (yycheck[yyn+1] = yychar) then { # e reduced! - yyn := yytable[yyn+1] + yyn := yytable[yyn+1] doaction := 1 # get ready to execute break # drop down to actions } else { #ERROR RECOVERY if yyerrflag == 0 then { - (\yyerror | write)("syntax error") - yynerrs +:= 1 + (\yyerror | write)("syntax error") + yynerrs +:= 1 } if yyerrflag < 3 then { # low error count? - yyerrflag := 3 + yyerrflag := 3 repeat { #do until break if *statestk < 1 then { # check for under & overflow here (\yyerror | write)("stack underflow. aborting...") # note lower case 's' - return 1 + return 1 } - yyn := yysindex[statestk[1]] + yyn := yysindex[statestk[1]] if ((yyn ~= 0) & (yyn +:= YYERRCODE) >= 0 & yyn <= YYTABLESIZE & yycheck[yyn+1] == YYERRCODE) then { - yystate := yytable[yyn+1] - push(statestk, yystate) - push(valstk, yylval) - doaction := 0 - break + yystate := yytable[yyn+1] + push(statestk, yystate) + push(valstk, yylval) + doaction := 0 + break } else { if *statestk = 0 then { # check for under & overflow here write("Stack underflow. aborting...") # capital 'S' - return 1 + return 1 } - pop(statestk) - pop(valstk) + pop(statestk) + pop(valstk) } } } @@ -2986,16 +2986,16 @@ procedure yyparse() { if yychar = 0 then return 1 # yyabort if \yydebug = 1 then { - yys := &null - if yychar <= YYMAXTOKEN then yys := yyname[yychar+1] - if integer(yys) & yys = 0 then yys := "illegal-symbol" + yys := &null + if yychar <= YYMAXTOKEN then yys := yyname[yychar+1] + if integer(yys) & yys = 0 then yys := "illegal-symbol" write("state ", yystate, ", error recovery discards token ", - yychar, " (", yys, ")") + yychar, " (", yys, ")") } yychar := -1 # read another } } # end error recovery - yyn := yydefred[yystate+1] + yyn := yydefred[yystate+1] }# yyn = 0 loop if doaction = 0 then # any reason not to proceed? @@ -3032,7 +3032,7 @@ procedure yyparse() } else { yystate := yydgoto[yym+1] # else go to new defred - } + } push(statestk, yystate) # going again, so push state & val... push(valstk, yyval) # for next action } @@ -3051,57 +3051,57 @@ end procedure action_1() #line 301 "unigram.y" - Progend(valstk[2]) + Progend(valstk[2]) end procedure action_2() #line 303 "unigram.y" - yyval := &null + yyval := &null end procedure action_3() #line 304 "unigram.y" - if /parsingErrors | *parsingErrors = 0 then iwrites(&errout,".") - yyval := node("decls", valstk[2], valstk[1]) - + if /parsingErrors | *parsingErrors = 0 then iwrites(&errout,".") + yyval := node("decls", valstk[2], valstk[1]) + end procedure action_12() #line 319 "unigram.y" - yyval := &null + yyval := &null end procedure action_13() #line 320 "unigram.y" - yyval := Method( , , , , , valstk[5], "initially", &null, "method", "(", ")") - yyval.locals := valstk[3] - yyval.initl := valstk[2] - yyval.procbody := valstk[1] - + yyval := Method( , , , , , valstk[5], "initially", &null, "method", "(", ")") + yyval.locals := valstk[3] + yyval.initl := valstk[2] + yyval.procbody := valstk[1] + end procedure action_14() #line 326 "unigram.y" - yyval := Method( , , , , , valstk[8], "initially", valstk[6], "method", "(", ")") - yyval.locals := valstk[3] - yyval.initl := valstk[2] - yyval.procbody := valstk[1] - + yyval := Method( , , , , , valstk[8], "initially", valstk[6], "method", "(", ")") + yyval.locals := valstk[3] + yyval.initl := valstk[2] + yyval.procbody := valstk[1] + end procedure action_15() #line 334 "unigram.y" - yyval := &null + yyval := &null end procedure action_17() #line 337 "unigram.y" yyval := class_from_parts(valstk[7], valstk[5], valstk[4], valstk[2]) - + end procedure action_18() @@ -3123,67 +3123,67 @@ procedure action_18() yyval.fields := valstk[2] yyval.lptoken := valstk[3] yyval.rptoken := valstk[1] - + end procedure action_19() #line 360 "unigram.y" - yyval := &null + yyval := &null end procedure action_20() #line 361 "unigram.y" - yyval := node("supers", valstk[3], valstk[2], valstk[1]) + yyval := node("supers", valstk[3], valstk[2], valstk[1]) end procedure action_21() #line 362 "unigram.y" - yyval := node("supers", valstk[3], valstk[2], valstk[1]) + yyval := node("supers", valstk[3], valstk[2], valstk[1]) end procedure action_22() #line 365 "unigram.y" - yyval := node("packageref", valstk[3],valstk[2],valstk[1]) + yyval := node("packageref", valstk[3],valstk[2],valstk[1]) end procedure action_23() #line 366 "unigram.y" - yyval := node("packageref", valstk[2],valstk[1]) + yyval := node("packageref", valstk[2],valstk[1]) end procedure action_24() #line 369 "unigram.y" - yyval := &null + yyval := &null end procedure action_25() #line 370 "unigram.y" - yyval := node("methods", valstk[2],valstk[1]) + yyval := node("methods", valstk[2],valstk[1]) end procedure action_26() #line 371 "unigram.y" - yyval := node("methods", valstk[2],valstk[1]) + yyval := node("methods", valstk[2],valstk[1]) end procedure action_27() #line 372 "unigram.y" - yyval := node("methods", valstk[2],valstk[1]) + yyval := node("methods", valstk[2],valstk[1]) end procedure action_28() #line 375 "unigram.y" - yyval := node("invocable", valstk[2], valstk[1]) + yyval := node("invocable", valstk[2], valstk[1]) end procedure action_30() #line 378 "unigram.y" - yyval := node("invoclist", valstk[3],valstk[2],valstk[1]) + yyval := node("invoclist", valstk[3],valstk[2],valstk[1]) end procedure action_33() #line 382 "unigram.y" -yyval := node("invocop3", valstk[3],valstk[2],valstk[1]) +yyval := node("invocop3", valstk[3],valstk[2],valstk[1]) end procedure action_34() @@ -3206,7 +3206,7 @@ procedure action_34() thePackage.insertfname(yyfilename) thePackage.add_imported() } - + end procedure action_35() @@ -3214,119 +3214,119 @@ procedure action_35() yyval := node("import", valstk[2],valstk[1]," ") import_class(valstk[1]) - + end procedure action_36() #line 409 "unigram.y" - yyval := node("link", valstk[2],valstk[1]," ") + yyval := node("link", valstk[2],valstk[1]," ") end procedure action_38() #line 412 "unigram.y" - yyval := node("lnklist", valstk[3],valstk[2],valstk[1]) + yyval := node("lnklist", valstk[3],valstk[2],valstk[1]) end procedure action_40() #line 415 "unigram.y" - yyval := node("implist", valstk[3],valstk[2],valstk[1]) + yyval := node("implist", valstk[3],valstk[2],valstk[1]) end procedure action_43() #line 420 "unigram.y" - yyval := node("global", valstk[2],valstk[1]) + yyval := node("global", valstk[2],valstk[1]) end procedure action_44() #line 422 "unigram.y" - yyval := declaration(valstk[4],valstk[2],valstk[5],valstk[3],valstk[1]) - if \iconc then - ca_add_proc(yyfilename, valstk[4].s) - + yyval := declaration(valstk[4],valstk[2],valstk[5],valstk[3],valstk[1]) + if \iconc then + ca_add_proc(yyfilename, valstk[4].s) + end procedure action_45() #line 428 "unigram.y" - yyval := &null + yyval := &null end procedure action_47() #line 431 "unigram.y" -# body_scopeck(valstk[2]) - valstk[4] := AppendListCompTemps(valstk[4], valstk[2]) - yyval := node("proc", valstk[6],";",valstk[4],valstk[3],valstk[2],valstk[1]) - +# body_scopeck(valstk[2]) + valstk[4] := AppendListCompTemps(valstk[4], valstk[2]) + yyval := node("proc", valstk[6],";",valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_48() #line 437 "unigram.y" - yyval := valstk[6] - yyval.locals := valstk[4] - yyval.initl := valstk[3] - yyval.procbody := valstk[2] - + yyval := valstk[6] + yyval.locals := valstk[4] + yyval.initl := valstk[3] + yyval.procbody := valstk[2] + end procedure action_49() #line 443 "unigram.y" - yyval := valstk[1] + yyval := valstk[1] yyval.abstract_flag := 1 - + end procedure action_50() #line 448 "unigram.y" - yyval := declaration(valstk[4], valstk[2], valstk[5], valstk[3], valstk[1]) - if \iconc then - ca_add_proc(yyfilename, valstk[4].s) - + yyval := declaration(valstk[4], valstk[2], valstk[5], valstk[3], valstk[1]) + if \iconc then + ca_add_proc(yyfilename, valstk[4].s) + end procedure action_51() #line 454 "unigram.y" - yyval := Method( , , , , , valstk[5], valstk[4].s, valstk[2], valstk[5].s, valstk[3], valstk[1]) - + yyval := Method( , , , , , valstk[5], valstk[4].s, valstk[2], valstk[5].s, valstk[3], valstk[1]) + end procedure action_52() #line 459 "unigram.y" - yyval := argList( , , &null) + yyval := argList( , , &null) end procedure action_53() #line 460 "unigram.y" - yyval := argList( , , valstk[1]) + yyval := argList( , , valstk[1]) end procedure action_54() #line 461 "unigram.y" - yyval := argList("[]" , , valstk[3]) + yyval := argList("[]" , , valstk[3]) end procedure action_55() #line 463 "unigram.y" - yyval := argList( , , &null) + yyval := argList( , , &null) end procedure action_56() #line 464 "unigram.y" - yyval := argList( , , valstk[1]) + yyval := argList( , , valstk[1]) end procedure action_57() #line 465 "unigram.y" - yyval := argList("[]" , , valstk[3]) + yyval := argList("[]" , , valstk[3]) end procedure action_59() #line 469 "unigram.y" - yyval := node("idlist", valstk[3],valstk[2],valstk[1]) + yyval := node("idlist", valstk[3],valstk[2],valstk[1]) end procedure action_61() @@ -3361,22 +3361,22 @@ end procedure action_69() #line 482 "unigram.y" - yyval := node("parmlist", valstk[3],valstk[2],valstk[1]) + yyval := node("parmlist", valstk[3],valstk[2],valstk[1]) end procedure action_71() #line 485 "unigram.y" - yyval := node("parmlist", valstk[3],valstk[2],valstk[1]) + yyval := node("parmlist", valstk[3],valstk[2],valstk[1]) end procedure action_73() #line 488 "unigram.y" - yyval := node("arg2", valstk[3], valstk[2], valstk[1]) + yyval := node("arg2", valstk[3], valstk[2], valstk[1]) end procedure action_74() #line 489 "unigram.y" - yyval := node("arg3", valstk[3], valstk[2], valstk[1]) + yyval := node("arg3", valstk[3], valstk[2], valstk[1]) end procedure action_75() @@ -3386,1087 +3386,1087 @@ end procedure action_76() #line 491 "unigram.y" - yyval := node("arg5", valstk[4], valstk[3], Keyword(valstk[2], valstk[1])) + yyval := node("arg5", valstk[4], valstk[3], Keyword(valstk[2], valstk[1])) end procedure action_77() #line 492 "unigram.y" - yyval := node("arg6", valstk[6], valstk[5], valstk[4], valstk[3], Keyword(valstk[2], valstk[1])) + yyval := node("arg6", valstk[6], valstk[5], valstk[4], valstk[3], Keyword(valstk[2], valstk[1])) end procedure action_78() #line 493 "unigram.y" - yyval := node("arg7", valstk[4], valstk[3], "[]") + yyval := node("arg7", valstk[4], valstk[3], "[]") end procedure action_79() #line 494 "unigram.y" - yyval := node("arg8", valstk[6], valstk[5], valstk[4], valstk[3], "[]") + yyval := node("arg8", valstk[6], valstk[5], valstk[4], valstk[3], "[]") end procedure action_80() #line 497 "unigram.y" - yyval := valstk[1] + yyval := valstk[1] end procedure action_81() #line 499 "unigram.y" - yyval := &null + yyval := &null end procedure action_84() #line 503 "unigram.y" - yyval := &null + yyval := &null end procedure action_85() #line 504 "unigram.y" - yyval := node("locals2", valstk[4],valstk[3],valstk[2],";") + yyval := node("locals2", valstk[4],valstk[3],valstk[2],";") end procedure action_86() #line 506 "unigram.y" - yyval := &null + yyval := &null end procedure action_87() #line 507 "unigram.y" - yyval := node("locals2", valstk[4],valstk[3],valstk[2],";") + yyval := node("locals2", valstk[4],valstk[3],valstk[2],";") end procedure action_88() #line 508 "unigram.y" - yyval := node("locals3", valstk[4],valstk[3],valstk[2],";") + yyval := node("locals3", valstk[4],valstk[3],valstk[2],";") end procedure action_89() #line 510 "unigram.y" - yyval := &null + yyval := &null end procedure action_90() #line 511 "unigram.y" - yyval := node("initial", valstk[3], valstk[2],";") - + yyval := node("initial", valstk[3], valstk[2],";") + end procedure action_91() #line 515 "unigram.y" - yyval := &null + yyval := &null end procedure action_92() #line 516 "unigram.y" - yyval := node("procbody", valstk[3],";",valstk[1]) + yyval := node("procbody", valstk[3],";",valstk[1]) end procedure action_93() #line 518 "unigram.y" - yyval := &null + yyval := &null end procedure action_96() #line 522 "unigram.y" - yyval := node("and", valstk[3],valstk[2],valstk[1]) + yyval := node("and", valstk[3],valstk[2],valstk[1]) end procedure action_98() #line 525 "unigram.y" - yyval := node("binques", valstk[3],valstk[2],valstk[1]) + yyval := node("binques", valstk[3],valstk[2],valstk[1]) end procedure action_100() #line 528 "unigram.y" - yyval := node("swap", valstk[3],valstk[2],valstk[1]) + yyval := node("swap", valstk[3],valstk[2],valstk[1]) end procedure action_101() #line 529 "unigram.y" yyval := parenthesize_assign(node("assign",valstk[3],valstk[2],valstk[1])) - + end procedure action_102() #line 532 "unigram.y" - yyval := node("revswap", valstk[3],valstk[2],valstk[1]) + yyval := node("revswap", valstk[3],valstk[2],valstk[1]) end procedure action_103() #line 533 "unigram.y" - yyval := node("revasgn", valstk[3],valstk[2],valstk[1]) + yyval := node("revasgn", valstk[3],valstk[2],valstk[1]) end procedure action_104() #line 534 "unigram.y" - yyval := node("augcat", valstk[3],valstk[2],valstk[1]) + yyval := node("augcat", valstk[3],valstk[2],valstk[1]) end procedure action_105() #line 535 "unigram.y" - yyval := node("auglcat", valstk[3],valstk[2],valstk[1]) + yyval := node("auglcat", valstk[3],valstk[2],valstk[1]) end procedure action_106() #line 536 "unigram.y" - yyval := node("Bdiffa", valstk[3],valstk[2],valstk[1]) + yyval := node("Bdiffa", valstk[3],valstk[2],valstk[1]) end procedure action_107() #line 537 "unigram.y" - yyval := node("Buniona", valstk[3],valstk[2],valstk[1]) + yyval := node("Buniona", valstk[3],valstk[2],valstk[1]) end procedure action_108() #line 538 "unigram.y" - yyval := node("Bplusa", valstk[3],valstk[2],valstk[1]) + yyval := node("Bplusa", valstk[3],valstk[2],valstk[1]) end procedure action_109() #line 539 "unigram.y" - yyval := node("Bminusa", valstk[3],valstk[2],valstk[1]) + yyval := node("Bminusa", valstk[3],valstk[2],valstk[1]) end procedure action_110() #line 540 "unigram.y" - yyval := node("Bstara", valstk[3],valstk[2],valstk[1]) + yyval := node("Bstara", valstk[3],valstk[2],valstk[1]) end procedure action_111() #line 541 "unigram.y" - yyval := node("Bintera", valstk[3],valstk[2],valstk[1]) + yyval := node("Bintera", valstk[3],valstk[2],valstk[1]) end procedure action_112() #line 542 "unigram.y" - yyval := node("Bslasha", valstk[3],valstk[2],valstk[1]) + yyval := node("Bslasha", valstk[3],valstk[2],valstk[1]) end procedure action_113() #line 543 "unigram.y" - yyval := node("Bmoda", valstk[3],valstk[2],valstk[1]) + yyval := node("Bmoda", valstk[3],valstk[2],valstk[1]) end procedure action_114() #line 544 "unigram.y" - yyval := node("Bcareta", valstk[3],valstk[2],valstk[1]) + yyval := node("Bcareta", valstk[3],valstk[2],valstk[1]) end procedure action_115() #line 545 "unigram.y" - yyval := node("Baugeq", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugeq", valstk[3],valstk[2],valstk[1]) end procedure action_116() #line 546 "unigram.y" - yyval := node("Baugeqv", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugeqv", valstk[3],valstk[2],valstk[1]) end procedure action_117() #line 547 "unigram.y" - yyval := node("Baugge", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugge", valstk[3],valstk[2],valstk[1]) end procedure action_118() #line 548 "unigram.y" - yyval := node("Bauggt", valstk[3],valstk[2],valstk[1]) + yyval := node("Bauggt", valstk[3],valstk[2],valstk[1]) end procedure action_119() #line 549 "unigram.y" - yyval := node("Baugle", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugle", valstk[3],valstk[2],valstk[1]) end procedure action_120() #line 550 "unigram.y" - yyval := node("Bauglt", valstk[3],valstk[2],valstk[1]) + yyval := node("Bauglt", valstk[3],valstk[2],valstk[1]) end procedure action_121() #line 551 "unigram.y" - yyval := node("Baugne", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugne", valstk[3],valstk[2],valstk[1]) end procedure action_122() #line 552 "unigram.y" - yyval := node("Baugneqv", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugneqv", valstk[3],valstk[2],valstk[1]) end procedure action_123() #line 553 "unigram.y" - yyval := node("Baugseq", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugseq", valstk[3],valstk[2],valstk[1]) end procedure action_124() #line 554 "unigram.y" - yyval := node("Baugsge", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugsge", valstk[3],valstk[2],valstk[1]) end procedure action_125() #line 555 "unigram.y" - yyval := node("Baugsgt", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugsgt", valstk[3],valstk[2],valstk[1]) end procedure action_126() #line 556 "unigram.y" - yyval := node("Baugsle", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugsle", valstk[3],valstk[2],valstk[1]) end procedure action_127() #line 557 "unigram.y" - yyval := node("Baugslt", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugslt", valstk[3],valstk[2],valstk[1]) end procedure action_128() #line 558 "unigram.y" - yyval := node("Baugsne", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugsne", valstk[3],valstk[2],valstk[1]) end procedure action_129() #line 559 "unigram.y" - yyval := node("Baugques", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugques", valstk[3],valstk[2],valstk[1]) end procedure action_130() #line 560 "unigram.y" - yyval := node("Baugamper", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugamper", valstk[3],valstk[2],valstk[1]) end procedure action_131() #line 561 "unigram.y" - yyval := node("Baugact", valstk[3],valstk[2],valstk[1]) + yyval := node("Baugact", valstk[3],valstk[2],valstk[1]) end procedure action_133() #line 564 "unigram.y" - yyval := node("BPmatch", valstk[3],valstk[2],valstk[1]) + yyval := node("BPmatch", valstk[3],valstk[2],valstk[1]) end procedure action_135() #line 567 "unigram.y" - yyval := node("to", valstk[3],valstk[2],valstk[1]) + yyval := node("to", valstk[3],valstk[2],valstk[1]) end procedure action_136() #line 568 "unigram.y" - yyval := node("toby", valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("toby", valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_137() #line 569 "unigram.y" - yyval := node("BPor", valstk[3],valstk[2],valstk[1]) + yyval := node("BPor", valstk[3],valstk[2],valstk[1]) end procedure action_139() #line 572 "unigram.y" - yyval := node("BPand", valstk[3],valstk[2],valstk[1]) + yyval := node("BPand", valstk[3],valstk[2],valstk[1]) end procedure action_140() #line 573 "unigram.y" - yyval := node(BAR, valstk[3],valstk[2],valstk[1]) + yyval := node(BAR, valstk[3],valstk[2],valstk[1]) end procedure action_142() #line 576 "unigram.y" - yyval := node("Bseq", valstk[3],valstk[2],valstk[1]) + yyval := node("Bseq", valstk[3],valstk[2],valstk[1]) end procedure action_143() #line 577 "unigram.y" - yyval := node("Bsge", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsge", valstk[3],valstk[2],valstk[1]) end procedure action_144() #line 578 "unigram.y" - yyval := node("Bsgt", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsgt", valstk[3],valstk[2],valstk[1]) end procedure action_145() #line 579 "unigram.y" - yyval := node("Bsle", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsle", valstk[3],valstk[2],valstk[1]) end procedure action_146() #line 580 "unigram.y" - yyval := node("Bslt", valstk[3],valstk[2],valstk[1]) + yyval := node("Bslt", valstk[3],valstk[2],valstk[1]) end procedure action_147() #line 581 "unigram.y" - yyval := node("Bsne", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsne", valstk[3],valstk[2],valstk[1]) end procedure action_148() #line 582 "unigram.y" - yyval := node("Beq", valstk[3],valstk[2],valstk[1]) + yyval := node("Beq", valstk[3],valstk[2],valstk[1]) end procedure action_149() #line 583 "unigram.y" - yyval := node("Bge", valstk[3],valstk[2],valstk[1]) + yyval := node("Bge", valstk[3],valstk[2],valstk[1]) end procedure action_150() #line 584 "unigram.y" - yyval := node("Bgt", valstk[3],valstk[2],valstk[1]) + yyval := node("Bgt", valstk[3],valstk[2],valstk[1]) end procedure action_151() #line 585 "unigram.y" - yyval := node("Ble", valstk[3],valstk[2],valstk[1]) + yyval := node("Ble", valstk[3],valstk[2],valstk[1]) end procedure action_152() #line 586 "unigram.y" - yyval := node("Blt", valstk[3],valstk[2],valstk[1]) + yyval := node("Blt", valstk[3],valstk[2],valstk[1]) end procedure action_153() #line 587 "unigram.y" - yyval := node("Bne", valstk[3],valstk[2],valstk[1]) + yyval := node("Bne", valstk[3],valstk[2],valstk[1]) end procedure action_154() #line 588 "unigram.y" - yyval := node("Beqv", valstk[3],valstk[2],valstk[1]) + yyval := node("Beqv", valstk[3],valstk[2],valstk[1]) end procedure action_155() #line 589 "unigram.y" - yyval := node("Bneqv", valstk[3],valstk[2],valstk[1]) + yyval := node("Bneqv", valstk[3],valstk[2],valstk[1]) end procedure action_157() #line 592 "unigram.y" - yyval := node("Bcat", valstk[3],valstk[2],valstk[1]) + yyval := node("Bcat", valstk[3],valstk[2],valstk[1]) end procedure action_158() #line 593 "unigram.y" - yyval := node("Blcat", valstk[3],valstk[2],valstk[1]) + yyval := node("Blcat", valstk[3],valstk[2],valstk[1]) end procedure action_160() #line 596 "unigram.y" - yyval := node("BPiam", valstk[3],valstk[2],valstk[1]) + yyval := node("BPiam", valstk[3],valstk[2],valstk[1]) end procedure action_161() #line 597 "unigram.y" - yyval := node("BPaom", valstk[3],valstk[2],valstk[1]) + yyval := node("BPaom", valstk[3],valstk[2],valstk[1]) end procedure action_162() #line 598 "unigram.y" - yyval := node("Bplus", valstk[3],valstk[2],valstk[1]) + yyval := node("Bplus", valstk[3],valstk[2],valstk[1]) end procedure action_163() #line 599 "unigram.y" - yyval := node("Bdiff", valstk[3],valstk[2],valstk[1]) + yyval := node("Bdiff", valstk[3],valstk[2],valstk[1]) end procedure action_164() #line 600 "unigram.y" - yyval := node("Bunion", valstk[3],valstk[2],valstk[1]) + yyval := node("Bunion", valstk[3],valstk[2],valstk[1]) end procedure action_165() #line 601 "unigram.y" - yyval := node("Bminus", valstk[3],valstk[2],valstk[1]) + yyval := node("Bminus", valstk[3],valstk[2],valstk[1]) end procedure action_167() #line 604 "unigram.y" - yyval := node("Bstar", valstk[3],valstk[2],valstk[1]) + yyval := node("Bstar", valstk[3],valstk[2],valstk[1]) end procedure action_168() #line 605 "unigram.y" - yyval := node("Binter", valstk[3],valstk[2],valstk[1]) + yyval := node("Binter", valstk[3],valstk[2],valstk[1]) end procedure action_169() #line 606 "unigram.y" - yyval := node("Bslash", valstk[3],valstk[2],valstk[1]) + yyval := node("Bslash", valstk[3],valstk[2],valstk[1]) end procedure action_170() #line 607 "unigram.y" - yyval := node("Bmod", valstk[3],valstk[2],valstk[1]) + yyval := node("Bmod", valstk[3],valstk[2],valstk[1]) end procedure action_173() #line 611 "unigram.y" - yyval := node("Bcaret", valstk[3],valstk[2],valstk[1]) + yyval := node("Bcaret", valstk[3],valstk[2],valstk[1]) end procedure action_174() #line 614 "unigram.y" - yyval := node("Bsnd", valstk[2],valstk[1],&null) + yyval := node("Bsnd", valstk[2],valstk[1],&null) end procedure action_175() #line 615 "unigram.y" - yyval := node("Bsndbk", valstk[2],valstk[1],&null) + yyval := node("Bsndbk", valstk[2],valstk[1],&null) end procedure action_176() #line 616 "unigram.y" - yyval := node("Brcv", valstk[2],valstk[1],&null) + yyval := node("Brcv", valstk[2],valstk[1],&null) end procedure action_177() #line 617 "unigram.y" - yyval := node("Brcvbk", valstk[2],valstk[1],&null) + yyval := node("Brcvbk", valstk[2],valstk[1],&null) end procedure action_179() #line 620 "unigram.y" - yyval := node("limit", valstk[3],valstk[2],valstk[1]) + yyval := node("limit", valstk[3],valstk[2],valstk[1]) end procedure action_180() #line 621 "unigram.y" - yyval := node("at", valstk[3],valstk[2],valstk[1]) + yyval := node("at", valstk[3],valstk[2],valstk[1]) end procedure action_181() #line 622 "unigram.y" - yyval := node("Bsnd", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsnd", valstk[3],valstk[2],valstk[1]) end procedure action_182() #line 623 "unigram.y" - yyval := node("Bsndbk", valstk[3],valstk[2],valstk[1]) + yyval := node("Bsndbk", valstk[3],valstk[2],valstk[1]) end procedure action_183() #line 624 "unigram.y" - yyval := node("Brcv", valstk[3],valstk[2],valstk[1]) + yyval := node("Brcv", valstk[3],valstk[2],valstk[1]) end procedure action_184() #line 625 "unigram.y" - yyval := node("Brcvbk", valstk[3],valstk[2],valstk[1]) + yyval := node("Brcvbk", valstk[3],valstk[2],valstk[1]) end procedure action_185() #line 626 "unigram.y" - yyval := node("apply", valstk[3],valstk[2],valstk[1]) + yyval := node("apply", valstk[3],valstk[2],valstk[1]) end procedure action_187() #line 629 "unigram.y" - yyval := node("uat", valstk[2],valstk[1]) + yyval := node("uat", valstk[2],valstk[1]) end procedure action_188() #line 630 "unigram.y" - yyval := node("Bsnd", &null,valstk[2],valstk[1]) + yyval := node("Bsnd", &null,valstk[2],valstk[1]) end procedure action_189() #line 631 "unigram.y" - yyval := node("Bsndbk", &null,valstk[2],valstk[1]) + yyval := node("Bsndbk", &null,valstk[2],valstk[1]) end procedure action_190() #line 632 "unigram.y" - yyval := node("Brcv", &null,valstk[2],valstk[1]) + yyval := node("Brcv", &null,valstk[2],valstk[1]) end procedure action_191() #line 633 "unigram.y" - yyval := node("Brcvbk", &null,valstk[2],valstk[1]) + yyval := node("Brcvbk", &null,valstk[2],valstk[1]) end procedure action_192() #line 634 "unigram.y" - yyval := node("unot", valstk[2],valstk[1]) + yyval := node("unot", valstk[2],valstk[1]) end procedure action_193() #line 635 "unigram.y" - yyval := node("ubar", valstk[2],valstk[1]) + yyval := node("ubar", valstk[2],valstk[1]) end procedure action_194() #line 636 "unigram.y" - yyval := node("uconcat", valstk[2],valstk[1]) + yyval := node("uconcat", valstk[2],valstk[1]) end procedure action_195() #line 637 "unigram.y" - yyval := node("ulconcat", valstk[2],valstk[1]) + yyval := node("ulconcat", valstk[2],valstk[1]) end procedure action_196() #line 638 "unigram.y" - yyval := node("udot", valstk[2],valstk[1]) + yyval := node("udot", valstk[2],valstk[1]) end procedure action_197() #line 639 "unigram.y" - yyval := node("ubang", valstk[2],valstk[1]) + yyval := node("ubang", valstk[2],valstk[1]) end procedure action_198() #line 640 "unigram.y" - yyval := node("udiff", valstk[2],valstk[1]) + yyval := node("udiff", valstk[2],valstk[1]) end procedure action_199() #line 641 "unigram.y" - yyval := node("uplus", valstk[2],valstk[1]) + yyval := node("uplus", valstk[2],valstk[1]) end procedure action_200() #line 642 "unigram.y" - yyval := node("ustar", valstk[2],valstk[1]) + yyval := node("ustar", valstk[2],valstk[1]) end procedure action_201() #line 643 "unigram.y" - yyval := node("uslash", valstk[2],valstk[1]) + yyval := node("uslash", valstk[2],valstk[1]) end procedure action_202() #line 644 "unigram.y" - yyval := node("ucaret", valstk[2],valstk[1]) + yyval := node("ucaret", valstk[2],valstk[1]) end procedure action_203() #line 645 "unigram.y" - yyval := node("uinter", valstk[2],valstk[1]) + yyval := node("uinter", valstk[2],valstk[1]) end procedure action_204() #line 646 "unigram.y" - yyval := node("utilde", valstk[2],valstk[1]) + yyval := node("utilde", valstk[2],valstk[1]) end procedure action_205() #line 647 "unigram.y" - yyval := node("uminus", valstk[2],valstk[1]) + yyval := node("uminus", valstk[2],valstk[1]) end procedure action_206() #line 648 "unigram.y" - yyval := node("unumeq", valstk[2],valstk[1]) + yyval := node("unumeq", valstk[2],valstk[1]) end procedure action_207() #line 649 "unigram.y" - yyval := node("unumne", valstk[2],valstk[1]) + yyval := node("unumne", valstk[2],valstk[1]) end procedure action_208() #line 650 "unigram.y" - yyval := node("ulexeq", valstk[2],valstk[1]) + yyval := node("ulexeq", valstk[2],valstk[1]) end procedure action_209() #line 651 "unigram.y" - yyval := node("ulexne", valstk[2],valstk[1]) + yyval := node("ulexne", valstk[2],valstk[1]) end procedure action_210() #line 652 "unigram.y" - yyval := node("uequiv", valstk[2],valstk[1]) + yyval := node("uequiv", valstk[2],valstk[1]) end procedure action_211() #line 653 "unigram.y" - yyval := node("uunion", valstk[2],valstk[1]) + yyval := node("uunion", valstk[2],valstk[1]) end procedure action_212() #line 654 "unigram.y" - yyval := node("uqmark", valstk[2],valstk[1]) + yyval := node("uqmark", valstk[2],valstk[1]) end procedure action_213() #line 655 "unigram.y" - yyval := node("unotequiv", valstk[2],valstk[1]) + yyval := node("unotequiv", valstk[2],valstk[1]) end procedure action_214() #line 656 "unigram.y" - yyval := node("ubackslash", valstk[2],valstk[1]) + yyval := node("ubackslash", valstk[2],valstk[1]) end procedure action_215() #line 657 "unigram.y" - yyval := node("upsetcur", valstk[2],valstk[1]) + yyval := node("upsetcur", valstk[2],valstk[1]) end procedure action_217() #line 660 "unigram.y" - next_gt_is_ender := 1 + next_gt_is_ender := 1 end procedure action_218() #line 660 "unigram.y" - yyval := node("regex", valstk[2]) + yyval := node("regex", valstk[2]) end procedure action_227() #line 669 "unigram.y" - yyval := node("Bsnd", &null,valstk[1],&null) + yyval := node("Bsnd", &null,valstk[1],&null) end procedure action_228() #line 670 "unigram.y" - yyval := node("Bsndbk", &null,valstk[1],&null) + yyval := node("Bsndbk", &null,valstk[1],&null) end procedure action_229() #line 671 "unigram.y" - yyval := node("Brcv", &null,valstk[1],&null) + yyval := node("Brcv", &null,valstk[1],&null) end procedure action_230() #line 672 "unigram.y" - yyval := node("Brcvbk", &null,valstk[1],&null) + yyval := node("Brcvbk", &null,valstk[1],&null) end procedure action_231() #line 673 "unigram.y" - yyval := node("BPuneval", valstk[1]) + yyval := node("BPuneval", valstk[1]) end procedure action_232() #line 674 "unigram.y" - yyval := node("create", valstk[2],valstk[1]) + yyval := node("create", valstk[2],valstk[1]) end procedure action_233() #line 675 "unigram.y" - fakeThreadIdent := Clone1stToken(valstk[2]) - fakeThreadIdent.tok := IDENT - fakeCreate := Clone1stToken(valstk[2]) - fakeCreate.tok := CREATE - fakeCreate.s := "create" - fakeThreadIdent.s := "spawn" - fakeLParen := Clone1stToken(valstk[2]) - fakeLParen.tok := LPAREN - fakeLParen.s := "(" - fakeRParen := Clone1stToken(valstk[2]) - fakeRParen.tok := RPAREN - fakeRParen.s := ")" - - yyval := SimpleInvocation(fakeThreadIdent,fakeLParen, - node("create", fakeCreate, valstk[1]), - fakeRParen) - + fakeThreadIdent := Clone1stToken(valstk[2]) + fakeThreadIdent.tok := IDENT + fakeCreate := Clone1stToken(valstk[2]) + fakeCreate.tok := CREATE + fakeCreate.s := "create" + fakeThreadIdent.s := "spawn" + fakeLParen := Clone1stToken(valstk[2]) + fakeLParen.tok := LPAREN + fakeLParen.s := "(" + fakeRParen := Clone1stToken(valstk[2]) + fakeRParen.tok := RPAREN + fakeRParen.s := ")" + + yyval := SimpleInvocation(fakeThreadIdent,fakeLParen, + node("create", fakeCreate, valstk[1]), + fakeRParen) + end procedure action_234() #line 693 "unigram.y" - yyval := node("critical", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("critical", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_236() #line 695 "unigram.y" - yyval := node("Next", valstk[1]) + yyval := node("Next", valstk[1]) end procedure action_237() #line 696 "unigram.y" - yyval := node("Break", valstk[2],valstk[1]) + yyval := node("Break", valstk[2],valstk[1]) end procedure action_238() #line 697 "unigram.y" - yyval := node("Paren", valstk[3],valstk[2],valstk[1]) + yyval := node("Paren", valstk[3],valstk[2],valstk[1]) end procedure action_239() #line 698 "unigram.y" - yyval := node("Brace", valstk[3],valstk[2],valstk[1]) + yyval := node("Brace", valstk[3],valstk[2],valstk[1]) end procedure action_240() #line 699 "unigram.y" - yyval := tablelit(valstk[3],valstk[2],valstk[1]) + yyval := tablelit(valstk[3],valstk[2],valstk[1]) end procedure action_241() #line 700 "unigram.y" - yyval := node("Brack", valstk[3],valstk[2],valstk[1]) + yyval := node("Brack", valstk[3],valstk[2],valstk[1]) end procedure action_242() #line 701 "unigram.y" - yyval := ListComp(valstk[3]) + yyval := ListComp(valstk[3]) end procedure action_243() #line 702 "unigram.y" - yyval := node("Subscript", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("Subscript", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_244() #line 703 "unigram.y" - yyval := node("Pdco0", valstk[3],valstk[2],valstk[1]) + yyval := node("Pdco0", valstk[3],valstk[2],valstk[1]) end procedure action_245() #line 704 "unigram.y" - yyval := node("Pdco1", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("Pdco1", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_246() #line 705 "unigram.y" yyval := SimpleInvocation(valstk[4],valstk[3],valstk[2],valstk[1]) - + end procedure action_247() #line 708 "unigram.y" - yyval := InvocationNode(valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) - + yyval := InvocationNode(valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_248() #line 711 "unigram.y" - yyval := InvocationNode(valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) - + yyval := InvocationNode(valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_249() #line 714 "unigram.y" - yyval := InvocationNode(valstk[8],valstk[7],valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) - + yyval := InvocationNode(valstk[8],valstk[7],valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_250() #line 717 "unigram.y" - yyval := InvocationNode(valstk[8],valstk[7],valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) - + yyval := InvocationNode(valstk[8],valstk[7],valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_251() #line 720 "unigram.y" yyval := FieldRef(valstk[3],valstk[2],valstk[1]) - + end procedure action_253() #line 724 "unigram.y" - yyval := Field(valstk[3],valstk[2],valstk[1]) + yyval := Field(valstk[3],valstk[2],valstk[1]) end procedure action_254() #line 725 "unigram.y" - yyval := node("keyword",valstk[2],valstk[1]) + yyval := node("keyword",valstk[2],valstk[1]) end procedure action_255() #line 726 "unigram.y" - yyval := Keyword(valstk[2],valstk[1]) + yyval := Keyword(valstk[2],valstk[1]) end procedure action_256() #line 728 "unigram.y" - yyval := node("While0", valstk[2],valstk[1]) - + yyval := node("While0", valstk[2],valstk[1]) + end procedure action_257() #line 731 "unigram.y" - # warn if a while loop should be an every. - # should generalize; compute a semantic attribute and - # warn if a while loop control expression is a generator. - # but for now, only complain about the most obvious case - if type(valstk[3]) == "treenode" & valstk[3].label === "assign" & - *valstk[3].children = 3 & type(valstk[3].children[3]) == "treenode" & - valstk[3].children[3].label == "to" & *(valstk[3].children[3].children)=3 & - (type(valstk[3].children[3].children[1]) === - type(valstk[3].children[3].children[3]) === "token") & - (valstk[3].children[3].children[1].tok = - valstk[3].children[3].children[3].tok = INTLIT) & - valstk[3].children[3].children[1].s<=valstk[3].children[3].children[3].s - then { - warning("infinite loop; use \"every\" to loop on generator results", - valstk[4].line, valstk[4].filename, valstk[4].s - ) - } - yyval := node("While1", valstk[4],valstk[3],valstk[2],valstk[1]) - + # warn if a while loop should be an every. + # should generalize; compute a semantic attribute and + # warn if a while loop control expression is a generator. + # but for now, only complain about the most obvious case + if type(valstk[3]) == "treenode" & valstk[3].label === "assign" & + *valstk[3].children = 3 & type(valstk[3].children[3]) == "treenode" & + valstk[3].children[3].label == "to" & *(valstk[3].children[3].children)=3 & + (type(valstk[3].children[3].children[1]) === + type(valstk[3].children[3].children[3]) === "token") & + (valstk[3].children[3].children[1].tok = + valstk[3].children[3].children[3].tok = INTLIT) & + valstk[3].children[3].children[1].s<=valstk[3].children[3].children[3].s + then { + warning("infinite loop; use \"every\" to loop on generator results", + valstk[4].line, valstk[4].filename, valstk[4].s + ) + } + yyval := node("While1", valstk[4],valstk[3],valstk[2],valstk[1]) + end procedure action_258() #line 752 "unigram.y" - yyval := node("until", valstk[2],valstk[1]) + yyval := node("until", valstk[2],valstk[1]) end procedure action_259() #line 753 "unigram.y" - yyval := node("until1", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("until1", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_260() #line 755 "unigram.y" - yyval := node("every", valstk[2],valstk[1]) + yyval := node("every", valstk[2],valstk[1]) end procedure action_261() #line 756 "unigram.y" - yyval := node("every1", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("every1", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_262() #line 758 "unigram.y" - yyval := node("repeat", valstk[2],valstk[1]) + yyval := node("repeat", valstk[2],valstk[1]) end procedure action_264() #line 761 "unigram.y" - yyval := node("return", valstk[2], valstk[1]) + yyval := node("return", valstk[2], valstk[1]) end procedure action_265() #line 762 "unigram.y" - yyval := node("Suspend0", valstk[2],valstk[1]) + yyval := node("Suspend0", valstk[2],valstk[1]) end procedure action_266() #line 763 "unigram.y" - yyval := node("Suspend1", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("Suspend1", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_267() #line 765 "unigram.y" - yyval := node("If0", valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("If0", valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_268() #line 766 "unigram.y" - yyval := node("If1", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("If1", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_269() #line 768 "unigram.y" - yyval := node("Case", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("Case", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_271() #line 771 "unigram.y" - yyval := node("Caselist", valstk[3],";",valstk[1]) + yyval := node("Caselist", valstk[3],";",valstk[1]) end procedure action_272() #line 773 "unigram.y" - yyval := node("cclause0", valstk[3],valstk[2],valstk[1]) + yyval := node("cclause0", valstk[3],valstk[2],valstk[1]) end procedure action_273() #line 774 "unigram.y" - yyval := node("cclause1", valstk[3],valstk[2],valstk[1]) + yyval := node("cclause1", valstk[3],valstk[2],valstk[1]) end procedure action_275() #line 777 "unigram.y" - if type(valstk[3])=="treenode" & (valstk[3].label=="elst1") then { - yyval := valstk[3]; put(yyval.children, valstk[2], valstk[1]) - } - else - yyval := node("elst1", valstk[3],valstk[2],valstk[1]) - + if type(valstk[3])=="treenode" & (valstk[3].label=="elst1") then { + yyval := valstk[3]; put(yyval.children, valstk[2], valstk[1]) + } + else + yyval := node("elst1", valstk[3],valstk[2],valstk[1]) + end procedure action_276() #line 785 "unigram.y" - yyval := node("pdcolist0", valstk[1]) + yyval := node("pdcolist0", valstk[1]) end procedure action_277() #line 786 "unigram.y" - yyval := node("pdcolist1", valstk[3],valstk[2],valstk[1]) + yyval := node("pdcolist1", valstk[3],valstk[2],valstk[1]) end procedure action_282() #line 793 "unigram.y" - yyval := regexp(valstk[1]) + yyval := regexp(valstk[1]) end procedure action_283() #line 794 "unigram.y" - yyval := "emptyregex" + yyval := "emptyregex" end procedure action_285() #line 799 "unigram.y" - yyval := node("regexbar", valstk[3], valstk[2], valstk[1]) + yyval := node("regexbar", valstk[3], valstk[2], valstk[1]) end procedure action_287() #line 803 "unigram.y" - yyval := node("regexconcat", valstk[2], valstk[1]) + yyval := node("regexconcat", valstk[2], valstk[1]) end procedure action_289() #line 807 "unigram.y" - yyval := node("kleene", valstk[2], valstk[1]) + yyval := node("kleene", valstk[2], valstk[1]) end procedure action_290() #line 808 "unigram.y" - yyval := node("oneormore", valstk[2], valstk[1]) + yyval := node("oneormore", valstk[2], valstk[1]) end procedure action_291() #line 809 "unigram.y" - yyval := node("optional", valstk[2], valstk[1]) + yyval := node("optional", valstk[2], valstk[1]) end procedure action_292() #line 810 "unigram.y" - if valstk[2].s < 0 then { - yyerror("regex occurrences may not be negative") - yyval := node("error") - } - else if valstk[2].s = 0 then { - yyerror("regex occurrences may not be zero yet") - yyval := node("error") - } - else if valstk[2].s = 1 then yyval := valstk[4] - else { # normal case, positive number of repeats of valstk[4] - yyval := valstk[4] - every i := 2 to valstk[2].s do { - yyval := node("regexconcat", yyval, valstk[4]) - } - } - + if valstk[2].s < 0 then { + yyerror("regex occurrences may not be negative") + yyval := node("error") + } + else if valstk[2].s = 0 then { + yyerror("regex occurrences may not be zero yet") + yyval := node("error") + } + else if valstk[2].s = 1 then yyval := valstk[4] + else { # normal case, positive number of repeats of valstk[4] + yyval := valstk[4] + every i := 2 to valstk[2].s do { + yyval := node("regexconcat", yyval, valstk[4]) + } + } + end procedure action_294() #line 830 "unigram.y" - yyval := valstk[1]; yyval.tok := IDENT + yyval := valstk[1]; yyval.tok := IDENT end procedure action_295() #line 831 "unigram.y" - yyval := valstk[1]; yyval.tok := IDENT + yyval := valstk[1]; yyval.tok := IDENT end procedure action_296() #line 832 "unigram.y" - yyval := valstk[1]; yyval.tok := IDENT + yyval := valstk[1]; yyval.tok := IDENT end procedure action_302() #line 838 "unigram.y" - yyval := node("Paren",valstk[3],valstk[2],valstk[1]) + yyval := node("Paren",valstk[3],valstk[2],valstk[1]) end procedure action_303() #line 839 "unigram.y" - yyval := node("acset", valstk[3], valstk[2], valstk[1]) - if type(valstk[2]) == "token" then { - if not ((valstk[3].line == valstk[2].line) & - (valstk[3].column + 1 == valstk[2].column)) then { - # [ is nonadjacent, add space - valstk[2].s := " " || valstk[2].s - } - } - else write("[ followed by ", type(valstk[2]), " so not checking for space") - + yyval := node("acset", valstk[3], valstk[2], valstk[1]) + if type(valstk[2]) == "token" then { + if not ((valstk[3].line == valstk[2].line) & + (valstk[3].column + 1 == valstk[2].column)) then { + # [ is nonadjacent, add space + valstk[2].s := " " || valstk[2].s + } + } + else write("[ followed by ", type(valstk[2]), " so not checking for space") + end procedure action_304() #line 850 "unigram.y" - yyval := node("notany", valstk[4], valstk[3], valstk[2], valstk[1]) + yyval := node("notany", valstk[4], valstk[3], valstk[2], valstk[1]) end procedure action_305() #line 851 "unigram.y" - yyval := node("escape", valstk[2], valstk[1]) + yyval := node("escape", valstk[2], valstk[1]) end procedure action_307() #line 855 "unigram.y" - yyval := node("brackchars", valstk[3], valstk[2], valstk[1]) + yyval := node("brackchars", valstk[3], valstk[2], valstk[1]) end procedure action_308() #line 856 "unigram.y" - if type(valstk[2]) == "treenode" then { - c1 := csetify(valstk[2]) - } - if type(valstk[1]) == "treenode" then c2 := csetify(valstk[1]) + if type(valstk[2]) == "treenode" then { + c1 := csetify(valstk[2]) + } + if type(valstk[1]) == "treenode" then c2 := csetify(valstk[1]) + + yyval := copy(valstk[2]) + while type(yyval) == "treenode" do { + yyval := copy(yyval.children[1]) + yyval.s := c1 + } + if type(yyval) ~== "token" then stop("regex type ", image(yyval)) - yyval := copy(valstk[2]) - while type(yyval) == "treenode" do { - yyval := copy(yyval.children[1]) - yyval.s := c1 - } - if type(yyval) ~== "token" then stop("regex type ", image(yyval)) + if type(valstk[1]) == "treenode" then yyval.s ||:= c2 + else yyval.s ||:= valstk[1].s - if type(valstk[1]) == "treenode" then yyval.s ||:= c2 - else yyval.s ||:= valstk[1].s - end procedure action_313() #line 875 "unigram.y" # ordinary escape char - yyval := valstk[1] - yyval.column := valstk[2].column - case yyval.s[1] of { - "b"|"d"|"e"|"f"|"l"|"n"|"r"|"t"|"v": yyval.s[1] := "\\" || yyval.s[1] - default: stop("unrecognized escape char \\", yyval.s[1]) - } - + yyval := valstk[1] + yyval.column := valstk[2].column + case yyval.s[1] of { + "b"|"d"|"e"|"f"|"l"|"n"|"r"|"t"|"v": yyval.s[1] := "\\" || yyval.s[1] + default: stop("unrecognized escape char \\", yyval.s[1]) + } + end procedure action_314() #line 883 "unigram.y" #escaped octal? - yyval := valstk[1] - yyval.column := valstk[2].column - case yyval.s[1] of { - "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7": yyval.s[1] := "\\" || yyval.s[1] - default: stop("non-octal numeric escape char \\", yyval.s[1]) - } - + yyval := valstk[1] + yyval.column := valstk[2].column + case yyval.s[1] of { + "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7": yyval.s[1] := "\\" || yyval.s[1] + default: stop("non-octal numeric escape char \\", yyval.s[1]) + } + end procedure action_315() #line 893 "unigram.y" - yyval := node("section", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) + yyval := node("section", valstk[6],valstk[5],valstk[4],valstk[3],valstk[2],valstk[1]) end procedure action_320() #line 900 "unigram.y" - yyval := node("compound", valstk[3],";",valstk[1]) + yyval := node("compound", valstk[3],";",valstk[1]) end procedure action_322() #line 903 "unigram.y" - yyval := node("error", valstk[4],valstk[2],valstk[1]) + yyval := node("error", valstk[4],valstk[2],valstk[1]) end procedure action_323() #line 904 "unigram.y" - yyval := node("error") + yyval := node("error") end #line 4476 "unigram.icn" diff --git a/uni/unicon/unigram.y b/uni/unicon/unigram.y index c65870c0a..407170e15 100644 --- a/uni/unicon/unigram.y +++ b/uni/unicon/unigram.y @@ -6,134 +6,134 @@ /* primitive tokens */ -%token IDENT -%token INTLIT -%token REALLIT -%token STRINGLIT -%token CSETLIT -%token EOFX +%token IDENT +%token INTLIT +%token REALLIT +%token STRINGLIT +%token CSETLIT +%token EOFX /* reserved words */ -%token BREAK /* break */ -%token BY /* by */ -%token CASE /* case */ -%token CLASS /* class */ -%token CREATE /* create */ -%token CRITICAL /* critical */ -%token DEFAULT /* default */ -%token DO /* do */ -%token ELSE /* else */ -%token END /* end */ -%token EVERY /* every */ -%token FAIL /* fail */ -%token GLOBAL /* global */ -%token IF /* if */ +%token BREAK /* break */ +%token BY /* by */ +%token CASE /* case */ +%token CLASS /* class */ +%token CREATE /* create */ +%token CRITICAL /* critical */ +%token DEFAULT /* default */ +%token DO /* do */ +%token ELSE /* else */ +%token END /* end */ +%token EVERY /* every */ +%token FAIL /* fail */ +%token GLOBAL /* global */ +%token IF /* if */ %token IMPORT /* import */ -%token iconINITIAL /* initial */ -%token INITIALLY /* initially */ -%token INVOCABLE /* invocable */ -%token LINK /* link */ -%token LOCAL /* local */ -%token METHOD /* method */ -%token NEXT /* next */ -%token NOT /* not */ -%token OF /* of */ -%token PACKAGE /* package */ -%token PROCEDURE /* procedure */ -%token RECORD /* record */ -%token REPEAT /* repeat */ -%token RETURN /* return */ -%token STATIC /* static */ -%token SUSPEND /* suspend */ -%token THEN /* then */ -%token THREAD /* thread */ -%token TO /* to */ -%token UNTIL /* until */ -%token WHILE /* while */ +%token iconINITIAL /* initial */ +%token INITIALLY /* initially */ +%token INVOCABLE /* invocable */ +%token LINK /* link */ +%token LOCAL /* local */ +%token METHOD /* method */ +%token NEXT /* next */ +%token NOT /* not */ +%token OF /* of */ +%token PACKAGE /* package */ +%token PROCEDURE /* procedure */ +%token RECORD /* record */ +%token REPEAT /* repeat */ +%token RETURN /* return */ +%token STATIC /* static */ +%token SUSPEND /* suspend */ +%token THEN /* then */ +%token THREAD /* thread */ +%token TO /* to */ +%token UNTIL /* until */ +%token WHILE /* while */ /* operators */ -%token BANG /* ! */ -%token MOD /* % */ -%token AUGMOD /* %:= */ -%token AND /* & */ -%token AUGAND /* &:= */ -%token STAR /* * */ -%token AUGSTAR /* *:= */ -%token INTER /* ** */ -%token AUGINTER /* **:= */ -%token PLUS /* + */ -%token AUGPLUS /* +:= */ -%token UNION /* ++ */ -%token AUGUNION /* ++:= */ -%token MINUS /* - */ -%token AUGMINUS /* -:= */ -%token DIFF /* -- */ -%token AUGDIFF /* --:= */ -%token DOT /* . */ -%token SLASH /* / */ -%token AUGSLASH /* /:= */ -%token ASSIGN /* := */ -%token SWAP /* :=: */ -%token NMLT /* < */ -%token AUGNMLT /* <:= */ -%token REVASSIGN /* <- */ -%token REVSWAP /* <-> */ -%token SLT /* << */ -%token AUGSLT /* <<:= */ -%token SLE /* <<= */ -%token AUGSLE /* <<=:= */ -%token NMLE /* <= */ -%token AUGNMLE /* <=:= */ -%token NMEQ /* = */ -%token AUGNMEQ /* =:= */ -%token SEQ /* == */ -%token AUGSEQ /* ==:= */ -%token EQUIV /* === */ -%token AUGEQUIV /* ===:= */ -%token NMGT /* > */ -%token AUGNMGT /* >:= */ -%token NMGE /* >= */ -%token AUGNMGE /* >=:= */ -%token SGT /* >> */ -%token AUGSGT /* >>:= */ -%token SGE /* >>= */ -%token AUGSGE /* >>=:= */ -%token QMARK /* ? */ -%token AUGQMARK /* ?:= */ -%token AT /* @ */ -%token AUGAT /* @:= */ -%token BACKSLASH /* \ */ -%token CARET /* ^ */ -%token AUGCARET /* ^:= */ -%token BAR /* | */ -%token CONCAT /* || */ -%token AUGCONCAT /* ||:= */ -%token LCONCAT /* ||| */ -%token AUGLCONCAT /* |||:= */ -%token TILDE /* ~ */ -%token NMNE /* ~= */ -%token AUGNMNE /* ~=:= */ -%token SNE /* ~== */ -%token AUGSNE /* ~==:= */ -%token NEQUIV /* ~=== */ -%token AUGNEQUIV /* ~===:= */ -%token LPAREN /* ( */ -%token RPAREN /* ) */ -%token PCOLON /* +: */ -%token COMMA /* , */ -%token MCOLON /* -: */ -%token COLON /* : */ -%token COLONCOLON /* :: */ -%token SEMICOL /* ; */ -%token LBRACK /* [ */ -%token RBRACK /* ] */ -%token LBRACE /* { */ -%token RBRACE /* } */ - -%token DOLLAR /* $ */ -%token ABSTRACT /* abstract */ +%token BANG /* ! */ +%token MOD /* % */ +%token AUGMOD /* %:= */ +%token AND /* & */ +%token AUGAND /* &:= */ +%token STAR /* * */ +%token AUGSTAR /* *:= */ +%token INTER /* ** */ +%token AUGINTER /* **:= */ +%token PLUS /* + */ +%token AUGPLUS /* +:= */ +%token UNION /* ++ */ +%token AUGUNION /* ++:= */ +%token MINUS /* - */ +%token AUGMINUS /* -:= */ +%token DIFF /* -- */ +%token AUGDIFF /* --:= */ +%token DOT /* . */ +%token SLASH /* / */ +%token AUGSLASH /* /:= */ +%token ASSIGN /* := */ +%token SWAP /* :=: */ +%token NMLT /* < */ +%token AUGNMLT /* <:= */ +%token REVASSIGN /* <- */ +%token REVSWAP /* <-> */ +%token SLT /* << */ +%token AUGSLT /* <<:= */ +%token SLE /* <<= */ +%token AUGSLE /* <<=:= */ +%token NMLE /* <= */ +%token AUGNMLE /* <=:= */ +%token NMEQ /* = */ +%token AUGNMEQ /* =:= */ +%token SEQ /* == */ +%token AUGSEQ /* ==:= */ +%token EQUIV /* === */ +%token AUGEQUIV /* ===:= */ +%token NMGT /* > */ +%token AUGNMGT /* >:= */ +%token NMGE /* >= */ +%token AUGNMGE /* >=:= */ +%token SGT /* >> */ +%token AUGSGT /* >>:= */ +%token SGE /* >>= */ +%token AUGSGE /* >>=:= */ +%token QMARK /* ? */ +%token AUGQMARK /* ?:= */ +%token AT /* @ */ +%token AUGAT /* @:= */ +%token BACKSLASH /* \ */ +%token CARET /* ^ */ +%token AUGCARET /* ^:= */ +%token BAR /* | */ +%token CONCAT /* || */ +%token AUGCONCAT /* ||:= */ +%token LCONCAT /* ||| */ +%token AUGLCONCAT /* |||:= */ +%token TILDE /* ~ */ +%token NMNE /* ~= */ +%token AUGNMNE /* ~=:= */ +%token SNE /* ~== */ +%token AUGSNE /* ~==:= */ +%token NEQUIV /* ~=== */ +%token AUGNEQUIV /* ~===:= */ +%token LPAREN /* ( */ +%token RPAREN /* ) */ +%token PCOLON /* +: */ +%token COMMA /* , */ +%token MCOLON /* -: */ +%token COLON /* : */ +%token COLONCOLON /* :: */ +%token SEMICOL /* ; */ +%token LBRACK /* [ */ +%token RBRACK /* ] */ +%token LBRACE /* { */ +%token RBRACE /* } */ + +%token DOLLAR /* $ */ +%token ABSTRACT /* abstract */ %token PMATCH /*?? */ %token PAND /*&& */ %token POR /* .| */ @@ -142,10 +142,10 @@ %token PIMDASSN /* $$ */ %token PSETCUR /* .$ */ -%token SND /* @> */ -%token SNDBK /* @>> */ -%token RCV /* @< */ -%token RCVBK /* @<< */ +%token SND /* @> */ +%token SNDBK /* @>> */ +%token RCV /* @< */ +%token RCVBK /* @<< */ %{ @@ -153,17 +153,17 @@ procedure Keyword(x1,x2) static keywords initial { keywords := set(["allocated","clock","collections","column","current", - "date","now","dateline","digits","e","error", - "errornumber","errortext","errorvalue","errout","fail", - "eventcode","eventsource","eventvalue","features", - "file","host","input","lcase","letters","level", - "line","main","null","output","phi","pi","pick","pos", - "progname","random","regions","source","storage", - "subject","time","trace","dump","ucase","version", - "errno","window","col","row","x","y","interval", - "control","shift","meta","lpress","mpress","rpress", - "lrelease","mrelease","rrelease","ldrag","mdrag", - "rdrag","resize","ascii","cset"]) + "date","now","dateline","digits","e","error", + "errornumber","errortext","errorvalue","errout","fail", + "eventcode","eventsource","eventvalue","features", + "file","host","input","lcase","letters","level", + "line","main","null","output","phi","pi","pick","pos", + "progname","random","regions","source","storage", + "subject","time","trace","dump","ucase","version", + "errno","window","col","row","x","y","interval", + "control","shift","meta","lpress","mpress","rpress", + "lrelease","mrelease","rrelease","ldrag","mdrag", + "rdrag","resize","ascii","cset"]) } # verify that x2 is a valid keyword @@ -179,9 +179,9 @@ initial { set_of_all_fields := set(); dummyrecno := 1 } if \iconc then { if type(x3) == "token" then { - insert(set_of_all_fields, x3.s) -# write(&errout, "field ", image(x3.s)) - } + insert(set_of_all_fields, x3.s) +# write(&errout, "field ", image(x3.s)) + } } return node("field",x1,x2,x3) @@ -191,8 +191,8 @@ procedure Clone1stToken(n) case type(n) of { "token": return copy(n) "treenode": { - return Clone1stToken(!n.children) - } + return Clone1stToken(!n.children) + } } end @@ -202,10 +202,10 @@ procedure Progend(x1) if *\parsingErrors > 0 then { every pe := !parsingErrors do { - write(&errout, pe.errorMessage) - } + write(&errout, pe.errorMessage) + } istop(*\parsingErrors || " error" || - (if *\parsingErrors > 1 then "s" else "")) + (if *\parsingErrors > 1 then "s" else "")) } if /x1 then istop("error: empty file") @@ -232,12 +232,12 @@ procedure Progend(x1) added := 0 every super := ((classes.foreach_t()).foreachsuper() | !imports) do { if /classes.lookup(super) then { - added := 1 - readspec(super) - cl := classes.lookup(super) - if /cl then halt("can't inherit class '",super,"'") - iwrite(" inherits ", super, " from ", cl.linkfile) - writelink(cl.dir, cl.linkfile) + added := 1 + readspec(super) + cl := classes.lookup(super) + if /cl then halt("can't inherit class '",super,"'") + iwrite(" inherits ", super, " from ", cl.linkfile) + writelink(cl.dir, cl.linkfile) } } if added = 0 then break @@ -271,16 +271,16 @@ $ifndef NoPatternIntegration if (*\list_of_invocables)>0 then { writes(yyout, "invocable ") every temp := list_of_invocables[i := 1 to *list_of_invocables] do { - writes(yyout, image(temp)) - if i < *list_of_invocables then writes(yyout, ",") + writes(yyout, image(temp)) + if i < *list_of_invocables then writes(yyout, ",") } write(yyout) } -$endif # NoPatternIntegration +$endif # NoPatternIntegration if \iconc & (type(set_of_all_fields) == "set") & - (*set_of_all_fields > 0) then { - arandomfield := !set_of_all_fields + (*set_of_all_fields > 0) then { + arandomfield := !set_of_all_fields writes(yyout, "record __dummyrecord",dummyrecno,"(",arandomfield) delete(set_of_all_fields, arandomfield) every writes(yyout, ",", !set_of_all_fields) @@ -299,38 +299,38 @@ end * This file is the iYacc input for building Icon-based Icon tools. */ -program : decls EOFX { Progend($1) } ; +program : decls EOFX { Progend($1) } ; -decls : { $$ := &null } ; - | decls decl { - if /parsingErrors | *parsingErrors = 0 then iwrites(&errout,".") - $$ := node("decls", $1, $2) - } ; +decls : { $$ := &null } ; + | decls decl { + if /parsingErrors | *parsingErrors = 0 then iwrites(&errout,".") + $$ := node("decls", $1, $2) + } ; -decl : record - | proc - | global - | link - | package - | import +decl : record + | proc + | global + | link + | package + | import | invocable - | cl - ; + | cl + ; initiallysection: { $$ := &null } - | INITIALLY SEMICOL locals initial procbody { - $$ := Method( , , , , , $1, "initially", &null, "method", "(", ")") - $$.locals := $3 - $$.initl := $4 - $$.procbody := $5 - } - | INITIALLY LPAREN arglist RPAREN SEMICOL locals initial procbody { - $$ := Method( , , , , , $1, "initially", $3, "method", "(", ")") - $$.locals := $6 - $$.initl := $7 - $$.procbody := $8 - } - ; + | INITIALLY SEMICOL locals initial procbody { + $$ := Method( , , , , , $1, "initially", &null, "method", "(", ")") + $$.locals := $3 + $$.initl := $4 + $$.procbody := $5 + } + | INITIALLY LPAREN arglist RPAREN SEMICOL locals initial procbody { + $$ := Method( , , , , , $1, "initially", $3, "method", "(", ")") + $$.locals := $6 + $$.initl := $7 + $$.procbody := $8 + } + ; optsemi : { $$ := &null } ; | SEMICOL; @@ -376,11 +376,11 @@ methods: { $$ := &null } ; invocable : INVOCABLE invoclist { $$ := node("invocable", $1, $2) } ; invoclist : invocop; - | invoclist COMMA invocop { $$ := node("invoclist", $1,$2,$3) } ; + | invoclist COMMA invocop { $$ := node("invoclist", $1,$2,$3) } ; invocop : IDENT ; - | STRINGLIT ; - | STRINGLIT COLON INTLIT {$$ := node("invocop3", $1,$2,$3) } ; + | STRINGLIT ; + | STRINGLIT COLON INTLIT {$$ := node("invocop3", $1,$2,$3) } ; package : PACKAGE lnkfile { if \thePackage then { @@ -407,502 +407,502 @@ import: IMPORT implist { import_class($2) } ; -link : LINK lnklist { $$ := node("link", $1,$2," ") } ; +link : LINK lnklist { $$ := node("link", $1,$2," ") } ; -lnklist : lnkfile ; - | lnklist COMMA lnkfile { $$ := node("lnklist", $1,$2,$3) } ; +lnklist : lnkfile ; + | lnklist COMMA lnkfile { $$ := node("lnklist", $1,$2,$3) } ; -implist : lnkfile ; - | implist COMMA lnkfile { $$ := node("implist", $1,$2,$3) } ; +implist : lnkfile ; + | implist COMMA lnkfile { $$ := node("implist", $1,$2,$3) } ; -lnkfile : IDENT ; - | STRINGLIT ; +lnkfile : IDENT ; + | STRINGLIT ; -global : GLOBAL idlist { $$ := node("global", $1,$2) } ; +global : GLOBAL idlist { $$ := node("global", $1,$2) } ; -record : RECORD IDENT LPAREN fldlist RPAREN { - $$ := declaration($2,$4,$1,$3,$5) - if \iconc then - ca_add_proc(yyfilename, $2.s) - } ; +record : RECORD IDENT LPAREN fldlist RPAREN { + $$ := declaration($2,$4,$1,$3,$5) + if \iconc then + ca_add_proc(yyfilename, $2.s) + } ; -fldlist : { $$ := &null } ; - | idlist ; +fldlist : { $$ := &null } ; + | idlist ; -proc : prochead SEMICOL locals initial procbody END { -# body_scopeck($5) - $3 := AppendListCompTemps($3, $5) - $$ := node("proc", $1,";",$3,$4,$5,$6) - } ; +proc : prochead SEMICOL locals initial procbody END { +# body_scopeck($5) + $3 := AppendListCompTemps($3, $5) + $$ := node("proc", $1,";",$3,$4,$5,$6) + } ; -meth : methhead SEMICOL locals initial procbody END { - $$ := $1 - $$.locals := $3 - $$.initl := $4 - $$.procbody := $5 - } - | ABSTRACT methhead { - $$ := $2 +meth : methhead SEMICOL locals initial procbody END { + $$ := $1 + $$.locals := $3 + $$.initl := $4 + $$.procbody := $5 + } + | ABSTRACT methhead { + $$ := $2 $$.abstract_flag := 1 - } ; + } ; prochead: PROCEDURE IDENT LPAREN arglist RPAREN { - $$ := declaration($2, $4, $1, $3, $5) - if \iconc then - ca_add_proc(yyfilename, $2.s) - } ; + $$ := declaration($2, $4, $1, $3, $5) + if \iconc then + ca_add_proc(yyfilename, $2.s) + } ; methhead: METHOD IDENT LPAREN arglist RPAREN { - $$ := Method( , , , , , $1, $2.s, $4, $1.s, $3, $5) - } ; + $$ := Method( , , , , , $1, $2.s, $4, $1.s, $3, $5) + } ; -arglist : { $$ := argList( , , &null) } ; - | parmlist { $$ := argList( , , $1) } ; - | parmlist LBRACK RBRACK { $$ := argList("[]" , , $1) } ; +arglist : { $$ := argList( , , &null) } ; + | parmlist { $$ := argList( , , $1) } ; + | parmlist LBRACK RBRACK { $$ := argList("[]" , , $1) } ; carglist: { $$ := argList( , , &null) } ; - | cparmlist { $$ := argList( , , $1) } ; - | cparmlist LBRACK RBRACK { $$ := argList("[]" , , $1) } ; + | cparmlist { $$ := argList( , , $1) } ; + | cparmlist LBRACK RBRACK { $$ := argList("[]" , , $1) } ; -idlist : IDENT ; - | idlist COMMA IDENT { $$ := node("idlist", $1,$2,$3) } ; +idlist : IDENT ; + | idlist COMMA IDENT { $$ := node("idlist", $1,$2,$3) } ; -varlist : IDENT ; - | IDENT ASSIGN expr1 { $$ := node("varlist2", $1, $2, $3)} - | varlist COMMA IDENT { $$ := node("varlist3", $1, $2, $3)} - | varlist COMMA IDENT ASSIGN expr1 { $$ := node("varlist4",$1,$2,$3,$4,$5)}; +varlist : IDENT ; + | IDENT ASSIGN expr1 { $$ := node("varlist2", $1, $2, $3)} + | varlist COMMA IDENT { $$ := node("varlist3", $1, $2, $3)} + | varlist COMMA IDENT ASSIGN expr1 { $$ := node("varlist4",$1,$2,$3,$4,$5)}; -stalist : IDENT ; - | IDENT ASSIGN expr1 { $$ := node("stalist2", $1, $2, $3)} - | stalist COMMA IDENT { $$ := node("stalist3", $1, $2, $3)} - | stalist COMMA IDENT ASSIGN expr1 { $$ := node("stalist4",$1,$2,$3,$4,$5)}; +stalist : IDENT ; + | IDENT ASSIGN expr1 { $$ := node("stalist2", $1, $2, $3)} + | stalist COMMA IDENT { $$ := node("stalist3", $1, $2, $3)} + | stalist COMMA IDENT ASSIGN expr1 { $$ := node("stalist4",$1,$2,$3,$4,$5)}; parmlist: arg ; - | parmlist COMMA arg { $$ := node("parmlist", $1,$2,$3) } ; + | parmlist COMMA arg { $$ := node("parmlist", $1,$2,$3) } ; cparmlist: carg ; - | cparmlist COMMA carg { $$ := node("parmlist", $1,$2,$3) } ; + | cparmlist COMMA carg { $$ := node("parmlist", $1,$2,$3) } ; -arg : IDENT ; - | IDENT COLON IDENT { $$ := node("arg2", $1, $2, $3) } ; - | IDENT COLON literal { $$ := node("arg3", $1, $2, $3) } ; - | IDENT COLON IDENT COLON literal { $$ := node("arg4", $1,$2,$3,$4,$5)}; - | IDENT COLON AND IDENT { $$ := node("arg5", $1, $2, Keyword($3, $4)) }; - | IDENT COLON IDENT COLON AND IDENT { $$ := node("arg6", $1, $2, $3, $4, Keyword($5, $6)) } ; - | IDENT COLON LBRACK RBRACK { $$ := node("arg7", $1, $2, "[]") } ; - | IDENT COLON IDENT COLON LBRACK RBRACK { $$ := node("arg8", $1, $2, $3, $4, "[]") } ; +arg : IDENT ; + | IDENT COLON IDENT { $$ := node("arg2", $1, $2, $3) } ; + | IDENT COLON literal { $$ := node("arg3", $1, $2, $3) } ; + | IDENT COLON IDENT COLON literal { $$ := node("arg4", $1,$2,$3,$4,$5)}; + | IDENT COLON AND IDENT { $$ := node("arg5", $1, $2, Keyword($3, $4)) }; + | IDENT COLON IDENT COLON AND IDENT { $$ := node("arg6", $1, $2, $3, $4, Keyword($5, $6)) } ; + | IDENT COLON LBRACK RBRACK { $$ := node("arg7", $1, $2, "[]") } ; + | IDENT COLON IDENT COLON LBRACK RBRACK { $$ := node("arg8", $1, $2, $3, $4, "[]") } ; -carg : priv arg { $$ := $2 }; +carg : priv arg { $$ := $2 }; priv: { $$ := &null } ; - | PLUS ; - | MINUS ; + | PLUS ; + | MINUS ; -clocals : { $$ := &null } ; - | clocals LOCAL varlist optsemi { $$ := node("locals2", $1,$2,$3,";") } ; +clocals : { $$ := &null } ; + | clocals LOCAL varlist optsemi { $$ := node("locals2", $1,$2,$3,";") } ; -locals : { $$ := &null } ; - | locals LOCAL varlist SEMICOL { $$ := node("locals2", $1,$2,$3,";") } ; - | locals STATIC stalist SEMICOL { $$ := node("locals3", $1,$2,$3,";") } ; +locals : { $$ := &null } ; + | locals LOCAL varlist SEMICOL { $$ := node("locals2", $1,$2,$3,";") } ; + | locals STATIC stalist SEMICOL { $$ := node("locals3", $1,$2,$3,";") } ; -initial : { $$ := &null } ; - | iconINITIAL expr SEMICOL { - $$ := node("initial", $1, $2,";") - } ; +initial : { $$ := &null } ; + | iconINITIAL expr SEMICOL { + $$ := node("initial", $1, $2,";") + } ; procbody: { $$ := &null } ; - | nexpr SEMICOL procbody { $$ := node("procbody", $1,";",$3) } ; + | nexpr SEMICOL procbody { $$ := node("procbody", $1,";",$3) } ; -nexpr : { $$ := &null } ; - | expr ; +nexpr : { $$ := &null } ; + | expr ; -expr : expr1a ; - | expr AND expr1a { $$ := node("and", $1,$2,$3) } ; +expr : expr1a ; + | expr AND expr1a { $$ := node("and", $1,$2,$3) } ; -expr1a : expr1 ; - | expr1a QMARK expr1 { $$ := node("binques", $1,$2,$3) } ; +expr1a : expr1 ; + | expr1a QMARK expr1 { $$ := node("binques", $1,$2,$3) } ; -expr1 : expr2a ; - | expr2a SWAP expr1 { $$ := node("swap", $1,$2,$3) } ; - | expr2a ASSIGN expr1 { +expr1 : expr2a ; + | expr2a SWAP expr1 { $$ := node("swap", $1,$2,$3) } ; + | expr2a ASSIGN expr1 { $$ := parenthesize_assign(node("assign",$1,$2,$3)) } ; - | expr2a REVSWAP expr1 { $$ := node("revswap", $1,$2,$3) } ; - | expr2a REVASSIGN expr1 { $$ := node("revasgn", $1,$2,$3) } ; - | expr2a AUGCONCAT expr1 { $$ := node("augcat", $1,$2,$3) } ; - | expr2a AUGLCONCAT expr1 { $$ := node("auglcat", $1,$2,$3) } ; - | expr2a AUGDIFF expr1 { $$ := node("Bdiffa", $1,$2,$3) } ; - | expr2a AUGUNION expr1 { $$ := node("Buniona", $1,$2,$3) } ; - | expr2a AUGPLUS expr1 { $$ := node("Bplusa", $1,$2,$3) } ; - | expr2a AUGMINUS expr1 { $$ := node("Bminusa", $1,$2,$3) } ; - | expr2a AUGSTAR expr1 { $$ := node("Bstara", $1,$2,$3) } ; - | expr2a AUGINTER expr1 { $$ := node("Bintera", $1,$2,$3) } ; - | expr2a AUGSLASH expr1 { $$ := node("Bslasha", $1,$2,$3) } ; - | expr2a AUGMOD expr1 { $$ := node("Bmoda", $1,$2,$3) } ; - | expr2a AUGCARET expr1 { $$ := node("Bcareta", $1,$2,$3) } ; - | expr2a AUGNMEQ expr1 { $$ := node("Baugeq", $1,$2,$3) } ; - | expr2a AUGEQUIV expr1 { $$ := node("Baugeqv", $1,$2,$3) } ; - | expr2a AUGNMGE expr1 { $$ := node("Baugge", $1,$2,$3) } ; - | expr2a AUGNMGT expr1 { $$ := node("Bauggt", $1,$2,$3) } ; - | expr2a AUGNMLE expr1 { $$ := node("Baugle", $1,$2,$3) } ; - | expr2a AUGNMLT expr1 { $$ := node("Bauglt", $1,$2,$3) } ; - | expr2a AUGNMNE expr1 { $$ := node("Baugne", $1,$2,$3) } ; - | expr2a AUGNEQUIV expr1 { $$ := node("Baugneqv", $1,$2,$3) } ; - | expr2a AUGSEQ expr1 { $$ := node("Baugseq", $1,$2,$3) } ; - | expr2a AUGSGE expr1 { $$ := node("Baugsge", $1,$2,$3) } ; - | expr2a AUGSGT expr1 { $$ := node("Baugsgt", $1,$2,$3) } ; - | expr2a AUGSLE expr1 { $$ := node("Baugsle", $1,$2,$3) } ; - | expr2a AUGSLT expr1 { $$ := node("Baugslt", $1,$2,$3) } ; - | expr2a AUGSNE expr1 { $$ := node("Baugsne", $1,$2,$3) } ; - | expr2a AUGQMARK expr1 { $$ := node("Baugques", $1,$2,$3) } ; - | expr2a AUGAND expr1 { $$ := node("Baugamper", $1,$2,$3) } ; - | expr2a AUGAT expr1 { $$ := node("Baugact", $1,$2,$3) } ; + | expr2a REVSWAP expr1 { $$ := node("revswap", $1,$2,$3) } ; + | expr2a REVASSIGN expr1 { $$ := node("revasgn", $1,$2,$3) } ; + | expr2a AUGCONCAT expr1 { $$ := node("augcat", $1,$2,$3) } ; + | expr2a AUGLCONCAT expr1 { $$ := node("auglcat", $1,$2,$3) } ; + | expr2a AUGDIFF expr1 { $$ := node("Bdiffa", $1,$2,$3) } ; + | expr2a AUGUNION expr1 { $$ := node("Buniona", $1,$2,$3) } ; + | expr2a AUGPLUS expr1 { $$ := node("Bplusa", $1,$2,$3) } ; + | expr2a AUGMINUS expr1 { $$ := node("Bminusa", $1,$2,$3) } ; + | expr2a AUGSTAR expr1 { $$ := node("Bstara", $1,$2,$3) } ; + | expr2a AUGINTER expr1 { $$ := node("Bintera", $1,$2,$3) } ; + | expr2a AUGSLASH expr1 { $$ := node("Bslasha", $1,$2,$3) } ; + | expr2a AUGMOD expr1 { $$ := node("Bmoda", $1,$2,$3) } ; + | expr2a AUGCARET expr1 { $$ := node("Bcareta", $1,$2,$3) } ; + | expr2a AUGNMEQ expr1 { $$ := node("Baugeq", $1,$2,$3) } ; + | expr2a AUGEQUIV expr1 { $$ := node("Baugeqv", $1,$2,$3) } ; + | expr2a AUGNMGE expr1 { $$ := node("Baugge", $1,$2,$3) } ; + | expr2a AUGNMGT expr1 { $$ := node("Bauggt", $1,$2,$3) } ; + | expr2a AUGNMLE expr1 { $$ := node("Baugle", $1,$2,$3) } ; + | expr2a AUGNMLT expr1 { $$ := node("Bauglt", $1,$2,$3) } ; + | expr2a AUGNMNE expr1 { $$ := node("Baugne", $1,$2,$3) } ; + | expr2a AUGNEQUIV expr1 { $$ := node("Baugneqv", $1,$2,$3) } ; + | expr2a AUGSEQ expr1 { $$ := node("Baugseq", $1,$2,$3) } ; + | expr2a AUGSGE expr1 { $$ := node("Baugsge", $1,$2,$3) } ; + | expr2a AUGSGT expr1 { $$ := node("Baugsgt", $1,$2,$3) } ; + | expr2a AUGSLE expr1 { $$ := node("Baugsle", $1,$2,$3) } ; + | expr2a AUGSLT expr1 { $$ := node("Baugslt", $1,$2,$3) } ; + | expr2a AUGSNE expr1 { $$ := node("Baugsne", $1,$2,$3) } ; + | expr2a AUGQMARK expr1 { $$ := node("Baugques", $1,$2,$3) } ; + | expr2a AUGAND expr1 { $$ := node("Baugamper", $1,$2,$3) } ; + | expr2a AUGAT expr1 { $$ := node("Baugact", $1,$2,$3) } ; expr2a : expr2; - | expr2a PMATCH expr2 { $$ := node("BPmatch", $1,$2,$3) } ; + | expr2a PMATCH expr2 { $$ := node("BPmatch", $1,$2,$3) } ; -expr2 : expr3 ; - | expr2 TO expr3 { $$ := node("to", $1,$2,$3) } ; - | expr2 TO expr3 BY expr3 { $$ := node("toby", $1,$2,$3,$4,$5) } ; +expr2 : expr3 ; + | expr2 TO expr3 { $$ := node("to", $1,$2,$3) } ; + | expr2 TO expr3 BY expr3 { $$ := node("toby", $1,$2,$3,$4,$5) } ; | expr2 POR expr3 { $$ := node("BPor", $1,$2,$3) }; -expr3 : expr4 ; +expr3 : expr4 ; | expr4 PAND expr3 { $$ := node("BPand", $1,$2,$3) }; - | expr4 BAR expr3 { $$ := node(BAR, $1,$2,$3) } ; - -expr4 : expr5; - | expr4 SEQ expr5 { $$ := node("Bseq", $1,$2,$3) } ; - | expr4 SGE expr5 { $$ := node("Bsge", $1,$2,$3) } ; - | expr4 SGT expr5 { $$ := node("Bsgt", $1,$2,$3) } ; - | expr4 SLE expr5 { $$ := node("Bsle", $1,$2,$3) } ; - | expr4 SLT expr5 { $$ := node("Bslt", $1,$2,$3) } ; - | expr4 SNE expr5 { $$ := node("Bsne", $1,$2,$3) } ; - | expr4 NMEQ expr5 { $$ := node("Beq", $1,$2,$3) } ; - | expr4 NMGE expr5 { $$ := node("Bge", $1,$2,$3) } ; - | expr4 NMGT expr5 { $$ := node("Bgt", $1,$2,$3) } ; - | expr4 NMLE expr5 { $$ := node("Ble", $1,$2,$3) } ; - | expr4 NMLT expr5 { $$ := node("Blt", $1,$2,$3) } ; - | expr4 NMNE expr5 { $$ := node("Bne", $1,$2,$3) } ; - | expr4 EQUIV expr5 { $$ := node("Beqv", $1,$2,$3) } ; - | expr4 NEQUIV expr5 { $$ := node("Bneqv", $1,$2,$3) } ; - -expr5 : expr6 ; - | expr5 CONCAT expr6 { $$ := node("Bcat", $1,$2,$3) } ; - | expr5 LCONCAT expr6 { $$ := node("Blcat", $1,$2,$3) } ; - -expr6 : expr7 ; - | expr6 PIMDASSN expr7 { $$ := node("BPiam", $1,$2,$3) } ; - | expr6 PASSNONMATCH expr7 { $$ := node("BPaom", $1,$2,$3) } ; - | expr6 PLUS expr7 { $$ := node("Bplus", $1,$2,$3) } ; - | expr6 DIFF expr7 { $$ := node("Bdiff", $1,$2,$3) } ; - | expr6 UNION expr7 { $$ := node("Bunion", $1,$2,$3) } ; - | expr6 MINUS expr7 { $$ := node("Bminus", $1,$2,$3) } ; - -expr7 : expr8 ; - | expr7 STAR expr8 { $$ := node("Bstar", $1,$2,$3) } ; - | expr7 INTER expr8 { $$ := node("Binter", $1,$2,$3) } ; - | expr7 SLASH expr8 { $$ := node("Bslash", $1,$2,$3) } ; - | expr7 MOD expr8 { $$ := node("Bmod", $1,$2,$3) } ; - -expr8 : expr9 ; - | postfixthreadop ; - | expr9 CARET expr8 { $$ := node("Bcaret", $1,$2,$3) } ; + | expr4 BAR expr3 { $$ := node(BAR, $1,$2,$3) } ; + +expr4 : expr5; + | expr4 SEQ expr5 { $$ := node("Bseq", $1,$2,$3) } ; + | expr4 SGE expr5 { $$ := node("Bsge", $1,$2,$3) } ; + | expr4 SGT expr5 { $$ := node("Bsgt", $1,$2,$3) } ; + | expr4 SLE expr5 { $$ := node("Bsle", $1,$2,$3) } ; + | expr4 SLT expr5 { $$ := node("Bslt", $1,$2,$3) } ; + | expr4 SNE expr5 { $$ := node("Bsne", $1,$2,$3) } ; + | expr4 NMEQ expr5 { $$ := node("Beq", $1,$2,$3) } ; + | expr4 NMGE expr5 { $$ := node("Bge", $1,$2,$3) } ; + | expr4 NMGT expr5 { $$ := node("Bgt", $1,$2,$3) } ; + | expr4 NMLE expr5 { $$ := node("Ble", $1,$2,$3) } ; + | expr4 NMLT expr5 { $$ := node("Blt", $1,$2,$3) } ; + | expr4 NMNE expr5 { $$ := node("Bne", $1,$2,$3) } ; + | expr4 EQUIV expr5 { $$ := node("Beqv", $1,$2,$3) } ; + | expr4 NEQUIV expr5 { $$ := node("Bneqv", $1,$2,$3) } ; + +expr5 : expr6 ; + | expr5 CONCAT expr6 { $$ := node("Bcat", $1,$2,$3) } ; + | expr5 LCONCAT expr6 { $$ := node("Blcat", $1,$2,$3) } ; + +expr6 : expr7 ; + | expr6 PIMDASSN expr7 { $$ := node("BPiam", $1,$2,$3) } ; + | expr6 PASSNONMATCH expr7 { $$ := node("BPaom", $1,$2,$3) } ; + | expr6 PLUS expr7 { $$ := node("Bplus", $1,$2,$3) } ; + | expr6 DIFF expr7 { $$ := node("Bdiff", $1,$2,$3) } ; + | expr6 UNION expr7 { $$ := node("Bunion", $1,$2,$3) } ; + | expr6 MINUS expr7 { $$ := node("Bminus", $1,$2,$3) } ; + +expr7 : expr8 ; + | expr7 STAR expr8 { $$ := node("Bstar", $1,$2,$3) } ; + | expr7 INTER expr8 { $$ := node("Binter", $1,$2,$3) } ; + | expr7 SLASH expr8 { $$ := node("Bslash", $1,$2,$3) } ; + | expr7 MOD expr8 { $$ := node("Bmod", $1,$2,$3) } ; + +expr8 : expr9 ; + | postfixthreadop ; + | expr9 CARET expr8 { $$ := node("Bcaret", $1,$2,$3) } ; postfixthreadop: - expr9 SND { $$ := node("Bsnd", $1,$2,&null) } ; - | expr9 SNDBK { $$ := node("Bsndbk", $1,$2,&null) } ; - | expr9 RCV { $$ := node("Brcv", $1,$2,&null) } ; - | expr9 RCVBK { $$ := node("Brcvbk", $1,$2,&null) } ; - -expr9 : expr10 ; - | expr9 BACKSLASH expr10 { $$ := node("limit", $1,$2,$3) } ; - | expr9 AT expr10 { $$ := node("at", $1,$2,$3) } ; - | expr9 SND expr10 { $$ := node("Bsnd", $1,$2,$3) } ; - | expr9 SNDBK expr10 { $$ := node("Bsndbk", $1,$2,$3) } ; - | expr9 RCV expr10 { $$ := node("Brcv", $1,$2,$3) } ; - | expr9 RCVBK expr10 { $$ := node("Brcvbk", $1,$2,$3) } ; - | expr9 BANG expr10 { $$ := node("apply", $1,$2,$3) }; - -expr10 : expr11 ; - | AT expr10 { $$ := node("uat", $1,$2) } ; - | SND expr10 { $$ := node("Bsnd", &null,$1,$2) } ; - | SNDBK expr10 { $$ := node("Bsndbk", &null,$1,$2) } ; - | RCV expr10 { $$ := node("Brcv", &null,$1,$2) } ; - | RCVBK expr10 { $$ := node("Brcvbk", &null,$1,$2) } ; - | NOT expr10 { $$ := node("unot", $1,$2) } ; - | BAR expr10 { $$ := node("ubar", $1,$2) } ; - | CONCAT expr10 { $$ := node("uconcat", $1,$2) } ; - | LCONCAT expr10 { $$ := node("ulconcat", $1,$2) } ; - | DOT expr10 { $$ := node("udot", $1,$2) } ; - | BANG expr10 { $$ := node("ubang", $1,$2) } ; - | DIFF expr10 { $$ := node("udiff", $1,$2) } ; - | PLUS expr10 { $$ := node("uplus", $1,$2) } ; - | STAR expr10 { $$ := node("ustar", $1,$2) } ; - | SLASH expr10 { $$ := node("uslash", $1,$2) } ; - | CARET expr10 { $$ := node("ucaret", $1,$2) } ; - | INTER expr10 { $$ := node("uinter", $1,$2) } ; - | TILDE expr10 { $$ := node("utilde", $1,$2) } ; - | MINUS expr10 { $$ := node("uminus", $1,$2) } ; - | NMEQ expr10 { $$ := node("unumeq", $1,$2) } ; - | NMNE expr10 { $$ := node("unumne", $1,$2) } ; - | SEQ expr10 { $$ := node("ulexeq", $1,$2) } ; - | SNE expr10 { $$ := node("ulexne", $1,$2) } ; - | EQUIV expr10 { $$ := node("uequiv", $1,$2) } ; - | UNION expr10 { $$ := node("uunion", $1,$2) } ; - | QMARK expr10 { $$ := node("uqmark", $1,$2) } ; - | NEQUIV expr10 { $$ := node("unotequiv", $1,$2) } ; - | BACKSLASH expr10 { $$ := node("ubackslash", $1,$2) } ; - | PSETCUR expr10 { $$ := node("upsetcur", $1,$2) } ; - -expr11 : literal ; - | NMLT { next_gt_is_ender := 1 } regex NMGT { $$ := node("regex", $3) } - | section ; - | return ; - | if ; - | case ; - | while ; - | until ; - | every ; - | repeat ; - | SND { $$ := node("Bsnd", &null,$1,&null) } ; - | SNDBK { $$ := node("Bsndbk", &null,$1,&null) } ; - | RCV { $$ := node("Brcv", &null,$1,&null) } ; - | RCVBK { $$ := node("Brcvbk", &null,$1,&null) } ; - | PUNEVAL { $$ := node("BPuneval", $1) } ; - | CREATE expr { $$ := node("create", $1,$2) } ; - | THREAD expr { - fakeThreadIdent := Clone1stToken($1) - fakeThreadIdent.tok := IDENT - fakeCreate := Clone1stToken($1) - fakeCreate.tok := CREATE - fakeCreate.s := "create" - fakeThreadIdent.s := "spawn" - fakeLParen := Clone1stToken($1) - fakeLParen.tok := LPAREN - fakeLParen.s := "(" - fakeRParen := Clone1stToken($1) - fakeRParen.tok := RPAREN - fakeRParen.s := ")" - - $$ := SimpleInvocation(fakeThreadIdent,fakeLParen, - node("create", fakeCreate, $2), - fakeRParen) - } ; - | CRITICAL expr2a COLON expr { $$ := node("critical", $1,$2,$3,$4) } ; - | IDENT ; - | NEXT { $$ := node("Next", $1) } ; - | BREAK nexpr { $$ := node("Break", $1,$2) } ; - | LPAREN exprlist RPAREN { $$ := node("Paren", $1,$2,$3) } ; - | LBRACE compound RBRACE { $$ := node("Brace", $1,$2,$3) } ; - | LBRACK caselist RBRACK { $$ := tablelit($1,$2,$3) } ; - | LBRACK exprlist RBRACK { $$ := node("Brack", $1,$2,$3) } ; - | LBRACK COLON expr COLON RBRACK { $$ := ListComp($3) } ; - | expr11 LBRACK exprlist RBRACK { $$ := node("Subscript", $1,$2,$3,$4) } ; - | expr11 LBRACE RBRACE { $$ := node("Pdco0", $1,$2,$3) } ; - | expr11 LBRACE pdcolist RBRACE { $$ := node("Pdco1", $1,$2,$3,$4) } ; - | expr11 LPAREN exprlist RPAREN { + expr9 SND { $$ := node("Bsnd", $1,$2,&null) } ; + | expr9 SNDBK { $$ := node("Bsndbk", $1,$2,&null) } ; + | expr9 RCV { $$ := node("Brcv", $1,$2,&null) } ; + | expr9 RCVBK { $$ := node("Brcvbk", $1,$2,&null) } ; + +expr9 : expr10 ; + | expr9 BACKSLASH expr10 { $$ := node("limit", $1,$2,$3) } ; + | expr9 AT expr10 { $$ := node("at", $1,$2,$3) } ; + | expr9 SND expr10 { $$ := node("Bsnd", $1,$2,$3) } ; + | expr9 SNDBK expr10 { $$ := node("Bsndbk", $1,$2,$3) } ; + | expr9 RCV expr10 { $$ := node("Brcv", $1,$2,$3) } ; + | expr9 RCVBK expr10 { $$ := node("Brcvbk", $1,$2,$3) } ; + | expr9 BANG expr10 { $$ := node("apply", $1,$2,$3) }; + +expr10 : expr11 ; + | AT expr10 { $$ := node("uat", $1,$2) } ; + | SND expr10 { $$ := node("Bsnd", &null,$1,$2) } ; + | SNDBK expr10 { $$ := node("Bsndbk", &null,$1,$2) } ; + | RCV expr10 { $$ := node("Brcv", &null,$1,$2) } ; + | RCVBK expr10 { $$ := node("Brcvbk", &null,$1,$2) } ; + | NOT expr10 { $$ := node("unot", $1,$2) } ; + | BAR expr10 { $$ := node("ubar", $1,$2) } ; + | CONCAT expr10 { $$ := node("uconcat", $1,$2) } ; + | LCONCAT expr10 { $$ := node("ulconcat", $1,$2) } ; + | DOT expr10 { $$ := node("udot", $1,$2) } ; + | BANG expr10 { $$ := node("ubang", $1,$2) } ; + | DIFF expr10 { $$ := node("udiff", $1,$2) } ; + | PLUS expr10 { $$ := node("uplus", $1,$2) } ; + | STAR expr10 { $$ := node("ustar", $1,$2) } ; + | SLASH expr10 { $$ := node("uslash", $1,$2) } ; + | CARET expr10 { $$ := node("ucaret", $1,$2) } ; + | INTER expr10 { $$ := node("uinter", $1,$2) } ; + | TILDE expr10 { $$ := node("utilde", $1,$2) } ; + | MINUS expr10 { $$ := node("uminus", $1,$2) } ; + | NMEQ expr10 { $$ := node("unumeq", $1,$2) } ; + | NMNE expr10 { $$ := node("unumne", $1,$2) } ; + | SEQ expr10 { $$ := node("ulexeq", $1,$2) } ; + | SNE expr10 { $$ := node("ulexne", $1,$2) } ; + | EQUIV expr10 { $$ := node("uequiv", $1,$2) } ; + | UNION expr10 { $$ := node("uunion", $1,$2) } ; + | QMARK expr10 { $$ := node("uqmark", $1,$2) } ; + | NEQUIV expr10 { $$ := node("unotequiv", $1,$2) } ; + | BACKSLASH expr10 { $$ := node("ubackslash", $1,$2) } ; + | PSETCUR expr10 { $$ := node("upsetcur", $1,$2) } ; + +expr11 : literal ; + | NMLT { next_gt_is_ender := 1 } regex NMGT { $$ := node("regex", $3) } + | section ; + | return ; + | if ; + | case ; + | while ; + | until ; + | every ; + | repeat ; + | SND { $$ := node("Bsnd", &null,$1,&null) } ; + | SNDBK { $$ := node("Bsndbk", &null,$1,&null) } ; + | RCV { $$ := node("Brcv", &null,$1,&null) } ; + | RCVBK { $$ := node("Brcvbk", &null,$1,&null) } ; + | PUNEVAL { $$ := node("BPuneval", $1) } ; + | CREATE expr { $$ := node("create", $1,$2) } ; + | THREAD expr { + fakeThreadIdent := Clone1stToken($1) + fakeThreadIdent.tok := IDENT + fakeCreate := Clone1stToken($1) + fakeCreate.tok := CREATE + fakeCreate.s := "create" + fakeThreadIdent.s := "spawn" + fakeLParen := Clone1stToken($1) + fakeLParen.tok := LPAREN + fakeLParen.s := "(" + fakeRParen := Clone1stToken($1) + fakeRParen.tok := RPAREN + fakeRParen.s := ")" + + $$ := SimpleInvocation(fakeThreadIdent,fakeLParen, + node("create", fakeCreate, $2), + fakeRParen) + } ; + | CRITICAL expr2a COLON expr { $$ := node("critical", $1,$2,$3,$4) } ; + | IDENT ; + | NEXT { $$ := node("Next", $1) } ; + | BREAK nexpr { $$ := node("Break", $1,$2) } ; + | LPAREN exprlist RPAREN { $$ := node("Paren", $1,$2,$3) } ; + | LBRACE compound RBRACE { $$ := node("Brace", $1,$2,$3) } ; + | LBRACK caselist RBRACK { $$ := tablelit($1,$2,$3) } ; + | LBRACK exprlist RBRACK { $$ := node("Brack", $1,$2,$3) } ; + | LBRACK COLON expr COLON RBRACK { $$ := ListComp($3) } ; + | expr11 LBRACK exprlist RBRACK { $$ := node("Subscript", $1,$2,$3,$4) } ; + | expr11 LBRACE RBRACE { $$ := node("Pdco0", $1,$2,$3) } ; + | expr11 LBRACE pdcolist RBRACE { $$ := node("Pdco1", $1,$2,$3,$4) } ; + | expr11 LPAREN exprlist RPAREN { $$ := SimpleInvocation($1,$2,$3,$4) } ; - | expr11 DOLLAR INITIALLY LPAREN exprlist RPAREN { - $$ := InvocationNode($1,$2,$3,$4,$5,$6) - } ; - | expr11 DOLLAR IDENT LPAREN exprlist RPAREN { - $$ := InvocationNode($1,$2,$3,$4,$5,$6) - } ; - | expr11 DOLLAR IDENT DOT INITIALLY LPAREN exprlist RPAREN { - $$ := InvocationNode($1,$2,$3,$4,$5,$6,$7,$8) - } ; - | expr11 DOLLAR IDENT DOT IDENT LPAREN exprlist RPAREN { - $$ := InvocationNode($1,$2,$3,$4,$5,$6,$7,$8) - } ; - | expr11 DOT IDENT { + | expr11 DOLLAR INITIALLY LPAREN exprlist RPAREN { + $$ := InvocationNode($1,$2,$3,$4,$5,$6) + } ; + | expr11 DOLLAR IDENT LPAREN exprlist RPAREN { + $$ := InvocationNode($1,$2,$3,$4,$5,$6) + } ; + | expr11 DOLLAR IDENT DOT INITIALLY LPAREN exprlist RPAREN { + $$ := InvocationNode($1,$2,$3,$4,$5,$6,$7,$8) + } ; + | expr11 DOLLAR IDENT DOT IDENT LPAREN exprlist RPAREN { + $$ := InvocationNode($1,$2,$3,$4,$5,$6,$7,$8) + } ; + | expr11 DOT IDENT { $$ := FieldRef($1,$2,$3) } ; - | packageref; - | expr11 DOT INITIALLY { $$ := Field($1,$2,$3) } ; - | AND FAIL { $$ := node("keyword",$1,$2) } ; - | AND IDENT { $$ := Keyword($1,$2) } ; - -while : WHILE expr { - $$ := node("While0", $1,$2) - } ; - | WHILE expr DO expr { - # warn if a while loop should be an every. - # should generalize; compute a semantic attribute and - # warn if a while loop control expression is a generator. - # but for now, only complain about the most obvious case - if type($2) == "treenode" & $2.label === "assign" & - *$2.children = 3 & type($2.children[3]) == "treenode" & - $2.children[3].label == "to" & *($2.children[3].children)=3 & - (type($2.children[3].children[1]) === - type($2.children[3].children[3]) === "token") & - ($2.children[3].children[1].tok = - $2.children[3].children[3].tok = INTLIT) & - $2.children[3].children[1].s<=$2.children[3].children[3].s - then { - warning("infinite loop; use \"every\" to loop on generator results", - $1.line, $1.filename, $1.s - ) - } - $$ := node("While1", $1,$2,$3,$4) - } ; - -until : UNTIL expr { $$ := node("until", $1,$2) } ; - | UNTIL expr DO expr { $$ := node("until1", $1,$2,$3,$4) } ; - -every : EVERY expr { $$ := node("every", $1,$2) } ; - | EVERY expr DO expr { $$ := node("every1", $1,$2,$3,$4) } ; - -repeat : REPEAT expr { $$ := node("repeat", $1,$2) } ; - -return : FAIL ; - | RETURN nexpr { $$ := node("return", $1, $2) } ; - | SUSPEND nexpr { $$ := node("Suspend0", $1,$2) } ; + | packageref; + | expr11 DOT INITIALLY { $$ := Field($1,$2,$3) } ; + | AND FAIL { $$ := node("keyword",$1,$2) } ; + | AND IDENT { $$ := Keyword($1,$2) } ; + +while : WHILE expr { + $$ := node("While0", $1,$2) + } ; + | WHILE expr DO expr { + # warn if a while loop should be an every. + # should generalize; compute a semantic attribute and + # warn if a while loop control expression is a generator. + # but for now, only complain about the most obvious case + if type($2) == "treenode" & $2.label === "assign" & + *$2.children = 3 & type($2.children[3]) == "treenode" & + $2.children[3].label == "to" & *($2.children[3].children)=3 & + (type($2.children[3].children[1]) === + type($2.children[3].children[3]) === "token") & + ($2.children[3].children[1].tok = + $2.children[3].children[3].tok = INTLIT) & + $2.children[3].children[1].s<=$2.children[3].children[3].s + then { + warning("infinite loop; use \"every\" to loop on generator results", + $1.line, $1.filename, $1.s + ) + } + $$ := node("While1", $1,$2,$3,$4) + } ; + +until : UNTIL expr { $$ := node("until", $1,$2) } ; + | UNTIL expr DO expr { $$ := node("until1", $1,$2,$3,$4) } ; + +every : EVERY expr { $$ := node("every", $1,$2) } ; + | EVERY expr DO expr { $$ := node("every1", $1,$2,$3,$4) } ; + +repeat : REPEAT expr { $$ := node("repeat", $1,$2) } ; + +return : FAIL ; + | RETURN nexpr { $$ := node("return", $1, $2) } ; + | SUSPEND nexpr { $$ := node("Suspend0", $1,$2) } ; | SUSPEND expr DO expr { $$ := node("Suspend1", $1,$2,$3,$4) }; -if : IF expr THEN expr { $$ := node("If0", $1,$2,$3,$4) } ; - | IF expr THEN expr ELSE expr { $$ := node("If1", $1,$2,$3,$4,$5,$6) } ; +if : IF expr THEN expr { $$ := node("If0", $1,$2,$3,$4) } ; + | IF expr THEN expr ELSE expr { $$ := node("If1", $1,$2,$3,$4,$5,$6) } ; -case : CASE expr OF LBRACE caselist RBRACE { $$ := node("Case", $1,$2,$3,$4,$5,$6) } ; +case : CASE expr OF LBRACE caselist RBRACE { $$ := node("Case", $1,$2,$3,$4,$5,$6) } ; caselist: cclause ; - | caselist SEMICOL cclause { $$ := node("Caselist", $1,";",$3) } ; + | caselist SEMICOL cclause { $$ := node("Caselist", $1,";",$3) } ; -cclause : DEFAULT COLON expr { $$ := node("cclause0", $1,$2,$3) } ; - | expr COLON expr { $$ := node("cclause1", $1,$2,$3) } ; +cclause : DEFAULT COLON expr { $$ := node("cclause0", $1,$2,$3) } ; + | expr COLON expr { $$ := node("cclause1", $1,$2,$3) } ; exprlist: nexpr ; - | exprlist COMMA nexpr { - if type($1)=="treenode" & ($1.label=="elst1") then { - $$ := $1; put($$.children, $2, $3) - } - else - $$ := node("elst1", $1,$2,$3) - } ; + | exprlist COMMA nexpr { + if type($1)=="treenode" & ($1.label=="elst1") then { + $$ := $1; put($$.children, $2, $3) + } + else + $$ := node("elst1", $1,$2,$3) + } ; pdcolist: nexpr { $$ := node("pdcolist0", $1) } ; - | pdcolist COMMA nexpr { $$ := node("pdcolist1", $1,$2,$3) } ; + | pdcolist COMMA nexpr { $$ := node("pdcolist1", $1,$2,$3) } ; -literal : INTLIT ; - | REALLIT ; - | STRINGLIT ; - | CSETLIT ; +literal : INTLIT ; + | REALLIT ; + | STRINGLIT ; + | CSETLIT ; regex: neregex { $$ := regexp($1) } - | { $$ := "emptyregex" } - ; + | { $$ := "emptyregex" } + ; /* nonempty regexp */ neregex: neregex2a - | neregex2a BAR neregex { $$ := node("regexbar", $1, $2, $3) } - ; + | neregex2a BAR neregex { $$ := node("regexbar", $1, $2, $3) } + ; neregex2a: neregex2 - | neregex2 neregex2a { $$ := node("regexconcat", $1, $2) } - ; + | neregex2 neregex2a { $$ := node("regexconcat", $1, $2) } + ; neregex2: neregex3 ; - | neregex2 STAR { $$ := node("kleene", $1, $2) } - | neregex2 PLUS { $$ := node("oneormore", $1, $2) } - | neregex2 QMARK { $$ := node("optional", $1, $2) } - | neregex2 LBRACE INTLIT RBRACE { - if $3.s < 0 then { - yyerror("regex occurrences may not be negative") - $$ := node("error") - } - else if $3.s = 0 then { - yyerror("regex occurrences may not be zero yet") - $$ := node("error") - } - else if $3.s = 1 then $$ := $1 - else { # normal case, positive number of repeats of $1 - $$ := $1 - every i := 2 to $3.s do { - $$ := node("regexconcat", $$, $1) - } - } - } - ; + | neregex2 STAR { $$ := node("kleene", $1, $2) } + | neregex2 PLUS { $$ := node("oneormore", $1, $2) } + | neregex2 QMARK { $$ := node("optional", $1, $2) } + | neregex2 LBRACE INTLIT RBRACE { + if $3.s < 0 then { + yyerror("regex occurrences may not be negative") + $$ := node("error") + } + else if $3.s = 0 then { + yyerror("regex occurrences may not be zero yet") + $$ := node("error") + } + else if $3.s = 1 then $$ := $1 + else { # normal case, positive number of repeats of $1 + $$ := $1 + every i := 2 to $3.s do { + $$ := node("regexconcat", $$, $1) + } + } + } + ; neregex3: IDENT - | BREAK { $$ := $1; $$.tok := IDENT } - | BY { $$ := $1; $$.tok := IDENT } - | PROCEDURE { $$ := $1; $$.tok := IDENT } - | INTLIT - | REALLIT - | STRINGLIT - | CSETLIT - | DOT - | LPAREN regex RPAREN { $$ := node("Paren",$1,$2,$3) } - | LBRACK brackchars RBRACK { - $$ := node("acset", $1, $2, $3) - if type($2) == "token" then { - if not (($1.line == $2.line) & - ($1.column + 1 == $2.column)) then { - # [ is nonadjacent, add space - $2.s := " " || $2.s - } - } - else { /* write("[ followed by ", type($2), " so not checking for space") */} - } - | LBRACK CARET brackchars RBRACK { $$ := node("notany", $1, $2, $3, $4) } - | BACKSLASH neregex { $$ := node("escape", $1, $2) } - ; + | BREAK { $$ := $1; $$.tok := IDENT } + | BY { $$ := $1; $$.tok := IDENT } + | PROCEDURE { $$ := $1; $$.tok := IDENT } + | INTLIT + | REALLIT + | STRINGLIT + | CSETLIT + | DOT + | LPAREN regex RPAREN { $$ := node("Paren",$1,$2,$3) } + | LBRACK brackchars RBRACK { + $$ := node("acset", $1, $2, $3) + if type($2) == "token" then { + if not (($1.line == $2.line) & + ($1.column + 1 == $2.column)) then { + # [ is nonadjacent, add space + $2.s := " " || $2.s + } + } + else { /* write("[ followed by ", type($2), " so not checking for space") */} + } + | LBRACK CARET brackchars RBRACK { $$ := node("notany", $1, $2, $3, $4) } + | BACKSLASH neregex { $$ := node("escape", $1, $2) } + ; brackchars: brackchars2 - | brackchars MINUS brackchars2 { $$ := node("brackchars", $1, $2, $3) } - | brackchars brackchars2 { - if type($1) == "treenode" then { - c1 := csetify($1) - } - if type($2) == "treenode" then c2 := csetify($2) - - $$ := copy($1) - while type($$) == "treenode" do { - $$ := copy($$.children[1]) - $$.s := c1 - } - if type($$) ~== "token" then stop("regex type ", image($$)) - - if type($2) == "treenode" then $$.s ||:= c2 - else $$.s ||:= $2.s - } - ; + | brackchars MINUS brackchars2 { $$ := node("brackchars", $1, $2, $3) } + | brackchars brackchars2 { + if type($1) == "treenode" then { + c1 := csetify($1) + } + if type($2) == "treenode" then c2 := csetify($2) + + $$ := copy($1) + while type($$) == "treenode" do { + $$ := copy($$.children[1]) + $$.s := c1 + } + if type($$) ~== "token" then stop("regex type ", image($$)) + + if type($2) == "treenode" then $$.s ||:= c2 + else $$.s ||:= $2.s + } + ; brackchars2: IDENT | INTLIT | REALLIT | DOT - | BACKSLASH IDENT { # ordinary escape char - $$ := $2 - $$.column := $1.column - case $$.s[1] of { - "b"|"d"|"e"|"f"|"l"|"n"|"r"|"t"|"v": $$.s[1] := "\\" || $$.s[1] - default: stop("unrecognized escape char \\", $$.s[1]) - } - } - | BACKSLASH INTLIT { #escaped octal? - $$ := $2 - $$.column := $1.column - case $$.s[1] of { - "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7": $$.s[1] := "\\" || $$.s[1] - default: stop("non-octal numeric escape char \\", $$.s[1]) - } - } - ; - -section : expr11 LBRACK expr sectop expr RBRACK { $$ := node("section", $1,$2,$3,$4,$5,$6) } ; - -sectop : COLON ; - | PCOLON ; - | MCOLON ; + | BACKSLASH IDENT { # ordinary escape char + $$ := $2 + $$.column := $1.column + case $$.s[1] of { + "b"|"d"|"e"|"f"|"l"|"n"|"r"|"t"|"v": $$.s[1] := "\\" || $$.s[1] + default: stop("unrecognized escape char \\", $$.s[1]) + } + } + | BACKSLASH INTLIT { #escaped octal? + $$ := $2 + $$.column := $1.column + case $$.s[1] of { + "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7": $$.s[1] := "\\" || $$.s[1] + default: stop("non-octal numeric escape char \\", $$.s[1]) + } + } + ; + +section : expr11 LBRACK expr sectop expr RBRACK { $$ := node("section", $1,$2,$3,$4,$5,$6) } ; + +sectop : COLON ; + | PCOLON ; + | MCOLON ; compound: nexpr ; - | nexpr SEMICOL compound { $$ := node("compound", $1,";",$3) } ; + | nexpr SEMICOL compound { $$ := node("compound", $1,";",$3) } ; -program : error decls EOFX ; -proc : prochead error procbody END { $$ := node("error", $1,$3,$4) } ; -expr : error { $$ := node("error") } ; +program : error decls EOFX ; +proc : prochead error procbody END { $$ := node("error", $1,$3,$4) } ; +expr : error { $$ := node("error") } ; %% @@ -953,31 +953,31 @@ procedure InvocationNode(args[]) else { n1 := node("Paren","(",node("assign","__"||tmpcount,":=",args[1]),")") if lparen := Clone1stToken(args[1]) then { - lparen.tok := LPAREN - lparen.s := "(" + lparen.tok := LPAREN + lparen.s := "(" } else lparen := "(" } if *args = 6 then { return node("Paren",lparen,node("invoke", - # iconc uses no __m business - (if /iconc then Field(Field(n1, ".", "__m"), "." , args[3]) - else Field(n1, ".", args[3])), - - args[4], node("exprlist", - if n1 === args[1] then args[1] else "__"||tmpcount, - if args[5] === &null then &null else ",",args[5]),args[6]) - ,")") + # iconc uses no __m business + (if /iconc then Field(Field(n1, ".", "__m"), "." , args[3]) + else Field(n1, ".", args[3])), + + args[4], node("exprlist", + if n1 === args[1] then args[1] else "__"||tmpcount, + if args[5] === &null then &null else ",",args[5]),args[6]) + ,")") } else { if /iconc then - return node("Paren",lparen,node("invoke",Field(Field( - Field(n1,".", "__m"), - "." , args[3]),".",args[5]), - args[6], node("exprlist", - if n1 === args[1] then args[1] else "__"||tmpcount, - if args[7] === &null then &null else ",",args[7]),args[8]) - ,")") + return node("Paren",lparen,node("invoke",Field(Field( + Field(n1,".", "__m"), + "." , args[3]),".",args[5]), + args[6], node("exprlist", + if n1 === args[1] then args[1] else "__"||tmpcount, + if args[7] === &null then &null else ",",args[7]),args[8]) + ,")") else return SuperMethodInvok ! args } end @@ -1065,14 +1065,14 @@ procedure buildtab_from_cclause(n, args) case n.label of { "cclause0": { if *args.children > 0 then push(args.children, comma) - push(args.children, n.children[3]) - } + push(args.children, n.children[3]) + } "cclause1": { if *args.children > 0 then push(args.children, comma) - push(args.children, n.children[3]) - push(args.children, comma) - push(args.children, n.children[1]) - } + push(args.children, n.children[3]) + push(args.children, comma) + push(args.children, n.children[1]) + } } end @@ -1086,9 +1086,9 @@ procedure ListComp(expr) tmpcount +:= 1 tmp := "__" || tmpcount return node("ListComp", - "{", string(tmp), " :=[]; every put(" || tmp || ", ", - expr, - "); if *" || tmp || ">0 then " || tmp || "}") + "{", string(tmp), " :=[]; every put(" || tmp || ", ", + expr, + "); if *" || tmp || ">0 then " || tmp || "}") end # @@ -1102,21 +1102,21 @@ procedure AppendListCompTemps(lcls, body) if *\(ltmps := ListCompTemps(body)) > 0 then { # make a varlist containing ltmps if *ltmps > 1 then { - vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") - every i := 2 to *ltmps do - vl := node("varlist3", vl, ",", - token(IDENT, ltmps[i], 0, 0, "lambda.icn")) - } + vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") + every i := 2 to *ltmps do + vl := node("varlist3", vl, ",", + token(IDENT, ltmps[i], 0, 0, "lambda.icn")) + } else { - # the varlist will just be an IDENT - vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") - } + # the varlist will just be an IDENT + vl := token(IDENT, ltmps[1], 0, 0, "lambda.icn") + } if (lcls === &null) | - (type(lcls)==="treenode" & lcls.label==("locals2"|"locals3")) then { - return node("locals2", lcls, "local", vl, ";") - } + (type(lcls)==="treenode" & lcls.label==("locals2"|"locals3")) then { + return node("locals2", lcls, "local", vl, ";") + } else - write(&errout, "don't know what to do with ", image(lcls)) + write(&errout, "don't know what to do with ", image(lcls)) } end @@ -1128,16 +1128,16 @@ procedure ListCompTemps(n) local LCT if type(n) == "treenode" then { if n.label=="ListComp" then { - LCT := [n.children[2]] - LCT |||:= ListCompTemps(n.children[4]) - return LCT - } + LCT := [n.children[2]] + LCT |||:= ListCompTemps(n.children[4]) + return LCT + } else if LCT := ListCompTemps(n.children[k := 1 to *(n.children)]) then { - every kk := k+1 to *(n.children) do { - LCT |||:= ListCompTemps(n.children[kk]) - } - return LCT - } + every kk := k+1 to *(n.children) do { + LCT |||:= ListCompTemps(n.children[kk]) + } + return LCT + } } end diff --git a/uni/unicon/unilex.icn b/uni/unicon/unilex.icn index 8ddf53ff2..2703a9736 100644 --- a/uni/unicon/unilex.icn +++ b/uni/unicon/unilex.icn @@ -166,38 +166,38 @@ initial { repeat { if pos(0) then fail if -# tokflags >= Newline & - ="#" then { - if ="line " then { - if yylineno := integer(tab(many(&digits))) then { - =" \"" - new_filename := tab(find("\"")|0) - if *new_filename > 0 then { - yyfilename := new_filename - } - } - } - tab(find("\n") | 0) - next - } +# tokflags >= Newline & + ="#" then { + if ="line " then { + if yylineno := integer(tab(many(&digits))) then { + =" \"" + new_filename := tab(find("\"")|0) + if *new_filename > 0 then { + yyfilename := new_filename + } + } + } + tab(find("\n") | 0) + next + } if ="\n" then { - yylineno +:= 1 - yycolno := 1 - if tokflags < Newline then - tokflags +:= Newline - next + yylineno +:= 1 + yycolno := 1 + if tokflags < Newline then + tokflags +:= Newline + next } if tab(any(' ')) then { yycolno +:= 1; next } if tab(any('\v\^l')) then { next } if tab(any('\t')) then { - yycolno +:= 1 - while (yycolno-1) % 8 ~= 0 do yycolno +:= 1 - next + yycolno +:= 1 + while (yycolno-1) % 8 ~= 0 do yycolno +:= 1 + next } yytext := move(1) if rv := punc_table[yytext]() then { - return rv + return rv } } end @@ -213,77 +213,77 @@ end procedure do_digits() local c, expstr, dsz, numdie - yytext ||:= tab(many(&digits)) - tokflags +:= Beginner+Ender - if yytext ||:= ="." then { - yytext ||:= tab(many(&digits)) - if yytext ||:= tab(any('eE')) then { - yytext ||:= tab(any('+-')) # optional + or - + yytext ||:= tab(many(&digits)) + tokflags +:= Beginner+Ender + if yytext ||:= ="." then { + yytext ||:= tab(many(&digits)) + if yytext ||:= tab(any('eE')) then { + yytext ||:= tab(any('+-')) # optional + or - if not (expstr := tab(many(&digits))) then { expstr := "" uni_error("malformed real number") } else if expstr > 308 then uni_error("real number out of range") - yytext ||:= expstr - } - return REALLIT - } - else if yytext ||:= tab(any('eE')) then { - yytext ||:= ="-" # optional; should we also allow + ? + yytext ||:= expstr + } + return REALLIT + } + else if yytext ||:= tab(any('eE')) then { + yytext ||:= ="-" # optional; should we also allow + ? if not (expstr := tab(many(&digits))) then uni_error("malformed real number") else if expstr > 308 then uni_error("real number out of range") else # keep this else, uni_error is non-fatal yytext ||:= expstr - return REALLIT - } - else { - if yytext ||:= tab(any('rR')) then { - yytext ||:= tab(many(R)) - } - else if c := tab(any('kK')) then { - yytext := string(yytext * 1024) - } - else if c := tab(any('mM')) then { - yytext := string(yytext * 1024^2) - } - else if c := tab(any('gG')) then { - yytext := string(yytext * 1024^3) - } - else if c := tab(any('tT')) then { - yytext := string(yytext * 1024^4) - } - else if c := tab(any('pP')) then { - yytext := string(yytext * 1024^5) - } + return REALLIT + } + else { + if yytext ||:= tab(any('rR')) then { + yytext ||:= tab(many(R)) + } + else if c := tab(any('kK')) then { + yytext := string(yytext * 1024) + } + else if c := tab(any('mM')) then { + yytext := string(yytext * 1024^2) + } + else if c := tab(any('gG')) then { + yytext := string(yytext * 1024^3) + } + else if c := tab(any('tT')) then { + yytext := string(yytext * 1024^4) + } + else if c := tab(any('pP')) then { + yytext := string(yytext * 1024^5) + } # e.g. 3D6 for sum of three six-sided dice - else if c := tab(any('dD')) & dsz := tab(many(&digits)) then { + else if c := tab(any('dD')) & dsz := tab(many(&digits)) then { numdie := integer(yytext) - yytext := "(" + yytext := "(" every !numdie do { if yytext ~== "(" then yytext ||:= "+" yytext ||:= "?" || dsz } - yytext ||:= ")" - } - if \c & any(&letters) then { - uni_error("missing space or malformed token") - } - return INTLIT - } + yytext ||:= ")" + } + if \c & any(&letters) then { + uni_error("missing space or malformed token") + } + return INTLIT + } end procedure do_dollar() - if yytext ||:= ="(" then { tokflags +:= Beginner; return LBRACE } - if yytext ||:= =")" then { tokflags +:= Ender; return RBRACE } - if yytext ||:= ="<" then { tokflags +:= Beginner; return LBRACK } - if yytext ||:= =">" then { tokflags +:= Ender; return RBRACK } + if yytext ||:= ="(" then { tokflags +:= Beginner; return LBRACE } + if yytext ||:= =")" then { tokflags +:= Ender; return RBRACE } + if yytext ||:= ="<" then { tokflags +:= Beginner; return LBRACK } + if yytext ||:= =">" then { tokflags +:= Ender; return RBRACK } $ifndef PatternIntegration - if yytext ||:= ="$" then { return PIMDASSN } + if yytext ||:= ="$" then { return PIMDASSN } $endif - return DOLLAR + return DOLLAR end procedure do_comma() @@ -319,38 +319,38 @@ procedure do_rparen() end procedure do_tilde() - if yytext ||:= ="=" then { - if yytext ||:= ="=" then { - if yytext ||:= ="=" then { - if yytext ||:= =":=" then {return AUGNEQUIV } - tokflags +:= Beginner - return NEQUIV - } - if yytext ||:= =":=" then {return AUGSNE} - tokflags +:= Beginner - return SNE - } - if yytext ||:= =":=" then { return AUGNMNE} - tokflags +:= Beginner - return NMNE - } - tokflags +:= Beginner - return TILDE + if yytext ||:= ="=" then { + if yytext ||:= ="=" then { + if yytext ||:= ="=" then { + if yytext ||:= =":=" then {return AUGNEQUIV } + tokflags +:= Beginner + return NEQUIV + } + if yytext ||:= =":=" then {return AUGSNE} + tokflags +:= Beginner + return SNE + } + if yytext ||:= =":=" then { return AUGNMNE} + tokflags +:= Beginner + return NMNE + } + tokflags +:= Beginner + return TILDE end procedure do_or() - if yytext ||:= ="|" then { - if yytext ||:= ="|" then { - if yytext ||:= =":=" then{return AUGLCONCAT} - tokflags +:= Beginner - return LCONCAT - } - if yytext ||:= =":=" then { return AUGCONCAT} - tokflags +:= Beginner - return CONCAT - } - tokflags +:= Beginner - return BAR + if yytext ||:= ="|" then { + if yytext ||:= ="|" then { + if yytext ||:= =":=" then{return AUGLCONCAT} + tokflags +:= Beginner + return LCONCAT + } + if yytext ||:= =":=" then { return AUGCONCAT} + tokflags +:= Beginner + return CONCAT + } + tokflags +:= Beginner + return BAR end procedure do_caret() @@ -380,29 +380,29 @@ procedure do_at() end procedure do_qmark() - if yytext ||:= =":=" then { return AUGQMARK } - else if yytext ||:= = "?" then {return PMATCH } - tokflags +:= Beginner - return QMARK + if yytext ||:= =":=" then { return AUGQMARK } + else if yytext ||:= = "?" then {return PMATCH } + tokflags +:= Beginner + return QMARK end procedure do_equal() - if yytext ||:= ="=" then { - if yytext ||:= ="=" then { - if yytext ||:= =":=" then{return AUGEQUIV} - tokflags +:= Beginner - return EQUIV - } - if yytext ||:= =":=" then { return AUGSEQ } - tokflags +:= Beginner - return SEQ - } - if yytext ||:= =":=" then { return AUGNMEQ } + if yytext ||:= ="=" then { + if yytext ||:= ="=" then { + if yytext ||:= =":=" then{return AUGEQUIV} + tokflags +:= Beginner + return EQUIV + } + if yytext ||:= =":=" then { return AUGSEQ } + tokflags +:= Beginner + return SEQ + } + if yytext ||:= =":=" then { return AUGNMEQ } $ifndef NoPatternIntegration - if yytext ||:= =">" then { return PIMDASSN } + if yytext ||:= =">" then { return PIMDASSN } $endif - tokflags +:= Beginner - return NMEQ + tokflags +:= Beginner + return NMEQ end global next_gt_is_ender @@ -412,9 +412,9 @@ procedure do_greater() if yytext ||:= =">" then { if yytext ||:= =":=" then { return AUGSGT } if yytext ||:= ="=" then { - if yytext ||:= =":=" then {return AUGSGE} - return SGE - } + if yytext ||:= =":=" then {return AUGSGE} + return SGE + } return SGT } if yytext ||:= ="=" then { @@ -434,40 +434,40 @@ procedure do_less() tokflags +:= Beginner + Ender return RCV } - if yytext ||:= =":=" then { return AUGNMLT } - if yytext ||:= ="-" then { - if yytext ||:= =">" then { return REVSWAP } - return REVASSIGN - } - if yytext ||:= ="<" then { - if yytext ||:= ="@" then { - tokflags +:= Beginner + Ender - return RCVBK - } - if yytext ||:= =":=" then { return AUGSLT } - if yytext ||:= ="=" then { - if yytext ||:= =":=" then {return AUGSLE} - return SLE - } - return SLT - } - if yytext ||:= ="=" then { - if yytext ||:= =":=" then { return AUGNMLE } - return NMLE - } - return NMLT + if yytext ||:= =":=" then { return AUGNMLT } + if yytext ||:= ="-" then { + if yytext ||:= =">" then { return REVSWAP } + return REVASSIGN + } + if yytext ||:= ="<" then { + if yytext ||:= ="@" then { + tokflags +:= Beginner + Ender + return RCVBK + } + if yytext ||:= =":=" then { return AUGSLT } + if yytext ||:= ="=" then { + if yytext ||:= =":=" then {return AUGSLE} + return SLE + } + return SLT + } + if yytext ||:= ="=" then { + if yytext ||:= =":=" then { return AUGNMLE } + return NMLE + } + return NMLT end procedure do_colon() - if yytext ||:= ="=" then { - if yytext ||:= =":" then { return SWAP } - return ASSIGN - } - if yytext ||:= =":" then { + if yytext ||:= ="=" then { + if yytext ||:= =":" then { return SWAP } + return ASSIGN + } + if yytext ||:= =":" then { tokflags +:= Beginner - return COLONCOLON - } - return COLON + return COLONCOLON + } + return COLON end procedure do_slash() @@ -478,41 +478,41 @@ end procedure do_dot() if yytext ||:= tab(many(&digits)) then { - tokflags +:= Beginner+Ender - return REALLIT + tokflags +:= Beginner+Ender + return REALLIT } else if yytext ||:= ="|" then { return POR } else if yytext ||:= =">" then { # .> is normally a cursor assignment, but not inside a regex if next_gt_is_ender === 1 then { - move(-1) # back up, don't eat the > - tokflags +:= Beginner - return DOT - } + move(-1) # back up, don't eat the > + tokflags +:= Beginner + return DOT + } else return PSETCUR } # next one .$ is candidate for deletion, old S.G. syntax else if yytext ||:= ="$" then { return PSETCUR } else { - tokflags +:= Beginner - return DOT + tokflags +:= Beginner + return DOT } end procedure do_minus() if yytext ||:= =":" then { - if yytext ||:= ="=" then { return AUGMINUS} - return MCOLON + if yytext ||:= ="=" then { return AUGMINUS} + return MCOLON } if yytext ||:= ="-" then { - if yytext ||:= =":=" then { return AUGDIFF} - tokflags +:= Beginner # could be two unary prefix - operators - return DIFF + if yytext ||:= =":=" then { return AUGDIFF} + tokflags +:= Beginner # could be two unary prefix - operators + return DIFF } if yytext ||:= =">" then { - return PASSNONMATCH - } + return PASSNONMATCH + } tokflags +:= Beginner return MINUS end @@ -540,9 +540,9 @@ end procedure do_star() if yytext ||:= =":=" then { return AUGSTAR } if yytext ||:= ="*" then { - if yytext ||:= =":=" then {return AUGINTER} - tokflags +:= Beginner # could be two unary prefix * operators - return INTER + if yytext ||:= =":=" then {return AUGINTER} + tokflags +:= Beginner # could be two unary prefix * operators + return INTER } tokflags +:= Beginner return STAR @@ -572,43 +572,43 @@ end procedure do_literal() local eat, s - until yytext ||:= =(yytext[1]) do { - if yytext ||:= ="\\" then { - # need more logic here to eat escape chars - yytext ||:= ="^" # \^ is a control-char escape - } - yytext ||:= move(1) | { - if not (yytext[-1]=="_") then { - uni_error("unterminated string constant") - break - } - } - if yytext[-1] == "\n" then { - # discard newline. discard trailing whitespace. - yytext := trim(yytext[1:-1]) - yylineno +:= 1 - yycolno := 1 - if not (yytext[-1] == "_") then { - uni_error("unterminated string constant") - break - } - else { - yytext := yytext[1:-1] # discard _ - if eat := tab(many(' \t')) then { - every s := !eat do { - yycolno +:= 1 - if s == "\t" then { - while (yycolno-1) % 8 ~= 0 do yycolno +:= 1 - } - } - } - } - } - } - tokflags +:= Beginner + Ender - if yytext[1] == "'" then - return CSETLIT - else return STRINGLIT + until yytext ||:= =(yytext[1]) do { + if yytext ||:= ="\\" then { + # need more logic here to eat escape chars + yytext ||:= ="^" # \^ is a control-char escape + } + yytext ||:= move(1) | { + if not (yytext[-1]=="_") then { + uni_error("unterminated string constant") + break + } + } + if yytext[-1] == "\n" then { + # discard newline. discard trailing whitespace. + yytext := trim(yytext[1:-1]) + yylineno +:= 1 + yycolno := 1 + if not (yytext[-1] == "_") then { + uni_error("unterminated string constant") + break + } + else { + yytext := yytext[1:-1] # discard _ + if eat := tab(many(' \t')) then { + every s := !eat do { + yycolno +:= 1 + if s == "\t" then { + while (yycolno-1) % 8 ~= 0 do yycolno +:= 1 + } + } + } + } + } + } + tokflags +:= Beginner + Ender + if yytext[1] == "'" then + return CSETLIT + else return STRINGLIT end @@ -618,25 +618,25 @@ procedure do_backquote() /unallowedchars := &ascii --( &letters ++ '()`., "_' ++ &digits) if yytext ||:= ="`" then { until yytext ||:= ="``" do { - if not (yytext ||:= move(1)) then { - uni_error(yytext) - return PUNEVAL - } - } + if not (yytext ||:= move(1)) then { + uni_error(yytext) + return PUNEVAL + } + } } else { until yytext ||:= ="`" do { - if not (yytext ||:= move(1)) then { - uni_error(yytext) - return PUNEVAL - } - } + if not (yytext ||:= move(1)) then { + uni_error(yytext) + return PUNEVAL + } + } } yytext ? { if tab(upto(unallowedchars)) then - uni_error(": character "||move(1)|| " not supported in ` ` expression") -# if *yytext = bal() then {} -# else uni_error(yytext) + uni_error(": character "||move(1)|| " not supported in ` ` expression") +# if *yytext = bal() then {} +# else uni_error(yytext) } tokflags +:= Ender return PUNEVAL @@ -664,12 +664,12 @@ procedure yylex(ender) initial { yylex2 := yylex2Normal if /buffer then - yylex_reinit() + yylex_reinit() } if /buffer then { if \debuglex then - write("yylex() : 0") + write("yylex() : 0") return 0 } if \saved_tok then { @@ -685,37 +685,37 @@ procedure yylex(ender) tokflags := 0 if *buffer=0 then { if type(yyin)=="list" then { - if buffer := pop(yyin) then { - yylineno +:= 1 - yycolno := 1 - if tokflags < Newline then - tokflags +:= Newline - return yylex(ender) - } - } + if buffer := pop(yyin) then { + yylineno +:= 1 + yycolno := 1 + if tokflags < Newline then + tokflags +:= Newline + return yylex(ender) + } + } buffer := &null if \debuglex then - write("yylex() : EOFX") + write("yylex() : EOFX") return EOFX } buffer ? { if rv := yylex2() then { - buffer := tab(0) + buffer := tab(0) } else { - if type(yyin)=="list" then { - if buffer := pop(yyin) then { - yylineno +:= 1 - yycolno := 1 - if tokflags < Newline then - tokflags +:= Newline - return yylex(ender) - } - } + if type(yyin)=="list" then { + if buffer := pop(yyin) then { + yylineno +:= 1 + yycolno := 1 + if tokflags < Newline then + tokflags +:= Newline + return yylex(ender) + } + } buffer := &null - yytext := "" - if \debuglex then - write("yylex() : EOFX") + yytext := "" + if \debuglex then + write("yylex() : EOFX") return EOFX } } @@ -737,7 +737,7 @@ end procedure token_isconst(t) return case t.tok of { INTLIT | REALLIT | STRINGLIT | CSETLIT : { - "const" + "const" } default: fail } diff --git a/uni/unicon/unix.icn b/uni/unicon/unix.icn index d82eb7693..06fe58119 100644 --- a/uni/unicon/unix.icn +++ b/uni/unicon/unix.icn @@ -1,5 +1,5 @@ # -# @(#)unix.icn 1.8 3/29/92 +# @(#)unix.icn 1.8 3/29/92 # OS-specific code for UNIX Idol # global icontopt,env,sysok,comp @@ -10,7 +10,7 @@ procedure mysystem(s) return system(s) end - + procedure sysinitialize() icontopt := " " env := getenv("IDOLENV") | "uniclass" diff --git a/uni/unicon/yyerror.icn b/uni/unicon/yyerror.icn index ddfc8c716..1b7c4163a 100644 --- a/uni/unicon/yyerror.icn +++ b/uni/unicon/yyerror.icn @@ -98,10 +98,10 @@ initial { __merr_errors +:= 1 if __merr_errors > 10 then { if *\parsingErrors > 0 then { - every pe := !parsingErrors do { - iwrite(&errout, pe.errorMessage) - } - } + every pe := !parsingErrors do { + iwrite(&errout, pe.errorMessage) + } + } istop("too many errors, aborting") } prefix := (\yyfilename||":") | "" @@ -114,19 +114,19 @@ initial { s := prefix ||yylineno||": # \""|| yytext || "\" " || s if \merrflag then { if ferr2 := open(\yyfilename) then { - if ferr := open("mail " || merraddress, "pw") then { - iwrite(&errout, "Reporting (-M) your error to the Oracle (", - merraddress, ") for assistance.") - iwrite(&errout, "Type any question you have on the lines below.", - " Type a blank line to finish.") - while iwrite(ferr, "" ~== read()) - iwrite(ferr) - iwrite(ferr, s) - iwrite(ferr) - while iwrite(ferr, read(ferr2)) - close(ferr) - } - close(ferr2) + if ferr := open("mail " || merraddress, "pw") then { + iwrite(&errout, "Reporting (-M) your error to the Oracle (", + merraddress, ") for assistance.") + iwrite(&errout, "Type any question you have on the lines below.", + " Type a blank line to finish.") + while iwrite(ferr, "" ~== read()) + iwrite(ferr) + iwrite(ferr, s) + iwrite(ferr) + while iwrite(ferr, read(ferr2)) + close(ferr) + } + close(ferr2) } } /parsingErrors := []