home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / compiler.jlc < prev    next >
Text File  |  1994-10-16  |  18KB  |  485 lines
  1. ;;; Source file: /usr/local/lib/jade/3.2/lisp/compiler.jl
  2. ;;; Compiled by jsh@orcrist on Sun Oct 16 20:21:16 1994
  3. ;;; Jade 3.2
  4.  
  5. (provide (quote compiler))
  6.  
  7. (defvar comp-write-docs nil 92938)
  8.  
  9. (defconst op-call 8)
  10.  
  11. (defconst op-push 16)
  12.  
  13. (defconst op-vrefc 24)
  14.  
  15. (defconst op-vsetc 32)
  16.  
  17. (defconst op-list 40)
  18.  
  19. (defconst op-bind 48)
  20.  
  21. (defconst op-last-with-args 55)
  22.  
  23. (defconst op-vref 64)
  24.  
  25. (defconst op-vset 65)
  26.  
  27. (defconst op-fref 66)
  28.  
  29. (defconst op-fset 67)
  30.  
  31. (defconst op-init-bind 68)
  32.  
  33. (defconst op-unbind 69)
  34.  
  35. (defconst op-dup 70)
  36.  
  37. (defconst op-swap 71)
  38.  
  39. (defconst op-pop 72)
  40.  
  41. (defconst op-nil 73)
  42.  
  43. (defconst op-t 74)
  44.  
  45. (defconst op-cons 75)
  46.  
  47. (defconst op-car 76)
  48.  
  49. (defconst op-cdr 77)
  50.  
  51. (defconst op-rplaca 78)
  52.  
  53. (defconst op-rplacd 79)
  54.  
  55. (defconst op-nth 80)
  56.  
  57. (defconst op-nthcdr 81)
  58.  
  59. (defconst op-aset 82)
  60.  
  61. (defconst op-aref 83)
  62.  
  63. (defconst op-length 84)
  64.  
  65. (defconst op-eval 85)
  66.  
  67. (defconst op-plus-2 86)
  68.  
  69. (defconst op-negate 87)
  70.  
  71. (defconst op-minus-2 88)
  72.  
  73. (defconst op-product-2 89)
  74.  
  75. (defconst op-divide-2 90)
  76.  
  77. (defconst op-mod-2 91)
  78.  
  79. (defconst op-lognot 92)
  80.  
  81. (defconst op-not 93)
  82.  
  83. (defconst op-logior-2 94)
  84.  
  85. (defconst op-logand-2 95)
  86.  
  87. (defconst op-equal 96)
  88.  
  89. (defconst op-eq 97)
  90.  
  91. (defconst op-num-eq 98)
  92.  
  93. (defconst op-num-noteq 99)
  94.  
  95. (defconst op-gtthan 100)
  96.  
  97. (defconst op-gethan 101)
  98.  
  99. (defconst op-ltthan 102)
  100.  
  101. (defconst op-lethan 103)
  102.  
  103. (defconst op-inc 104)
  104.  
  105. (defconst op-dec 105)
  106.  
  107. (defconst op-lsh 106)
  108.  
  109. (defconst op-zerop 107)
  110.  
  111. (defconst op-null 108)
  112.  
  113. (defconst op-atom 109)
  114.  
  115. (defconst op-consp 110)
  116.  
  117. (defconst op-listp 111)
  118.  
  119. (defconst op-numberp 112)
  120.  
  121. (defconst op-stringp 113)
  122.  
  123. (defconst op-vectorp 114)
  124.  
  125. (defconst op-catch-kludge 115)
  126.  
  127. (defconst op-throw 116)
  128.  
  129. (defconst op-unwind-pro 117)
  130.  
  131. (defconst op-un-unwind-pro 118)
  132.  
  133. (defconst op-fboundp 119)
  134.  
  135. (defconst op-boundp 120)
  136.  
  137. (defconst op-symbolp 121)
  138.  
  139. (defconst op-get 122)
  140.  
  141. (defconst op-put 123)
  142.  
  143. (defconst op-error-pro 124)
  144.  
  145. (defconst op-signal 125)
  146.  
  147. (defconst op-return 126)
  148.  
  149. (defconst op-reverse 127)
  150.  
  151. (defconst op-nreverse 128)
  152.  
  153. (defconst op-assoc 129)
  154.  
  155. (defconst op-assq 130)
  156.  
  157. (defconst op-rassoc 131)
  158.  
  159. (defconst op-rassq 132)
  160.  
  161. (defconst op-last 133)
  162.  
  163. (defconst op-mapcar 134)
  164.  
  165. (defconst op-mapc 135)
  166.  
  167. (defconst op-member 136)
  168.  
  169. (defconst op-memq 137)
  170.  
  171. (defconst op-delete 138)
  172.  
  173. (defconst op-delq 139)
  174.  
  175. (defconst op-delete-if 140)
  176.  
  177. (defconst op-delete-if-not 141)
  178.  
  179. (defconst op-copy-sequence 142)
  180.  
  181. (defconst op-sequencep 143)
  182.  
  183. (defconst op-functionp 144)
  184.  
  185. (defconst op-special-form-p 145)
  186.  
  187. (defconst op-subrp 146)
  188.  
  189. (defconst op-eql 147)
  190.  
  191. (defconst op-logxor-2 148)
  192.  
  193. (defconst op-set-current-buffer 176)
  194.  
  195. (defconst op-swap-buffer 177)
  196.  
  197. (defconst op-current-buffer 178)
  198.  
  199. (defconst op-bufferp 179)
  200.  
  201. (defconst op-markp 180)
  202.  
  203. (defconst op-windowp 181)
  204.  
  205. (defconst op-swap-window 182)
  206.  
  207. (defconst op-last-before-jmps 250)
  208.  
  209. (defconst op-jmp 251)
  210.  
  211. (defconst op-jn 252)
  212.  
  213. (defconst op-jt 253)
  214.  
  215. (defconst op-jnp 254)
  216.  
  217. (defconst op-jtp 255)
  218.  
  219. (defconst comp-max-1-byte-arg 5)
  220.  
  221. (defconst comp-max-2-byte-arg 255)
  222.  
  223. (defconst comp-max-3-byte-arg 65535)
  224.  
  225. (defvar comp-constant-alist (quote nil))
  226.  
  227. (defvar comp-constant-index 0)
  228.  
  229. (defvar comp-current-stack 0)
  230.  
  231. (defvar comp-max-stack 0)
  232.  
  233. (defvar comp-output nil)
  234.  
  235. (defvar comp-output-pc 0)
  236.  
  237. (defvar comp-macro-env (quote nil))
  238.  
  239. (defvar comp-const-env (quote nil))
  240.  
  241. (defvar comp-top-level-compiled (quote (if cond when unless let let* catch unwind-protect error-protect with-buffer with-window progn prog1 prog2 while and or)) 93037)
  242.  
  243. (defun compile-file (file-name) 93150 (interactive "fLisp file to compile:") (jade-byte-code "DIIIII01234
  244. F$þ#    
  245. 
  246.  
  247. F#þH  H|HJE" [comp-const-env comp-macro-env form dst-file src-file open file-name "r" concat 99 "w" format ";;; Source file: %s
  248. ;;; Compiled by %s@%s on %s
  249. ;;; Jade %d.%d
  250. " user-login-name system-name current-time-string major-version-number minor-version-number (jade-byte-code "uDI1 J
  251. H    ]þ\\        F!þXL
  252. ‰ü3     F!ûEL ‰üD    F!ûEIHþX
  253. H
  254. HûEv" [(jade-byte-code "    H    " [close dst-file src-file] 2) form message concat "Compiling " file-name "..." file-eof-p src-file read (defun defmacro defvar defconst require) comp-compile-top-form comp-top-level-compiled compile-form print dst-file write 10] 5) (error (jade-byte-code "D
  255. 3    þ    EHt" [concat file-name 99 fname file-exists-p delete-file error error-info] 3)) 2] 9))
  256.  
  257. (defun compile-directory (dir-name &optional force-p exclude-list) 93272 (interactive "DDirectory of Lisp files to compile:
  258. P") (jade-byte-code "D    2nþEL
  259. þLˆlþ<DL
  260. 6    
  261. 6
  262.  
  263.  
  264. þ;     EHMF\"HûHJE" [directory-files dir-name dir regexp-match "\\.jl$" exclude-list file-name-concat file concat 99 cfile file-newer-than-file-p compile-file] 3))
  265.  
  266. (defvar compile-lib-exclude-list (quote ("autoload.jl")))
  267.  
  268. (defun compile-lisp-lib (&optional force-p) 93522 (interactive "P") (jade-byte-code "DJ0 E" [comp-write-docs compile-directory lisp-lib-dir force-p compile-lib-exclude-list] 4))
  269.  
  270. (put (quote compile-error) (quote error-message) "Compilation mishap")
  271.  
  272. (defun comp-error (&rest data) (jade-byte-code "}" [compile-error data] 2))
  273.  
  274. (defun comp-compile-top-form (form) (jade-byte-code "DL1aü2DP‚5þINHIOEHPQK    MKKûñ    aüpDQK    P‚56
  275. üW
  276. OûaP
  277. KKF$H    P
  278. MKKEûñ aü­DPU P66þqþš Q    NHPKKF&EHûñaüÖD P6þÃqþÐ Q    NEHûñaüäUHûñJüð    ûñIE" [form fun defun 1 comp-macro-env tmp comp-compile-lambda lambda 2 defmacro code defconst 3 doc value comp-write-docs add-doc-string comp-const-env defvar require comp-error "Shouldn't have got here!"] 6))
  279.  
  280. (defun compile-form (form) 93772 (jade-byte-code "DII123456    Hþ\"    
  281.  ,E" [0 comp-output-pc comp-output comp-max-stack comp-current-stack comp-constant-index comp-constant-alist comp-compile-form form jade-byte-code comp-make-code-string comp-make-const-vec] 6))
  282.  
  283. (defun comp-make-code-string nil (jade-byte-code "D
  284. nþLMLLRHMF$HûHE" [make-string comp-output-pc 42 comp-output data code-string] 3))
  285.  
  286. (defun comp-make-const-vec nil (jade-byte-code "D    34nþLMLLRHMF#HûHE" [make-vector comp-constant-index comp-constant-alist consts vec] 3))
  287.  
  288. (defun comp-inc-stack nil (jade-byte-code "hF dþ F!" [comp-current-stack comp-max-stack] 2))
  289.  
  290. (defmacro comp-dec-stack (&optional n) (jade-byte-code "ü+û*+" [setq comp-current-stack n - 1-] 5))
  291.  
  292. (defun comp-compile-form (form) (jade-byte-code "Iaü    Hû-Jaü    Hû-yüfDI5    ü>            
  293. Hûb
  294. ‚F%üO M    ûbJüa     
  295. HûbIEû-nü!DI6Lyþ}LzF&ü‰
  296. û
  297. F HLyþ LzF&ü¬
  298. ûLF&HyüÀ    ûénþÌLaüÚ        ûéJüè
  299. ûéIHMF HD6nþ  L    Hh&MF HûôH
  300. HXF&EEû-Jü,    û-I" [form comp-write-op 73 comp-inc-stack 74 val const-variable-p 16 comp-add-constant symbol-value comp-const-env comp-compile-form 24 fun compile-fun funcall macroexpand comp-macro-env comp-compile-constant lambda comp-compile-lambda comp-error "Bad function name" 0 i 8 comp-current-stack] 5))
  301.  
  302. (defun comp-compile-constant (form) (jade-byte-code "    
  303. H" [comp-write-op 16 comp-add-constant form comp-inc-stack] 4))
  304.  
  305. (defun comp-add-constant (const) (jade-byte-code "MÿKK!hF\"Hi" [const comp-constant-alist comp-constant-index] 2))
  306.  
  307. (defun comp-compile-body (body) (jade-byte-code "lü    Hû0nþ0L    HMþ'    HiF&HMF Hû" [body comp-write-op 73 comp-inc-stack comp-compile-form 72 comp-current-stack] 2))
  308.  
  309. (defun comp-compile-lambda (list) (jade-byte-code "DQI23Lqü+M#Pü\"P    û%P+F\"û:Jü9P*F\"û:IHLLaþP    L)
  310. \"MF#H    
  311.  K    IK
  312. E" [2 list new-head body lambda 1 comp-write-docs add-doc-string interactive nconc compile-form progn] 5))
  313.  
  314. (defmacro comp-make-label nil (jade-byte-code "" [(cons nil nil)] 1))
  315.  
  316. (defun comp-compile-jmp (opcode label) (jade-byte-code "    HLpüLj    HL_    û/Jü.MKOHVF%û/I" [comp-byte-out opcode label -8 255 comp-output-pc 2] 3))
  317.  
  318. (defun comp-set-label (label) (jade-byte-code "dþ        HNHMF$Hnþ4jLK_LhKKK&MF$Hû" [comp-output-pc 65535 comp-error "Jump destination overflow!" label -8 255 comp-output] 3))
  319.  
  320. (defun comp-write-op (opco