Changeset 9528


Ignore:
Timestamp:
May 16, 2008, 2:20:00 AM (11 years ago)
Author:
gb
Message:

Try to get all istruct definitions here.

Make CLASS and STANDARD-CLASS share more slots, so that we can use
simpler/shared accessors in higher level code.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711-perf/ccl/library/lispequ.lisp

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