movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 26 Mar '04

26 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv30553 Modified Files: repl.lisp Log Message: Minor edits. Date: Thu Mar 25 20:36:30 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.5 movitz/losp/lib/repl.lisp:1.6 --- movitz/losp/lib/repl.lisp:1.5 Wed Mar 24 19:40:35 2004 +++ movitz/losp/lib/repl.lisp Thu Mar 25 20:36:30 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.5 2004/03/25 00:40:35 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.6 2004/03/26 01:36:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -45,12 +45,12 @@ (terpri) (multiple-value-bind (form buffer-pointer) (handler-bind - (#+ignore (muerte::missing-delimiter - (lambda (c) - (declare (ignore c)) - (format t "~&> ") - (invoke-restart 'muerte::next-line - (muerte.readline:contextual-readline *repl-readline-context*))))) + ((muerte::missing-delimiter + (lambda (c) + (declare (ignore c)) + (format t "~&> ") + (invoke-restart 'muerte::next-line + (muerte.readline:contextual-readline *repl-readline-context*))))) (simple-read-from-string buffer-string t t)) (multiple-value-call (lambda (form previous-package &rest results) @@ -74,11 +74,11 @@ (apply 'muerte.toplevel:invoke-toplevel-command form (loop for arg = (multiple-value-bind (arg x) - (simple-read-from-string buffer-string nil 'eof + (simple-read-from-string buffer-string nil '#0=#:eof :start buffer-pointer) (setq buffer-pointer x) arg) - until (eq arg 'eof) + until (eq arg '#0#) collect arg))))))) #+ignore (muerte.readline::readline-break (c) (declare (ignore c))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/environment.lisp
by Frode Vatvedt Fjeld 26 Mar '04

26 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27600 Modified Files: environment.lisp Log Message: Put a maximum on the tracing indenting. Date: Thu Mar 25 20:35:29 2004 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.4 movitz/losp/muerte/environment.lisp:1.5 --- movitz/losp/muerte/environment.lisp:1.4 Wed Mar 24 19:52:54 2004 +++ movitz/losp/muerte/environment.lisp Thu Mar 25 20:35:29 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.4 2004/03/25 00:52:54 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.5 2004/03/26 01:35:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -94,9 +94,10 @@ (declare (dynamic-extent results)) (let ((*trace-escape* t)) (fresh-line *trace-output*) - (dotimes (i *trace-level*) + (dotimes (i (min *trace-level* 10)) (write-string " " *trace-output*)) - (format *trace-output* "~&~D: =>~{ ~W~^,~}.~%" *trace-level* results) + (format *trace-output* "~D: =>~{ ~W~^,~}.~%" + *trace-level* results) (values-list results))) (let ((*trace-level* (1+ *trace-level*)) (*trace-escape* nil))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 26 Mar '04

26 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19195 Modified Files: compiler.lisp Log Message: Forgot to :init-lexvar &key bindings. Caused a nasty bug. Date: Thu Mar 25 20:34:13 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.35 movitz/compiler.lisp:1.36 --- movitz/compiler.lisp:1.35 Wed Mar 24 19:54:07 2004 +++ movitz/compiler.lisp Thu Mar 25 20:34:13 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.35 2004/03/25 00:54:07 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.36 2004/03/26 01:34:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -4079,7 +4079,9 @@ (cond ((and (movitz-constantp (optional-function-argument-init-form binding)) (< 1 position)) - `( + `((:init-lexvar ,binding) + ,@(when supplied-p-var + `((:init-lexvar ,supplied-p-binding))) ,@(compiler-call #'compile-self-evaluating :form (eval-form (optional-function-argument-init-form binding) env nil) :funobj funobj @@ -4105,7 +4107,10 @@ (:movl (:ebp (:ecx 4) ,(* -4 (1- (1+ position)))) :ebx) default-done (:store-lexical ,binding :ebx :type t))) - (t `((:arg-cmp ,(+ 2 position)) + (t `((:init-lexvar ,binding) + ,@(when supplied-p-var + `((:init-lexvar ,supplied-p-binding))) + (:arg-cmp ,(+ 2 position)) (:jb '(:sub-program (default) ,@(append (when supplied-p-var

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20042 Modified Files: basic-functions.lisp Log Message: The functions malloc-words and malloc-clumps are needed to do anything, of course.. Date: Thu Mar 25 06:27:01 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.5 movitz/losp/muerte/basic-functions.lisp:1.6 --- movitz/losp/muerte/basic-functions.lisp:1.5 Tue Mar 23 05:53:25 2004 +++ movitz/losp/muerte/basic-functions.lisp Thu Mar 25 06:27:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.5 2004/03/23 10:53:25 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.6 2004/03/25 11:27:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -354,4 +354,18 @@ (:addl :ecx :eax)))) (defun %word-offset (word offset) - (%word-offset word offset)) \ No newline at end of file + (%word-offset word offset)) + +(defun malloc-words (words) + (malloc-clumps (1+ (truncate (1+ words) 2)))) + +(defun malloc-clumps (clumps) + (let ((x (with-inline-assembly (:returns :eax :side-effects t) + (:compile-form (:result-mode :ebx) clumps) + (:shll 1 :ebx) + (:globally (:call (:edi (:edi-offset malloc)))) + (:addl #.(movitz::tag :other) :eax)))) + (dotimes (i clumps) + (setf (memref x -6 i :lisp) nil + (memref x -2 i :lisp) nil)) + x))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32192 Modified Files: arrays.lisp Log Message: Remember to initialize flags fields when constructing simple-vectors. Date: Thu Mar 25 06:17:22 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.7 movitz/losp/muerte/arrays.lisp:1.8 --- movitz/losp/muerte/arrays.lisp:1.7 Mon Mar 22 11:37:47 2004 +++ movitz/losp/muerte/arrays.lisp Thu Mar 25 06:17:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.7 2004/03/22 16:37:47 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.8 2004/03/25 11:17:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -555,12 +555,15 @@ :other-tag :vector :wide-other-tag #.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)))) - (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::type) - 0 :unsigned-byte16) - #.(movitz:vector-type-tag :any-t)) (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::num-elements) 0 :unsigned-byte16) dimensions) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::flags) + 0 :unsigned-byte16) + 0) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::type) + 0 :unsigned-byte16) + #.(movitz:vector-type-tag :any-t)) (setf (fill-pointer array) fill-pointer) (cond (initial-contents

1 0

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv13432 Modified Files: los0.lisp Log Message: Add notification about *build-number* in genesis. Date: Thu Mar 25 04:24:01 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.5 movitz/losp/los0.lisp:1.6 --- movitz/losp/los0.lisp:1.5 Wed Mar 24 08:25:13 2004 +++ movitz/losp/los0.lisp Thu Mar 25 04:24:00 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.5 2004/03/24 13:25:13 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.6 2004/03/25 09:24:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -595,9 +595,6 @@ (memref-int #x1000004 0 0 :unsigned-byte8))) - - - ;;;;; ;;;;;;;;;;;;;;; CL @@ -863,6 +860,7 @@ (let ((* nil) (** nil) (*** nil) (/ nil) (// nil) (/// nil) (+ nil) (++ nil) (+++ nil)) + (format t "~&Movitz image Los0 build ~D." *build-number*) (loop (catch :top-level-repl ; If restarts don't work, you can throw this.. (with-simple-restart (abort "Abort to the top command level.")

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3327 Modified Files: basic-macros.lisp Log Message: Add "pointer" to the set of types that check-type inlines. Date: Wed Mar 24 19:55:12 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.4 movitz/losp/muerte/basic-macros.lisp:1.5 --- movitz/losp/muerte/basic-macros.lisp:1.4 Fri Feb 20 10:10:43 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Mar 24 19:55:12 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.4 2004/02/20 15:10:43 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.5 2004/03/25 00:55:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -510,7 +510,7 @@ ((movitz:movitz-constantp place env) (assert (typep (movitz::eval-form place env) type)) nil) - (t (if (member type '(standard-gf-instance function + (t (if (member type '(standard-gf-instance function pointer integer fixnum cons symbol character null list string vector simple-vector vector-u8 vector-u16)) `(unless (typep ,place ',type)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11463 Modified Files: compiler.lisp Log Message: Fixed nasty little bug in assign-bindings that would mess up everything if a function argument variable was lended to some closure. Date: Wed Mar 24 19:54:07 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.34 movitz/compiler.lisp:1.35 --- movitz/compiler.lisp:1.34 Wed Mar 24 13:38:18 2004 +++ movitz/compiler.lisp Wed Mar 24 19:54:07 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.34 2004/03/24 18:38:18 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.35 2004/03/25 00:54:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2619,7 +2619,7 @@ ((typep binding 'forwarding-binding)) ((typep binding 'borrowed-binding)) ((typep binding 'fixed-required-function-argument) - (prog1 t + (prog1 nil ; may need lending-cons (setf (new-binding-location binding frame-map) :argument-stack))) ((not (plusp (or (car (gethash binding var-counts)) 0)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/environment.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5443 Modified Files: environment.lisp Log Message: Re-wrote the way tracing works. Use a designated closure for each traced function, rather than the same trace-wrapper function for everyone. Seems to work much better. Date: Wed Mar 24 19:52:54 2004 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.3 movitz/losp/muerte/environment.lisp:1.4 --- movitz/losp/muerte/environment.lisp:1.3 Wed Mar 24 14:33:40 2004 +++ movitz/losp/muerte/environment.lisp Wed Mar 24 19:52:54 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.3 2004/03/24 19:33:40 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.4 2004/03/25 00:52:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -67,60 +67,52 @@ ((equal name 'eval) (return nil)))))) -(defun trace-wrapper (&edx function-name-symbol &rest args) - (declare (dynamic-extent args)) - (check-type function-name-symbol symbol) - (let ((map (assoc function-name-symbol *trace-map* - :key #'function-name-symbol))) - (assert map () - "~S is not traced!?" function-name-symbol) - (let ((function-name (car map)) - (function (cadr map)) - (callers (caddr map))) - (cond - ((or *trace-escape* - (and (not (eq t callers)) - (notany 'match-caller callers))) - (apply function args)) - (t (let ((*trace-escape* t)) - (fresh-line *trace-output*) - (dotimes (i *trace-level*) - (write-string " " *trace-output*)) - (format *trace-output* "~D: (~S~{ ~S~})~%" - *trace-level* function-name args)) - (multiple-value-call - (lambda (&rest results) - (declare (dynamic-extent results)) - (let ((*trace-escape* t)) - (fresh-line *trace-output*) - (dotimes (i *trace-level*) - (write-string " " *trace-output*)) - (format *trace-output* "~&~D: =>~{ ~W~^,~}.~%" *trace-level* results) - (values-list results))) - (apply function args))))))) - (defun do-trace (function-name &key (callers t)) (when (assoc function-name *trace-map* :test #'equal) (do-untrace function-name)) (let ((function-symbol (function-name-symbol function-name))) (assert (fboundp function-symbol) (function-name) "Can't trace undefined function ~S." function-name) - (push (list function-name - (symbol-function function-symbol) - callers) - *trace-map*) - (setf (symbol-function function-symbol) - #'trace-wrapper)) + (let* ((real-function (symbol-function function-symbol)) + (wrapper (lambda (&rest args) + (declare (dynamic-extent args)) + (if *trace-escape* + (apply real-function args) + (let ((*trace-escape* t)) + (cond + ((and (not (eq t callers)) + (notany 'match-caller callers)) + (apply real-function args)) + (t (let ((*trace-escape* t)) + (fresh-line *trace-output*) + (dotimes (i *trace-level*) + (write-string " " *trace-output*)) + (format *trace-output* "~D: (~S~{ ~S~})~%" + *trace-level* function-name args)) + (multiple-value-call + (lambda (&rest results) + (declare (dynamic-extent results)) + (let ((*trace-escape* t)) + (fresh-line *trace-output*) + (dotimes (i *trace-level*) + (write-string " " *trace-output*)) + (format *trace-output* "~&~D: =>~{ ~W~^,~}.~%" *trace-level* results) + (values-list results))) + (let ((*trace-level* (1+ *trace-level*)) + (*trace-escape* nil)) + (apply real-function args)))))))))) + (push (cons function-name + real-function) + *trace-map*) + (setf (symbol-function function-symbol) + wrapper))) (values)) (defun do-untrace (name) (let ((map (assoc name *trace-map*))) (assert map () "~S is not traced." name) (let ((function-name-symbol (function-name-symbol name)) - (function (cadr map))) - (unless (eq (symbol-function function-name-symbol) - #'trace-wrapper) - (warn "~S was traced, but not fbound to trace-wrapper." name)) + (function (cdr map))) (setf (symbol-function function-name-symbol) function) (setf *trace-map*

1 0

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 25 Mar '04

25 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv15200 Modified Files: repl.lisp Log Message: Some refactoring of read-eval-print. Now supports *repl-consless* which basically disables the / // /// variables, in order not to cons up lists for them. Date: Wed Mar 24 19:40:37 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.4 movitz/losp/lib/repl.lisp:1.5 --- movitz/losp/lib/repl.lisp:1.4 Wed Feb 18 06:48:20 2004 +++ movitz/losp/lib/repl.lisp Wed Mar 24 19:40:35 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.4 2004/02/18 11:48:20 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.5 2004/03/25 00:40:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,8 +23,9 @@ (defparameter *repl-level* -1) (defparameter *repl-prompter* 'default-repl-prompter) (defparameter *repl-prompt-context* nil) -(defparameter *repl-print-format* "~{~&~W~}") +(defparameter *repl-print-format* "~@{~&~W~}") (defvar *repl-readline-context*) +(defvar *repl-consless* nil) (defun default-repl-prompter () (fresh-line) @@ -44,37 +45,41 @@ (terpri) (multiple-value-bind (form buffer-pointer) (handler-bind - ((muerte::missing-delimiter - (lambda (c) - (declare (ignore c)) - (format t "~&> ") - (invoke-restart 'muerte::next-line - (muerte.readline:contextual-readline *repl-readline-context*))))) + (#+ignore (muerte::missing-delimiter + (lambda (c) + (declare (ignore c)) + (format t "~&> ") + (invoke-restart 'muerte::next-line + (muerte.readline:contextual-readline *repl-readline-context*))))) (simple-read-from-string buffer-string t t)) - (let ((results (multiple-value-list - (if (keywordp form) - (apply 'muerte.toplevel:invoke-toplevel-command - form - (loop for arg = (multiple-value-bind (arg x) - (simple-read-from-string - buffer-string nil 'eof - :start buffer-pointer) - (setq buffer-pointer x) - arg) - until (eq arg 'eof) - collect arg)) - (eval form))))) - (unless (boundp '*) - (warn "* was unbound!") - (setf * nil)) - (format t *repl-print-format* results) - (psetq +++ ++ ++ + + form) - (psetq *** ** ** * * (first results)) - (psetq /// // // / / results)) - (unless (packagep *package*) - (warn "Resetting *package*..") - (setf *package* previous-package)))) - (values-list /)) + (multiple-value-call + (lambda (form previous-package &rest results) + (declare (dynamic-extent results)) + (unless (packagep *package*) + (warn "Resetting *package*") + (setf *package* previous-package)) + (unless (boundp '*) + (warn "* was unbound!") + (setf * nil)) + (apply #'format t *repl-print-format* results) + (psetq +++ ++ ++ + + form) + (psetq *** ** ** * * (car results)) + (psetq /// // // / / (if *repl-consless* + nil + (copy-list results))) + (values-list results)) + form previous-package + (if (not (keywordp form)) + (eval form) + (apply 'muerte.toplevel:invoke-toplevel-command + form + (loop for arg = (multiple-value-bind (arg x) + (simple-read-from-string buffer-string nil 'eof + :start buffer-pointer) + (setq buffer-pointer x) + arg) + until (eq arg 'eof) + collect arg))))))) #+ignore (muerte.readline::readline-break (c) (declare (ignore c)) (values))))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs