v08i051: Elk (Extension Language Toolkit) part 03 of 14
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Sun Sep 24 07:39:39 AEST 1989
Posting-number: Volume 8, Issue 51
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part03
[Let this be a lesson to submitters: this was submitted as uuencoded,
compressed files. I lost the source information while unpacking it; this
is the best approximation I could come up with. ++bsa]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 3 (of 14)."
# Contents: doc/xlib.ms src/heap.c src/extern.h src/error.c
# src/alloca.s.pyramid src/alloca.s src/alloca.s.68k
# Wrapped by net at tub on Sun Sep 17 17:32:21 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f doc/xlib.ms -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/xlib.ms\"
else
echo shar: Extracting \"doc/xlib.ms\" \(34657 characters\)
sed "s/^X//" >doc/xlib.ms <<'END_OF_doc/xlib.ms'
X.\" A font suitable for Scheme keywords and program examples
X.\" must be mounted on font position 5.
X.\" For example: .fp 5 TT (Typewriter font)
X.\" or: .fp 5 HR (Helvetica Roman)
X.\"
X.fp 5 HR
X.de f
X.br
X.ne 3
X.ft 5
X.nr x \w'\\$1'
X.if \\n(.l<\\nx .nr x \\n(.l
X.sp -.5
X.ps 6
X\l'\\nxu'
X.ps
X.sp -.1
X\\$1
X.ft
X.LP
X.if !'\\$2'' \f2[\\$2]\fP
X.if !'\\$2'' .br
X..
X.de fa
X.br
X.ne 3
X.ft 5
X.nr x \w'\\$1'
X.if \\n(.l<\\nx .nr x \\n(.l
X.sp -.5
X.ps 6
X\l'\\nxu'
X.ps
X.sp -.1
X\\$1
X.ft
X..
X.de fb
X.br
X.ne 3
X.ft 5
X.sp -.1
X\\$1
X.ft
X..
X.de fc
X.br
X.ne 3
X.ft 5
X.sp -.1
X\\$1
X.ft
X.LP
X.if !'\\$2'' \f2[\\$2]\fP
X.if !'\\$2' .br
X..
X.TL
XFunctions Exported by the Scheme/Xlib Interface
X.AU
XOliver Laumann
X.AB
XThis memo provides a list of the functions exported by the interface
Xto the Xlib library.
XIf a function is equivalent to a function of the C library, only
Xthe name of the corresponding C function is given (in square brackets).
X.AE
X.NH
XLoading the Interface
X.LP
XThe Xlib-interface is loaded by evaluating
X.DS
X.ft 5
X(require 'xlib).
X.ft
X.DE
X.NH
XFunctions Operating on Colors
X
X.f "(color? x)"
XReturns #t if \f5x\fP is a color, #f otherwise.
X
X.f "(make-color r g b)"
XReturns an object of type \f5color\fP with the specified RGB components.
X\f5r\fP, \f5g\fP, and \f5b\fP are reals in the range 0.0 to 1.0.
X
X.f "(color-rgb-values color)"
XReturns a list of three elements, the RGB components of the
Xgiven color (see \f5make-color\fP above).
X
X.f "(query-color colormap pixel)" XQueryColor
X
X.f "(query-colors colormap pixels)" XQueryColors
X\f5pixels\fP is a vector of pixels.
XReturns a vector of colors of the same size as \f5pixels\fP.
X
X.f "(lookup-color colormap color-name)" XLookupColor
X\f5color-name\fP is a string or a symbol.
XReturns a pair of colors.
X
X.NH
XFunctions Operating on Colormaps
X
X.f "(colormap? x)"
XReturns #t if \f5x\fP is a colormap, #f otherwise.
X
X.f "(colormap-display colormap)"
XReturns the display associated with the given colormap.
X
X.f "(free-colormap colormap)" XFreeColormap
X
X.NH
XFunctions Operating on Cursors
X
X.f "(cursor? x)"
XReturns #t if \f5x\fP is a cursor, #f otherwise.
X
X.f "(cursor-display cursor)"
XReturns the display associated with the given cursor.
X
X.f "(free-cursor cursor)" XFreeCursor
X
X.f "(create-cursor src-pixmap mask-pixmap x y foreground background)" XCreatePixmapCursor
X\f5mask-pixmap\fP can be the symbol \f5none\fP.
X
X.f "(create-glyph-cursor src-font source-char mask-font mask-char foreground background)" XCreateGlyphCursor
XThe display is obtained from \f5src-font\fP.
X\f5src-char\fP and \f5mask-char\fP are integers.
X\f5mask-font\fP can be the symbol \f5none\fP.
X
X.f "(create-font-cursor display char)" XCreateGlyphCursor
XCalls \f5create-glyph-cursor\fP with the font named ``cursor'', the
Xspecified \f5source-char\fP, a \f5mask-char\fP of \f5(1+ char)\fP,
Xblack foreground, and white background.
X
X.f "(recolor-cursor cursor foreground background)" XRecolorCursor
X
X.f "(define-cursor window cursor)"
XSynonym for \f5(set-window-cursor! window cursor)\fP
X
X.f "(undefine-cursor window)"
XSynonym for \f5(set-window-cursor! window 'none)\fP
X
X.NH
XFunctions Operating on Displays
X
X.f "(display? x)"
XReturns #t if \f5x\fP is a display, #f otherwise.
X
X.f "(open-display . name-of-display)" XOpenDisplay
X\f5name-of-display\fP is a string or a symbol.
XIf no name is specified, a NULL name will be passed to XOpenDisplay.
X
X.f "(close-display display)" XCloseDisplay
XFinalizes all objects associated with the display, then closes
Xthe display.
X
X.f "(display-root-window display)" DefaultRootWindow
X
X.f "(display-colormap display)" DefaultColormap
XReturns the default colormap of the display's default screen.
X
X.f "(display-default-gcontext display)" DefaultGC
XReturns the default GC of the display's default screen.
X
X.fa "(display-width display)"
X.fc "(display-height display)" "DisplayWidth, DisplayHeight"
XReturns the width/height of the display's default screen.
X
X.f "(display-flush-output display)" XFlush
X
X.f "(display-wait-output display discard-events?)" XSync
X
X.f "(set-input-focus display window revert-to time)" XSetInputFocus
X\f5window\fP can be the symbol \f5pointer-root\fP.
X\f5revert-to\fP is a symbol (\f5none\fP, \f5pointer-root\fP, or \f5parent\fP).
X\f5time\fP is an integer or the symbol \f5now\fP.
X
X.f "(input-focus display)" XGetInputFocus
XReturns a pair the car of which is a window, and the cdr is a symbol
X(\f5none\fP, \f5pointer-root\fP, or \f5parent\fP).
X
X.f "(set-after-function! display procedure)" XSetAfterFunction
XReturns the old after function.
XIf \f5procedure\fP is #f, the current after function is disassociated
Xfrom the display.
X
X.f "(after-function display)"
XReturns the after function currently associated with the given
Xdisplay (#f if there is none).
X
X.f "(synchronize display)"
XSets the display's after function to \f5display-wait-output\fP.
X
X.NH
XEvent Handling
X
X.f "(handle-events display-or-window . clauses)" "XNextEvent, XWindowEvent"
X\f5handle-events\fP is a special form.
XEach \f5clause\fP is of the form \f5(guard function)\fP; \f5guard\fP
Xis either an event name (a symbol, e.g. \f5key-press\fP or \f5exposure\fP),
Xa list of event names, or the symbol \f5else\fP.
X\f5handle-events\fP gets the next event from the specified display
Xusing XNextEvent or from the specified window using XWindowEvent.
XThen the event type is matched against each event name in each guard
Xin order.
XWhen a match occurs, the corresponding function is invoked with
Xthe name of the event being dispatched (a symbol) and other, event
Xspecific arguments (the \f2details\fP).
XWhen no clause matches and an \f5else\fP clause is present, the function
Xfrom this clause is invoked.
X\f5handle-events\fP loops until a function returns a value not
Xequal to #f in which case handle-events returns this value.
X
X.NH
XFunctions Operating on Fonts
X
X.f "(font? x)"
XReturns #t if \f5x\fP is a font, #f otherwise.
X
X.f "(font-display font)"
XReturns the display associated with the given font.
X
X.f "(open-font display font-name)" XLoadQueryFont
X\f5font-name\fP is a string or a symbol.
X
X.f "(close-font font)" XUnloadFont
X
X.f "(font-name font)"
XReturns the name of the specified font or #f if the name could
Xnot be determined (e.g. when the font has been obtained by a call
Xto \f5gcontext-font\fP).
X
X.f "(gcontext-font gcontext)"
XCalls XQueryFont with the GC obtained by XGContextFromGC.
XOnly a limited number of functions can be applied to a font
Xreturned by \f5gcontext-font\fP, since it has neither a name nor
Xa font-ID.
X
X.f "(list-font-names display pattern)" XListFonts
X\f5pattern\fP is a string or a symbol.
XReturns a vector of font names (strings).
X
X.f "(list-fonts display pattern)" XListFontsWithInfo
X\f5pattern\fP is a string or a symbol.
XReturns a vector of fonts.
XThese fonts are ``pseudo fonts'' which do not have a font-ID.
XA pseudo font is loaded automatically and turned into a ``real''
Xfont the first time it is passed to a function that makes use
Xof the font-ID.
X
X.f "(font-info font)"
XThis function is not intended to be used by the application programmer.
X
X.fa "(font-direction font)"
X.fb "(font-min-byte2 font)"
X.fb "(font-max-byte2 font)"
X.fb "(font-min-byte1 font)"
X.fb "(font-max-byte1 font)"
X.fb "(font-all-chars-exist? font)"
X.fb "(font-default-char font)"
X.fb "(font-ascent font)"
X.fc "(font-descent font)"
XThese functions return the font direction as a symbol (\f5left-to-right\fP
Xor \f5right-to-left\fP), the first and last character (as an integer),
Xthe first and last row (integer), an indication whether all characters
Xhave non-zero size (boolean), the default character (integer), and the
Xascent and descent (integer) of the specified font.
X
X.f "(char-info font index)"
XThis function is not intended to be used by the application programmer.
X\f5index\fP is an integer or one of the symbols \f5min\fP and \f5max\fP.
X
X.fa "(char-rbearing font index)"
X.fb "(char-lbearing font index)"
X.fb "(char-width font index)"
X.fb "(char-ascent font index)"
X.fc "(char-descent font index)"
XThese functions return the metrics of
Xthe character specified by the integer \f5index\fP of the given font.
XEach function returns an integer.
X\f5font\fP can be a 1-byte as well as a 2-byte font.
X
X.fa "(max-char-lbearing font)"
X.fb "(max-char-rbearing font)"
X.fb "(max-char-width font)"
X.fb "(max-char-ascent font)"
X.fc "(max-char-descent font)"
XThese functions return the maximum metrics over all characters
Xin the specified font.
XEach function returns an integer.
X
X.fa "(min-char-lbearing font)"
X.fb "(min-char-rbearing font)"
X.fb "(min-char-width font)"
X.fb "(min-char-ascent font)"
X.fc "(min-char-descent font)"
XThese functions return the minimum metrics over all characters
Xin the specified font.
XEach function returns an integer.
X
X.f "(font-properties font)"
XReturns a vector of font properties; each element of the vector
Xis a pair consisting of the property name (an atom) and an
Xunsigned integer (the value of the property).
X
X.f "(font-property font property-name)"
XReturns the value of the specified property associated with the
Xspecified font.
X\f5property-name\fP is a string or a symbol.
X
X.f "(font-path display)" XGetFontPath
XReturns the current font path as a vector of strings.
X
X.f "(set-font-path! display path)" XSetFontPath
X\f5path\fP is a list; each element is a string or a symbol.
X
X.NH
XFunctions Operating on Graphic Contexts
X
X.f "(gcontext? x)"
XReturns #t if \f5x\fP is a GC, #f otherwise.
X
X.f "(gcontext-display gcontext)"
XReturns the display associated with the given GC.
X
X.f "(create-gcontext window tagged-vector)" XCreateGC
XThis function is not intended to be used by the application programmer.
X
X.f "(make-gcontext . attributes)" XCreateGC
XThis macro is used to create a new GC.
XEach \f5attribute\fP is a list of two elements, the first of which
Xis a symbol identifying the attribute, and the second element is
Xthe value of the attribute.
XThe attributes can be specified in any order.
XAttributes are \f5window\fP (mandatory) and all the attributes that can be
Xset by the \f5set-gcontext-\fP\f2attribute\fP\f5!\fP functions
Xbelow.
X
X.f "(copy-gcontext gcontext window)" XCopyGC
XReturns a copy of \f5gcontext\fP (associated with the specified window).
X
X.f "(free-gcontext gcontext)" XFreeGC
X
X.f "(query-best-size display width height shape)" XQueryBestSize
X\f5shape\fP is a symbol (\f5cursor\fP, \f5tile\fP, or \f5stipple\fP).
XReturns a pair of integers (result width and result height).
X
X.fa "(query-best-cursor display width height)"
X.fb "(query-best-tile display width height)"
X.fc "(query-best-stipple display width height)" XQueryBestSize
XInvokes \f5query-best-size\fP with the given arguments and a shape
Xof \f5cursor\fP, \f5tile\fP, or \f5stipple\fP, respectively.
X
X.f "(change-gcontext gcontext tagged-vector)" XChangeGC
XThis function is not intended to be used by the application programmer.
X
X.fa "(set-gcontext-function! gcontext value)"
X.fb "(set-gcontext-plane-mask! gcontext value)"
X.fb "(set-gcontext-foreground! gcontext value)"
X.fb "(set-gcontext-background! gcontext value)"
X.fb "(set-gcontext-line-width! gcontext value)"
X.fb "(set-gcontext-line-style! gcontext value)"
X.fb "(set-gcontext-cap-style! gcontext value)"
X.fb "(set-gcontext-join-style! gcontext value)"
X.fb "(set-gcontext-fill-style! gcontext value)"
X.fb "(set-gcontext-fill-rule! gcontext value)"
X.fb "(set-gcontext-arc-mode! gcontext value)"
X.fb "(set-gcontext-tile! gcontext value)"
X.fb "(set-gcontext-stipple! gcontext value)"
X.fb "(set-gcontext-ts-x! gcontext value)"
X.fb "(set-gcontext-ts-y! gcontext value)"
X.fb "(set-gcontext-font! gcontext value)"
X.fb "(set-gcontext-subwindow-mode! gcontext value)"
X.fb "(set-gcontext-exposures! gcontext value)"
X.fb "(set-gcontext-clip-x! gcontext value)"
X.fb "(set-gcontext-clip-y! gcontext value)"
X.fb "(set-gcontext-clip-mask! gcontext value)"
X.fb "(set-gcontext-dash-offset! gcontext value)"
X.fc "(set-gcontext-dashes! gcontext value)" "XChangeGC"
XSets the logical operation, plane mask, foreground and background pixel
Xvalue, line width and style, cap and join style, fill style and rule,
Xarc mode, tiling and stippling pixmap, tiling x- and y-origin, font,
Xsubwindow mode, clipping x- and y-origin, clipping bitmap, and dashed line
Xinformation for the specified graphics context.
X.LP
XThe \f5value\fP argument to \f5set-gcontext-function!\fP is a symbol
X(\f5clear\fP, \f5and\fP, \f5and-reverse\fP, \f5copy\fP, \f5and-inverted\fP,
X\f5no-op\fP, \f5xor\fP, \f5or\fP, \f5nor\fP, \f5equiv\fP, \f5invert\fP,
X\f5or-reverse\fP, \f5copy-inverted\fP, \f5nand\fP, or \f5set\fP).
XThe argument to \f5set-gcontext-plane-mask!\fP, \f5set-gcontext-foreground!\fP,
Xand \f5set-gcontext-background!\fP is a pixel.
X\f5set-gcontext-tile!\fP, \f5set-gcontext-stipple\fP, and
X\f5set-gcontext-clip-mask!\fP expect a pixmap as the second argument.
XThe line style is a symbol (\f5solid\fP, \f5dash\fP, \f5double-dash\fP);
Xthe cap style is a symbol (\f5not-last\fP, \f5butt\fP, \f5round\fP,
X\f5projecting\fP); the join style is a symbol (\f5miter\fP, \f5round\fP,
X\f5bevel\fP); the fill style is a symbol (\f5solid\fP, \f5tiled\fP,
X\f5stippled\fP, \f5opaque-stippled\fP); the fill rule is a symbol
X(\f5even-odd\fP, \f5winding\fP); the arc mode is a symbol (\f5chord\fP,
X\f5pie-slice\fP).
XThe \f5value\fP argument to \f5set-gcontext-font!\fP must be a font.
XThe \f5value\fP argument to \f5set-gcontext-subwindow-mode!\fP is a
Xsymbol (\f5clip-by-children\fP, \f5include-inferiors\fP).
X\f5set-gcontext-exposures!\fP expects a boolean.
XAll other functions have an integer \f5value\fP argument.
X
X.NH
XGraphics Functions
X
X.f "(clear-area window x y width height exposures?)" XClearArea
X
X.f "(copy-area src-drawable gcontext src-x src-y width height dst-drawable dst-x dst-y)" XCopyArea
X
X.f "(copy-plane src-drawable gcontext plane src-x src-y width height dst-drawable dst-x dst-y)" XCopyPlane
X\f5plane\fP is an integer.
XAn error is signaled unless exactly one bit is set in \f5plane\fP.
X
X.f "(draw-point drawable gcontext x y)" XDrawPoint
X
X.f "(draw-points drawable gcontext vector-of-points relative?)" XDrawPoints
X\f5vector-of-points\fP is a vector of pairs consisting of two integers
X(the x- and y-coordinates).
XIf \f5relative?\fP is #t, CoordModePrevious
Xis passed to XDrawPoints, otherwise CoordModeOrigin is used.
X
X.f "(draw-line drawable gcontext x1 y1 x2 y2)" XDrawLine
X
X.f "(draw-lines drawable gcontext vector-of-points relative?)" XDrawLines
XSee \f5draw-points\fP above.
X
X.f "(draw-segments drawable gcontext vector-of-points)" XDrawSegments
X\f5vector-of-points\fP is a vector of lists of four integers
X(x1, y1, x2, and y2).
X
X.f "(draw-rectangle drawable gcontext x y width height)" XDrawRectangle
X
X.f "(fill-rectangle drawable gcontext x y width height)" XFillRectangle
X
X.f "(draw-rectangles drawable gcontext vector-of-rectangles)" XDrawRectangles
X\f5vector-of-rectangles\fP is a vector of lists of four integers
X(x, y, width, and height).
X
X.f "(fill-rectangles drawable gcontext vector-of-rectangles)" XFillRectangles
XSee \f5draw-rectangles\fP above.
X
X.f "(draw-arc drawable gcontext x y width height angle1 angle2)" XDrawArc
X
X.f "(fill-arc drawable gcontext x y width height angle1 angle2)" XFillArc
X
X.f "(draw-arcs drawable gcontext vector-of-data)" XDrawArcs
X\f5vector-of-data\fP is a vector of lists of six integers
X(x, y, width, height, angle1, and angle2).
X
X.f "(fill-arcs drawable gcontext vector-of-data)" XFillArcs
XSee \f5draw-arcs\fP above.
X
X.f "(fill-polygon drawable gcontext vector-of-points relative? shape)" XFillPolygon
XSee \f5draw-points\fP above.
X\f5shape\fP is a symbol (\f5complex\fP, \f5non-convex\fP, or \f5convex\fP).
X
X.NH
XKeycodes and Keysyms
X
X.fa "(display-min-keycode display)"
X.fc "(display-max-keycode display)"
XReturns the minimum/maximum keycode (an integer) for the given display.
X
X.f "(display-keysyms-per-keycode display)"
XReturns the number of keysyms per keycode for the given display.
X
X.f "(string\(mi>keysym string)" XStringToKeysym
X\f5string\fP is a string or a symbol.
XReturns an integer if XStringToKeysym succeeds, #f otherwise.
X
X.f "(keysym\(mi>string keysym)" XKeysymToString
X\f5keysym\fP is an integer.
XReturns #f if XKeysymToString fails.
X
X.f "(keycode\(mi>keysym display keycode index)" XKeycodeToKeysym
X\f5keycode\fP and \f5index\fP are integers.
X
X.f "(keysym\(mi>keycode display keysym)" XKeysymToKeycode
X\f5keysym\fP is an integer.
X
X.f "(lookup-string display keycode mask)" XLookupString
X\f5keycode\fP is an integer.
X\f5mask\fP is a list of symbols (\f5shift\fP, \f5lock\fP, \f5control\fP,
X\f5mod1\fP .. \f5mod5\fP, \f5button1\fP .. \f5button5\fP,
Xor \f5any-modifier\fP).
X
X.NH
XFunctions Operating on Pixels
X
X.f "(pixel? x)"
XReturns #t if \f5x\fP is a pixel, #f otherwise.
X
X.f "(pixel-value pixel)"
XReturns the value of the pixel as an unsigned integer.
X
X.fa "(black-pixel display)"
X.fc "(white-pixel display)" "BlackPixel, WhitePixel"
XApplies BlackPixel/WhitePixel to the display's default screen.
X
X.NH
XFunctions Operating on Pixmaps
X
X.f "(pixmap? x)"
XReturns #t if \f5x\fP is a pixmap, #f otherwise.
X
X.f "(pixmap-display pixmap)"
XReturns the display associated with the pixmap.
X
X.f "(free-pixmap pixmap)" XFreePixmap
X
X.f "(create-pixmap drawable width height depth)" XCreatePixmap
X
X.f "(create-bitmap-from-data window data width height)" XCreateBitmapFromData
X\f5data\fP is a string.
X\f5(* width height)\fP must not exceed the number of bits in \f5string\fP.
X
X.f "(write-bitmap-file filename pixmap width height x-hot y-hot)" XWriteBitmapFile
X\f5filename\fP is a string or a symbol.
X\f5x-hot\fP and \f5y-hot\fP are optional
X(\(mi1 is used if they are omitted), but either both or none of them must be given.
X\f5write-bitmap-file\fP returns a symbol (\f5success\fP, \f5open-failed\fP,
X\f5file-invalid\fP, or \f5no-memory\fP).
X
X.NH
XPointer Handling, Grabs
X
X.f "(grab-pointer window owner? events pointer-sync? keyboard-sync? confine-to-window cursor time)" XGrabPointer
X\f5events\fP is a list of symbols (event mask names, such as \f5enter-window\fP,
X\f5pointer-motion\fP, etc.).
X\f5pointer-sync?\fP and \f5keyboard-sync?\fP determine whether synchronous
Xor asynchronous grab mode is to be used.
X\f5time\fP is an integer or the symbol \f5now\fP (for CurrentTime).
X\f5grab-pointer\fP returns a symbol (\f5success\fP, \f5not-viewable\fP,
X\f5already-grabbed\fP, \f5frozen\fP, or \f5invalid-time\fP).
X
X.f "(ungrab-pointer display time)" XUngrabPointer
X
X.f "(grab-button window button modifiers owner? events pointer-sync? keyboard-sync? confine-to-window cursor)" XGrabButton
X\f5button\fP is a symbol (\f5button1\fP .. \f5button5\fP, or \f5any-button\fP).
X\f5modifiers\fP is a list of symbols (\f5shift\fP, \f5lock\fP, \f5control\fP,
X\f5mod1\fP .. \f5mod5\fP, \f5button1\fP .. \f5button5\fP,
Xor \f5any-modifier\fP).
XFor the other arguments see \f5grab-pointer\fP above.
X
X.f "(ungrab-button window button modifiers)" XUngrabButton
XSee \f5grab-button\fP above.
X
X.f "(change-active-pointer-grab display events cursor time)" XChangeActivePointerGrab
X\f5events\fP is a list of symbols (event mask names, such as \f5enter-window\fP,
X\f5pointer-motion\fP, etc.).
X
X.f "(grab-keyboard window owner? pointer-sync? keyboard-sync? time)" XGrabKeyboard
XFor a description of the arguments and the return value see
X\f5grab-pointer\fP above.
X
X.f "(ungrab-keyboard display time)" XUngrabKeyboard
X
X.f "(grab-key window key modifiers owner? pointer-sync? keyboard-sync?)" XGrabKey
X\f5key\fP is a keycode (an integer) or the symbol \f5any\fP.
XFor the other arguments see \f5grab-pointer\fP above.
X
X.f "(ungrab-key window key modifiers)" XUngrabKey
XSee \f5grab-key\fP above.
X
X.f "(allow-events display mode time)" XAllowEvents
X\f5mode\fP is a symbol (\f5async-pointer\fP, \f5sync-pointer\fP,
X\f5replay-pointer\fP, \f5async-keyboard\fP, \f5sync-keyboard\fP,
X\f5replay-keyboard\fP, \f5async-both\fP, or \f5sync-both\fP).
X
X.f "(grab-server display)" XGrabServer
X
X.f "(ungrab-server display)" XUngrabServer
X
X.f "(with-server-grabbed display . body-forms)"
XThis macro performs \f5grab-server\fP on the specified display,
Xevaluates the \f5body-forms\fP in order, and then ungrabs the server.
XThe macro body is guarded by a \f5dynamic-wind\fP to ensure that the
X\f5ungrab-server\fP is performed when a body-form calls a continuation
Xcreated outside the macro, and that it is grabbed again when
Xthe body is re-entered at a later point in time.
X\f5with-server-grabbed\fP returns the value of the last body-form.
X
X.f "(query-pointer window)" XQueryPointer
XReturns a list of eight items:
X x
X y
X same-screen? (the return value of XQueryPointer, a boolean)
X root-window
X root-x
X root-y
X child-window
X modifiers (a list of modifier names, see \f5grab-button\fP above).
X
X.f "(general-warp-pointer display dst-window dst-x dst-y src-window src-x src-y src-width src-height)" XWarpPointer
X
X.f "(warp-pointer dst-window dst-x dst-y)" XWarpPointer
XInvokes \f5general-warp-pointer\fP with the display associated with the
X\f5dst-window\fP, the \f5dst-window\fP, \f5dst-x\fP, \f5dst-y\fP,
Xa \f5src-window\fP of \f5none\fP, and zero source coordinates and dimensions.
X
X.f "(warp-pointer-relative display x-offset y-offset)" XWarpPointer
XInvokes \f5general-warp-pointer\fP with the specified \f5display\fP,
Xa \f5dst-window\fP of \f5none\fP, \f5x-offset\fP, \f5y-offset\fP,
Xa \f5src-window\fP of \f5none\fP, and zero source coordinates and dimensions.
X
X.f "(bell display . percent)" XBell
XIf \f5percent\fP is omitted, 0 is used.
X
X.NH
XFunctions Operating on Atoms and Properties
X
X.f "(atom? x)"
XReturns #t if \f5x\fP is an atom, #f otherwise.
X
X.f "(make-atom value)"
XReturns an atom with the given \f5value\fP (\f5value\fP is an integer).
XThis function is only used for debugging purposes.
X
X.f "(intern-atom display name)" XInternAtom
X\f5name\fP is a string or a symbol.
XThe atom is created if it does not yet exist.
X
X.f "(find-atom display name)" XInternAtom
X\f5name\fP is a string or a symbol.
XIf the atom does not exist, the symbol \f5none\fP is returned.
X
X.f "(atom-name display atom)" XGetAtomName
XReturns a string.
X
X.f "(list-properties window)" XListProperties
XReturns a vector of atoms.
X
X.f "(get-property window property request-type offset length delete?)" XGetWindowProperty
X\f5property\fP is an object of type \f5atom\fP.
X\f5request-type\fP is an atom or #f in which case AnyPropertyType will be used.
X\f5offset\fP and \f5length\fP are integers.
XAn error is signaled if XGetWindowProperty fails.
X.LP
X\f5get-property\fP returns a list of four items:
X the ``actual type'' (an atom)
X the format (an integer)
X the data (if any, () otherwise)
X the number of bytes left (an integer)
X.LP
XThe data returned is either a string (if the format indicates
X8-bit data) or a vector of integers.
X
X.f "(change-property window property type format mode data)" XChangeProperty
X\f5property\fP and \f5type\fP are atoms.
X\f5format\fP is an integer (8, 16, or 32).
XIf \f5format\fP is 8 \f5data\fP must be a string, otherwise a vector of
Xintegers of the appropriate size.
XAn error is signaled if the
Xvalue of \f5format\fP is invalid or if \f5data\fP holds an integer
Xthat exceeds the size indicated by \f5format\fP.
X\f5mode\fP is a symbol (\f5replace\fP, \f5prepend\fP, or \f5append\fP).
X
X.f "(delete-property window property)" XDeleteProperty
X
X.f "(rotate-properties window vector-of-atoms delta)" XRotateWindowProperties
X
X.f "(set-selection-owner! display selection owner time)" XSetSelectionOwner
X\f5selection\fP is an atom; \f5owner\fP is a window; \f5time\fP is an
Xinteger or the symbol \f5now\fP (for CurrentTime).
X
X.f "(selection-owner display selection)" XGetSelectionOwner
X
X.f "(convert-selection selection target property requestor-window time)" XConvertSelection
X\f5selection\fP and \f5target\fP are atoms;
X\f5property\fP is an atom or the symbol \f5none\fP.
X
X.NH
XFunctions for Drawing Text
X
X.f "(text-width font text format)" "XTextWidth, XTextWidth16"
X\f5format\fP indicates whether 8-bit or 16-bit text is used; it is either
Xthe symbol \f51-byte\fP or the symbol \f52-byte\fP.
X\f5text\fP is a vector of integers; the integers must not exceed the
Xsize indicated by the format.
X
X.f "(text-extents font text format)" "XTextExtents, XTextExtents16"
XThis function is not intended to be used by the application programmer.
X
X.fa "(extents-lbearing font text format)"
X.fb "(extents-rbearing font text format)"
X.fb "(extents-width font text format)"
X.fb "(extents-ascent font text format)"
X.fc "(extents-descent font text format) "XTextExtents, XTextExtents16""
XThese functions are used to compute the overall metrics of an 8-bit
Xor 16-bit character string.
XEach function returns an integer.
XFor the format of \f5text\fP and \f5format\fP see \f5text-width\fP above.
X
X.f "(draw-image-text drawable gcontext x y text format)" "XDrawImageString, XDrawImageString16"
XSee \f5text-width\fP above.
X
X.f "(draw-poly-text drawable gcontext x y text format)" "XDrawText, XDrawText16"
XSee \f5text-width\fP above.
X\f5text\fP is a vector of integers with intermixed objects of type \f5font\fP.
X
X.f "(translate-text string)"
XConvert the string into a representation suitable as an argument
Xto \f5text-width\fP, \f5draw-image-text\fP, or \f5draw-poly-text\fP
X(a vector of integers obtained by applying \f5char\(mi>integer\fP
Xto the characters of the string argument).
X
X.NH
XFunctions Operating on Windows
X
X.f "(window? x)"
XReturns #t if \f5x\fP is a window, #f otherwise.
X
X.f "(drawable? x)"
XReturns #t if \f5x\fP is a ``drawable'' (window or pixmap), #f otherwise.
X
X.f "(window-display window)"
XReturns the display associated with the window.
X
X.f "(window-unique-id window)"
XReturns a small integer uniquely identifying the given window.
X
X.f "(create-window parent-window x y width height border-width tagged-vector)" XCreateWindow
XThis function is not intended to be used by the application programmer.
X
X.f "(make-window . attributes)" XCreateWindow
XThis macro is used to create a new window.
XEach \f5attribute\fP is a list of two elements, the first of which
Xis a symbol identifying the attribute, and the second element is
Xthe value of the attribute.
XThe attributes can be specified in any order.
XAttributes are \f5x\fP, \f5y\fP, \f5width\fP, \f5height\fP,
X\f5border\fP (each of which has an integer value), \f5parent\fP
X(the parent window), and all attributes that can be set by means
Xof the \f5set-window-\fP\f2attribute\fP\f5!\fP functions below
Xexcept \f5sibling\fP and \f5stack-mode\fP.
XThe attributes \f5parent\fP, \f5width\fP, and \f5height\fP are
Xmandatory.
XThe default for \f5x\fP and \f5y\fP is 0, the default for
X\f5border\fP is 2.
X
X.f "(configure-window window tagged-vector)" XConfigureWindow
XThis function is not intended to be used by the application programmer.
X
X.f "(change-window-attributes window tagged-vector)" XChangeWindowAttributes
XThis function is not intended to be used by the application programmer.
X
X.fa "(set-window-x! window value)"
X.fb "(set-window-y! window value)"
X.fb "(set-window-width! window value)"
X.fb "(set-window-height! window value)"
X.fb "(set-window-border-width! window value)"
X.fb "(set-window-sibling! window value)"
X.fb "(set-window-stack-mode! window value)"
X.fb "(set-window-background-pixmap! window value)"
X.fb "(set-window-background-pixel! window value)"
X.fb "(set-window-border-pixmap! window value)"
X.fb "(set-window-border-pixel! window value)"
X.fb "(set-window-bit-gravity! window value)"
X.fb "(set-window-gravity! window value)"
X.fb "(set-window-backing-store! window value)"
X.fb "(set-window-backing-planes! window value)"
X.fb "(set-window-backing-pixel! window value)"
X.fb "(set-window-save-under! window value)"
X.fb "(set-window-event-mask! window value)"
X.fb "(set-window-do-not-propagate-mask! window value)"
X.fb "(set-window-override-redirect! window value)"
X.fb "(set-window-colormap! window value)"
X.fc "(set-window-cursor! window value)" "XConfigureWindow, XChangeWindowAttributes"
XSet the sibling window, stacking mode, background pixmap, background
Xpixel, border pixel, cursor, and other attributes (see
Xthe \f5window-\fP functions below) of the specified window.
X.LP
XThe stacking mode is a symbol (\f5above\fP, \f5below\fP, \f5top-if\fP,
X\f5bottom-if\fP, \f5opposite\fP).
XThe \f5value\fP argument to \f5set-window-sibling!\fP must be a window,
X\f5set-window-background-pixmap!\fP expects a pixmap,
X\f5set-window-background-pixel!\fP and \f5set-window-border-pixel!\fP
Xexpect a pixel, and \f5set-window-cursor!\fP expects a cursor argument.
XFor the types of the \f5value\fP argument of the other functions
Xsee the return values of the \f5window-\fP functions below.
X
X.f "(get-window-attributes window)" XGetWindowAttributes
XThis function is not intended to be used by the application programmer.
X
X.fa "(window-x window)"
X.fb "(window-y window)"
X.fb "(window-width window)"
X.fb "(window-height window)"
X.fb "(window-border-width window)"
X.fb "(window-depth window)"
X.fb "(window-visual window)"
X.fb "(window-root window)"
X.fb "(window-class window)"
X.fb "(window-bit-gravity window)"
X.fb "(window-gravity window)"
X.fb "(window-backing-store window)"
X.fb "(window-backing-planes window)"
X.fb "(window-backing-pixel window)"
X.fb "(window-save-under window)"
X.fb "(window-colormap window)"
X.fb "(window-map-installed window)"
X.fb "(window-map-state window)"
X.fb "(window-all-event-masks window)"
X.fb "(window-your-event-mask window)"
X.fb "(window-do-not-propagate-mask window)"
X.fb "(window-override-redirect window)"
X.fc "(window-screen window)" XGetWindowAttributes
XReturns the x- and y-coordinates, width, height, border width,
Xdepth, visual, root window, class, bit gravity, window gravity,
Xbacking store availability, backing planes, backing pixel,
Xsave under availability, colormap, colormap installation information,
Xmap state, global event mask, local event mask, ``do-not-propagate'' mask,
Xoverride redirect attribute, and screen of the specified window.
X.LP
X\f5window-visual\fP and \f5window-screen\fP always return the empty
Xlist in the current release of the software.
X\f5window-root\fP returns a window.
X\f5window-class\fP returns a symbol (\f5input-output\fP, \f5input-only\fP).
X\f5window-bit-gravity\fP returns a symbol (\f5forget\fP, \f5north-west\fP,
X\f5north\fP, \f5north-east\fP, \f5west\fP, \f5center\fP, \f5east\fP,
X\f5south-west\fP, \f5south\fP, \f5south-east\fP, \f5static\fP).
X\f5window-gravity\fP returns a symbol (same as \f5window-bit-gravity\fP
Xwith \f5unmap\fP instead of \f5forget\fP).
X\f5window-backing-store\fP returns a symbol (\f5not-useful\fP,
X\f5when-mapped\fP, \f5always\fP).
X\f5window-backing-planes\fP and \f5window-backing-pixel\fP return
Xa pixel.
X\f5window-save-under\fP, \f5window-map-installed\fP and
X\f5window-override-redirect\fP return #t or #f.
X\f5window-colormap\fP returns a colormap.
X\f5window-map-state\fP returns a symbol (\f5unmapped\fP,
X\f5unviewable\fP, \f5viewable\fP).
X\f5window-all-event-masks\fP, \f5window-your-event-mask\fP, and
X\f5window-do-not-propagate-mask\fP return a list of symbols
X(event mask names such as \f5enter-window\fP, \f5pointer-motion\fP, etc.).
XAll other functions return an integer.
X
X.f "(get-geometry drawable)" XGetGeometry
XThis function is not intended to be used by the application programmer.
X
X.fa "(drawable-root drawable)"
X.fb "(drawable-x drawable)"
X.fb "(drawable-y drawable)"
X.fb "(drawable-width drawable)"
X.fb "(drawable-height drawable)"
X.fb "(drawable-border-width drawable)"
X.fc "(drawable-depth drawable)" XGetGeometry
XReturns the root window, x- and y-coordinates, width, height,
Xborder width, and depth of the specified drawable.
X\f5drawable-root\fP returns a window, all other functions return
Xan integer.
X
X.f "(map-window window)" XMapWindow
X
X.f "(unmap-window window)" XUnmapWindow
X
X.f "(destroy-window window)" XDestroyWindow
X
X.f "(destroy-subwindows window)" XDestroySubwindows
X
X.f "(map-subwindows window)" XMapSubwindows
X
X.f "(unmap-subwindows window)" XUnmapSubwindows
X
X.f "(reparent-window window parent-window x y)" XReparentWindow
X
X.f "(clear-window window)"
XPerforms a \f5clear-area\fP on the entire window.
X
X.f "(query-tree window)" XQueryTree
XReturns a list of three elements:
X root-window
X parent-window
X children (a vector of windows).
X
X.f "(translate-coordinates src-window x y dst-window)" XTranslateCoordinates
XReturns a list of three elements:
X dst-x
X dst-y
X child-window.
X
X.NH
XWindow Manager Functions
X
X.f "(wm-name window)" XFetchName
XReturns a string or #f if XFetchName fails.
X
X.f "(wm-icon-name window)" XGetIconName
XReturns a string or #f if XGetIconName fails.
X
X.f "(set-wm-name! window name)" XStoreName
X\f5name\fP is a string or a symbol.
X
X.f "(set-wm-icon-name! window name)" XSetIconName
X\f5name\fP is a string or a symbol.
X
X.f "(wm-class window)" XGetClassHint
XReturns a pair (name and class) each component of which is either
Xa string or #f.
X
X.f "(set-wm-class! window name class)" XSetClassHint
X\f5name\fP and \f5class\fP are strings or symbols.
X
X.f "(wm-command window)"
XReturns the value of the WM_COMMAND property of the given window
Xas a list of strings.
X
X.f "(set-wm-command! window command)" XSetCommand
X\f5command\fP is a list; each element is either a string or a symbol.
X
X.f "(wm-hints window)" XGetWMHints
XThis function is not intended to be used by the application programmer.
X
X.f "(set-wm-hints! window tagged-vector)" XSetWMHints
XThis function is not intended to be used by the application programmer.
X
X.f "(size-hints window property)" XGetSizeHints
XThis function is not intended to be used by the application programmer.
X
X.f "(set-size-hints! window property tagged-vector)" XSetSizeHints
XThis function is not intended to be used by the application programmer.
X
X.f "(icon-sizes window)" XGetIconSize
XThis function is not intended to be used by the application programmer.
X
X.f "(set-icon-sizes! window tagged-vector)" XSetIconSize
XThis function is not intended to be used by the application programmer.
X
X.f "(transient-for window)" XGetTransientForHint
X
X.f "(set-transient-for! window property-window)" XSetTransientForHint
X
X.NH
XMiscellaneous Functions
X
X.f "(with object . body-forms)"
X\f5with\fP is a macro.
X\f5object\fP must be a drawable or a font.
XThe \f5body-forms\fP are evaluated in order; \f5with\fP returns the value
Xof the last body-form.
X.LP
XWithin the scope of the \f5with\fP, the first call to an accessor
Xfunction accessing \f5object\fP (such as \f5window-\fP\f2attribute\fP
Xor \f5font-\fP\f2attribute\fP) causes the result of the corresponding
XXlib function to be retained in a cache; subsequent calls just return
Xthe value from the cache.
XLikewise, calls to Xlib functions for mutator functions modifying
X\f5object\fP (such as \f5set-window-\fP\f2attribute\fP\f5!\fP)
Xare delayed until exit of the \f5with\fP body or until an accessor
Xfunction is called and the cached data for this accessor function
Xhas been invalidated by the call to a mutator function.
END_OF_doc/xlib.ms
if test 34657 -ne `wc -c <doc/xlib.ms`; then
echo shar: \"doc/xlib.ms\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/heap.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/heap.c\"
else
echo shar: Extracting \"src/heap.c\" \(7038 characters\)
sed "s/^X//" >src/heap.c <<'END_OF_src/heap.c'
X/* Memory allocation, garbage collection
X */
X
X#include <signal.h>
X
X#include "scheme.h"
X
X#define Recursive_Visit(p) {\
X register Object *pp = p;\
X if (Types[TYPE(*pp)].haspointer) Visit (pp);\
X}
X
Xchar *Heap_Start,
X *Hp, /* First free byte */
X *Heap_End, /* Points behind free bytes */
X *Free_Start, /* Start of free area */
X *Free_End; /* Points behind free area */
X
XGCNODE *GC_List;
X
Xstatic Object *Global_GC_Buf[GLOBAL_GC_OBJ];
Xstatic int Next_Global;
X
Xstatic void (*After_GC[AFTER_GC_FUNCS])();
Xstatic Next_After_GC;
X
Xstatic char *To;
Xstatic Object V_Garbage_Collect_Notifyp;
X
XInit_Heap () {
X Define_Variable (&V_Garbage_Collect_Notifyp, "garbage-collect-notify?",
X True);
X}
X
XMake_Heap (size) {
X register unsigned k = 1024 * size;
X register unsigned s = 2 * k;
X
X if (s > VALMASK)
X Fatal_Error ("heap size too large (%u bytes max)", VALMASK/2048);
X if ((Hp = Heap_Start = sbrk (s)) == (char *)-1)
X Fatal_Error ("cannot allocate heap (%u bytes)", s);
X Heap_End = Heap_Start + k;
X Free_Start = Heap_End;
X Free_End = Free_Start + k;
X}
X
Xchar *Get_Bytes (n) {
X register char *p = Hp;
X
X if (GC_Debug) {
X P_Collect ();
X p = Hp;
X }
X ALIGN(p);
X if (p + n > Heap_End) {
X (void)P_Collect ();
X p = Hp;
X ALIGN(p);
X if (p + n > Heap_End - HEAP_MARGIN)
X Uncatchable_Error ("Out of heap space");
X }
X Hp = p + n;
X return p;
X}
X
XRegister_After_GC (f) void (*f)(); {
X if (Next_After_GC >= AFTER_GC_FUNCS)
X Fatal_Error ("too many after GC functions");
X After_GC[Next_After_GC++] = f;
X}
X
XCall_After_GC () {
X register i;
X
X for (i = 0; i < Next_After_GC; i++)
X (*After_GC[i])();
X}
X
XObject P_Collect () {
X register char *tmp;
X register i, msg = 0;
X Object a[2];
X
X if (!initialized)
X Fatal_Error ("heap too small (increase heap size)");
X Disable_Interrupts;
X if (GC_Debug) {
X printf ("."); (void)fflush (stdout);
X } else if (Truep (Val (V_Garbage_Collect_Notifyp))) {
X msg++;
X Format (Standard_Output_Port, "[Garbage collecting... ", 23, 0,
X (Object *)0);
X fflush (stdout);
X }
X To = Free_Start;
X for (i = 0; i < Next_Global; i++)
X Visit (Global_GC_Buf[i]);
X Visit_GC_List (GC_List, 0);
X Visit_Wind (First_Wind, 0);
X Hp = To;
X tmp = Heap_Start; Heap_Start = Free_Start; Free_Start = tmp;
X tmp = Heap_End; Heap_End = Free_End; Free_End = tmp;
X if (!GC_Debug) {
X if (msg) {
X a[0] = Make_Fixnum ((Hp-Heap_Start) / 1024);
X a[1] = Make_Fixnum ((Heap_End-Heap_Start) / 1024);
X Format (Standard_Output_Port, "~sK of ~sK]~%", 13, 2, a);
X }
X }
X Call_After_GC ();
X Enable_Interrupts;
X return Void;
X}
X
XVisit (p) register Object *p; {
X register Object *tag;
X register t, size, reloc;
X
Xagain:
X t = TYPE(*p);
X if (!Types[t].haspointer)
X return;
X tag = (Object *)POINTER(*p);
X if ((char *)tag >= Free_Start && (char *)tag < Free_End)
X return;
X if (TYPE(*tag) == T_Broken_Heart) {
X SETPOINTER(*p, POINTER(*tag));
X return;
X }
X ALIGN(To);
X switch (t) {
X case T_Bignum:
X size = sizeof (struct S_Bignum) - sizeof (gran_t)
X + BIGNUM(*p)->size * sizeof (gran_t);
X bcopy ((char *)tag, To, size);
X break;
X case T_Flonum:
X size = sizeof (struct S_Flonum);
X *(struct S_Flonum *)To = *(struct S_Flonum *)tag;
X break;
X case T_Symbol:
X size = sizeof (struct S_Symbol);
X *(struct S_Symbol *)To = *(struct S_Symbol *)tag;
X break;
X case T_Pair:
X case T_Environment:
X size = sizeof (struct S_Pair);
X *(struct S_Pair *)To = *(struct S_Pair *)tag;
X break;
X case T_String:
X size = sizeof (struct S_String) + STRING(*p)->size - 1;
X bcopy ((char *)tag, To, size);
X break;
X case T_Vector:
X size = sizeof (struct S_Vector) + (VECTOR(*p)->size - 1) *
X sizeof (Object);
X bcopy ((char *)tag, To, size);
X break;
X case T_Primitive:
X size = sizeof (struct S_Primitive);
X *(struct S_Primitive *)To = *(struct S_Primitive *)tag;
X break;
X case T_Compound:
X size = sizeof (struct S_Compound);
X *(struct S_Compound *)To = *(struct S_Compound *)tag;
X break;
X case T_Control_Point:
X size = sizeof (struct S_Control) + CONTROL(*p)->size - 1;
X bcopy ((char *)tag, To, size);
X reloc = To - (char *)tag;
X break;
X case T_Promise:
X size = sizeof (struct S_Promise);
X *(struct S_Promise *)To = *(struct S_Promise *)tag;
X break;
X case T_Port:
X size = sizeof (struct S_Port);
X *(struct S_Port *)To = *(struct S_Port *)tag;
X break;
X case T_Autoload:
X size = sizeof (struct S_Autoload);
X *(struct S_Autoload *)To = *(struct S_Autoload *)tag;
X break;
X case T_Macro:
X size = sizeof (struct S_Macro);
X *(struct S_Macro *)To = *(struct S_Macro *)tag;
X break;
X case T_Broken_Heart:
X Panic ("broken heart in GC");
X default:
X if (t < 0 || t >= MAX_TYPE || !Types[t].name)
X Panic ("bad type in GC");
X if (Types[t].size == NOFUNC)
X size = Types[t].const_size;
X else
X size = (*Types[t].size)(*p);
X bcopy ((char *)tag, To, size);
X }
X SETPOINTER(*p, To);
X SET(*tag, T_Broken_Heart, To);
X To += size;
X if (To > Free_End)
X Panic ("free exhausted in GC");
X if (Types[t].visit == NOFUNC)
X return;
X switch (t) {
X case T_Symbol:
X Recursive_Visit (&SYMBOL(*p)->next);
X Recursive_Visit (&SYMBOL(*p)->name);
X Recursive_Visit (&SYMBOL(*p)->value);
X p = &SYMBOL(*p)->plist;
X goto again;
X case T_Pair:
X case T_Environment:
X Recursive_Visit (&PAIR(*p)->car);
X p = &PAIR(*p)->cdr;
X goto again;
X case T_Vector: {
X register i, n;
X for (i = 0, n = VECTOR(*p)->size; i < n; i++)
X Recursive_Visit (&VECTOR(*p)->data[i]);
X break;
X }
X case T_Compound:
X Recursive_Visit (&COMPOUND(*p)->closure);
X Recursive_Visit (&COMPOUND(*p)->env);
X p = &COMPOUND(*p)->name;
X goto again;
X case T_Control_Point:
X *(int *)(CONTROL(*p)->stack) += reloc;
X Visit_GC_List (CONTROL(*p)->gclist, *(int *)(CONTROL(*p)->stack));
X Visit_Wind (CONTROL(*p)->firstwind, *(int *)(CONTROL(*p)->stack));
X p = &CONTROL(*p)->env;
X goto again;
X case T_Promise:
X Recursive_Visit (&PROMISE(*p)->env);
X p = &PROMISE(*p)->thunk;
X goto again;
X case T_Port:
X p = &PORT(*p)->name;
X goto again;
X case T_Autoload:
X Recursive_Visit (&AUTOLOAD(*p)->file);
X p = &AUTOLOAD(*p)->env;
X goto again;
X case T_Macro:
X Recursive_Visit (&MACRO(*p)->body);
X p = &MACRO(*p)->name;
X goto again;
X default:
X (*Types[t].visit)(p, Visit);
X }
X}
X
XVisit_GC_List (list, delta) GCNODE *list; {
X register GCNODE *gp, *p;
X register n;
X register Object *vec;
X
X for (gp = list; gp; gp = p->next) {
X p = (GCNODE *)NORM(gp);
X if (p->gclen <= 0) {
X Visit ((Object *)NORM(p->gcobj));
X } else {
X vec = (Object *)NORM(p->gcobj);
X for (n = 0; n < p->gclen-1; n++)
X Visit (&vec[n]);
X }
X }
X}
X
XVisit_Wind (list, delta) WIND *list; {
X register WIND *wp, *p;
X
X for (wp = list; wp; wp = p->next) {
X p = (WIND *)NORM(wp);
X Visit (&p->in);
X Visit (&p->out);
X }
X}
X
X_Global_GC_Link (x) Object *x; {
X if (Next_Global == GLOBAL_GC_OBJ)
X Fatal_Error ("too many global GC links");
X Global_GC_Buf[Next_Global++] = x;
X}
END_OF_src/heap.c
if test 7038 -ne `wc -c <src/heap.c`; then
echo shar: \"src/heap.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/extern.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/extern.h\"
else
echo shar: Extracting \"src/extern.h\" \(7045 characters\)
sed "s/^X//" >src/extern.h <<'END_OF_src/extern.h'
X#ifndef EXTERN_H
X#define EXTERN_H
X
X/* External definitions
X */
X
Xextern errno;
Xextern char *sbrk(), *alloca(), *malloc(), *getenv(), *mktemp();
X
X/* auto.c:
X */
Xextern Object V_Autoload_Notifyp;
Xextern Object P_Autoload(), Do_Autoload();
X
X/* bignum.c:
X */
Xextern Bignum_Zero(), Bignum_Positive(), Bignum_Negative(), Bignum_Even();
Xextern Object Make_Bignum(), Integer_To_Bignum(), Bignum_Divide();
Xextern Object Bignum_Abs(), Bignum_Plus(), Bignum_Minus();
Xextern Object Bignum_Fixnum_Multiply(), Bignum_Multiply();
Xextern Object Bignum_Fixnum_Divide(), Double_To_Bignum();
Xextern Object Unsigned_To_Bignum();
Xextern double Bignum_To_Double();
X
X/* bool.c:
X */
Xextern Object P_Booleanp(), P_Not(), P_Eq(), P_Eqv(), P_Equal();
Xextern Eqv(), Equal();
X
X/* char.c:
X */
Xextern Object Make_Char(), P_Charp(), P_Char_Upcase(), P_Char_Downcase();
Xextern Object P_Chr_Eq(), P_Chr_Less(), P_Chr_Greater(), P_Chr_Eq_Less();
Xextern Object P_Chr_Eq_Greater(), P_Chr_CI_Eq(), P_Chr_CI_Less();
Xextern Object P_Chr_CI_Greater(), P_Chr_CI_Eq_Less(), P_Chr_CI_Eq_Greater();
Xextern Object P_Char_Upper_Case(), P_Char_Lower_Case();
Xextern Object P_Char_Alphabetic(), P_Char_Numeric(), P_Char_Whitespace();
Xextern Object P_Char_To_Integer(), P_Integer_To_Char();
X
X/* cont.c:
X */
Xextern WIND *First_Wind, *Last_Wind;
Xextern Object P_Call_CC(), P_Dynamic_Wind(), P_Control_Pointp();
Xextern Object P_Control_Point_Env(), Make_Control_Point();
X
X/* debug.c:
X */
Xextern Object P_Backtrace_List();
X
X/* dump.c:
X */
Xextern Object P_Dump();
Xextern Object Dump_Control_Point;
X
X/* env.c:
X */
Xextern Object The_Environment, Global_Environment;
Xextern Object P_The_Environment(), P_Define(), P_Set(), P_Env_List();
Xextern Object Add_Binding(), P_Define_Macro(), P_Boundp();
Xextern Object P_Global_Environment(), P_Environmentp();
X
X/* error.c:
X */
Xextern Object Arg_True;
Xextern Intr_Handler(), P_Error(), P_Reset();
X
X/* features.c:
X */
Xextern Object P_Featurep(), P_Provide(), P_Require();
X
X/* fixmul.c:
X */
Xextern Object Fixnum_Multiply();
X
X/* heap.c:
X */
Xextern char *Hp, *Heap_Start, *Heap_End, *Free_Start, *Free_End;
Xextern GCNODE *GC_List;
Xextern char *Get_Bytes();
Xextern Object P_Collect();
X
X/* io.c:
X */
Xextern Object Curr_Input_Port, Curr_Output_Port;
Xextern Object Standard_Input_Port, Standard_Output_Port;
Xextern Object P_Curr_Input_Port(), P_Curr_Output_Port(), P_Input_Portp();
Xextern Object P_Curr_Input_Port(), P_Curr_Output_Port(), P_Input_Portp();
Xextern Object P_Output_Portp(), P_Open_Input_File(), P_Open_Output_File();
Xextern Object P_Close_Port(), P_Eof_Objectp(), P_With_Input(), P_With_Output();
Xextern Object P_Call_With_Input(), P_Call_With_Output(), General_Open_File();
Xextern Object P_Open_Input_String(), P_Open_Output_String();
Xextern Object P_Port_File_Name(), P_Tilde_Expand(), P_File_Existsp();
X
X/* load.c:
X */
Xextern char Loader_Input[];
Xextern Object P_Load();
X
X/* list.c:
X */
Xextern Object P_Cons(), P_Car(), P_Cdr(), P_Setcar(), P_Setcdr();
Xextern Object P_List(), P_Length(), P_Nullp(), P_Pairp(), P_Cxr();
Xextern Object P_Cddr(), P_Cdar(), P_Cadr(), P_Caar(), P_Cdddr(), P_Cddar();
Xextern Object P_Cdadr(), P_Cdaar(), P_Caddr(), P_Cadar(), P_Caadr(), P_Caaar();
Xextern Object P_Append(), P_Append_Set(), P_Last_Pair(), P_Reverse();
Xextern Object P_Reverse_Set(), P_List_Tail(), P_List_Ref();
Xextern Object General_Assoc(), P_Assq(), P_Assv(), P_Assoc();
Xextern Object P_Memq(), P_Memv(), P_Member(), P_Make_List(), Copy_List();
X
X/* main.c:
X */
Xextern char *stkbase, *myname;
Xextern maxstack, initialized, dumped, GC_Debug;
Xextern SYMTAB *The_Symbols;
Xextern Object P_Command_Line_Args();
X
X/* math.c:
X */
Xextern Object Make_Integer(), Make_Fixnum(), Make_Reduced_Flonum(), P_Numberp();
Xextern Object P_Complexp(), P_Realp(), P_Rationalp(), P_Integerp(), P_Abs();
Xextern Object P_Zerop(), P_Positivep(), P_Negativep(), P_Oddp(), P_Evenp();
Xextern Object P_Exactp(), P_Inexactp(), P_Inc(), P_Dec();
Xextern Object P_Generic_Equal(), P_Generic_Less(), P_Generic_Greater();
Xextern Object P_Generic_Eq_Less(), P_Generic_Eq_Greater();
Xextern Object P_Generic_Plus(), P_Generic_Minus(), P_Generic_Multiply();
Xextern Object P_Generic_Divide(), P_Quotient(), P_Remainder(), P_Modulo();
Xextern Object P_Gcd(), P_Lcm(), P_Floor(), P_Ceiling(), P_Truncate();
Xextern Object P_Round(), P_Sqrt(), P_Exp(), P_Log(), P_Sin(), P_Cos(), P_Tan();
Xextern Object P_Asin(), P_Acos(), P_Atan(), P_Min(), P_Max(), P_Random();
Xextern Object P_Srandom(), P_Make_Unsigned();
Xextern double Get_Double();
X
X/* prim.c:
X */
X
X/* print.c:
X */
Xextern Object P_Write(), P_Display(), P_Write_Char(), P_Newline(), P_Format();
Xextern Object P_Clear_Output_Port(), P_Flush_Output_Port(), P_Print();
Xextern Object P_Get_Output_String();
Xextern Saved_Errno;
X
X/* proc.c:
X */
Xextern char *Error_Tag;
Xextern Tail_Call;
Xextern Object Eval();
Xextern Object Sym_Lambda, Sym_Macro;
Xextern Object P_Eval(), P_Apply(), Funcall(), P_Lambda(), P_Begin(), P_Map();
Xextern Object P_Procedure_Env(), P_Procedure_Lambda(), Make_Primitive();
Xextern Object P_Begin1(), P_For_Each(), P_Procedurep(), Funcall_Compound();
Xextern Object P_Macro(), P_Macro_Body(), P_Macro_Expand();
Xextern Object P_Primitivep(), P_Compoundp(), P_Macrop();
X
X/* promise.c:
X */
Xextern Object P_Delay(), P_Force(), P_Promisep(), P_Promise_Env();
X
X/* read.c:
X */
Xextern Object Sym_Quote, Sym_Quasiquote, Sym_Unquote, Sym_Unquote_Splicing;
Xextern Object P_Exit(), General_Read(), P_Read(), P_Read_Char();
Xextern Object P_Unread_Char(), P_Read_String(), P_Clear_Input_Port();
Xextern Object Read_Number_Maybe();
X
X/* special.c:
X */
Xextern Object P_Quote(), P_If(), P_Let(), P_Letseq(), P_Letrec(), P_Case();
Xextern Object P_Cond(), P_And(), P_Or(), P_Do(), P_Quasiquote(), P_Fluid_Let();
X
X/* stab.c:
X */
Xextern SYMTAB *Snarf_Symbols(), *Open_File_And_Snarf_Symbols();
X
X/* string.c:
X */
Xextern char Char_Map[];
Xextern Object Make_String(), P_Stringp(), P_Make_String();
Xextern Object P_String_To_Number();
Xextern Object P_Str_Eq(), P_Str_Less(), P_Str_Greater(), P_Str_Eq_Less();
Xextern Object P_Str_Eq_Greater(), P_Str_CI_Eq(), P_Str_CI_Less();
Xextern Object P_Str_CI_Greater(), P_Str_CI_Eq_Less(), P_Str_CI_Eq_Greater();
Xextern Object P_String_Length(), P_String_Ref(), P_String_Set(), P_Substring();
Xextern Object P_String_Copy(), P_String_Append(), P_List_To_String();
Xextern Object P_String_To_List(), P_Substring_Fill(), P_String_Fill();
Xextern Object P_String(), P_Substringp(), P_CI_Substringp();
X
X/* symbol.c:
X */
Xextern Object Null, True, False, Unbound, Special, Void, Newline, Eof;
Xextern Object Zero, One;
Xextern Object Lookup_Symbol(), Intern(), P_Oblist();
Xextern Object P_Symbolp(), P_Symbol_To_String(), P_String_To_Symbol();
Xextern Object P_Put(), P_Get(), P_Symbol_Plist();
X
X/* type.c:
X */
Xextern TYPEDESCR Types[];
Xextern Object P_Type(), P_Voidp();
X
X/* vector.c:
X */
Xextern Object Make_Vector(), P_Make_Vector(), P_Vectorp(), P_Vector();
Xextern Object P_Vector_Length(), P_Vector_Ref(), P_Vector_Set();
Xextern Object P_Vector_To_List(), P_List_To_Vector(), P_Vector_Fill();
Xextern Object P_Vector_Copy();
X
X#endif
END_OF_src/extern.h
if test 7045 -ne `wc -c <src/extern.h`; then
echo shar: \"src/extern.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/error.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/error.c\"
else
echo shar: Extracting \"src/error.c\" \(3376 characters\)
sed "s/^X//" >src/error.c <<'END_OF_src/error.c'
X/* Error handling and error checking
X */
X
X#include <signal.h>
X#include <setjmp.h>
X#include <varargs.h>
X
X#include "scheme.h"
X
XObject Arg_True;
X
Xstatic Object V_Error_Handler,
X V_Interrupt_Handler,
X V_Top_Level_Control_Point;
X
XInit_Error () {
X Arg_True = Cons (True, Null);
X Global_GC_Link (Arg_True);
X Define_Variable (&V_Error_Handler, "error-handler", Null);
X Define_Variable (&V_Interrupt_Handler, "interrupt-handler", Null);
X Define_Variable (&V_Top_Level_Control_Point, "top-level-control-point",
X Null);
X}
X
X#ifdef lint
X/*VARARGS1*/
XFatal_Error (foo) char *foo; { foo = foo; }
X#else
XFatal_Error (va_alist) va_dcl {
X va_list args;
X char *fmt;
X
X va_start (args);
X fmt = va_arg (args, char *);
X (void)fflush (stdout);
X fprintf (stderr, "\nFatal error: ");
X vfprintf (stderr, fmt, args);
X fprintf (stderr, ".\n");
X va_end (args);
X exit (1);
X}
X#endif
X
XPanic (msg) char *msg; {
X (void)fflush (stdout);
X fprintf (stderr, "\nPanic: %s (dumping core).\n", msg);
X abort ();
X}
X
XUncatchable_Error (errmsg) char *errmsg; {
X Reset_IO (0);
X Format (Curr_Output_Port, errmsg, strlen (errmsg), 0, (Object *)0);
X P_Newline (0);
X Reset ();
X}
X
X#ifdef lint
X/*VARARGS1*/
XPrimitive_Error (foo) char *foo; { foo = foo; }
X#else
XPrimitive_Error (va_alist) va_dcl {
X va_list args;
X register char *p, *fmt;
X register i, n;
X Object msg, sym, argv[10];
X GC_Node; GCNODE gcv;
X
X Enable_Interrupts; /* In case the error occured after a disable_intr */
X va_start (args);
X fmt = va_arg (args, char *);
X for (n = 0, p = fmt; *p; p++)
X if (*p == '~' && p[1] != '~' && p[1] != '%') n++;
X if (n > 10)
X Panic ("Primitive_Error args");
X for (i = 0; i < n; i++)
X argv[i] = va_arg (args, Object);
X sym = Null;
X GC_Link (sym);
X gcv.gclen = 1 + i; gcv.gcobj = argv; gcv.next = &gc1; GC_List = &gcv;
X sym = Intern (Error_Tag);
X msg = Make_String (fmt, p - fmt);
X Err_Handler (sym, msg, i, argv);
X /*NOTREACHED*/
X}
X#endif
X
XP_Error (argc, argv) Object *argv; {
X Check_Type (argv[1], T_String);
X Err_Handler (argv[0], argv[1], argc-2, argv+2);
X /*NOTREACHED*/
X}
X
XErr_Handler (sym, fmt, argc, argv) Object sym, fmt, *argv; {
X Object fun, args, a[1];
X GC_Node3;
X
X Reset_IO (0);
X args = Null;
X GC_Link3 (args, sym, fmt);
X args = P_List (argc, argv);
X args = Cons (fmt, args);
X args = Cons (sym, args);
X fun = Val (V_Error_Handler);
X if (TYPE(fun) == T_Compound)
X (void)Funcall (fun, args, 0);
X a[0] = sym;
X Format (Curr_Output_Port, "~s: ", 4, 1, a);
X Format (Curr_Output_Port, STRING(fmt)->data, STRING(fmt)->size,
X argc, argv);
X P_Newline (0);
X GC_Unlink;
X Reset ();
X /*NOTREACHED*/
X}
X
XIntr_Handler () {
X Object fun;
X
X Error_Tag = "interrupt-handler";
X Reset_IO (1);
X fun = Val (V_Interrupt_Handler);
X if (TYPE(fun) == T_Compound)
X (void)Funcall (fun, Null, 0);
X Format (Curr_Output_Port, "~%\7Interrupt!~%", 15, 0, (Object *)0);
X Reset ();
X /*NOTREACHED*/
X}
X
XReset () {
X Object cp;
X
X cp = Val (V_Top_Level_Control_Point);
X if (TYPE(cp) == T_Control_Point)
X (void)Funcall_Control_Point (cp, Arg_True, 0);
X (void)fflush (stdout);
X exit (1);
X}
X
XP_Reset () {
X Reset_IO (0);
X Reset ();
X}
X
XRange_Error (i) Object i; {
X Primitive_Error ("argument out of range: ~s", i);
X}
END_OF_src/error.c
if test 3376 -ne `wc -c <src/error.c`; then
echo shar: \"src/error.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/alloca.s.pyramid -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/alloca.s.pyramid\"
else
echo shar: Extracting \"src/alloca.s.pyramid\" \(194 characters\)
sed "s/^X//" >src/alloca.s.pyramid <<'END_OF_src/alloca.s.pyramid'
X.globl _alloca
X
X_alloca: addw $3,pr0 # add 3 (dec) to first argument
X bicw $3,pr0 # then clear its last 2 bits
X subw pr0,sp # subtract from SP the val in PR0
X movw sp,pr0 # ret. current SP
X ret
END_OF_src/alloca.s.pyramid
if test 194 -ne `wc -c <src/alloca.s.pyramid`; then
echo shar: \"src/alloca.s.pyramid\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/alloca.s -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/alloca.s\"
else
echo shar: Extracting \"src/alloca.s\" \(0 character\)
sed "s/^X//" >src/alloca.s <<'END_OF_src/alloca.s'
END_OF_src/alloca.s
if test 0 -ne `wc -c <src/alloca.s`; then
echo shar: \"src/alloca.s\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/alloca.s.68k -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/alloca.s.68k\"
else
echo shar: Extracting \"src/alloca.s.68k\" \(0 character\)
sed "s/^X//" >src/alloca.s.68k <<'END_OF_src/alloca.s.68k'
END_OF_src/alloca.s.68k
if test 0 -ne `wc -c <src/alloca.s.68k`; then
echo shar: \"src/alloca.s.68k\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 3 \(of 14\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 14 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
More information about the Comp.sources.misc
mailing list