Changeset 9917
- Timestamp:
- Jul 7, 2008, 7:24:57 PM (13 years ago)
- Location:
- trunk/source
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/compiler/nx0.lisp
r9892 r9917 28 28 29 29 ; Phony AFUNC "defstruct": 30 (defun make-afunc (&aux (v ( allocate-typed-vector :istruct $afunc-size nil)))30 (defun make-afunc (&aux (v (%make-afunc))) 31 31 (setf (%svref v 0) 'afunc) 32 32 (setf (afunc-fn-refcount v) 0) -
trunk/source/compiler/nxenv.lisp
r9253 r9917 29 29 #+x8664-target (require "X8664ENV") 30 30 31 (defconstant $afunc-size32 (def-accessors (afunc) %svref33 () ; 'afunc34 afunc-acode35 afunc-parent36 afunc-vars37 afunc-inherited-vars38 afunc-blocks39 afunc-tags40 afunc-inner-functions41 afunc-name42 afunc-bits43 afunc-lfun44 afunc-environment45 afunc-lambdaform46 afunc-argsword47 afunc-ref-form48 afunc-warnings49 afunc-fn-refcount50 afunc-fn-downward-refcount51 afunc-all-vars52 afunc-callers53 afunc-vcells54 afunc-fcells55 afunc-fwd-refs56 afunc-lfun-info57 afunc-linkmap58 ))59 60 31 ; 61 62 (def-accessors (compiler-policy) uvref63 nil ; 'compiler-policy64 policy.allow-tail-recursion-elimination65 policy.inhibit-register-allocation66 policy.trust-declarations67 policy.open-code-inline68 policy.inhibit-safety-checking69 policy.the-typechecks70 policy.inline-self-calls71 policy.allow-transforms72 policy.force-boundp-checks73 policy.allow-constant-substitution74 policy.misc)75 32 76 33 (defconstant $vbittemporary 16) ; a compiler temporary … … 224 181 (lap-inline . 0) 225 182 (%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)) 226 185 (%ttagp . #.(logior operator-cc-invertable-mask operator-single-valued-mask)) 227 186 (%ttag . #.operator-single-valued-mask) … … 471 430 (defconstant $fbitruntimedef 8) 472 431 (defconstant $fbitnonnullenv 9) 432 (defconstant $fbitccoverage 10) 473 433 474 434 (defconstant $eaclosedbit 24) … … 538 498 `(consp ,x)) 539 499 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 `(progn545 (record-source-file ',name 'function)546 (svset *nx2-specials* (%ilogand operator-id-mask (%nx1-operator ,locative)) ,fn)))))547 500 548 501 (defmacro defnxdecl (sym lambda-list &body forms) … … 564 517 ,@body))) 565 518 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))576 519 577 520 (eval-when (:compile-toplevel :load-toplevel :execute) -
trunk/source/level-0/l0-cfm-support.lisp
r9858 r9917 40 40 41 41 42 (def-accessor-macros %svref43 nil ; 'external-entry-point44 eep.address45 eep.name46 eep.container)47 48 (defun %cons-external-entry-point (name &optional container)49 (%istruct 'external-entry-point nil name container))50 42 51 43 (defun external-entry-point-p (x) 52 44 (istruct-typep x 'external-entry-point)) 53 54 (def-accessor-macros %svref55 nil ;'foreign-variable56 fv.addr ; a MACPTR, or nil57 fv.name ; a string58 fv.type ; a foreign type59 fv.container ; containing library60 )61 62 (defun %cons-foreign-variable (name type &optional container)63 (%istruct 'foreign-variable nil name type container))64 65 (def-accessor-macros %svref66 nil ;'shlib67 shlib.soname68 shlib.pathname69 shlib.handle ; if explicitly opened70 shlib.map71 shlib.base72 shlib.opencount)73 74 (defun %cons-shlib (soname pathname map base)75 (%istruct 'shlib soname pathname nil map base 0))76 45 77 46 (defvar *rtld-next*) -
trunk/source/level-1/l1-clos-boot.lisp
r9879 r9917 40 40 (defun %class-name (class) 41 41 (%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 42 59 43 60 (defun %class-own-wrapper (class) … … 1247 1264 (defun check-setf-find-class-protected-class (old-class new-class name) 1248 1265 (when (and (standard-instance-p old-class) 1249 (%class .kernel-p old-class)1266 (%class-kernel-p old-class) 1250 1267 *warn-if-redefine-kernel* 1251 1268 ;; EQL might be necessary on foreign classes … … 1255 1272 marked as being a critical part of the system; an attempt is being made 1256 1273 to 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))) 1258 1275 1259 1276 -
trunk/source/level-1/l1-clos.lisp
r9894 r9917 1668 1668 (check-type new symbol) 1669 1669 (when (and (standard-instance-p class) 1670 (%class .kernel-p class)1670 (%class-kernel-p class) 1671 1671 (not (eq new (%class.name class))) 1672 1672 *warn-if-redefine-kernel*) -
trunk/source/level-1/sysutils.lisp
r9892 r9917 527 527 528 528 (defparameter *outstanding-deferred-warnings* nil) 529 (def-accessors (deferred-warnings) %svref530 nil531 deferred-warnings.parent532 deferred-warnings.warnings533 deferred-warnings.defs534 deferred-warnings.flags ; might use to distinguish interactive case/compile-file535 )536 529 537 530 (defun %defer-warnings (override &optional flags) -
trunk/source/lib/pprint.lisp
r9240 r9917 128 128 "initial print dispatch table.") 129 129 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 130 142 ;default (bad) definitions for the non-portable functions 131 143 … … 169 181 ;the number of entries in the OTHERS list that have a higher priority. 170 182 171 (progn172 (eval-when (:compile-toplevel :execute)173 (def-accessors uvref ; %svref174 () ;'entry175 entry-test ;predicate function or count of higher priority others.176 entry-fn ;pprint function177 entry-full-spec ;list of priority and type specifier178 ))179 180 183 (defun make-entry (&key test fn full-spec) 181 184 (%istruct 'entry test fn full-spec)) 182 )183 185 184 186 (defun copy-pprint-dispatch (&optional (table *print-pprint-dispatch*)) … … 370 372 371 373 (progn 372 (eval-when (:compile-toplevel :execute)373 (def-accessors %svref374 () ; 'xp-structure375 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 :CAPW380 xp-char-mode-counter ;depth of nesting of ~(...~)381 xp-depth-in-blocks;;Number of logical blocks at QRIGHT that382 ;;are started but not ended.383 xp-block-stack384 xp-block-stack-ptr385 ;;This stack is pushed and popped in accordance with the way blocks are386 ;;nested at the moment they are entered into the queue. It contains the387 ;;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-buffer391 xp-charpos392 xp-buffer-ptr393 xp-buffer-offset394 ;;This is a vector of characters (eg a string) that builds up the395 ;;line images that will be printed out. BUFFER-PTR is the396 ;;buffer position where the next character should be inserted in397 ;;the string. CHARPOS is the output character position of the398 ;;first character in the buffer (non-zero only if a partial line399 ;;has been output). BUFFER-OFFSET is used in computing total lengths.400 ;;It is changed to reflect all shifting and insertion of prefixes so that401 ;;total length computes things as they would be if they were402 ;;all on one line. Positions are kept three different ways403 ;; 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-queue408 xp-qleft409 xp-qright410 ;;This holds a queue of action descriptors. QLEFT and QRIGHT411 ;;point to the next entry to dequeue and the last entry enqueued412 ;;respectively. The queue is empty when413 ;;(> QLEFT QRIGHT). The queue entries have several parts:414 ;;QTYPE one of :NEWLINE/:IND/:START-BLOCK/:END-BLOCK415 ;;QKIND :LINEAR/:MISER/:FILL/:MANDATORY or :UNCONDITIONAL/:FRESH416 ;; or :BLOCK/:CURRENT417 ;;QPOS total position corresponding to this entry418 ;;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 delta423 ;; for :START-BLOCK suffix in the block if any.424 ;; or if per-line-prefix then cons of suffix and425 ;; per-line-prefix.426 ;; for :END-BLOCK suffix for the block if any.427 xp-prefix428 ;;this stores the prefix that should be used at the start of the line429 xp-prefix-stack430 xp-prefix-stack-ptr431 ;;This stack is pushed and popped in accordance with the way blocks432 ;;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 suffix436 ;;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-suffix440 ;;this stores the suffixes that have to be printed to close of the current441 ;;open blocks. For convenient in popping, the whole suffix442 ;;is stored in reverse order.443 xp-stream ;;; the xp-stream containing this structure444 xp-string-stream;; string-stream for output until first circularity (in case none)445 )446 )447 448 374 (setf (symbol-function 'xp-stream-stream) #'(lambda (s) (xp-stream s))) 449 375 … … 488 414 (write-internal-1 (xp-stream xp-struc) object level list-kludge)) 489 415 490 (defmacro xp-structure-p (x) 491 `(istruct-typep ,x 'xp-structure)) 416 492 417 493 418 (defun get-xp-stream (pp) -
trunk/source/library/lispequ.lisp
r7958 r9917 139 139 (defconstant $lfbits-aok-bit 16) 140 140 (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 142 143 (defconstant $lfbits-trampoline-bit 24) 143 (defconstant $lfbits- evaluated-bit 25)144 (defconstant $lfbits-code-coverage-bit 25) 144 145 (defconstant $lfbits-cm-bit 26) ; combined-method 145 146 (defconstant $lfbits-nextmeth-bit 26) ; or call-next-method with method-bit … … 933 934 %wrapper-set-slot-id-value ; "fast" (SETF SLOT-VALUE) function 934 935 %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 935 938 ) 936 939 … … 981 984 %class.dependents ; arbitrary dependents 982 985 %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. 983 991 ) 984 992 … … 995 1003 nil ; dependents, 996 1004 nil ; ctype. 997 %class.direct-slots; local slots998 %class.slots; all slots999 %class.kernel-p; true if a non-redefinable class1000 %class.local-default-initargs; local default initargs alist1001 %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. 1002 1010 %class.alist ; other stuff about the class. 1003 1011 %class.make-instance-initargs ; (vector of) valid initargs to make-instance … … 1020 1028 ,instance))) 1021 1029 1030 1031 1032 1022 1033 (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 )) 1025 1050 1026 1051 (defmacro %cons-standard-class (name &optional 1027 1052 (metaclass-wrapper '*standard-class-wrapper*)) 1028 1053 `(%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 1033 1080 1034 1081 (def-accessors () standard-instance-instance-location-access … … 1318 1365 (defmacro make-class-cell (name) `(%istruct 'class-cell ,name nil '%make-instance nil)) 1319 1366 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)) 1320 1602 1321 1603 (provide "LISPEQU") -
trunk/source/xdump/faslenv.lisp
r8407 r9917 38 38 faslstate.fasldispatch) 39 39 40 ;;; loader framework istruct41 (def-accessors (faslapi) %svref42 ()43 ;; these represent all users of faslstate.iobuffer, .bufcount, and44 ;; .faslfd -- I think these are all the important file- and45 ;; buffer-IO-specific slots in faslstate; encapsulating these allows46 ;; sophisticated users to load fasl data from nonstandard sources47 ;; without too much trouble48 faslapi.fasl-open49 faslapi.fasl-close50 faslapi.fasl-init-buffer51 faslapi.fasl-set-file-pos52 faslapi.fasl-get-file-pos53 faslapi.fasl-read-buffer54 faslapi.fasl-read-byte55 faslapi.fasl-read-n-bytes)56 40 57 41 (defconstant numfaslops 80 "Number of fasl file opcodes, roughly")
Note: See TracChangeset
for help on using the changeset viewer.