source: trunk/source/xdump/faslenv.lisp @ 13791

Last change on this file since 13791 was 13279, checked in by gb, 10 years ago

Lots of changes from "purify" branch, mostly involving:

  • new memory layout, to support x86 function purification, static cons
  • fasloader changes to load/save string constants faster

Fasl version, image version changed; new binaries for all platforms soon.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.2 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18
19(in-package "CCL")
20
21;; Compile-time environment for fasl dumper/loader.
22
23; loader state istruct
24(def-accessors (faslstate) %svref
25  ()
26  faslstate.faslfname
27  faslstate.faslevec
28  faslstate.faslecnt
29  faslstate.faslfd
30  faslstate.faslval
31  faslstate.faslstr
32  faslstate.oldfaslstr
33  faslstate.faslerr
34  faslstate.iobuffer
35  faslstate.bufcount
36  faslstate.faslversion
37  faslstate.faslepush
38  faslstate.faslgsymbols
39  faslstate.fasldispatch)
40
41
42(defconstant numfaslops 80 "Number of fasl file opcodes, roughly")
43(defconstant $fasl-epush-bit 7)
44(defconstant $fasl-file-id #xff00)
45(defconstant $fasl-file-id1 #xff01)
46(defconstant $fasl-vers #x5e)
47(defconstant $fasl-min-vers #x5e)
48(defconstant $faslend #xff)
49(defconstant $fasl-buf-len 2048)
50(defmacro deffaslop (n arglist &body body)
51  `(setf (svref *fasl-dispatch-table* ,n)
52         (nfunction ,n (lambda ,arglist ,@body))))
53
54
55(defconstant $fasl-noop 0)              ;<nada:zilch>. 
56(defconstant $fasl-s32-vector 1)        ;<count> Make a (SIMPLE-ARRAY (SIGNED-BYTE 32) <count>)
57(defconstant $fasl-code-vector 2)       ;<count> words of code
58(defconstant $fasl-clfun 3)             ;<size:count><codesize:count>code,size-codesize exprs
59(defconstant $fasl-lfuncall 4)          ;<lfun:expr> funcall the lfun.
60(defconstant $fasl-globals 5)           ;<expr> global symbols vector
61(defconstant $fasl-char 6)              ;<char:byte> Make a char
62(defconstant $fasl-fixnum 7)            ;<value:long> Make a (4-byte) fixnum
63(defconstant $fasl-dfloat 8)            ;<hi:long><lo:long> Make a DOUBLE-FLOAT
64(defconstant $fasl-bignum32 9)          ;<count> make a bignum with count digits
65(defconstant $fasl-word-fixnum 10)      ;<value:word> Make a fixnum
66(defconstant $fasl-double-float-vector 11) ;<count> make a (SIMPLE-ARRAY DOUBLE-FLOAT <count>)
67(defconstant $fasl-single-float-vector 12) ;<count> make a (SIMPLE-ARRAY SINGLE-FLOAT <count>)
68(defconstant $fasl-bit-vector 13)       ;<count> make a (SIMPLE-ARRAY BIT <count>)
69(defconstant $fasl-u8-vector 14)        ;<count> make a (SIMPLE-ARRAY (UNSIGNED-BYTE 8) <count>)
70(defconstant $fasl-cons 15)             ;<car:expr><cdr:expr> Make a cons
71(defconstant $fasl-s8-vector 16)        ;<count> make a (SIMPLE-ARRAY (SIGNED-BYTE 8) <count>)
72(defconstant $fasl-t-vector 17)         ;<count> make a (SIMPLE-ARRAY T <count>)
73(defconstant $fasl-nil 18)              ; Make nil
74(defconstant $fasl-timm 19)             ;<n:long>
75(defconstant $fasl-function 20)         ;<count> Make function
76(defconstant $fasl-vstr 21)             ;<vstring> Make a string
77(defconstant $fasl-vmksym 22)           ;<vstring> Make an uninterned symbol
78(defconstant $fasl-platform 23)         ;<n:byte> Ensure that file's loadable on platform n.
79(defconstant $fasl-vetab-alloc 24)      ;<count:count> Make a new expression table
80                                        ; with count slots.  Current etab gets lost.
81(defconstant $fasl-veref 25)            ;<index:count> Get the value from an etab slot.
82(defconstant $fasl-fixnum8 26)          ;<high:long><low:long> Make an 8-byte fixnum.
83(defconstant $fasl-symfn 27)            ;<sym:expr>
84(defconstant $fasl-eval 28)             ;<expr> Eval <expr> and return value.
85(defconstant $fasl-u16-vector 29)       ;<count> Make a (SIMPLE-ARRAY (UNSIGNED-BYTE 16) <count>)
86(defconstant $fasl-s16-vector 30)       ;<count> Make a (SIMPLE-ARRAY (SIGNED-BYTE 16) <count>)
87(defconstant $fasl-vintern 31)          ;<vstring> Intern in current pkg.
88(defconstant $fasl-vpkg-intern 32)      ;<pkg:expr><vstring> Make a sym in pkg.
89(defconstant $fasl-vpkg 33)             ;<vstring> Returns the package of given name
90(defconstant $fasl-vgvec 34)            ;<subtype:byte><n:count><n exprs>
91(defconstant $fasl-defun 35)            ;<fn:expr><doc:expr>
92(defconstant $fasl-macro 37)            ;<fn:expr><doc:expr>
93(defconstant $fasl-defconstant 38)      ;<sym:expr><val:expr><doc:expr>
94(defconstant $fasl-defparameter 39)     ;<sym:expr><val:expr><doc:expr>
95(defconstant $fasl-defvar 40)           ;<sym:expr>
96(defconstant $fasl-defvar-init 41)      ;<sym:expr><val:expr><doc:expr>
97(defconstant $fasl-vivec 42)            ;<subtype:byte><n:count><n data bytes>
98(defconstant $fasl-prog1 43)            ;<expr><expr> - Second <expr> is for side-affects only
99(defconstant $fasl-vlist 44)            ;<n:count> <data: n+1 exprs> Make a list
100(defconstant $fasl-vlist* 45)           ;<n:count> <data:n+2 exprs> Make an sexpr
101(defconstant $fasl-sfloat 46)           ;<long> Make SINGLE-FLOAT from bits
102(defconstant $fasl-src 47)              ;<expr> - Set *loading-file-source-file * to <expr>.
103(defconstant $fasl-u32-vector 48)       ;<count> Make a (SIMPLE-ARRAY (UNSIGNED-BYTE 32) <count>)
104(defconstant $fasl-provide 49)          ;<string:expr>
105(defconstant $fasl-u64-vector 50)       ;<count> Make a (SIMPLE-ARRAY (UNSIGNED-BYTE 64) <count>)
106(defconstant $fasl-s64-vector 51)       ;<count> Make a (SIMPLE-ARRAY (SIGNED-BYTE 64) <count>)
107(defconstant $fasl-istruct 52)          ;<count> Make an ISTRUCT with <count> elements
108(defconstant $fasl-complex 53)          ;<real:expr><imag:expr>
109(defconstant $fasl-ratio 54)            ;<num:expr><den:expr>
110(defconstant $fasl-vector-header 55)    ;<count> Make a vector header
111(defconstant $fasl-array-header 56)     ;<count> Make an array header.
112(defconstant $fasl-s32 57)              ;<4bytes> Make a (SIGNED-BYTE 32)
113(defconstant $fasl-vintern-special 58)  ;<vstring> Intern in current pkg, ensure that it has a special binding index
114(defconstant $fasl-s64 59)              ;<8bytes> Make a (SIGNED-BYTE 64)
115(defconstant $fasl-vpkg-intern-special 60) ;<pkg:expr><vstring> Make a sym in pkg, ensure that it has a special binding index
116(defconstant $fasl-vmksym-special 61)   ;<vstring> Make an uninterned symbol, ensure special binding index
117(defconstant $fasl-nvmksym-special 62)  ;<nvstring> Make an uninterned symbol, ensure special binding index
118(defconstant $fasl-nvpkg-intern-special 63) ;<pkg:expr><nvstring> Make a sym in pkg, ensure that it has a special binding index
119(defconstant $fasl-nvintern-special 64)  ;<nvstring> Intern in current pkg, ensure that it has a special binding index
120(defconstant $fasl-nvpkg 65)            ;<vstring> Returns the package of given name
121(defconstant $fasl-nvpkg-intern 66)     ;<nvstring> Intern in current pkg.
122(defconstant $fasl-nvintern 67)         ;<pkg:expr><nvstring> Make a sym in pkg.
123(defconstant $fasl-nvmksym 68)          ;<nvstring> Make a string
124(defconstant $fasl-nvstr 69)            ;<nvstring> Make an uninterned symbol
125(defconstant $fasl-toplevel-location 70);<expr> - Set *loading-toplevel-location* to <expr>
126(defconstant $fasl-istruct-cell 71)     ;<expr> register istruct cell for expr
127
128
129;;; <string> means <size><size bytes> (this is no longer used)
130;;; <size> means either <n:byte> with n<#xFF, or <FF><n:word> with n<#xFFFF or
131;;;   <FFFF><n:long>
132;;; <count> is a variable-length encoding of an unsigned integer, written
133;;;  7 bits per octet, the least significant bits written first and the most
134;;;  significant octet having bit 7 set, so 127 would be written as #x00 and
135;;;  128 as #x00 #x81
136;;; <vstring> is a <count> (string length) followed by count octets of
137;;; 8-bit charcode data.
138;;; <nvstring> is a <count> (string length) followd by count <counts> of
139;;;  variable-length charcode data.  This encodes ASCII/STANDARD-CHAR as
140;;;  compactly as the <vstring> encoding, which should probably be deprecated.
141
142
143
144(defconstant $fasl-end #xFF)    ;Stop reading.
145
146(defconstant $fasl-epush-mask #x80)  ;Push value on etab if this bit is set in opcode.
147
148(defmacro fasl-epush-op (op) `(%ilogior2 ,$fasl-epush-mask ,op))
149
150(provide "FASLENV")
Note: See TracBrowser for help on using the repository browser.