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

Last change on this file since 10310 was 10310, checked in by gb, 11 years ago

DEFFASLOP names the function.

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