(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL-USER")
(IL:FILECREATED " 9-Sep-94 14:12:09" ("compiled on " IL:|{DSK}<lispcore>lispusers>PACKED-STRUCTURE.;1|
) "28-Jul-94 17:28:46" IL:|bcompl'd| IL:|in| "Medley 25-Aug-94 ..." IL:|dated| "25-Aug-94 10:02:49")
(IL:FILECREATED "19-Oct-87 14:53:33" IL:{ERINYES}<LISPUSERS>LYRIC>PACKED-STRUCTURE.\;1 4305 IL:|changes|
 IL:|to:| (IL:SETFS LOGBITP) (IL:FUNCTIONS DEF-PACKED-STRUCTURE SIGNED-LDB) IL:|previous| IL:|date:| 
"29-Sep-87 18:13:33" IL:|{IE:PARC:XEROX}<LISP>LYRIC>LISPUSERS>PACKED-STRUCTURE.;1|)
(IL:PRETTYCOMPRINT IL:PACKED-STRUCTURECOMS)
(IL:RPAQQ IL:PACKED-STRUCTURECOMS ((IL:FUNCTIONS DEF-PACKED-STRUCTURE SIGNED-LDB) (IL:SETFS LOGBITP) (
IL:PROP IL:MAKEFILE-ENVIRONMENT IL:PACKED-STRUCTURE)))
(DEFDEFINER DEF-PACKED-STRUCTURE IL:STRUCTURES (NAME &REST SLOTS) (LET* ((*PACKAGE* (SYMBOL-PACKAGE 
NAME)) (COUNT 0) (MAX-COUNT 0) (LOCATIONS)) (LABELS ((SLOT-NAME (SLOT) (CAR SLOT)) (SLOT-TYPE (SLOT) (
LET ((TYPE (GETF (CDDR SLOT) (QUOTE :TYPE) T))) (COND ((SUBTYPEP TYPE (QUOTE (MEMBER NIL T))) (QUOTE 
:BOOLEAN)) (T (IL:* IL:\; 
" punt for now, this should really coerce other things into stuff that looks like signed or unsigned byte "
) TYPE)))) (INFIX (X Y) (INTERN (FORMAT NIL "~A-~A" (STRING X) (STRING Y)))) (SLOT-LOCATION (SLOT) (
CDR (ASSOC (SLOT-NAME SLOT) LOCATIONS))) (SLOT-SUPPLIED-P (SLOT) (INFIX (SLOT-NAME SLOT) "SUPPLIED-P")
) (SLOT-SIGNED (SLOT) (AND (LISTP (SLOT-TYPE SLOT)) (EQ (CAR (SLOT-TYPE SLOT)) (QUOTE SIGNED-BYTE)))) 
(SLOT-SIZE (SLOT) (LET ((TYPE (SLOT-TYPE SLOT))) (CASE TYPE (:BOOLEAN 1) (T (ECASE (CAR TYPE) ((
UNSIGNED-BYTE SIGNED-BYTE) (SECOND TYPE)))))))) (MAPC (FUNCTION (LAMBDA (SLOT) (WHEN (GETF (CDDR SLOT)
 (QUOTE :OVERLAY)) (SETQ COUNT 0)) (PUSH (CONS (SLOT-NAME SLOT) COUNT) LOCATIONS) (INCF COUNT (
SLOT-SIZE SLOT)) (SETQ MAX-COUNT (MAX MAX-COUNT COUNT)))) SLOTS) (IL:BQUOTE (PROGN (DEFTYPE (IL:\\\, 
NAME) NIL (QUOTE (UNSIGNED-BYTE (IL:\\\, COUNT)))) (IL:\\\,@ (MAPCAR (FUNCTION (LAMBDA (S) (IL:BQUOTE 
(DEFMACRO (IL:\\\, (INFIX NAME (SLOT-NAME S))) (X) (IL:\\\, (COND ((EQ (SLOT-TYPE S) (QUOTE :BOOLEAN))
 (IL:BQUOTE (IL:BQUOTE (LOGBITP (IL:\\\, (QUOTE (IL:\\\, (SLOT-LOCATION S)))) (IL:\\\, X))))) (T (
IL:BQUOTE (IL:BQUOTE ((IL:\\\, (QUOTE (IL:\\\, (IF (SLOT-SIGNED S) (QUOTE SIGNED-LDB) (QUOTE LDB))))) 
(IL:\\\, (QUOTE (IL:\\\, (BYTE (SLOT-SIZE S) (SLOT-LOCATION S))))) (IL:\\\, X))))))))))) SLOTS)) (
DEFMACRO (IL:\\\, (INFIX "MAKE" NAME)) (&KEY (IL:\\\,@ (MAPCAR (FUNCTION (LAMBDA (S) (LIST (SLOT-NAME 
S) (SECOND S) (SLOT-SUPPLIED-P S)))) SLOTS)) &AUX (VALUE 0)) (IL:\\\,@ (MAPCAR (FUNCTION (LAMBDA (S) (
IL:BQUOTE (WHEN (IL:\\\, (SLOT-SUPPLIED-P S)) (SETQ VALUE (IL:\\\, (COND ((EQ (SLOT-TYPE S) (QUOTE 
:BOOLEAN)) (IL:BQUOTE (IL:BQUOTE (LOGIOR (IF (IL:\\\, (IL:\\\, (SLOT-NAME S))) (IL:\\\, (QUOTE (IL:\\\,
 (ASH 1 (SLOT-LOCATION S))))) 0) (IL:\\\, VALUE))))) ((SLOT-SIGNED S) (IL:BQUOTE (IL:BQUOTE (DPB (
IL:\\\, (IL:\\\, (SLOT-NAME S))) (IL:\\\, (QUOTE (IL:\\\, (BYTE (SLOT-SIZE S) (SLOT-LOCATION S))))) (
IL:\\\, VALUE))))) (T (IL:BQUOTE (IL:BQUOTE (LOGIOR (ASH (IL:\\\, (IL:\\\, (SLOT-NAME S))) (IL:\\\, (
QUOTE (IL:\\\, (SLOT-LOCATION S))))) (IL:\\\, VALUE)))))))))))) SLOTS)) VALUE))))))
(DEFUN SIGNED-LDB (BYTESPEC INTEGER) (FLET ((SIGN-EXTEND (NUMBER POSITION) (IF (LOGBITP (1- POSITION) 
NUMBER) (DPB NUMBER (BYTE POSITION 0) -1) NUMBER))) (SIGN-EXTEND (LDB BYTESPEC INTEGER) (BYTE-SIZE 
BYTESPEC))))
(DEFINE-SETF-METHOD LOGBITP (INDEX INTEGER) (MULTIPLE-VALUE-BIND (TEMPS VALS STORES STORE-FORM 
ACCESS-FORM) (GET-SETF-METHOD INTEGER) (IL:* IL:\; "get SETF method for integer.") (LET ((BTEMP (
IL:GENSYM)) (IL:* IL:\; "Temp var for index") (STORE (IL:GENSYM)) (IL:* IL:\; "Temp var for new value"
) (STEMP (FIRST STORES)) (IL:* IL:\; "Temp var for int to store.")) (VALUES (CONS BTEMP TEMPS) (IL:* 
IL:\; "Temporary variables.") (CONS INDEX VALS) (IL:* IL:\; "Value forms.") (LIST STORE) (IL:* IL:\; 
"Store variables.") (IL:BQUOTE (LET (((IL:\\\, STEMP) (IF (IL:\\\, STORE) (LOGIOR (IL:\\\, ACCESS-FORM
) (ASH 1 (IL:\\\, BTEMP))) (LOGANDC2 (IL:\\\, ACCESS-FORM) (ASH 1 (IL:\\\, BTEMP)))))) (IL:\\\, 
STORE-FORM) (IL:\\\, STORE))) (IL:* IL:\; "Storing form") (IL:BQUOTE (LOGBITP (IL:\\\, BTEMP) (IL:\\\,
 ACCESS-FORM)))))))
(IL:PUTPROPS IL:PACKED-STRUCTURE IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL-USER"))
(IL:PUTPROPS IL:PACKED-STRUCTURE IL:COPYRIGHT ("Xerox Corporation" 1987))
NIL