Changeset 9917 for trunk/source/library


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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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")
Note: See TracChangeset for help on using the changeset viewer.