Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!rsalz From: rsalz@uunet.UU.NET (Rich Salz) Newsgroups: comp.sources.unix Subject: REPOST v12i055: A PostScript interpreter, Part06/18 Message-ID: <3630@uunet.UU.NET> Date: Sun, 29-Nov-87 18:56:22 EST Article-I.D.: uunet.3630 Posted: Sun Nov 29 18:56:22 1987 Date-Received: Wed, 2-Dec-87 20:55:52 EST Organization: UUNET Communications Services, Arlington, VA Lines: 4540 Approved: rs@uunet.UU.NET Submitted-by: Crispin Goswell Posting-number: Volume 12, Issue 55 Archive-name: postscript/part06 [ Sorry for the delays; when the net was free, I was busy. --r$ ] #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'postscript/fonts/Times/greek.r' <<'END_OF_FILE' XCharStrings X/2027 X Xput XMetrics X/2027 X[2 X20] Xput XCharStrings X/2028 X Xput XMetrics X/2028 X[1 X22] Xput XCharStrings X/2029 X Xput XMetrics X/2029 X[3 X18] Xput XCharStrings X/2030 X Xput XMetrics X/2030 X[2 X20] Xput XCharStrings X/2031 X Xput XMetrics X/2031 X[1 X21] Xput XCharStrings X/2032 X Xput XMetrics X/2032 X[2 X20] Xput XCharStrings X/2033 X Xput XMetrics X/2033 X[0 X24] Xput XCharStrings X/2034 X Xput XMetrics X/2034 X[1 X22] Xput XCharStrings X/2035 X Xput XMetrics X/2035 X[7 X11] Xput XCharStrings X/2036 X Xput XMetrics X/2036 X[0 X22] Xput XCharStrings X/2037 X Xput XMetrics X/2037 X[2 X20] Xput XCharStrings X/2038 X Xput XMetrics X/2038 X[0 X25] Xput XCharStrings X/2039 X Xput XMetrics X/2039 X[1 X23] Xput XCharStrings X/2040 X Xput XMetrics X/2040 X[2 X22] Xput XCharStrings X/2041 X Xput XMetrics X/2041 X[1 X22] Xput XCharStrings X/2042 X Xput XMetrics X/2042 X[0 X24] Xput XCharStrings X/2043 X Xput XMetrics X/2043 X[1 X22] Xput XCharStrings X/2044 X Xput XMetrics X/2044 X[2 X21] Xput XCharStrings X/2045 X Xput XMetrics X/2045 X[3 X19] Xput XCharStrings X/2046 X Xput XMetrics X/2046 X[3 X19] Xput XCharStrings X/2047 X Xput XMetrics X/2047 X[2 X21] Xput XCharStrings X/2048 X Xput XMetrics X/2048 X[2 X20] Xput XCharStrings X/2049 X Xput XMetrics X/2049 X[1 X23] Xput XCharStrings X/2050 X Xput XMetrics X/2050 X[1 X22] Xput XCharStrings X/2127 X Xput XMetrics X/2127 X[-3 X23] Xput XCharStrings X/2128 X Xput XMetrics X/2128 X[1 X21] Xput XCharStrings X/2129 X Xput XMetrics X/2129 X[-1 X20] Xput XCharStrings X/2130 X Xput XMetrics X/2130 X[4 X19] Xput XCharStrings X/2131 X Xput XMetrics X/2131 X[-3 X18] Xput XCharStrings X/2132 X Xput XMetrics X/2132 X[3 X18] Xput XCharStrings X/2133 X Xput XMetrics X/2133 X[-1 X22] Xput XCharStrings X/2134 X Xput XMetrics X/2134 X[0 X23] Xput XCharStrings X/2135 X Xput XMetrics X/2135 X[-1 X12] Xput XCharStrings X/2136 X Xput XMetrics X/2136 X[-2 X20] Xput XCharStrings X/2137 X Xput XMetrics X/2137 X[2 X20] Xput XCharStrings X/2138 X Xput XMetrics X/2138 X[-1 X23] Xput XCharStrings X/2139 X Xput XMetrics X/2139 X[-3 X20] Xput XCharStrings X/2140 X Xput XMetrics X/2140 X[3 X17] Xput XCharStrings X/2141 X Xput XMetrics X/2141 X[-3 X18] Xput XCharStrings X/2142 X Xput XMetrics X/2142 X[-2 X22] Xput XCharStrings X/2143 X Xput XMetrics X/2143 X[0 X19] Xput XCharStrings X/2144 X Xput XMetrics X/2144 X[-3 X21] Xput XCharStrings X/2145 X Xput XMetrics X/2145 X[-2 X20] Xput XCharStrings X/2146 X Xput XMetrics X/2146 X[-1 X20] Xput XCharStrings X/2147 X Xput XMetrics X/2147 X[-3 X22] Xput XCharStrings X/2148 X Xput XMetrics X/2148 X[-1 X18] Xput XCharStrings X/2149 X Xput XMetrics X/2149 X[0 X23] Xput XCharStrings X/2150 X Xput XMetrics X/2150 X[-3 X23] Xput END_OF_FILE if test 8441 -ne `wc -c <'postscript/fonts/Times/greek.r'`; then echo shar: \"'postscript/fonts/Times/greek.r'\" unpacked with wrong size! fi # end of 'postscript/fonts/Times/greek.r' fi if test -f 'postscript/fonts/Times/roman.r' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'postscript/fonts/Times/roman.r'\" else echo shar: Extracting \"'postscript/fonts/Times/roman.r'\" $9406 characters$ sed "s/^X//" >'postscript/fonts/Times/roman.r' <<'END_OF_FILE' XCharStrings X/a X Xput XMetrics X/a X[-3 X20] Xput XCharStrings X/b X Xput XMetrics X/b X[1 X21] Xput XCharStrings X/c X Xput XMetrics X/c X[-3 X19] Xput XCharStrings X/d X Xput XMetrics X/d X[2 X21] Xput XCharStrings X/e X Xput XMetrics X/e X[-3 X19] Xput XCharStrings X/f X Xput XMetrics X/f X[5 X13] Xput XCharStrings X/g X Xput XMetrics X/g X[-2 X19] Xput XCharStrings X/h X Xput XMetrics X/h X[1 X22] Xput XCharStrings X/i X Xput XMetrics X/i X[7 X11] Xput XCharStrings X/j X Xput XMetrics X/j X[7 X11] Xput XCharStrings X/k X Xput XMetrics X/k X[1 X21] Xput XCharStrings X/l X Xput XMetrics X/l X[7 X11] Xput XCharStrings X/m X Xput XMetrics X/m X[-2 X33] Xput XCharStrings X/n X Xput XMetrics X/n X[-2 X22] Xput XCharStrings X/o X Xput XMetrics X/o X[-3 X20] Xput XCharStrings X/p X Xput XMetrics X/p X[-2 X21] Xput XCharStrings X/q X Xput XMetrics X/q X[-3 X20] Xput XCharStrings X/r X Xput XMetrics X/r X[-2 X17] Xput XCharStrings X/s X Xput XMetrics X/s X[-3 X17] Xput XCharStrings X/t X Xput XMetrics X/t X[5 X15] Xput XCharStrings X/u X Xput XMetrics X/u X[-2 X22] Xput XCharStrings X/v X Xput XMetrics X/v X[-1 X18] Xput XCharStrings X/w X Xput XMetrics X/w X[-1 X24] Xput XCharStrings X/x X Xput XMetrics X/x X[-2 X20] Xput XCharStrings X/y X Xput XMetrics X/y X[-2 X19] Xput XCharStrings X/z X Xput XMetrics X/z X[-3 X18] Xput XCharStrings X/space X() Xput XMetrics X/space X[0 X20] Xput XCharStrings X/A X Xput XMetrics X/A X[2 X20] Xput XCharStrings X/B X Xput XMetrics X/B X[1 X22] Xput XCharStrings X/C X Xput XMetrics X/C X[1 X21] Xput XCharStrings X/D X Xput XMetrics X/D X[1 X22] Xput XCharStrings X/E X Xput XMetrics X/E X[1 X21] Xput XCharStrings X/F X Xput XMetrics X/F X[1 X20] Xput XCharStrings X/G X Xput XMetrics X/G X[1 X23] Xput XCharStrings X/H X Xput XMetrics X/H X[0 X24] Xput XCharStrings X/I X Xput XMetrics X/I X[7 X11] Xput XCharStrings X/J X Xput XMetrics X/J X[5 X15] Xput XCharStrings X/K X Xput XMetrics X/K X[0 X22] Xput XCharStrings X/L X Xput XMetrics X/L X[3 X18] Xput XCharStrings X/M X Xput XMetrics X/M X[0 X25] Xput XCharStrings X/N X Xput XMetrics X/N X[1 X23] Xput XCharStrings X/O X Xput XMetrics X/O X[1 X22] Xput XCharStrings X/P X Xput XMetrics X/P X[1 X22] Xput XCharStrings X/Q X Xput XMetrics X/Q X[1 X22] Xput XCharStrings X/R X Xput XMetrics X/R X[1 X22] Xput XCharStrings X/S X Xput XMetrics X/S X[2 X20] Xput XCharStrings X/T X Xput XMetrics X/T X[3 X19] Xput XCharStrings X/U X Xput XMetrics X/U X[0 X24] Xput XCharStrings X/V X Xput XMetrics X/V X[2 X20] Xput XCharStrings X/W X Xput XMetrics X/W X[0 X24] Xput XCharStrings X/X X Xput XMetrics X/X X[2 X20] Xput XCharStrings X/Y X Xput XMetrics X/Y X[2 X21] Xput XCharStrings X/Z X Xput XMetrics X/Z X[2 X20] Xput XCharStrings X/ff X Xput XMetrics X/ff X[1 X23] Xput XCharStrings X/fi X Xput XMetrics X/fi X[1 X22] Xput XCharStrings X/fl X Xput XMetrics X/fl X[1 X22] Xput XCharStrings X/ffi X Xput XMetrics X/ffi X[-2 X33] Xput XCharStrings X/ffl X Xput XMetrics X/ffl X[-2 X33] Xput XCharStrings X/dotlessi X Xput XMetrics X/dotlessi X[0 X11] Xput END_OF_FILE if test 9406 -ne `wc -c <'postscript/fonts/Times/roman.r'`; then echo shar: \"'postscript/fonts/Times/roman.r'\" unpacked with wrong size! fi # end of 'postscript/fonts/Times/roman.r' fi if test -f 'source/colour-ww.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'source/colour-ww.c'\" else echo shar: Extracting \"'source/colour-ww.c'\" $9048 characters$ sed "s/^X//" >'source/colour-ww.c' <<'END_OF_FILE' X/* X * Copyright (C) Rutherford Appleton Laboratory 1987 X * X * This source may be copied, distributed, altered or used, but not sold for profit X * or incorporated into a product except under licence from the author. X * It is not in the public domain. X * This notice should remain in the source unaltered, and any changes to the source X * made by persons other than the author should be marked as such. X * X * Crispin Goswell @ Rutherford Appleton Laboratory caag@uk.ac.rl.vd X */ X#include "main.h" X#include "graphics.h" X#include "canon.h" X#include "wwinfo.h" X Xstatic void xxrasterop (); X Xstatic struct hardware *NewHardware (); X X#define COLOURS 256 X Xstatic unsigned char reds[COLOURS], greens[COLOURS], blues[COLOURS]; Xstatic int colours_used = 0; X Xstruct hardware *InitHardware () X { X wwstartup (COLOURS); X InitTransfer (wwask (ASKXPPI)); X X return NULL; X } X Xint HardColour (h, colour) struct hardware *h; Colour colour; X { X float r, g, b; X unsigned char red, green, blue; X int i; X X ColourRGB (colour, &r, &g, &b); X X red = 255 * r; green = 255 * g; blue = 255 * b; X for (i = 0; i < colours_used; i++) X if (reds[i] == red && greens[i] == green && blues[i] == blue) X return i; X if (colours_used == COLOURS) X return 0; X reds[colours_used] = red; greens[colours_used] = green; blues[colours_used] = blue; X colours_used++; X X InstallColour (h, i); X return i; X } X Xvoid Paint (from, to, fromPoint, toPoint, extent, colour) X struct hardware *from, *to; X DevicePoint fromPoint, toPoint, extent; X Colour colour; X { X dd->d_fore = HardColour (to, colour); X BitBlt (from, to, fromPoint, toPoint, extent, ROP_OR); X } X Xvoid PaintLine (h, fromPoint, toPoint, colour) X struct hardware *h; X DevicePoint fromPoint, toPoint; X Colour colour; X { X dd->d_fore = HardColour (h, colour); X BitBltLine (h, fromPoint, toPoint, ROP_TRUE); X } X Xvoid PaintTrapezoid (to, lefttop, leftbottom, righttop, rightbottom, top, bottom, colour) X struct hardware *to; X DevicePoint lefttop, leftbottom, righttop, rightbottom; X int top, bottom; X Colour colour; X { X dd->d_fore = HardColour (to, colour); X BitBltTrapezoid (to, lefttop, leftbottom, righttop, rightbottom, top, bottom, ROP_TRUE); X } X X#define TRANSFER_SIZE 256 X Xstatic int transfer [TRANSFER_SIZE]; X Xvoid InitTransfer (ppi) int ppi; X { X int i; X X pixels_per_inch = ppi; X for (i = 0; i < TRANSFER_SIZE; i++) X transfer [i] = i; X } X Xint TransferSize () X { X return TRANSFER_SIZE; X } X Xvoid SetTransfer (tran) float *tran; X { X int i; X X for (i = 0; i < TRANSFER_SIZE; i++) X transfer [i] = (TRANSFER_SIZE - 1) * tran[i] + .5; X } X Xint ScreenSize (freq, rot) float freq, rot; X { X return 0; X } X Xvoid BuildScreen (freq, rotation, x, y) float freq, rotation, *x, *y; X { X } X Xvoid SetScreen (freq, rotation, thresh) float freq, rotation, *thresh; X { X } X Xstruct hardware *NewWindowHardware (width, height) int width, height; X { X DevicePoint real_extent; X window *w; X X real_extent = NewDevicePoint (width, height); X X if (width == 0) X width = 1; X if (height == 0) X height = 1; X X if ((w = wwxget (boxbuild (0, 0, width, height), COLOURS, "PostScript", 0)) == NULL) X return NULL; X return NewHardware (w->w_bm, real_extent, ISWIN); X } X Xstruct hardware *NewBitmapHardware (width, height) int width, height; X { X DevicePoint real_extent; X bitmap *bm; X X real_extent = NewDevicePoint (width, height); X X if (width == 0) X width = 1; X if (height == 0) X height = 1; X if ((bm = bmxget (width, height, 2)) == NULL) X return NULL; X X return NewHardware (bm, real_extent, 0); X } X X#define DeviceBitmap(h) ((bitmap *) ((h)->hard.addr)) X XInstallColour (h, col) struct hardware *h; int col; X { X corep (DeviceBitmap (h), &reds[col], &greens[col], &blues[col], 0, col, 1, COSET); X } X Xstatic void DestroyHard (dev) struct hardware *dev; X { X bitmap *bm = DeviceBitmap (dev); X X if (bm) X { X if (bm->bm_window) X wwfree (bm->bm_window); X else X bmfree (bm); X } X } X Xvoid DestroyHardware (dev) struct hardware *dev; X { X if (dev == NULL) X return; X DestroyHard (dev); X if (dev->aux) X DestroyHardware (dev->aux); X Free ((char *) dev); X } X Xstatic struct hardware *NewHardware (bm, extent, flags) bitmap *bm; DevicePoint extent; int flags; X { X struct hardware *d = (struct hardware *) Malloc (sizeof (struct hardware)); X X d->flags = flags; X d->hard.addr = (char *) bm; X d->aux = d->clip = NULL; X d->extent = extent; X X return d; X } X Xstruct hardware *HardwareFromString (st, width, height) char *st; int width, height; X { X unsigned size = height * (width + 7) / 8; X char *s = Malloc (size + 4); X struct hardware *h; X X s[0] = height >> 8; s[1] = height; X s[2] = width >> 8; s[3] = width; X Bcopy (s + 4, st, size); X X h = NewHardware (bmdecode (s, ENWWSTYLE), NewDevicePoint (width, height), 0); X Free ((char *) s); X X return h; X } X Xchar *StringFromHardware (dev) struct hardware *dev; X { X int length; X X return bmencode (DeviceBitmap (dev), ENWWSTYLE, &length) + 4; X } X Xvoid UpdateControl (h, flag) struct hardware *h; int flag; X { X window *oldddwin = ddwin; X X if (h == NULL) X return; X ddwin = DeviceBitmap (h)->bm_window; X if (ddwin) X wwstack (flag ? WWPOP : WWPUSHOFF); X ddwin = oldddwin; X } X Xvoid RasterTile (from, to, toPoint, extent, rop) X struct hardware *from, *to; X DevicePoint toPoint, extent; X int rop; X { X if (to == NULL || DeviceBitmap (to) == NULL || extent.dx == 0 || extent.dy == 0) X return; X bmclip (DeviceBitmap (to), boxbuild (toPoint.dx, toPoint.dy, toPoint.dx + extent.dx - 1, toPoint.dy + extent.dy - 1)); X xxrasterop (DeviceBitmap (from), DeviceBitmap (from)->bm_box, DeviceBitmap (to), DeviceBitmap (to)->bm_box, rop); X bmclip (DeviceBitmap (to), noclipbox); X } X Xvoid BitBlt (from, to, fromPoint, toPoint, extent, rop) X struct hardware *from, *to; X DevicePoint fromPoint, toPoint, extent; X int rop; X { X box frombox, tobox; X X if (to == NULL || DeviceBitmap (to) == NULL || extent.dx == 0 || extent.dy == 0) X return; X X if (from == NULL || DeviceBitmap (from) == NULL) X rop = single_rop [rop]; X else X frombox = boxbuild (fromPoint.dx, fromPoint.dy, fromPoint.dx + extent.dx - 1, fromPoint.dy + extent.dy - 1); X X tobox = boxbuild (toPoint.dx, toPoint.dy, toPoint.dx + extent.dx - 1, toPoint.dy + extent.dy - 1); X X xxrasterop ((from == NULL ? NULL : DeviceBitmap (from)), frombox, DeviceBitmap (to), tobox, rop); X } X Xvoid BitBltLine (h, fromPoint, toPoint, rop) X struct hardware *h; X DevicePoint fromPoint, toPoint; X int rop; X { X if (h == NULL || DeviceBitmap (h) == NULL) X return; X X switch (single_rop [rop]) X { X case ROP_FALSE: rop = WWAND; break; X case ROP_TRUE: rop = WWOR; break; X case ROP_NOTDEST: rop = WWXOR; break; X case ROP_DEST: return; break; X X default: X fprintf (stderr, "illegal rasterop\n"); X exit (1); X } X X ddbm = DeviceBitmap (h); X dd->d_line = rop; X X line (fromPoint.dx, fromPoint.dy, LNMOVEABS); X line (toPoint.dx, toPoint.dy, LNDRAWABS); X } X Xvoid BitBltBlob (to, top, height, left, right, rop) struct hardware *to; int top, height, *left, *right, rop; X { X int i, op, offset = top; X height += top; X switch (rop) X { X case ROP_FALSE: op = BMCLEARALL; break; X case ROP_DEST: return; X case ROP_NOTDEST: op = BMNOTALL; break; X case ROP_TRUE: op = BMNOTALL | BMCLEARALL; break; X } X ddbm = DeviceBitmap (to); X wwstack (WWPUSHOFF); X for (i = top; i < height; i++) X bmbox (boxbuild (left[i - offset], i, right[i - offset], i), op); X wwstack (WWPOP); X } X Xstatic void xxrasterop (from, frombox, to, tobox, rop) bitmap *from, *to; box frombox, tobox; int rop; X { X switch (rop) X { X case ROP_FALSE: bmxbox (to, tobox, BMCLEARALL); break; X case ROP_AND: bmxcopy (from, frombox, to, tobox, WWAND); break; X case ROP_ANDNOT: bmxcopy (from, frombox, to, tobox, WWOR | WWNOT); bmxbox (to, tobox, BMNOTALL); break; X case ROP_SOURCE: bmxcopy (from, frombox, to, tobox, WWCOPY); break; X case ROP_NOTAND: bmxcopy (from, frombox, to, tobox, WWAND | WWNOT); break; X case ROP_DEST: break; X case ROP_XOR: bmxcopy (from, frombox, to, tobox, WWXOR); break; X case ROP_OR: bmxcopy (from, frombox, to, tobox, WWOR); break; X case ROP_NOR: bmxcopy (from, frombox, to, tobox, WWOR); bmxbox (to, tobox, BMNOTALL); break; X case ROP_NXOR: bmxcopy (from, frombox, to, tobox, WWXOR); bmxbox (to, tobox, BMNOTALL); break; X case ROP_NOTDEST: bmxbox (to, tobox, BMNOTALL); break; X case ROP_ORNOT: bmxcopy (from, frombox, to, tobox, WWAND | WWNOT); bmxbox (to, tobox, BMNOTALL); break; X case ROP_NOTSOURCE: bmxcopy (from, frombox, to, tobox, WWCOPY | WWNOT); break; X case ROP_NOTOR: bmxcopy (from, frombox, to, tobox, WWOR | WWNOT); break; X case ROP_NAND: bmxcopy (from, frombox, to, tobox, WWAND); bmxbox (to, tobox, BMNOTALL); break; X case ROP_TRUE: bmxbox (to, tobox, BMCLEARALL | BMNOTALL); break; X X default: X fprintf (stderr, "Illegal rasterop %d (hex 0x%x)\n", rop, rop); X exit (1); X } X } END_OF_FILE if test 9048 -ne `wc -c <'source/colour-ww.c'`; then echo shar: \"'source/colour-ww.c'\" unpacked with wrong size! fi # end of 'source/colour-ww.c' fi if test -f 'source/integer.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'source/integer.c'\" else echo shar: Extracting \"'source/integer.c'\" $8759 characters$ sed "s/^X//" >'source/integer.c' <<'END_OF_FILE' X/* X * Copyright (C) Rutherford Appleton Laboratory 1987 X * X * This source may be copied, distributed, altered or used, but not sold for profit X * or incorporated into a product except under licence from the author. X * It is not in the public domain. X * This notice should remain in the source unaltered, and any changes to the source X * made by persons other than the author should be marked as such. X * X * Crispin Goswell @ Rutherford Appleton Laboratory caag@uk.ac.rl.vd X */ X#include X#include "main.h" X Xstatic Object OpFor; X Xstatic int For (), PFor (), Eq (), Lt (), Le (), Gt (), Ge (), Not (), And (), Or (), Xor (), BitShift (); Xstatic int Abs (), Add (), Sub (), Mul (), Div (), Mod (), Neg (); Xstatic int Exp (), Sqrt (), Sin (), Cos (), Atan (), Ln (), Log (), Identity (); Xstatic int Cvr (), Cvs (), EqEq (); X Xstatic int WordSize, Word2, LowMask; X XInitInteger () X { X unsigned word; X X OpFor = MakeOp ("(forinteger)", For, 0, 1, 5, 6); X X TypeInstallOp (Integer, "cvi", Identity, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "cvr", Cvr, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "cvs", Cvs, 2, 1, 0, 0, Integer, String); X TypeInstallOp (Integer, "==", EqEq, 1, 0, 0, 0, Integer); X TypeInstallOp (Integer, "for", PFor, 4, 0, 0, 6, Integer, Integer, Integer, Array); X TypeInstallOp (Integer, "eq", Eq, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "lt", Lt, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "le", Le, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "gt", Gt, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "ge", Ge, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "not", Not, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "and", And, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "or", Or, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "xor", Xor, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "bitshift", BitShift, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "abs", Abs, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "add", Add, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "sub", Sub, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "mul", Mul, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "div", Div, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "mod", Mod, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "neg", Neg, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "exp", Exp, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "sqrt", Sqrt, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "sin", Sin, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "cos", Cos, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "atan", Atan, 2, 1, 0, 0, Integer, Integer); X TypeInstallOp (Integer, "ln", Ln, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "log", Log, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "ceiling", Identity, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "floor", Identity, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "round", Identity, 1, 1, 0, 0, Integer); X TypeInstallOp (Integer, "truncate", Identity, 1, 1, 0, 0, Integer); X X word = -1; X PanicIf (word != ~0, "Need 2's complement machine! Sorry."); X X for (WordSize = 0; word != 0; WordSize++) X word >>= 1; X Word2 = WordSize / 2; X LowMask = (1<> Word2; X btop = b >> Word2; X sum = abot * btop + atop * bbot; X sum += ((unsigned) (abot * bbot) >> Word2); X sum = ((unsigned) sum >> Word2) + atop * btop; X if (sum != 0 || a * b < 0) X kill (getpid (), SIGFPE); X return signed ? -a * b : a * b; X } X Xint StrictAdd (a, b) int a, b; X { X if ((a < 0) == (b < 0) && (a < 0) != (a + b < 0)) X kill (getpid (), SIGFPE); X return a + b; X } X Xint BodyInteger (item) Object item; X { X return item.u.Integer; X } X Xstatic int Body (item) Object item; X { X return item.u.Integer; X } X XObject MakeInteger (i) int i; X { X Object res; X X res = MakeObject (Integer); X res.u.Integer = i; X X return res; X } X Xstatic Object Make (i) int i; X { X Object res; X X res = MakeObject (Integer); X res.u.Integer = i; X X return res; X } X Xstatic int Cvr (item) Object item; X { X return Push (OpStack, RealInteger (item)); X } X Xstatic int Cvs (v, string) Object v, string; X { X int length; X char buf [BUFSIZE]; X X VOID sprintf (buf, "%d", BodyInteger (v)); X if ((length = strlen (buf)) > lengthString (string)) X return Error (PRangeCheck); X VOID Bcopy (BodyString (string), buf, length); X return Push (OpStack, getIString (string, 0, length)); X } X Xstatic int EqEq (v) Object v; X { X printf ("%d", BodyInteger (v)); X return TRUE; X } X XObject IntReal (o) Object o; X { X return Make ((int) BodyReal (o)); X } X Xstatic int PFor (initial, increment, limit, proc) Object initial, increment, limit, proc; X { X VOID Push (ExecStack, Nil); X VOID Push (ExecStack, increment); X VOID Push (ExecStack, limit); X VOID Push (ExecStack, initial); X VOID Push (ExecStack, proc); X VOID Push (ExecStack, OpFor); X X return TRUE; X } X Xstatic int For () X { X Object current, limit, increment, proc; X X proc = Pop (ExecStack); X current = Pop (ExecStack); X limit = Pop (ExecStack); X increment = Pop (ExecStack); X X if (Body (increment) > 0 X ? Body (current) > Body (limit) X : Body (current) < Body (limit)) X VOID Pop (ExecStack); X else X { X VOID Push (ExecStack, increment); X VOID Push (ExecStack, limit); X VOID Push (ExecStack, Make (StrictAdd (Body (current), Body (increment)))); X VOID Push (ExecStack, proc); X VOID Push (ExecStack, OpFor); X VOID Push (ExecStack, proc); X VOID Push (OpStack, current); X } X return TRUE; X } X Xstatic int Eq (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) == Body (b))); X } X Xstatic int Lt (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) < Body (b))); X } X Xstatic int Le (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) <= Body (b))); X } X Xstatic int Gt (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) > Body (b))); X } X Xstatic int Ge (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) >= Body (b))); X } X Xstatic int Not (integer) Object integer; X { X return Push (OpStack, Make (~ Body (integer))); X } X Xstatic int And (a, b) Object a, b; X { X return Push (OpStack, Make (Body (a) & Body (b))); X } X Xstatic int Or (a, b) Object a, b; X { X return Push (OpStack, Make (Body (a) | Body (b))); X } X Xstatic int Xor (a, b) Object a, b; X { X return Push (OpStack, Make (Body (a) ^ Body (b))); X } X Xstatic int BitShift (a, b) Object a, b; X { X if (Body (b) > 0) X return Push (OpStack, Make ((int) ((unsigned) Body (a) << Body (b)))); X else X return Push (OpStack, Make ((int) ((unsigned) Body (a) >> (-Body (b))))); X } X Xstatic int Abs (v) Object v; X { X return Push (OpStack, Make (Body (v) >= 0 ? Body (v) : -Body (v))); X } X Xstatic int Add (a, b) Object a, b; X { X return Push (OpStack, Make (StrictAdd (Body (a), Body (b)))); X } X Xstatic int Sub (a, b) Object a, b; X { X return Push (OpStack, Make (StrictAdd (Body (a), -Body (b)))); X } X Xstatic int Mul (a, b) Object a, b; X { X return Push (OpStack, Make (StrictMul (Body (a), Body (b)))); X } X Xstatic int Div (a, b) Object a, b; X { X if (Body (b) == 0) X return Error (PUnResult); X return Push (OpStack, MakeReal ((float) Body (a) / (float) Body (b))); X } X Xstatic int Mod (a, b) Object a, b; X { X if (Body (b) == 0) X return Error (PUnResult); X return Push (OpStack, Make (Body (a) % Body (b))); X } X Xstatic int Neg (a) Object a; X { X return Push (OpStack, Make (-Body (a))); X } X Xstatic int Sqrt (v) Object v; X { X if (Body (v) < 0) X return Error (PUnResult); X return Push (OpStack, MakeReal ((float) sqrt ((double) Body (v)))); X } X Xstatic int Exp (a, b) Object a, b; X { X return Push (OpStack, MakeReal ((float) pow ((double) Body (a), (double) Body (b)))); X } X Xstatic int Identity (v) Object v; X { X return Push (OpStack, v); X } X Xstatic int Sin (v) Object v; X { X return Push (OpStack, MakeReal ((float) sin (Rad ((double) Body (v))))); X } X Xstatic int Cos (v) Object v; X { X return Push (OpStack, MakeReal ((float) cos (Rad ((double) Body (v))))); X } X Xstatic int Atan (a, b) Object a, b; X { X return Push (OpStack, MakeReal ((float) Deg (atan2 ((double) Body (a), (double) Body (b))))); X } X Xstatic int Ln (v) Object v; X { X return Push (OpStack, MakeReal ((float) log ((double) Body (v)))); X } X Xstatic int Log (v) Object v; X { X return Push (OpStack, MakeReal ((float) log10 ((double) Body (v)))); X } END_OF_FILE if test 8759 -ne `wc -c <'source/integer.c'`; then echo shar: \"'source/integer.c'\" unpacked with wrong size! fi # end of 'source/integer.c' fi if test -f 'source/operator.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'source/operator.c'\" else echo shar: Extracting \"'source/operator.c'\" $8110 characters$ sed "s/^X//" >'source/operator.c' <<'END_OF_FILE' X/* X * Copyright (C) Rutherford Appleton Laboratory 1987 X * X * This source may be copied, distributed, altered or used, but not sold for profit X * or incorporated into a product except under licence from the author. X * It is not in the public domain. X * This notice should remain in the source unaltered, and any changes to the source X * made by persons other than the author should be marked as such. X * X * Crispin Goswell @ Rutherford Appleton Laboratory caag@uk.ac.rl.vd X */ X#include "main.h" X Xstruct op_struct X { X Object name; X int (*fn)(), arguments, results, execpop, execpush; X Type *argtypes; X }; X Xint ExecOperator (); Xstatic int EqEq (), Cvs (), Eq (), Signature (); X XInitOperator () X { X X TypeInstallOp (Operator, "==", EqEq, 1, 0, 0, 0, Operator); X TypeInstallOp (Operator, "cvs", Cvs, 2, 1, 0, 0, Operator, String); X TypeInstallOp (Operator, "exec",ExecOperator, 1, 0, 0, 0, Operator); X TypeInstallOp (Operator, "eq", Eq, 2, 1, 0, 0, Operator, Operator); X TypeInstallOp (Operator, "signature", Signature, 1, 0, 0, 0, Operator); X } X X/*VARARGS6*/ X/*ARGSUSED*/ XObject MakeOp (name, fn, arguments, results, execpop, execpush, arg1, arg2, arg3, arg4, arg5, arg6, arg7) X char *name; X int (*fn)(), arguments, results, execpop, execpush; X Type arg1, arg2, arg3, arg4, arg5, arg6, arg7; X { X Object res; X struct op_struct *op; X int i; X X res = Cvx (MakeObject (Operator)); X res.u.Operator = op = (struct op_struct *) Malloc (sizeof (struct op_struct)); X X op->name = NameFrom (name); X op->fn = fn; X op->arguments = arguments; X op->results = results; X op->execpop = execpop; X op->execpush = execpush; X X op->argtypes = (Type *) Malloc ((unsigned) sizeof (Type) * arguments); X X for (i = 0; i < arguments; i++) X op->argtypes[i] = (&arg1)[i]; X X return res; X } X X/*VARARGS6*/ X/*ARGSUSED*/ XInstallOp (name, fn, arguments, results, execpop, execpush, arg1, arg2, arg3, arg4, arg5, arg6, arg7) X char *name; X int (*fn)(), arguments, results, execpop, execpush; X Type arg1, arg2, arg3, arg4, arg5, arg6, arg7; X { X Object res; X struct op_struct *op; X int i; X res = Cvx (MakeObject (Operator)); X res.u.Operator = op = (struct op_struct *) Malloc (sizeof (struct op_struct)); X X op->name = NameFrom (name); X op->fn = fn; X op->arguments = arguments; X op->results = results; X op->execpop = execpop; X op->execpush = execpush; X X op->argtypes = (Type *) Malloc ((unsigned) sizeof (Type) * arguments); X X/* for (i = 0; i < arguments; i++) X op->argtypes[i] = (&arg1)[i]; X */ switch (arguments) X { X default: X Panic ("too many arguments in InstallOp"); X break; X case 7: op->argtypes[6] = arg7; X case 6: op->argtypes[5] = arg6; X case 5: op->argtypes[4] = arg5; X case 4: op->argtypes[3] = arg4; X case 3: op->argtypes[2] = arg3; X case 2: op->argtypes[1] = arg2; X case 1: op->argtypes[0] = arg1; X case 0: break; X } X DictStore (SysDict, NameOperator (res), res); X } X X/*VARARGS7*/ X/*ARGSUSED*/ XTypeInstallOp (type, name, fn, arguments, results, execpop, execpush, arg1, arg2, arg3, arg4, arg5, arg6, arg7) X char *name; X int (*fn)(), arguments, results, execpop, execpush; X Type type, arg1, arg2, arg3, arg4, arg5, arg6, arg7; X { X Object res; X struct op_struct *op; X int i; X X res = Cvx (MakeObject (Operator)); X res.u.Operator = op = (struct op_struct *) Malloc (sizeof (struct op_struct)); X X op->name = NameFrom (name); X op->fn = fn; X op->arguments = arguments; X op->results = results; X op->execpop = execpop; X op->execpush = execpush; X X op->argtypes = (Type *) Malloc ((unsigned) sizeof (Type) * arguments); X X for (i = 0; i < arguments; i++) X op->argtypes[i] = (&arg1)[i]; X X TypeInstall (type, name, res); X } X Xstatic struct op_struct *Body (item) Object item; X { X return item.u.Operator; X } X X#define Body(op) ((op).u.Operator) X Xstatic int Eq (a, b) Object a, b; X { X return Push (OpStack, MakeBoolean (Body (a) == Body (b))); X } X XObject NameOperator (item) Object item; X { X return Body (item)->name; X } X X#define NameOperator(op) ((op).u.Operator->name) X Xstatic int Cvs (v, string) Object v, string; X { X Object vv; X int length; X X vv = NameOperator (v); X X if (lengthString (string) < (length = lengthName (vv))) X return Error (PRangeCheck); X VOID strncpy (BodyString (string), BodyName (vv), length); X return Push (OpStack, getIString (string, 0, length)); X } X Xstatic int EqEq (v) Object v; X { X VOID Push (OpStack, NameOperator (v)); X VOID Push (ExecStack, Cvx (NameFrom ("=="))); X return TRUE; X } X X/* X * Operator types. X * X * PostScript has 200 or so operators which can be divided into groups by the X * arguments required. X * X * The type Real causes an Integer argument to get floated. X * The type Unchecked causes an argument to be passed through whatever type it has. X * The type Number causes all Number arguments to be Integer or Real X * X * An operator object comprises several pieces of information: X * X * 1 Number of arguments required X * 2 Number of results which may be returned X * 3 Number of items required on the ExecStack X * 4 Number of items added to the ExecStack X * 5 A List of argument types X * X * Functions requiring strange arguments can declare themselves to take few X * arguments and then use some directly from the OpStack. X * X * The first four arguments are only required for checking Stack over and underflow, X * thus operators are not required to hold to their requests. X * X * After resolving any peculiar type rules, Exec will lookup the operator name in the type X * dictionary for the argument type which is specified as being the controlling argument. X * The operator will receive the correct number of arguments and will be expected to stack X * its own results. There will be a fixed maximum limit of the number of arguments an operator X * can declare for itself. This is likely to be the maximum that PostScript uses, i.e. 6 or 7. X * X */ X Xint ExecOperator (item) Object item; X { X struct op_struct *op = Body (item); X int i, res, (*fn)() = op->fn; X Object arg[7]; X X Self = NameOperator (item); X if (op->results > MaxStack (OpStack) - Height (OpStack)) return Error (POpOverflow); X else if (op->execpush > MaxStack (ExecStack) - Height (ExecStack)) return Error (PExecOverflow); X else if (op->arguments > Height (OpStack)) return Error (POpUnderflow); X else if (op->execpop > Height (ExecStack)) return Error (PExecUnderflow); X X for (i = op->arguments - 1; i >= 0; i--) X arg[i] = Pop (OpStack); X for (i = op->arguments - 1; i >= 0; i--) X { X Type formal = op->argtypes[i], actual = TypeOf (arg[i]); X X if (formal == Float && actual == Integer) X arg[i] = RealInteger (arg[i]); X if (formal == actual || X formal == Poly || X formal == Float && X (actual == Integer || actual == Real)) X continue; X for (i = 0; i < op->arguments; i++) X VOID Push (OpStack, arg[i]); X return Error (PTypeCheck); X } X X /*if (setjmp (env)) X res = Error (PUnResult); X else */ X switch (op->arguments) X { X case 0: res = (*fn) (); break; X case 1: res = (*fn) (arg[0]); break; X case 2: res = (*fn) (arg[0], arg[1]); break; X case 3: res = (*fn) (arg[0], arg[1], arg[2]); break; X case 4: res = (*fn) (arg[0], arg[1], arg[2], arg[3]); break; X case 5: res = (*fn) (arg[0], arg[1], arg[2], arg[3], arg[4]); break; X case 6: res = (*fn) (arg[0], arg[1], arg[2], arg[3], arg[4], arg[5]); break; X case 7: res = (*fn) (arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6]); break; X X default: Panic ("primitve with too many arguments"); X } X /* res = (*fn) (arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6]); */ X X if (!res) X for (i = 0; i < op->arguments; i++) X VOID Push (OpStack, arg[i]); X return res; X } X Xstatic int Signature (op) Object op; X { X Object tn; X struct op_struct *ops = Body (op); X int i; X X tn = NameFrom ("type"); X if (!OpCheck (0, ops->arguments + 1)) X return FALSE; X for (i = 0; i < ops->arguments; i++) X VOID Push (OpStack, Lookup (ops->argtypes[i], tn)); X VOID Push (OpStack, MakeInteger (ops->arguments)); X VOID Push (OpStack, MakeInteger (ops->results)); X X return TRUE; X } END_OF_FILE if test 8110 -ne `wc -c <'source/operator.c'`; then echo shar: \"'source/operator.c'\" unpacked with wrong size! fi # end of 'source/operator.c' fi echo shar: End of archive 6 $of 18$. cp /dev/null ark6isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 18 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0