source: trunk/ccl/xdump/faslenv.lisp @ 6242

Last change on this file since 6242 was 6242, checked in by gb, 14 years ago

Bump min fasl version.

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