home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / compiler.jl < prev    next >
Lisp/Scheme  |  1994-10-06  |  36KB  |  1,068 lines
  1. ;;;; compiler.jl -- Simple compiler for Lisp files/forms
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. ;;; Notes:
  22. ;;;
  23. ;;; Instruction Encoding
  24. ;;; ====================
  25. ;;; Instructions which get an argument (with opcodes of zero up to
  26. ;;; `op-last-with-args') encode the type of argument in the low 3 bits
  27. ;;; of their opcode (this is why these instructions take up 8 opcodes).
  28. ;;; A value of 0 to 5 (inclusive) is the literal argument, value of
  29. ;;; 6 means the next byte holds the argument, or a value of 7 says
  30. ;;; that the next two bytes are used to encode the argument (in big-
  31. ;;; endian form, i.e. first extra byte has the high 8 bits)
  32. ;;;
  33. ;;; All instructions greater than the `op-last-before-jmps' are branches,
  34. ;;; currently only absolute destinations are supported, all branch
  35. ;;; instructions encode their destination in the following two bytes (also
  36. ;;; in big-endian form).
  37. ;;;
  38. ;;; Any opcode between `op-last-with-args' and `op-last-before-jmps' is
  39. ;;; a straightforward single-byte instruction.
  40. ;;;
  41. ;;; The machine simulated by lispmach.c is a simple stack-machine, each
  42. ;;; call to the byte-code interpreter gets its own stack; the size of
  43. ;;; stack needed is calculated by the compiler.
  44. ;;;
  45. ;;; If you hadn't already noticed I based this on the Emacs version 18
  46. ;;; byte-compiler.
  47. ;;;
  48. ;;; Constants
  49. ;;; =========
  50. ;;; `defconst' forms have to be used with some care. The compiler assumes
  51. ;;; that the value of the constant is always the same, whenever it is
  52. ;;; evaluated. It may even be evaluated more than once.
  53. ;;;
  54. ;;; In general, any symbols declared as constants (by defconst) have their
  55. ;;; values set in stone. These values are hard-coded into the compiled
  56. ;;; byte-code.
  57. ;;;
  58. ;;; Also, the value of a constant-symbol is *not* likely to be eq to itself!
  59. ;;;
  60. ;;; Use constants as you would use macros in C, i.e. to define values which
  61. ;;; have to be the same throughout a module. For example, this compiler uses
  62. ;;; defconst forms to declare the instruction opcodes.
  63. ;;;
  64. ;;; If you have doubts about whether or not to use constants -- don't; it may
  65. ;;; lead to subtle bugs.
  66.  
  67.  
  68. (provide 'compiler)
  69.  
  70.  
  71. ;; Options
  72. (defvar comp-write-docs nil
  73.   "When t all doc-strings are appended to the doc file and replaced with
  74. their position in that file.")
  75.  
  76.  
  77. ;; Opcodes
  78. (defconst op-call 0x08)            ;call (stk[n] stk[n-1] ... stk[0])
  79.                     ; pops n values, replacing the
  80.                     ; function with the result.
  81. (defconst op-push 0x10)            ;pushes constant # n
  82. (defconst op-vrefc 0x18)        ;pushes val of symbol n (in c-v)
  83. (defconst op-vsetc 0x20)        ;sets symbol n (in c-v) to stk[0],
  84.                     ; then pops the stack.
  85. (defconst op-list 0x28)            ;makes top n items into a list
  86. (defconst op-bind 0x30)            ;bind constant n to stk[0], pops stk
  87.  
  88. (defconst op-last-with-args 0x37)
  89.  
  90. (defconst op-vref 0x40)            ;replace symbol with it's value
  91. (defconst op-vset 0x41)            ;set (sym)stk[0]=stk[1], pops both
  92. (defconst op-fref 0x42)            ;similar to vref/vset, but for
  93. (defconst op-fset 0x43)            ; function value.
  94. (defconst op-init-bind 0x44)        ;initialise a new set of bindings
  95. (defconst op-unbind 0x45)        ;unbind all bindings in the top set
  96. (defconst op-dup 0x46)            ;duplicate top of stack
  97. (defconst op-swap 0x47)            ;swap top two values on stack
  98. (defconst op-pop 0x48)            ;pops the stack
  99.  
  100. (defconst op-nil 0x49)            ;pushes nil
  101. (defconst op-t 0x4a)            ;pushes t
  102. (defconst op-cons 0x4b)
  103. (defconst op-car 0x4c)
  104. (defconst op-cdr 0x4d)
  105. (defconst op-rplaca 0x4e)
  106. (defconst op-rplacd 0x4f)
  107. (defconst op-nth 0x50)
  108. (defconst op-nthcdr 0x51)
  109. (defconst op-aset 0x52)
  110. (defconst op-aref 0x53)
  111. (defconst op-length 0x54)
  112. (defconst op-eval 0x55)
  113. (defconst op-plus-2 0x56)        ;The `-2' on the end means that it
  114. (defconst op-negate 0x57)        ; only works on 2 arguments.
  115. (defconst op-minus-2 0x58)
  116. (defconst op-product-2 0x59)
  117. (defconst op-divide-2 0x5a)
  118. (defconst op-mod-2 0x5b)
  119. (defconst op-lognot 0x5c)
  120. (defconst op-not 0x5d)
  121. (defconst op-logior-2 0x5e)
  122. (defconst op-logand-2 0x5f)
  123. (defconst op-equal 0x60)
  124. (defconst op-eq 0x61)
  125. (defconst op-num-eq 0x62)
  126. (defconst op-num-noteq 0x63)
  127. (defconst op-gtthan 0x64)
  128. (defconst op-gethan 0x65)
  129. (defconst op-ltthan 0x66)
  130. (defconst op-lethan 0x67)
  131. (defconst op-inc 0x68)
  132. (defconst op-dec 0x69)
  133. (defconst op-lsh 0x6a)
  134. (defconst op-zerop 0x6b)
  135. (defconst op-null 0x6c)
  136. (defconst op-atom 0x6d)
  137. (defconst op-consp 0x6e)
  138. (defconst op-listp 0x6f)
  139. (defconst op-numberp 0x70)
  140. (defconst op-stringp 0x71)
  141. (defconst op-vectorp 0x72)
  142. (defconst op-catch-kludge 0x73)
  143. (defconst op-throw 0x74)
  144. (defconst op-unwind-pro 0x75)
  145. (defconst op-un-unwind-pro 0x76)
  146. (defconst op-fboundp 0x77)
  147. (defconst op-boundp 0x78)
  148. (defconst op-symbolp 0x79)
  149. (defconst op-get 0x7a)
  150. (defconst op-put 0x7b)
  151. (defconst op-error-pro 0x7c)
  152. (defconst op-signal 0x7d)
  153. (defconst op-return 0x7e)
  154. (defconst op-reverse 0x7f)        ;new 12/7/94
  155. (defconst op-nreverse 0x80)
  156. (defconst op-assoc 0x81)
  157. (defconst op-assq 0x82)
  158. (defconst op-rassoc 0x83)
  159. (defconst op-rassq 0x84)
  160. (defconst op-last 0x85)
  161. (defconst op-mapcar 0x86)
  162. (defconst op-mapc 0x87)
  163. (defconst op-member 0x88)
  164. (defconst op-memq 0x89)
  165. (defconst op-delete 0x8a)
  166. (defconst op-delq 0x8b)
  167. (defconst op-delete-if 0x8c)
  168. (defconst op-delete-if-not 0x8d)
  169. (defconst op-copy-sequence 0x8e)
  170. (defconst op-sequencep 0x8f)
  171. (defconst op-functionp 0x90)
  172. (defconst op-special-form-p 0x91)
  173. (defconst op-subrp 0x92)
  174. (defconst op-eql 0x93)
  175. (defconst op-logxor-2 0x94)        ;new 23-8-94
  176.  
  177. (defconst op-set-current-buffer 0xb0)
  178. (defconst op-swap-buffer 0xb1)        ;switch to buffer stk[0], stk[0]
  179.                     ; becomes old buffer.
  180. (defconst op-current-buffer 0xb2)
  181. (defconst op-bufferp 0xb3)
  182. (defconst op-markp 0xb4)
  183. (defconst op-windowp 0xb5)
  184. (defconst op-swap-window 0xb6)
  185.  
  186. (defconst op-last-before-jmps 0xfa)
  187.  
  188. ;; All jmps take two-byte arguments
  189. (defconst op-jmp 0xfb)            ;jmp to x
  190. (defconst op-jn 0xfc)            ;pop the stack, if nil, jmp x
  191. (defconst op-jt 0xfd)            ;pop the stack, if t, jmp x
  192. (defconst op-jnp 0xfe)            ;if stk[0] nil, jmp x, else pop
  193. (defconst op-jtp 0xff)            ;if stk[0] t, jmp x, else pop
  194.  
  195. (defconst comp-max-1-byte-arg 5)    ;max arg held in 1-byte instruction
  196. (defconst comp-max-2-byte-arg 0xff)    ;max arg held in 2-byte instruction
  197. (defconst comp-max-3-byte-arg 0xffff)    ;max arg help in 3-byte instruction
  198.  
  199.  
  200. ;; Environment of this byte code sequence being compiled
  201.  
  202. (defvar comp-constant-alist '())    ;list of (VALUE . INDEX)
  203. (defvar comp-constant-index 0)        ;next free constant index number
  204. (defvar comp-current-stack 0)        ;current stack requirement
  205. (defvar comp-max-stack 0)        ;highest possible stack
  206. (defvar comp-output nil)        ;list of (BYTE . INDEX)
  207. (defvar comp-output-pc 0)        ;INDEX of next byte
  208. (defvar comp-macro-env '())        ;alist of (NAME . MACRO-DEF)
  209. (defvar comp-const-env '())        ;alist of (NAME . CONST-DEF)
  210.  
  211.  
  212. (defvar comp-top-level-compiled
  213.   '(if cond when unless let let* catch unwind-protect error-protect
  214.     with-buffer with-window progn prog1 prog2 while and or)
  215.   "List of symbols, when the name of the function called by a top-level form
  216. is one of these that form is compiled.")
  217.  
  218. ;;;###autoload
  219. (defun compile-file (file-name)
  220.   "Compiles the file of jade-lisp code FILE-NAME into a new file called
  221. `(concat FILE-NAME ?c)' (ie, `foo.jl' => `foo.jlc')."
  222.   (interactive "fLisp file to compile:")
  223.   (let
  224.       (src-file dst-file form
  225.        comp-macro-env
  226.        comp-const-env)
  227.     (when (and (setq src-file (open file-name "r"))
  228.            (setq dst-file (open (concat file-name ?c) "w")))
  229.       (format dst-file
  230.           ";;; Source file: %s\n;;; Compiled by %s@%s on %s\n;;; Jade %d.%d\n"
  231.