movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/tmp/packet.lisp
by Luke Gorrie 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/tmp In directory common-lisp.net:/tmp/cvs-serv29764 Added Files: packet.lisp Log Message: Imported packet.lisp "version 2" from small-cl-src mailing list. Date: Wed Jul 21 05:02:15 2004 Author: lgorrie

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4295 Modified Files: inspect.lisp Log Message: Added docstring to objects-equalp, and removed some debugging lines. Date: Wed Jul 21 04:49:48 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.28 movitz/losp/muerte/inspect.lisp:1.29 --- movitz/losp/muerte/inspect.lisp:1.28 Wed Jul 21 04:48:16 2004 +++ movitz/losp/muerte/inspect.lisp Wed Jul 21 04:49:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.28 2004/07/21 11:48:16 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.29 2004/07/21 11:49:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -205,12 +205,8 @@ (structure-object (copy-structure old)))) -(defvar *objects-equalp-last-x*) -(defvar *objects-equalp-last-y*) - (defun objects-equalp (x y) - (setf *objects-equalp-last-x* x - *objects-equalp-last-y* y) + "Basically, this verifies whether x is a shallow-copy of y, or vice versa." (or (eql x y) (if (not (and (typep x 'pointer) (typep y 'pointer)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10288 Modified Files: inspect.lisp Log Message: Added support for symbols in objects-equalp. Date: Wed Jul 21 04:48:16 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.27 movitz/losp/muerte/inspect.lisp:1.28 --- movitz/losp/muerte/inspect.lisp:1.27 Tue Jul 20 16:53:00 2004 +++ movitz/losp/muerte/inspect.lisp Wed Jul 21 04:48:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.27 2004/07/20 23:53:00 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.28 2004/07/21 11:48:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -232,6 +232,13 @@ (test funobj-num-jumpers) (dotimes (i (funobj-num-constants x) t) (unless (test funobj-constant-ref i))))) + (symbol + (and (test memref -7 0 :lisp) + (test memref -7 1 :lisp) + (test memref -7 2 :lisp) + (test memref -7 3 :lisp) + (test memref -7 4 :lisp) + (test memref -7 5 :lisp))) (vector (and (typep y 'vector) (test array-element-type)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Luke Gorrie 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5452 Modified Files: arrays.lisp Log Message: Fixed a bug where (make-array '(K)) was mistaken for multi-dimensional (which is not supported). The dimension argument was not allowed to be a cons even if it was really a one-element list. Date: Wed Jul 21 04:47:49 2004 Author: lgorrie Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.37 movitz/losp/muerte/arrays.lisp:1.38 --- movitz/losp/muerte/arrays.lisp:1.37 Tue Jul 20 05:38:59 2004 +++ movitz/losp/muerte/arrays.lisp Wed Jul 21 04:47:49 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.37 2004/07/20 12:38:59 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.38 2004/07/21 11:47:49 lgorrie Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -685,23 +685,25 @@ (defun make-array (dimensions &key element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset) (declare (ignore adjustable displaced-to displaced-index-offset)) - (etypecase dimensions - (cons - (error "Multi-dimensional arrays not supported.")) - (integer - (cond + (let ((size (cond ((integerp dimensions) + dimensions) + ((and (consp dimensions) (null (cdr dimensions))) + (car dimensions)) + (t + (error "Multi-dimensional arrays not supported."))))) + (cond ;; These should be replaced by subtypep sometime. ((eq element-type 'character) - (make-basic-vector%character dimensions fill-pointer initial-element initial-contents)) + (make-basic-vector%character size fill-pointer initial-element initial-contents)) ((member element-type '(bit (unsigned-byte 1)) :test #'equal) - (make-basic-vector%bit dimensions fill-pointer initial-element initial-contents)) + (make-basic-vector%bit size fill-pointer initial-element initial-contents)) ((member element-type '(u8 (unsigned-byte 8)) :test #'equal) - (make-basic-vector%u8 dimensions fill-pointer initial-element initial-contents)) + (make-basic-vector%u8 size fill-pointer initial-element initial-contents)) ((member element-type '(u32 (unsigned-byte 32)) :test #'equal) - (make-basic-vector%u32 dimensions fill-pointer initial-element initial-contents)) + (make-basic-vector%u32 size fill-pointer initial-element initial-contents)) ((eq element-type 'code) - (make-basic-vector%code dimensions fill-pointer initial-element initial-contents)) - (t (make-basic-vector%t dimensions fill-pointer initial-element initial-contents)))))) + (make-basic-vector%code size fill-pointer initial-element initial-contents)) + (t (make-basic-vector%t size fill-pointer initial-element initial-contents))))) (defun vector (&rest objects) "=> vector"

1 0

[movitz-cvs] CVS update: movitz/bochsrc.txt
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19298 Modified Files: bochsrc.txt Log Message: Minor edits. Date: Wed Jul 21 04:45:52 2004 Author: ffjeld Index: movitz/bochsrc.txt diff -u movitz/bochsrc.txt:1.4 movitz/bochsrc.txt:1.5 --- movitz/bochsrc.txt:1.4 Wed Jul 14 17:29:39 2004 +++ movitz/bochsrc.txt Wed Jul 21 04:45:52 2004 @@ -1,6 +1,20 @@ -############################################################### -# bochsrc.txt file for DLX Linux disk image. -############################################################### +###################################################################### +## +## Copyright (C) 2003-2004, +## Department of Computer Science, University of Tromso, Norway. +## +## For distribution policy, see the accompanying file COPYING. +## +## Filename: bochsrc.txt +## Description: Bochs configuration file for frodef's Movitz setup. +## You can use this as a template, but you'll need to +## change the file paths etc. +## Author: Frode Vatvedt Fjeld <frodef(a)acm.org> +## Created at: Wed Jul 21 13:41:59 2004 +## +## $Id: bochsrc.txt,v 1.5 2004/07/21 11:45:52 ffjeld Exp $ +## +###################################################################### # how much memory the emulated machine will have megs: 64 @@ -11,6 +25,9 @@ romimage: file=../../tmp/bochs-cvs/bios/BIOS-bochs-latest, address=0xf0000 vgaromimage: ../../tmp/bochs-cvs/bios/VGABIOS-elpin-2.40 +# This is just to make X11 clipboard pasting into bochs work. +keyboard_mapping: enabled=1, map=../../tmp/bochs-cvs/gui/keymaps/x11-pc-us.map + # what disk images will be used floppya: 1_44=los0-image, status=inserted #floppya: 1_44=grub, status=inserted @@ -18,8 +35,6 @@ #diskc: file=hd10meg.img, cyl=306, heads=4, spt=17 #newharddrivesupport: enabled=1 -# This is just to make X11 clipboard pasting into bochs work. -keyboard_mapping: enabled=1, map=../../tmp/bochs-cvs/gui/keymaps/x11-pc-us.map # choose the boot disk. boot: a

1 0

[movitz-cvs] CVS update: movitz/ide/movitz-slime.el movitz/ide/ide.lisp
by Luke Gorrie 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/ide In directory common-lisp.net:/tmp/cvs-serv4064/ide Added Files: movitz-slime.el ide.lisp Log Message: Date: Wed Jul 21 03:54:42 2004 Author: lgorrie

1 0

[movitz-cvs] CVS update: Directory change: movitz/ide
by Luke Gorrie 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/ide In directory common-lisp.net:/tmp/cvs-serv16128/ide Log Message: Directory /project/movitz/cvsroot/movitz/ide added to the repository Date: Wed Jul 21 03:47:24 2004 Author: lgorrie New directory movitz/ide added

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv25217 Modified Files: debugger.lisp Log Message: Some tweaks to backtrace. Date: Tue Jul 20 16:53:48 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.17 movitz/losp/x86-pc/debugger.lisp:1.18 --- movitz/losp/x86-pc/debugger.lisp:1.17 Tue Jul 20 05:40:48 2004 +++ movitz/losp/x86-pc/debugger.lisp Tue Jul 20 16:53:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.17 2004/07/20 12:40:48 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.18 2004/07/20 23:53:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -431,8 +431,10 @@ (serious-condition (conditon) (write-string "#<error printing frame>")))) -(defun backtrace (&key ((:frame initial-stack-frame) - (or *debugger-invoked-stack-frame* +(defun backtrace (&key stack + ((:frame initial-stack-frame) + (or (and stack (svref%unsafe stack 0)) + *debugger-invoked-stack-frame* (current-stack-frame))) ((:spartan *backtrace-be-spartan-p*)) ((:fresh-lines *backtrace-do-fresh-lines*) *backtrace-do-fresh-lines*) @@ -445,7 +447,10 @@ (*print-length* *backtrace-print-length*) (*print-level* *backtrace-print-level*)) (loop with conflate-count = 0 with count = 0 - for stack-frame = initial-stack-frame then (stack-frame-uplink stack-frame) + for stack-frame = initial-stack-frame + then (let ((uplink (stack-frame-uplink stack-frame))) + (assert (> uplink stack-frame)) + uplink) as funobj = (stack-frame-funobj stack-frame t) do (flet ((print-leadin (stack-frame count conflate-count) (when *backtrace-do-fresh-lines*

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11057 Modified Files: inspect.lisp Log Message: Wrote function copy-control-stack, which does that. Date: Tue Jul 20 16:53:00 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.26 movitz/losp/muerte/inspect.lisp:1.27 --- movitz/losp/muerte/inspect.lisp:1.26 Tue Jul 20 05:37:59 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jul 20 16:53:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.26 2004/07/20 12:37:59 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.27 2004/07/20 23:53:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -105,8 +105,8 @@ (<= bottom pointer top))) (defun stack-ref (pointer offset index type) - (assert (stack-ref-p pointer) (pointer) - "Stack pointer not in range: #x~X" pointer) + #+ignore (assert (stack-ref-p pointer) (pointer) + "Stack pointer not in range: #x~X" pointer) (memref-int pointer offset index type)) (defun current-dynamic-context () @@ -336,3 +336,25 @@ #.(movitz::movitz-type-word-size :movitz-struct) (* 2 (truncate (+ (structure-object-length object) 1) 2)))))))) + +(defun copy-control-stack (&optional (stack (%run-time-context-slot 'stack-vector)) + (frame (current-stack-frame))) + (assert (location-in-object-p stack frame)) + (let* ((stack-start-location (+ 2 (object-location stack))) + (frame-index (- frame stack-start-location)) + (copy (subseq stack frame-index)) + (copy-start-location (+ 2 (object-location copy))) + (cc (subseq copy 0))) + (do ((i 0)) (nil) + (let ((uplink-frame (svref%unsafe copy i))) + (cond + ((= 0 uplink-frame) + (setf (svref%unsafe copy i) 0) + (return (values copy cc))) + (t (let ((uplink-index (- uplink-frame stack-start-location frame-index))) + (assert (< -1 uplink-index (length copy)) () + "Uplink-index outside copy: ~S, i: ~S" uplink-index i) + (let ((x (+ uplink-index copy-start-location))) + (assert (location-in-object-p copy x)) + (setf (svref%unsafe copy i) x) + (setf i uplink-index)))))))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26465 Modified Files: primitive-functions.lisp Log Message: Moved some macros to new files and changed the order files are loaded/compiled. The idea is to not compile function-calls before compiler-macros are defined, etc. Date: Tue Jul 20 16:51:19 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.32 movitz/losp/muerte/primitive-functions.lisp:1.33 --- movitz/losp/muerte/primitive-functions.lisp:1.32 Tue Jul 20 06:00:00 2004 +++ movitz/losp/muerte/primitive-functions.lisp Tue Jul 20 16:51:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.32 2004/07/20 13:00:00 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.33 2004/07/20 23:51:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,13 +19,6 @@ (in-package muerte) -(defmacro define-primitive-function (function-name lambda-list docstring &body body) - (declare (ignore lambda-list)) - (assert (stringp docstring) (docstring) - "Mandatory docstring for define-primitive-function.") - `(make-primitive-function ,function-name ,docstring - ,(cons 'cl:progn body))) - (define-primitive-function trampoline-funcall%1op () "Call a function with 1 argument" (with-inline-assembly (:returns :nothing) @@ -470,23 +463,13 @@ (:leal (:eax :ecx 6) :eax) (:ret))) -(define-compiler-macro malloc-pointer-words (words) - `(with-inline-assembly (:returns :eax :type pointer) - (:compile-form (:result-mode :eax) ,words) - (:call-local-pf malloc-pointer-words))) - (defun malloc-pointer-words (words) (check-type words (integer 2 *)) - (malloc-pointer-words words)) - -(define-compiler-macro malloc-non-pointer-words (words) - `(with-inline-assembly (:returns :eax :type pointer) - (:compile-form (:result-mode :eax) ,words) - (:call-local-pf malloc-non-pointer-words))) + (compiler-macro-call malloc-pointer-words words)) (defun malloc-non-pointer-words (words) (check-type words (integer 2 *)) - (malloc-non-pointer-words words)) + (compiler-macro-call malloc-non-pointer-words words)) (define-primitive-function muerte::get-cons-pointer () "Return in EAX the next object location with space for EAX words, with tag 6.

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