Changeset 9917


Ignore:
Timestamp:
Jul 7, 2008, 7:24:57 PM (11 years ago)
Author:
gz
Message:

Move more definitions into lispequ. To bootstrap, (load "ccl:library;lispequ.lisp") before recompiling

Location:
trunk/source
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/compiler/nx0.lisp

    r9892 r9917  
    2828
    2929; Phony AFUNC "defstruct":
    30 (defun make-afunc (&aux (v (allocate-typed-vector :istruct $afunc-size nil)))
     30(defun make-afunc (&aux (v (%make-afunc)))
    3131  (setf (%svref v 0) 'afunc)
    3232  (setf (afunc-fn-refcount v) 0)

  • trunk/source/compiler/nxenv.lisp

    r9253 r9917  
    2929#+x8664-target (require "X8664ENV")
    3030
    31 (defconstant $afunc-size
    32   (def-accessors (afunc) %svref
    33     ()                                    ; 'afunc
    34     afunc-acode
    35     afunc-parent
    36     afunc-vars
    37     afunc-inherited-vars
    38     afunc-blocks
    39     afunc-tags
    40     afunc-inner-functions
    41     afunc-name
    42     afunc-bits
    43     afunc-lfun
    44     afunc-environment
    45     afunc-lambdaform
    46     afunc-argsword
    47     afunc-ref-form
    48     afunc-warnings
    49     afunc-fn-refcount
    50     afunc-fn-downward-refcount
    51     afunc-all-vars
    52     afunc-callers
    53     afunc-vcells
    54     afunc-fcells
    55     afunc-fwd-refs
    56     afunc-lfun-info
    57     afunc-linkmap
    58 ))
    59 
    6031;
    61 
    62 (def-accessors (compiler-policy) uvref
    63   nil                                   ; 'compiler-policy
    64   policy.allow-tail-recursion-elimination
    65   policy.inhibit-register-allocation
    66   policy.trust-declarations
    67   policy.open-code-inline
    68   policy.inhibit-safety-checking
    69   policy.the-typechecks
    70   policy.inline-self-calls
    71   policy.allow-transforms
    72   policy.force-boundp-checks
    73   policy.allow-constant-substitution
    74   policy.misc)
    7532
    7633(defconstant $vbittemporary 16)    ; a compiler temporary
    … …  
    224181     (lap-inline . 0)
    225182     (%function . #.operator-single-valued-mask)
     183     #+not-yet
     184     (%valid-code-char . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    226185     (%ttagp . #.(logior operator-cc-invertable-mask operator-single-valued-mask))
    227186     (%ttag . #.operator-single-valued-mask) 
    … …  
    471430(defconstant $fbitruntimedef 8)
    472431(defconstant $fbitnonnullenv 9)
     432(defconstant $fbitccoverage 10)
    473433
    474434(defconstant $eaclosedbit 24)
    … …  
    538498  `(consp ,x))
    539499
    540 (defmacro defnx2 (name locative arglist &body forms)
    541   (multiple-value-bind (body decls)
    542                        (parse-body forms nil t)
    543     (let ((fn `(nfunction ,name (lambda ,arglist ,@decls (block ,name .,body)))))
    544     `(progn
    545        (record-source-file ',name 'function)
    546        (svset *nx2-specials* (%ilogand operator-id-mask (%nx1-operator ,locative)) ,fn)))))
    547500
    548501(defmacro defnxdecl (sym lambda-list &body forms)
    … …  
    564517      ,@body)))
    565518
    566          
    567 
    568 (defmacro with-p2-declarations (declsform &body body)
    569   `(let* ((*nx2-tail-allow* *nx2-tail-allow*)
    570           (*nx2-reckless* *nx2-reckless*)
    571           (*nx2-inhibit-eventchecks* *nx2-inhibit-eventchecks*)
    572           (*nx2-open-code-inline* *nx2-open-code-inline*)
    573           (*nx2-trust-declarations* *nx2-trust-declarations*))
    574      (nx2-decls ,declsform)
    575      ,@body))
    576519
    577520(eval-when (:compile-toplevel :load-toplevel :execute)

  • trunk/source/level-0/l0-cfm-support.lisp

    r9858 r9917  
    4040
    4141
    42 (def-accessor-macros %svref
    43   nil                                 ; 'external-entry-point
    44   eep.address
    45   eep.name
    46   eep.container)
    47 
    48 (defun %cons-external-entry-point (name &optional container)
    49   (%istruct 'external-entry-point nil name container))
    5042
    5143(defun external-entry-point-p (x)
    5244  (istruct-typep x 'external-entry-point))
    53 
    54 (def-accessor-macros %svref
    55     nil                                 ;'foreign-variable
    56   fv.addr                               ; a MACPTR, or nil
    57   fv.name                               ; a string
    58   fv.type                               ; a foreign type
    59   fv.container                          ; containing library
    60   )
    61 
    62 (defun %cons-foreign-variable (name type &optional container)
    63   (%istruct 'foreign-variable nil name type container))
    64 
    65 (def-accessor-macros %svref
    66     nil                                 ;'shlib
    67   shlib.soname
    68   shlib.pathname
    69   shlib.handle                          ; if explicitly opened
    70   shlib.map
    71   shlib.base
    72   shlib.opencount)
    73 
    74 (defun %cons-shlib (soname pathname map base)
    75   (%istruct 'shlib soname pathname nil map base 0))
    7645
    7746(defvar *rtld-next*)

  • trunk/source/level-1/l1-clos-boot.lisp

    r9879 r9917  
    4040(defun %class-name (class)
    4141  (%class.name class))
     42
     43(defun %class-info (class)
     44  (%class.info class))
     45
     46
     47(defun %class-kernel-p (class)
     48  (car (%class-info class)))
     49
     50(defun (setf %class-kernel-p) (new class)
     51  (setf (car (%class-info class)) new))
     52
     53(defun %class-proper-name (class)
     54  (cdr (%class-info class)))
     55
     56(defun (setf %class-proper-name) (new class)
     57  (setf (cdr (%class-info class)) new))
     58
    4259
    4360(defun %class-own-wrapper (class)
    … …  
    12471264(defun check-setf-find-class-protected-class (old-class new-class name)
    12481265  (when (and (standard-instance-p old-class)
    1249              (%class.kernel-p old-class)
     1266             (%class-kernel-p old-class)
    12501267             *warn-if-redefine-kernel*
    12511268             ;; EQL might be necessary on foreign classes
    … …  
    12551272marked as being a critical part of the system; an attempt is being made
    12561273to replace that class with ~s" name old-class new-class)
    1257     (setf (%class.kernel-p old-class) nil)))
     1274    (setf (%class-kernel-p old-class) nil)))
    12581275
    12591276

  • trunk/source/level-1/l1-clos.lisp

    r9894 r9917  
    16681668  (check-type new symbol)
    16691669  (when (and (standard-instance-p class)
    1670              (%class.kernel-p class)
     1670             (%class-kernel-p class)
    16711671             (not (eq new (%class.name class)))
    16721672             *warn-if-redefine-kernel*)

  • trunk/source/level-1/sysutils.lisp

    r9892 r9917  
    527527
    528528(defparameter *outstanding-deferred-warnings* nil)
    529 (def-accessors (deferred-warnings) %svref
    530   nil
    531   deferred-warnings.parent
    532   deferred-warnings.warnings
    533   deferred-warnings.defs
    534   deferred-warnings.flags ; might use to distinguish interactive case/compile-file
    535 )
    536529
    537530(defun %defer-warnings (override &optional flags)

  • trunk/source/lib/pprint.lisp

    r9240 r9917  
    128128  "initial print dispatch table.")
    129129
     130(eval-when (:compile-toplevel :execute)
     131  (declaim (inline xp-structure-p)))
     132
     133(defun xp-structure-p (x)
     134  (istruct-typep x 'xp-structure))
     135
     136
     137(defun entry-p (x)
     138  (istruct-typep x 'entry))
     139
     140 
     141
    130142;default (bad) definitions for the non-portable functions
    131143
    … …  
    169181;the number of entries in the OTHERS list that have a higher priority.
    170182
    171 (progn
    172 (eval-when (:compile-toplevel :execute)
    173   (def-accessors uvref ; %svref
    174     ()                                  ;'entry
    175     entry-test                          ;predicate function or count of higher priority others.
    176     entry-fn                            ;pprint function
    177     entry-full-spec                     ;list of priority and type specifier
    178     ))
    179 
    180183(defun make-entry (&key test fn full-spec)
    181184  (%istruct 'entry test fn full-spec))
    182 )
    183185
    184186(defun copy-pprint-dispatch (&optional (table *print-pprint-dispatch*))
    … …  
    370372
    371373(progn
    372   (eval-when (:compile-toplevel :execute)
    373     (def-accessors %svref
    374         ()                              ; 'xp-structure
    375       xp-base-stream;;The stream io eventually goes to.
    376       xp-linel;;The line length to use for formatting.
    377       xp-line-limit;;If non-NIL the max number of lines to print.
    378       xp-line-no;;number of next line to be printed.
    379       xp-char-mode;;NIL :UP :DOWN :CAP0 :CAP1 :CAPW
    380       xp-char-mode-counter              ;depth of nesting of ~(...~)
    381       xp-depth-in-blocks;;Number of logical blocks at QRIGHT that
    382       ;;are started but not ended.             
    383       xp-block-stack
    384       xp-block-stack-ptr
    385       ;;This stack is pushed and popped in accordance with the way blocks are
    386       ;;nested at the moment they are entered into the queue.  It contains the
    387       ;;following block specific value.
    388       ;;SECTION-START total position where the section (see AIM-1102)
    389       ;;that is rightmost in the queue started.
    390       xp-buffer
    391       xp-charpos
    392       xp-buffer-ptr
    393       xp-buffer-offset
    394       ;;This is a vector of characters (eg a string) that builds up the
    395       ;;line images that will be printed out.  BUFFER-PTR is the
    396       ;;buffer position where the next character should be inserted in
    397       ;;the string.  CHARPOS is the output character position of the
    398       ;;first character in the buffer (non-zero only if a partial line
    399       ;;has been output).  BUFFER-OFFSET is used in computing total lengths.
    400       ;;It is changed to reflect all shifting and insertion of prefixes so that
    401       ;;total length computes things as they would be if they were
    402       ;;all on one line.  Positions are kept three different ways
    403       ;; Buffer position (eg BUFFER-PTR)
    404       ;; Line position (eg (+ BUFFER-PTR CHARPOS)).  Indentations are stored in this form.
    405       ;; Total position if all on one line (eg (+ BUFFER-PTR BUFFER-OFFSET))
    406       ;;  Positions are stored in this form.
    407       xp-queue
    408       xp-qleft
    409       xp-qright
    410       ;;This holds a queue of action descriptors.  QLEFT and QRIGHT
    411       ;;point to the next entry to dequeue and the last entry enqueued
    412       ;;respectively.  The queue is empty when
    413       ;;(> QLEFT QRIGHT).  The queue entries have several parts:
    414       ;;QTYPE one of :NEWLINE/:IND/:START-BLOCK/:END-BLOCK
    415       ;;QKIND :LINEAR/:MISER/:FILL/:MANDATORY or :UNCONDITIONAL/:FRESH
    416       ;; or :BLOCK/:CURRENT
    417       ;;QPOS total position corresponding to this entry
    418       ;;QDEPTH depth in blocks of this entry.
    419       ;;QEND offset to entry marking end of section this entry starts. (NIL until known.)
    420       ;; Only :start-block and non-literal :newline entries can start sections.
    421       ;;QOFFSET offset to :END-BLOCK for :START-BLOCK (NIL until known).
    422       ;;QARG for :IND indentation delta
    423       ;;     for :START-BLOCK suffix in the block if any.
    424       ;;                      or if per-line-prefix then cons of suffix and
    425       ;;                      per-line-prefix.
    426       ;;     for :END-BLOCK suffix for the block if any.
    427       xp-prefix
    428       ;;this stores the prefix that should be used at the start of the line
    429       xp-prefix-stack
    430       xp-prefix-stack-ptr
    431       ;;This stack is pushed and popped in accordance with the way blocks
    432       ;;are nested at the moment things are taken off the queue and printed.
    433       ;;It contains the following block specific values.
    434       ;;PREFIX-PTR current length of PREFIX.
    435       ;;SUFFIX-PTR current length of pending suffix
    436       ;;NON-BLANK-PREFIX-PTR current length of non-blank prefix.
    437       ;;INITIAL-PREFIX-PTR prefix-ptr at the start of this block.
    438       ;;SECTION-START-LINE line-no value at last non-literal break at this level.
    439       xp-suffix
    440       ;;this stores the suffixes that have to be printed to close of the current
    441       ;;open blocks.  For convenient in popping, the whole suffix
    442       ;;is stored in reverse order.
    443       xp-stream  ;;; the xp-stream containing this structure
    444       xp-string-stream;; string-stream for output until first circularity (in case none)
    445       )
    446     )
    447 
    448374  (setf (symbol-function 'xp-stream-stream) #'(lambda (s) (xp-stream s)))
    449375
    … …  
    488414    (write-internal-1 (xp-stream xp-struc) object level list-kludge))
    489415
    490   (defmacro xp-structure-p (x)
    491     `(istruct-typep ,x 'xp-structure))
     416
    492417
    493418  (defun get-xp-stream (pp)

  • trunk/source/library/lispequ.lisp

    r7958 r9917  
    139139(defconstant $lfbits-aok-bit 16)
    140140(defconstant $lfbits-numinh (byte 6 17))
    141 (defconstant $lfbits-symmap-bit 23)
     141(defconstant $lfbits-info-bit 23)
     142(defconstant $lfbits-symmap-bit 23) ;; bootstrapping
    142143(defconstant $lfbits-trampoline-bit 24)
    143 (defconstant $lfbits-evaluated-bit 25)
     144(defconstant $lfbits-code-coverage-bit 25)
    144145(defconstant $lfbits-cm-bit 26)         ; combined-method
    145146(defconstant $lfbits-nextmeth-bit 26)   ; or call-next-method with method-bit
    … …  
    933934  %wrapper-set-slot-id-value            ; "fast" (SETF SLOT-VALUE) function
    934935  %wrapper-cpl                          ; cached cpl of %wrapper-class or NIL
     936  %wrapper-class-ordinal                ; cached copy of class-ordinal
     937  %wrapper-cpl-bits                     ; bitvector representation of cpl
    935938)
    936939
    … …  
    981984  %class.dependents                     ; arbitrary dependents
    982985  %class.ctype
     986  %class.direct-slots                   ; local slots
     987  %class.slots                          ; all slots
     988  %class.info                           ; cons of kernel-p, proper-name
     989  %class.local-default-initargs         ; local default initargs alist
     990  %class.default-initargs               ; all default initargs if initialized.
    983991)
    984992
    … …  
    9951003  nil                                   ;   dependents,
    9961004  nil                                   ;   ctype.
    997   %class.direct-slots                   ; local slots
    998   %class.slots                          ; all slots
    999   %class.kernel-p                       ; true if a non-redefinable class
    1000   %class.local-default-initargs         ; local default initargs alist
    1001   %class.default-initargs               ; all default initargs if initialized.
     1005  nil                                   ; local slots
     1006  nil                                   ; all slots
     1007  nil                                ; true if a non-redefinable class
     1008  nil                                   ; local default initargs alist
     1009  nil                           ; all default initargs if initialized.
    10021010  %class.alist                          ; other stuff about the class.
    10031011  %class.make-instance-initargs         ; (vector of) valid initargs to make-instance
    … …  
    10201028       ,instance)))
    10211029 
     1030
     1031
     1032
    10221033(defmacro %cons-built-in-class (name)
    1023   `(%instance-vector *built-in-class-wrapper* nil nil ,name nil nil nil nil nil nil))
    1024 
     1034  `(%instance-vector  *built-in-class-wrapper*
     1035    nil                                 ;direct-methods
     1036    nil                                 ;prototype
     1037    ,name                               ;name
     1038    nil                                 ;precedence-list
     1039    nil                                 ;own-wrapper
     1040    nil                                 ;direct-superclasses
     1041    nil                                 ;direct-subclasses
     1042    nil                                 ;dependents
     1043    nil                                 ;class-ctype
     1044    nil                                 ;direct-slots
     1045    nil                                 ;slots
     1046    (cons nil nil)                      ;info
     1047    nil                                 ;direct-default-initargs
     1048    nil                                 ;default-initargs
     1049    ))
    10251050
    10261051(defmacro %cons-standard-class (name &optional
    10271052                                     (metaclass-wrapper '*standard-class-wrapper*))
    10281053  `(%instance-vector  ,metaclass-wrapper
    1029                       nil nil ,name nil nil nil nil nil nil nil nil
    1030                       nil nil nil nil nil nil nil nil)
    1031 
    1032 )
     1054    nil                                 ;direct-methods
     1055    nil                                 ;prototype
     1056    ,name                               ;name
     1057    nil                                 ;precedence-list
     1058    nil                                 ;own-wrapper
     1059    nil                                 ;direct-superclasses
     1060    nil                                 ;direct-subclasses
     1061    nil                                 ;dependents
     1062    nil                                 ;class-ctype
     1063    nil                                 ;direct-slots
     1064    nil                                 ;slots
     1065    (cons nil nil)                      ;info
     1066    nil                                 ;direct-default-initargs
     1067    nil                                 ;default-initargs
     1068    nil                                 ;alist
     1069    nil                                 ;make-instance-initargs
     1070    nil                                 ;reinit-initargs
     1071    nil                                 ;redefined-initargs
     1072    nil                                 ;changed-initargs
     1073    )
     1074)
     1075
     1076
     1077
     1078(defconstant max-class-ordinal (ash 1 20))
     1079
    10331080
    10341081(def-accessors () standard-instance-instance-location-access
    … …  
    13181365(defmacro make-class-cell (name) `(%istruct 'class-cell ,name nil '%make-instance nil))
    13191366
     1367;;; Map between TYPE-SPECIFIERS and CTYPEs
     1368(def-accessors (type-cell) %svref
     1369  nil
     1370  type-cell-type-specifier
     1371  type-cell-ctype)
     1372
     1373(defmacro make-type-cell (specifier) `(%istruct 'type-cell ,specifier nil))
     1374
     1375;;; Map between package names and packages, sometimes.
     1376(def-accessors (package-ref) %svref
     1377  nil
     1378  package-ref.name                      ; a string
     1379  package-ref.pkg                       ; a package or NIL
     1380  )
     1381
     1382(defmacro make-package-ref (name) `(%istruct 'package-ref (string ,name) nil))
     1383
     1384
     1385(def-accessor-macros %svref
     1386  nil                                 ; 'external-entry-point
     1387  eep.address
     1388  eep.name
     1389  eep.container)
     1390
     1391(defmacro %cons-external-entry-point (name &optional container)
     1392  `(%istruct 'external-entry-point nil ,name ,container))
     1393
     1394(def-accessor-macros %svref
     1395    nil                                 ;'foreign-variable
     1396  fv.addr                               ; a MACPTR, or nil
     1397  fv.name                               ; a string
     1398  fv.type                               ; a foreign type
     1399  fv.container                          ; containing library
     1400  )
     1401
     1402(defun %cons-foreign-variable (name type &optional container)
     1403  (%istruct 'foreign-variable nil name type container))
     1404
     1405(def-accessor-macros %svref
     1406    nil                                 ;'shlib
     1407  shlib.soname
     1408  shlib.pathname
     1409  shlib.handle                          ; if explicitly opened
     1410  shlib.map
     1411  shlib.base
     1412  shlib.opencount)
     1413
     1414(defmacro %cons-shlib (soname pathname map base)
     1415  `(%istruct 'shlib ,soname ,pathname nil ,map ,base 0))
     1416
     1417(def-accessors uvref ; %svref
     1418    ()                                  ;'entry
     1419  entry-test                          ;predicate function or count of higher priority others.
     1420  entry-fn                            ;pprint function
     1421  entry-full-spec                     ;list of priority and type specifier
     1422  )
     1423
     1424(def-accessors %svref
     1425    ()                                  ; 'xp-structure
     1426  xp-base-stream ;;The stream io eventually goes to.
     1427  xp-linel ;;The line length to use for formatting.
     1428  xp-line-limit ;;If non-NIL the max number of lines to print.
     1429  xp-line-no ;;number of next line to be printed.
     1430  xp-char-mode ;;NIL :UP :DOWN :CAP0 :CAP1 :CAPW
     1431  xp-char-mode-counter                  ;depth of nesting of ~(...~)
     1432  xp-depth-in-blocks ;;Number of logical blocks at QRIGHT that
     1433  ;;are started but not ended.             
     1434  xp-block-stack
     1435  xp-block-stack-ptr
     1436  ;;This stack is pushed and popped in accordance with the way blocks are
     1437  ;;nested at the moment they are entered into the queue.  It contains the
     1438  ;;following block specific value.
     1439  ;;SECTION-START total position where the section (see AIM-1102)
     1440  ;;that is rightmost in the queue started.
     1441  xp-buffer
     1442  xp-charpos
     1443  xp-buffer-ptr
     1444  xp-buffer-offset
     1445  ;;This is a vector of characters (eg a string) that builds up the
     1446  ;;line images that will be printed out.  BUFFER-PTR is the
     1447  ;;buffer position where the next character should be inserted in
     1448  ;;the string.  CHARPOS is the output character position of the
     1449  ;;first character in the buffer (non-zero only if a partial line
     1450  ;;has been output).  BUFFER-OFFSET is used in computing total lengths.
     1451  ;;It is changed to reflect all shifting and insertion of prefixes so that
     1452  ;;total length computes things as they would be if they were
     1453  ;;all on one line.  Positions are kept three different ways
     1454  ;; Buffer position (eg BUFFER-PTR)
     1455  ;; Line position (eg (+ BUFFER-PTR CHARPOS)).  Indentations are stored in this form.
     1456  ;; Total position if all on one line (eg (+ BUFFER-PTR BUFFER-OFFSET))
     1457  ;;  Positions are stored in this form.
     1458  xp-queue
     1459  xp-qleft
     1460  xp-qright
     1461  ;;This holds a queue of action descriptors.  QLEFT and QRIGHT
     1462  ;;point to the next entry to dequeue and the last entry enqueued
     1463  ;;respectively.  The queue is empty when
     1464  ;;(> QLEFT QRIGHT).  The queue entries have several parts:
     1465  ;;QTYPE one of :NEWLINE/:IND/:START-BLOCK/:END-BLOCK
     1466  ;;QKIND :LINEAR/:MISER/:FILL/:MANDATORY or :UNCONDITIONAL/:FRESH
     1467  ;; or :BLOCK/:CURRENT
     1468  ;;QPOS total position corresponding to this entry
     1469  ;;QDEPTH depth in blocks of this entry.
     1470  ;;QEND offset to entry marking end of section this entry starts. (NIL until known.)
     1471  ;; Only :start-block and non-literal :newline entries can start sections.
     1472  ;;QOFFSET offset to :END-BLOCK for :START-BLOCK (NIL until known).
     1473  ;;QARG for :IND indentation delta
     1474  ;;     for :START-BLOCK suffix in the block if any.
     1475  ;;                      or if per-line-prefix then cons of suffix and
     1476  ;;                      per-line-prefix.
     1477  ;;     for :END-BLOCK suffix for the block if any.
     1478  xp-prefix
     1479  ;;this stores the prefix that should be used at the start of the line
     1480  xp-prefix-stack
     1481  xp-prefix-stack-ptr
     1482  ;;This stack is pushed and popped in accordance with the way blocks
     1483  ;;are nested at the moment things are taken off the queue and printed.
     1484  ;;It contains the following block specific values.
     1485  ;;PREFIX-PTR current length of PREFIX.
     1486  ;;SUFFIX-PTR current length of pending suffix
     1487  ;;NON-BLANK-PREFIX-PTR current length of non-blank prefix.
     1488  ;;INITIAL-PREFIX-PTR prefix-ptr at the start of this block.
     1489  ;;SECTION-START-LINE line-no value at last non-literal break at this level.
     1490  xp-suffix
     1491  ;;this stores the suffixes that have to be printed to close of the current
     1492  ;;open blocks.  For convenient in popping, the whole suffix
     1493  ;;is stored in reverse order.
     1494  xp-stream  ;;; the xp-stream containing this structure
     1495  xp-string-stream ;; string-stream for output until first circularity (in case none)
     1496  )
     1497
     1498  (def-accessors (afunc) %svref
     1499    ()                                    ; 'afunc
     1500    afunc-acode
     1501    afunc-parent
     1502    afunc-vars
     1503    afunc-inherited-vars
     1504    afunc-blocks
     1505    afunc-tags
     1506    afunc-inner-functions
     1507    afunc-name
     1508    afunc-bits
     1509    afunc-lfun
     1510    afunc-environment
     1511    afunc-lambdaform
     1512    afunc-argsword
     1513    afunc-ref-form
     1514    afunc-warnings
     1515    afunc-fn-refcount
     1516    afunc-fn-downward-refcount
     1517    afunc-all-vars
     1518    afunc-callers
     1519    afunc-vcells
     1520    afunc-fcells
     1521    afunc-fwd-refs
     1522    afunc-lfun-info
     1523    afunc-linkmap)
     1524
     1525(declaim (inline %make-afunc))
     1526
     1527(defmacro %make-afunc ()
     1528  `(%istruct 'afunc
     1529    nil                                 ;afunc-acode
     1530    nil                                 ;afunc-parent
     1531    nil                                 ;afunc-vars
     1532    nil                                 ;afunc-inherited-vars
     1533    nil                                 ;afunc-blocks
     1534    nil                                 ;afunc-tags
     1535    nil                                 ;afunc-inner-functions
     1536    nil                                 ;afunc-name
     1537    nil                                 ;afunc-bits
     1538    nil                                 ;afunc-lfun
     1539    nil                                 ;afunc-environment
     1540    nil                                 ;afunc-lambdaform
     1541    nil                                 ;afunc-argsword
     1542    nil                                 ;afunc-ref-form
     1543    nil                                 ;afunc-warnings
     1544    nil                                 ;afunc-fn-refcount
     1545    nil                                 ;afunc-fn-downward-refcount
     1546    nil                                 ;afunc-all-vars
     1547    nil                                 ;afunc-callers
     1548    nil                                 ;afunc-vcells
     1549    nil                                 ;afunc-fcells
     1550    nil                                 ;afunc-fwd-refs
     1551    nil                                 ;afunc-lfun-info
     1552    nil                                 ;afunc-linkmap
     1553    ))
     1554
     1555
     1556(def-accessors (compiler-policy) uvref
     1557  nil                                   ; 'compiler-policy
     1558  policy.allow-tail-recursion-elimination
     1559  policy.inhibit-register-allocation
     1560  policy.trust-declarations
     1561  policy.open-code-inline
     1562  policy.inhibit-safety-checking
     1563  policy.the-typechecks
     1564  policy.inline-self-calls
     1565  policy.allow-transforms
     1566  policy.force-boundp-checks
     1567  policy.allow-constant-substitution
     1568  policy.misc)
     1569
     1570
     1571(def-accessors (deferred-warnings) %svref
     1572  nil
     1573  deferred-warnings.parent
     1574  deferred-warnings.warnings
     1575  deferred-warnings.defs
     1576  deferred-warnings.flags ; might use to distinguish interactive case/compile-file
     1577)
     1578
     1579;;; loader framework istruct
     1580(def-accessors (faslapi) %svref
     1581  ()
     1582  ;; these represent all users of faslstate.iobuffer, .bufcount, and
     1583  ;; .faslfd -- I think these are all the important file- and
     1584  ;; buffer-IO-specific slots in faslstate; encapsulating these allows
     1585  ;; sophisticated users to load fasl data from nonstandard sources
     1586  ;; without too much trouble
     1587  faslapi.fasl-open
     1588  faslapi.fasl-close
     1589  faslapi.fasl-init-buffer
     1590  faslapi.fasl-set-file-pos
     1591  faslapi.fasl-get-file-pos
     1592  faslapi.fasl-read-buffer
     1593  faslapi.fasl-read-byte
     1594  faslapi.fasl-read-n-bytes)
     1595
     1596
     1597(defmacro istruct-cell-name (cell)
     1598  `(car ,cell))
     1599
     1600(defmacro istruct-cell-info (cell)
     1601  `(cdr ,cell))
    13201602
    13211603(provide "LISPEQU")

  • trunk/source/xdump/faslenv.lisp

    r8407 r9917  
    3838  faslstate.fasldispatch)
    3939
    40 ;;; loader framework istruct
    41 (def-accessors (faslapi) %svref
    42   ()
    43   ;; these represent all users of faslstate.iobuffer, .bufcount, and
    44   ;; .faslfd -- I think these are all the important file- and
    45   ;; buffer-IO-specific slots in faslstate; encapsulating these allows
    46   ;; sophisticated users to load fasl data from nonstandard sources
    47   ;; without too much trouble
    48   faslapi.fasl-open
    49   faslapi.fasl-close
    50   faslapi.fasl-init-buffer
    51   faslapi.fasl-set-file-pos
    52   faslapi.fasl-get-file-pos
    53   faslapi.fasl-read-buffer
    54   faslapi.fasl-read-byte
    55   faslapi.fasl-read-n-bytes)
    5640
    5741(defconstant numfaslops 80 "Number of fasl file opcodes, roughly")
Note: See TracChangeset for help on using the changeset viewer.