home *** CD-ROM | disk | FTP | other *** search
Wrap
;;; Source file: /usr/local/lib/jade/3.2/lisp/compiler.jl ;;; Compiled by jsh@orcrist on Sun Oct 16 20:21:16 1994 ;;; Jade 3.2 (provide (quote compiler)) (defvar comp-write-docs nil 92938) (defconst op-call 8) (defconst op-push 16) (defconst op-vrefc 24) (defconst op-vsetc 32) (defconst op-list 40) (defconst op-bind 48) (defconst op-last-with-args 55) (defconst op-vref 64) (defconst op-vset 65) (defconst op-fref 66) (defconst op-fset 67) (defconst op-init-bind 68) (defconst op-unbind 69) (defconst op-dup 70) (defconst op-swap 71) (defconst op-pop 72) (defconst op-nil 73) (defconst op-t 74) (defconst op-cons 75) (defconst op-car 76) (defconst op-cdr 77) (defconst op-rplaca 78) (defconst op-rplacd 79) (defconst op-nth 80) (defconst op-nthcdr 81) (defconst op-aset 82) (defconst op-aref 83) (defconst op-length 84) (defconst op-eval 85) (defconst op-plus-2 86) (defconst op-negate 87) (defconst op-minus-2 88) (defconst op-product-2 89) (defconst op-divide-2 90) (defconst op-mod-2 91) (defconst op-lognot 92) (defconst op-not 93) (defconst op-logior-2 94) (defconst op-logand-2 95) (defconst op-equal 96) (defconst op-eq 97) (defconst op-num-eq 98) (defconst op-num-noteq 99) (defconst op-gtthan 100) (defconst op-gethan 101) (defconst op-ltthan 102) (defconst op-lethan 103) (defconst op-inc 104) (defconst op-dec 105) (defconst op-lsh 106) (defconst op-zerop 107) (defconst op-null 108) (defconst op-atom 109) (defconst op-consp 110) (defconst op-listp 111) (defconst op-numberp 112) (defconst op-stringp 113) (defconst op-vectorp 114) (defconst op-catch-kludge 115) (defconst op-throw 116) (defconst op-unwind-pro 117) (defconst op-un-unwind-pro 118) (defconst op-fboundp 119) (defconst op-boundp 120) (defconst op-symbolp 121) (defconst op-get 122) (defconst op-put 123) (defconst op-error-pro 124) (defconst op-signal 125) (defconst op-return 126) (defconst op-reverse 127) (defconst op-nreverse 128) (defconst op-assoc 129) (defconst op-assq 130) (defconst op-rassoc 131) (defconst op-rassq 132) (defconst op-last 133) (defconst op-mapcar 134) (defconst op-mapc 135) (defconst op-member 136) (defconst op-memq 137) (defconst op-delete 138) (defconst op-delq 139) (defconst op-delete-if 140) (defconst op-delete-if-not 141) (defconst op-copy-sequence 142) (defconst op-sequencep 143) (defconst op-functionp 144) (defconst op-special-form-p 145) (defconst op-subrp 146) (defconst op-eql 147) (defconst op-logxor-2 148) (defconst op-set-current-buffer 176) (defconst op-swap-buffer 177) (defconst op-current-buffer 178) (defconst op-bufferp 179) (defconst op-markp 180) (defconst op-windowp 181) (defconst op-swap-window 182) (defconst op-last-before-jmps 250) (defconst op-jmp 251) (defconst op-jn 252) (defconst op-jt 253) (defconst op-jnp 254) (defconst op-jtp 255) (defconst comp-max-1-byte-arg 5) (defconst comp-max-2-byte-arg 255) (defconst comp-max-3-byte-arg 65535) (defvar comp-constant-alist (quote nil)) (defvar comp-constant-index 0) (defvar comp-current-stack 0) (defvar comp-max-stack 0) (defvar comp-output nil) (defvar comp-output-pc 0) (defvar comp-macro-env (quote nil)) (defvar comp-const-env (quote nil)) (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) (defun compile-file (file-name) 93150 (interactive "fLisp file to compile:") (jade-byte-code "DIIIII01234 F$þ # 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 ;;; Compiled by %s@%s on %s ;;; Jade %d.%d " user-login-name system-name current-time-string major-version-number minor-version-number (jade-byte-code "uDI1J H ]þ \\ F!þ XL ü 3 F!û ELü D F!û EIHþ X H 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 3 þ EHt" [concat file-name 99 fname file-exists-p delete-file error error-info] 3)) 2] 9)) (defun compile-directory (dir-name &optional force-p exclude-list) 93272 (interactive "DDirectory of Lisp files to compile: P") (jade-byte-code "D 2nþ EL þ Llþ <DL 6 6 þ ; 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)) (defvar compile-lib-exclude-list (quote ("autoload.jl"))) (defun compile-lisp-lib (&optional force-p) 93522 (interactive "P") (jade-byte-code "DJ0E" [comp-write-docs compile-directory lisp-lib-dir force-p compile-lib-exclude-list] 4)) (put (quote compile-error) (quote error-message) "Compilation mishap") (defun comp-error (&rest data) (jade-byte-code "}" [compile-error data] 2)) (defun comp-compile-top-form (form) (jade-byte-code "DL1aü 2DP5þ INHIOEHPQK MKKû ñ aü pDQK P56 ü W Oû aP KKF$H P MKKEû ñaü DPUP6 6þ qþ Q NHPKKF&EHû ñaü ÖDP6 þ Ã 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)) (defun compile-form (form) 93772 (jade-byte-code "DII123456 Hþ \" ,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)) (defun comp-make-code-string nil (jade-byte-code "D nþ LMLLRHMF$Hû HE" [make-string comp-output-pc 42 comp-output data code-string] 3)) (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)) (defun comp-inc-stack nil (jade-byte-code "hF dþ F!" [comp-current-stack comp-max-stack] 2)) (defmacro comp-dec-stack (&optional n) (jade-byte-code "ü +û *+" [setq comp-current-stack n - 1-] 5)) (defun comp-compile-form (form) (jade-byte-code "Iaü Hû-Jaü Hû-yü fDI5 ü > Hû b F%ü OM û bJü a Hû bIEû-nü!DI6 Lyþ }LzF& ü û F HLyþ LzF& ü ¬ ûLF& H yü À û é nþ Ì Laü Ú û éJü è û éIHMF HD6nþL Hh&MF Hû ôH 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)) (defun comp-compile-constant (form) (jade-byte-code " H" [comp-write-op 16 comp-add-constant form comp-inc-stack] 4)) (defun comp-add-constant (const) (jade-byte-code "Mÿ KK!hF\"Hi" [const comp-constant-alist comp-constant-index] 2)) (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)) (defun comp-compile-lambda (list) (jade-byte-code "DQI23Lqü +M#Pü \"P û %P+F\"û :Jü 9P*F\"û :IHLLaþ P L) \"MF#H K IK E" [2 list new-head body lambda 1 comp-write-docs add-doc-string interactive nconc compile-form progn] 5)) (defmacro comp-make-label nil (jade-byte-code "" [(cons nil nil)] 1)) (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)) (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)) (defun comp-write-op (opcode &optional arg) (jade-byte-code "lü û Ugü V û Ugü +V H û Ugü HV Hj H_ û UJü T û UI" [arg comp-byte-out opcode 5 255 6 65535 7 -8 comp-error "Opcode overflow!"] 3)) (defun comp-byte-out (byte) (jade-byte-code "KK\"hF!" [byte comp-output-pc comp-output] 2)) (put (quote if) (quote compile-fun) (quote comp-compile-if)) (defun comp-compile-if (form) (jade-byte-code "P HTbü .DIIK4 HiF&HP H Eû lDIIK4IIK6 HiF&HP H H HiF&H Q H E" [comp-compile-form 1 form 3 end-label comp-compile-jmp 254 comp-current-stack 2 comp-set-label else-label 252 251 comp-compile-body] 3)) (put (quote when) (quote compile-fun) (quote comp-compile-when)) (defun comp-compile-when (form) (jade-byte-code "P HDIIK3 HiF&HQ H E" [comp-compile-form 1 form end-label comp-compile-jmp 254 comp-current-stack comp-compile-body 2 comp-set-label] 3)) (put (quote unless) (quote compile-fun) (quote comp-compile-unless)) (defun comp-compile-unless (form) (jade-byte-code "P HDIIK3 HiF&HQ H E" [comp-compile-form 1 form end-label comp-compile-jmp 255 comp-current-stack comp-compile-body 2 comp-set-label] 3)) (put (quote quote) (quote compile-fun) (quote comp-compile-quote)) (defun comp-compile-quote (form) (jade-byte-code "ML " [comp-compile-constant form] 2)) (put (quote function) (quote compile-fun) (quote comp-compile-function)) (defun comp-compile-function (form) (jade-byte-code "MLF Hyü û " [form comp-compile-constant comp-compile-lambda] 3)) (put (quote while) (quote compile-fun) (quote comp-compile-while)) (defun comp-compile-while (form) (jade-byte-code "DIIK0IIK1 HP H HiF&H Q H HiF&H H HE" [tst-label end-label comp-set-label comp-compile-form 1 form comp-compile-jmp 254 comp-current-stack comp-compile-body 2 comp-write-op 72 251 comp-inc-stack] 3)) (put (quote progn) (quote compile-fun) (quote comp-compile-progn)) (defun comp-compile-progn (form) (jade-byte-code "M " [comp-compile-body form] 2)) (put (quote prog1) (quote compile-fun) (quote comp-compile-prog1)) (defun comp-compile-prog1 (form) (jade-byte-code "P HQ H HiF&" [comp-compile-form 1 form comp-compile-body 2 comp-write-op 72 comp-current-stack] 3)) (put (quote prog2) (quote compile-fun) (quote comp-compile-prog2)) (defun comp-compile-prog2 (form) (jade-byte-code "P H HiF%HP HQ H HiF%" [comp-compile-form 1 form comp-write-op 72 comp-current-stack 2 comp-compile-body 3] 3)) (put (quote setq) (quote compile-fun) (quote comp-compile-setq)) (defun comp-compile-setq (form) (jade-byte-code "MF Hnþ Mnþ >ML HQnÿ # HHL HiF&HQF Hû " [form comp-compile-form 2 comp-write-op 70 comp-inc-stack 32 comp-add-constant comp-current-stack] 4)) (put (quote set) (quote compile-fun) (quote comp-compile-set)) (defun comp-compile-set (form) (jade-byte-code "P H HHP H HXF&" [comp-compile-form 2 form comp-write-op 70 comp-inc-stack 1 65 comp-current-stack] 3)) (put (quote fset) (quote compile-fun) (quote comp-compile-fset)) (defun comp-compile-fset (form) (jade-byte-code "P H HHP H HXF&" [comp-compile-form 2 form comp-write-op 70 comp-inc-stack 1 67 comp-current-stack] 3)) (put (quote let*) (quote compile-fun) (quote comp-compile-let*)) (defun comp-compile-let* (form) (jade-byte-code "DML1 Hnþ TLnü *DL4M HL Eû DJü C H HL û DIH iF& HMF!Hû HQ H E" [form list comp-write-op 68 tmp comp-compile-body 48 comp-add-constant 73 comp-inc-stack comp-current-stack 2 69] 4)) (put (quote let) (quote compile-fun) (quote comp-compile-let)) (defun comp-compile-let (form) (jade-byte-code "DMLI12 Hnþ FLnü &LLKF!HLM û =Jü <LKF!H Hû =IHMF\"Hû Hnþ e L H iF& HMF!Hû GHQ H E" [form sym-stk list comp-write-op 68 comp-compile-body 73 comp-inc-stack 48 comp-add-constant comp-current-stack 2 69] 4)) (put (quote defun) (quote compile-fun) (quote comp-compile-defun)) (defun comp-compile-defun (form) (jade-byte-code "P H HHQK H H HXF&" [comp-compile-constant 1 form comp-write-op 70 comp-inc-stack comp-compile-lambda lambda 2 71 67 comp-current-stack] 5)) (put (quote defmacro) (quote compile-fun) (quote comp-compile-defmacro)) (defun comp-compile-defmacro (form) (jade-byte-code "P H HH QK K H H H XF&" [comp-compile-constant 1 form comp-write-op 70 comp-inc-stack macro comp-compile-lambda lambda 2 71 67 comp-current-stack] 6)) (put (quote cond) (quote compile-fun) (quote comp-compile-cond)) (defun comp-compile-cond (form) (jade-byte-code "DIIK0MF!Hnþ _DLIIK23L HiF%HMnü G HM HiF%H H û UJü T û UIHMF!EHû H HH E" [end-label form next-label subl comp-compile-form comp-current-stack comp-compile-jmp 252 comp-compile-body 251 comp-set-label 255 comp-write-op 73 comp-inc-stack] 3)) (put (quote or) (quote compile-fun) (quote comp-compile-or)) (defun comp-compile-or (form) (jade-byte-code "DIIK0MF!Hnþ +L HiF#HMþ \" HMF!Hû HH E" [end-label form comp-compile-form comp-current-stack comp-compile-jmp 255 comp-inc-stack comp-set-label] 3)) (put (quote and) (quote compile-fun) (quote comp-compile-and)) (defun comp-compile-and (form) (jade-byte-code "DIIK0MF!Hnþ +L HiF#HMþ \" HMF!Hû HH E" [end-label form comp-compile-form comp-current-stack comp-compile-jmp 254 comp-inc-stack comp-set-label] 3)) (put (quote catch) (quote compile-fun) (quote comp-compile-catch)) (defun comp-compile-catch (form) (jade-byte-code "QK HP H HiF&" [comp-compile-constant compile-form progn 2 form 1 comp-write-op 115 comp-current-stack] 5)) (put (quote unwind-protect) (quote compile-fun) (quote comp-compile-unwind-pro)) (defun comp-compile-unwind-pro (form) (jade-byte-code "QK H HiF&H P H " [comp-compile-constant compile-form progn 2 form comp-write-op 117 comp-current-stack comp-compile-form 1 118] 5)) (put (quote error-protect) (quote compile-fun) (quote comp-compile-error-protect)) (defun comp-compile-error-protect (form) (jade-byte-code "D1MF\"Hnÿ HL HMF\"Hnþ QDL6nÿ 4 HL MK * HM\"hF!EHû Hh H HXF&E" [0 i form comp-error "No FORM to `error-protect'" comp-compile-constant compile-form handler "Badly formed handler to `error-protect'" progn comp-write-op 124 comp-current-stack] 5)) (put (quote list) (quote compile-fun) (quote comp-compile-list)) (defun comp-compile-list (form) (jade-byte-code "D1MF\"Hnþ L Hh!MF\"Hû H HiXF&E" [0 count form comp-compile-form comp-write-op 40 comp-current-stack] 3)) (put (quote with-buffer) (quote compile-fun) (quote comp-compile-with-buffer)) (defun comp-compile-with-buffer (form) (jade-byte-code "P H HQ H H H H iF& " [comp-compile-form 1 form comp-write-op 177 comp-compile-body 2 71 72 comp-current-stack] 3)) (put (quote with-window) (quote compile-fun) (quote comp-compile-with-window)) (defun comp-compile-with-window (form) (jade-byte-code "P H HQ H H H H iF& " [comp-compile-form 1 form comp-write-op 182 comp-compile-body 2 71 72 comp-current-stack] 3)) (put (quote -) (quote compile-fun) (quote comp-compile-minus)) (put (quote -) (quote compile-opcode) op-minus-2) (defun comp-compile-minus (form) (jade-byte-code "Tcü û ML H " [form 2 comp-compile-binary-op comp-compile-form comp-write-op 87] 2)) (defun comp-compile-0-args (form) (jade-byte-code "Lz H" [comp-write-op form compile-opcode 0 comp-inc-stack] 3)) (defun comp-compile-1-args (form) (jade-byte-code "P HLz " [comp-compile-form 1 form comp-write-op compile-opcode 0] 3)) (defun comp-compile-2-args (form) (jade-byte-code "P HP HLz HiF&" [comp-compile-form 1 form 2 comp-write-op compile-opcode 0 comp-current-stack] 3)) (defun comp-compile-3-args (form) (jade-byte-code "P HP HP HLz HXF&" [comp-compile-form 1 form 2 3 comp-write-op compile-opcode 0 comp-current-stack] 3)) (defun comp-compile-binary-op (form) (jade-byte-code "DLz2MF HTeÿ HL HMF Hnþ AL H HiF&HMF Hû \"E" [form compile-opcode opcode 2 comp-error "Too few args to binary operator" comp-compile-form comp-write-op comp-current-stack] 3)) (jade-byte-code "{H{H{H{H{H {H {H {H{H {H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H {H !{H\"{H\"#{H${H$%{H&{H&'{H({H(){H*{H*+{H,{H,-{H.{H./{H0{H01{H2{H23{H4{H45{H6{H67{H8{H89{H:{H:;{H<{H<={H>{H>?{H@{H@A{HB{HBC{HD{HDE{HF{HFG{HH{HHI{HJ{HJK{HL{HLM{HN{HNO{HP{HPQ{HR{HRS{HT{HTU{HV{HVW{HX{HXY{HZ{HZ[{H\\{H\\]{H^{H^_{H`{H`a{Hb{Hbc{Hd{Hde{Hf{Hfg{Hh{Hhi{Hj{Hjk{Hl{Hlm{Hn{Hno{Hp{Hpq{Hr{Hrs{Ht{Htu{Hv{Hvw{Hx{Hxy{Hz{Hz{{H|{H|}{H~{H~{H{H{H{H{H{H
{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{H{" [cons compile-fun comp-compile-2-args compile-opcode 75 car comp-compile-1-args 76 cdr 77 rplaca 78 rplacd 79 nth 80 nthcdr 81 aset comp-compile-3-args 82 aref 83 length 84 eval 85 + comp-compile-binary-op 86 * 89 / 90 % 91 lognot 92 not 93 logior 94 logxor 148 logand 95 equal 96 eq 97 = 98 /= 99 > 100 < 102 >= 101 <= 103 1+ 104 1- 105 lsh 106 zerop 107 null 108 atom 109 consp 110 listp 111 numberp 112 stringp 113 vectorp 114 throw 116 fboundp 119 boundp 120 symbolp 121 get 122 put 123 signal 125 return 126 reverse 127 nreverse 128 assoc 129 assq 130 rassoc 131 rassq 132 last 133 mapcar 134 mapc 135 member 136 memq 137 delete 138 delq 139 delete-if 140 delete-if-not 141 copy-sequence 142 sequencep 143 functionp 144 special-form-p 145 subrp 146 eql 147 set-current-buffer 176 current-buffer 178 bufferp 179 markp 180 windowp 181] 3)