movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

20 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3082 Modified Files: format.lisp Log Message: For (format nil ...) make initial output string somewhat longer. Date: Thu May 20 13:47:24 2004 Author: ffjeld Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.4 movitz/losp/muerte/format.lisp:1.5 --- movitz/losp/muerte/format.lisp:1.4 Tue Apr 13 10:21:57 2004 +++ movitz/losp/muerte/format.lisp Thu May 20 13:47:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Mar 23 01:18:36 2002 ;;;; -;;;; $Id: format.lisp,v 1.4 2004/04/13 14:21:57 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.5 2004/05/20 17:47:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,7 +30,7 @@ (declare (dynamic-extent args)) (let ((destination (case destination - ((nil) (make-array (* 2 (length control)) + ((nil) (make-array (* 3 (length control)) :element-type 'character :fill-pointer 0)) ((t) *standard-output*)

1 0

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

20 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31939 Modified Files: basic-macros.lisp Log Message: Make defpackage :use list translate the common-lisp package to the muerte.common-lisp package, so as to better support movitz-compiling the same code as normal. Date: Thu May 20 13:43:47 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.17 movitz/losp/muerte/basic-macros.lisp:1.18 --- movitz/losp/muerte/basic-macros.lisp:1.17 Mon Apr 19 11:06:26 2004 +++ movitz/losp/muerte/basic-macros.lisp Thu May 20 13:43:46 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.17 2004/04/19 15:06:26 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.18 2004/05/20 17:43:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,12 +65,19 @@ (defmacro defpackage (package-name &rest options) (pushnew '(:use) options :key #'car) (let ((uses (cdr (assoc :use options)))) + (setf uses (mapcar (lambda (use) + (if (member use '(:cl :common-lisp) :test #'string=) + :muerte.cl + use)) + uses)) (when (or (null uses) (member :muerte.cl uses :test #'string=) (member :muerte.common-lisp uses :test #'string=)) - (push '(:shadowing-import-from :common-lisp nil) options))) - `(eval-when (:compile-toplevel) - (defpackage ,package-name ,@options))) + (push '(:shadowing-import-from :common-lisp nil) options)) + (let ((movitz-options (cons (cons :use uses) + (remove :use options :key #'car)))) + `(eval-when (:compile-toplevel) + (defpackage ,package-name ,@movitz-options))))) (defmacro cond (&rest clauses) (if (null clauses)

1 0

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

20 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23259 Modified Files: arrays.lisp Log Message: A slightly improved vector-push-extend. Date: Thu May 20 13:41:46 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.18 movitz/losp/muerte/arrays.lisp:1.19 --- movitz/losp/muerte/arrays.lisp:1.18 Fri Apr 23 10:59:55 2004 +++ movitz/losp/muerte/arrays.lisp Thu May 20 13:41:46 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.18 2004/04/23 14:59:55 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.19 2004/05/20 17:41:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -611,7 +611,16 @@ (defun vector-push-extend (new-element vector &optional extension) (declare (ignore extension)) - (vector-push new-element vector)) + (check-type vector vector) + (let ((p (vector-fill-pointer vector))) + (declare (type (unsigned-byte 16) p)) + (cond + ((< p (vector-dimension vector)) + (setf (aref vector p) new-element + (fill-pointer vector) (1+ p))) + (t (error "Vector-push extending not implemented yet."))) + p)) + (define-compiler-macro bvref-u16 (&whole form vector offset index &environment env) (let ((actual-index (and (movitz:movitz-constantp index env)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1920 Modified Files: integers.lisp Log Message: Added floor. Date: Wed May 19 11:42:08 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.9 movitz/losp/muerte/integers.lisp:1.10 --- movitz/losp/muerte/integers.lisp:1.9 Wed May 19 11:09:05 2004 +++ movitz/losp/muerte/integers.lisp Wed May 19 11:42:08 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.9 2004/05/19 15:09:05 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.10 2004/05/19 15:42:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1132,3 +1132,19 @@ (gcd gcd (car rest))) (rest (cdr numbers) (cdr rest))) ((null rest) gcd))))) + +(defun floor (n &optional (divisor 1)) + "This is floor written in terms of truncate." + (numargs-case + (1 (n) n) + (2 (n divisor) + (multiple-value-bind (q r) + (truncate n divisor) + (cond + ((<= 0 q) + (values q r)) + ((= 0 r) + (values q 0)) + (t (values (1- q) (+ r divisor)))))) + (t (n &optional (divisor 1)) + (floor n divisor)))) \ No newline at end of file

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24256 Modified Files: integers.lisp Log Message: Added gcd, mainly borrowed from cmucl. Date: Wed May 19 11:09:07 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.8 movitz/losp/muerte/integers.lisp:1.9 --- movitz/losp/muerte/integers.lisp:1.8 Fri Apr 23 09:02:22 2004 +++ movitz/losp/muerte/integers.lisp Wed May 19 11:09:05 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.8 2004/04/23 13:02:22 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.9 2004/05/19 15:09:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1103,3 +1103,32 @@ (defun minus-if (x y) (if (integerp x) (- x y) x)) +(defun gcd (&rest numbers) + (numargs-case + (1 (u) u) + (2 (u v) + ;; Code borrowed from CMUCL. + (do ((k 0 (1+ k)) + (u (abs u) (ash u -1)) + (v (abs v) (ash v -1))) + ((oddp (logior u v)) + (do ((temp (if (oddp u) (- v) (ash u -1)) + (ash temp -1))) + (nil) + (declare (fixnum temp)) + (when (oddp temp) + (if (plusp temp) + (setq u temp) + (setq v (- temp))) + (setq temp (- u v)) + (when (zerop temp) + (let ((res (ash u k))) + (declare (type (signed-byte 31) res) + (optimize (inhibit-warnings 3))) + (return res)))))))) + (t (&rest numbers) + (declare (dynamic-extent numbers)) + (do ((gcd (car numbers) + (gcd gcd (car rest))) + (rest (cdr numbers) (cdr rest))) + ((null rest) gcd)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette-compiler.lisp
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4421 Modified Files: los-closette-compiler.lisp Log Message: Accept (but ignore) the :documentation class option. Date: Wed May 19 11:02:50 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.12 movitz/losp/muerte/los-closette-compiler.lisp:1.13 --- movitz/losp/muerte/los-closette-compiler.lisp:1.12 Mon Apr 19 18:38:22 2004 +++ movitz/losp/muerte/los-closette-compiler.lisp Wed May 19 11:02:50 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 29 13:15:11 2002 ;;;; -;;;; $Id: los-closette-compiler.lisp,v 1.12 2004/04/19 22:38:22 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.13 2004/05/19 15:02:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -674,8 +674,9 @@ (apply #'initialize-class-object class all-keys))) (defun make-instance-standard-class (metaclass &key name direct-superclasses direct-slots - default-initargs-function) - (declare (ignore metaclass)) + default-initargs-function + documentation) + (declare (ignore metaclass documentation)) (let ((class (std-allocate-instance *the-class-standard-class*))) (setf (movitz-class-name class) name) (setf (class-direct-subclasses class) ())

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11878 Modified Files: image.lisp Log Message: Added a small check for the package-name when dumping packages, so as not to blindly dump packages that are native to the host system should a symbol in such a package accidentally be referenced. Date: Wed May 19 10:59:53 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.27 movitz/image.lisp:1.28 --- movitz/image.lisp:1.27 Wed Apr 21 11:06:50 2004 +++ movitz/image.lisp Wed May 19 10:59:52 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.27 2004/04/21 15:06:50 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.28 2004/05/19 14:59:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1065,6 +1065,12 @@ name symbol) name))) (ensure-package (package-name lisp-package) + (assert (not (member (package-name lisp-package) + #+allegro '(excl common-lisp sys aclmop) + #-allegro '(common-lisp) + :test #'string=)) () + "I don't think you really want to dump the package ~A with Movitz." + lisp-package) (setf (gethash lisp-package lisp-to-movitz-package) (or (gethash package-name packages-hash nil) (let ((p (funcall 'muerte::make-package-object

1 0

[movitz-cvs] CVS update: movitz/movitz-mode.el
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv27298 Modified Files: movitz-mode.el Log Message: File-header edits. Date: Wed May 19 10:57:46 2004 Author: ffjeld Index: movitz/movitz-mode.el diff -u movitz/movitz-mode.el:1.4 movitz/movitz-mode.el:1.5 --- movitz/movitz-mode.el:1.4 Wed May 19 10:56:46 2004 +++ movitz/movitz-mode.el Wed May 19 10:57:46 2004 @@ -1,16 +1,16 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, -;;;; Department of Computer Science, University of Tromsø, Norway. +;;;; Copyright (C) 2001, 2004 +;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. ;;;; ;;;; Filename: movitz-mode.el -;;;; Description: +;;;; Description: Modifies Franz' ELI slightly to integrate with Movitz. ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Sep 27 18:12:17 2001 ;;;; -;;;; $Id: movitz-mode.el,v 1.4 2004/05/19 14:56:46 ffjeld Exp $ +;;;; $Id: movitz-mode.el,v 1.5 2004/05/19 14:57:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

1 0

[movitz-cvs] CVS update: movitz/movitz-mode.el
by Frode Vatvedt Fjeld 19 May '04

19 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24617 Modified Files: movitz-mode.el Log Message: Don't check for movitz-package in movitz-compile-file. Date: Wed May 19 10:56:46 2004 Author: ffjeld Index: movitz/movitz-mode.el diff -u movitz/movitz-mode.el:1.3 movitz/movitz-mode.el:1.4 --- movitz/movitz-mode.el:1.3 Mon Feb 2 08:31:23 2004 +++ movitz/movitz-mode.el Wed May 19 10:56:46 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Sep 27 18:12:17 2001 ;;;; -;;;; $Id: movitz-mode.el,v 1.3 2004/02/02 13:31:23 ffjeld Exp $ +;;;; $Id: movitz-mode.el,v 1.4 2004/05/19 14:56:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -113,12 +113,11 @@ (defun movitz-compile-file () (interactive) - (when (in-movitz-package-p) - (save-some-buffers) - (message "Movitz compiling \"%s\"..." (buffer-file-name)) - (fi:eval-in-lisp "(movitz:movitz-compile-file \"%s\")" (buffer-file-name)) - (message "Movitz compiling \"%s\"...done." - (buffer-file-name)))) + (save-some-buffers) + (message "Movitz compiling \"%s\"..." (buffer-file-name)) + (fi:eval-in-lisp "(movitz:movitz-compile-file \"%s\")" (buffer-file-name)) + (message "Movitz compiling \"%s\"...done." + (buffer-file-name))) (defun movitz-eval-in-acl (string msg) (fi::note-background-request nil) @@ -284,6 +283,11 @@ (when (in-movitz-package-p) (message "Switching to Movitz keymap.") (use-local-map (make-movitz-common-lisp-mode-map))))) + +(defun movitz-mode () + "Switch on Movitz-mode." + (interactive) + (use-local-map (make-movitz-common-lisp-mode-map))) (let ((tag 'fi:common-lisp-indent-hook)) (put 'compiler-values tag '(like with-open-file))

1 0

[movitz-cvs] CVS update: movitz/losp/tmp/harddisk.lisp
by Frode Vatvedt Fjeld 11 May '04

11 May '04

Update of /project/movitz/cvsroot/movitz/losp/tmp In directory common-lisp.net:/tmp/cvs-serv3598 Modified Files: harddisk.lisp Log Message: Updates from Peter Minten. Date: Tue May 11 11:05:28 2004 Author: ffjeld Index: movitz/losp/tmp/harddisk.lisp diff -u movitz/losp/tmp/harddisk.lisp:1.3 movitz/losp/tmp/harddisk.lisp:1.4 --- movitz/losp/tmp/harddisk.lisp:1.3 Wed May 5 04:26:14 2004 +++ movitz/losp/tmp/harddisk.lisp Tue May 11 11:05:25 2004 @@ -1,4 +1,4 @@ -;;;; $Id: harddisk.lisp,v 1.3 2004/05/05 08:26:14 ffjeld Exp $ +;;;; $Id: harddisk.lisp,v 1.4 2004/05/11 15:05:25 ffjeld Exp $ (require :lib/named-integers) @@ -7,6 +7,7 @@ (defpackage muerte.x86-pc.harddisk (:use muerte.cl muerte muerte.lib muerte.x86-pc) (:export hdc-reset + hd-identify-device hd-read-sectors hd-write-sectors)) @@ -118,19 +119,35 @@ (setf (lba-low-register hdc) (ldb (byte 8 0) lba)) (setf (lba-mid-register hdc) (ldb (byte 8 8) lba)) (setf (lba-high-register hdc) (ldb (byte 8 16) lba)) - (setf (device-register hdc) (dpb (ash (ldb (byte 4 24) lba) -24) + (setf (device-register hdc) (dpb (ldb (byte 4 24) lba) (byte 4 0) (device-register hdc)))) +(defun set-lba-address-ext (hdc lba) + (setf (lba-low-register hdc) (ldb (byte 8 0) lba)) + (setf (lba-mid-register hdc) (ldb (byte 8 8) lba)) + (setf (lba-high-register hdc) (ldb (byte 8 16) lba)) + + ;; movitz byte function has a restriction, the location must be <= 30 + ;; therefore this workaround + (setf (lba-low-register hdc) (ldb (byte 8 0) (ash lba -24))) + (setf (lba-mid-register hdc) (ldb (byte 8 8) (ash lba -24))) + (setf (lba-high-register hdc) (ldb (byte 8 16) (ash lba -24)))) + (defun set-sector-count (hdc count) (setf (sector-count-register hdc) count)) +(defun set-sector-count-ext (hdc count) + (setf (sector-count-register hdc) (ldb (byte 8 0) count)) + (setf (sector-count-register hdc) (ldb (byte 8 8) count))) + (defun set-command (hdc command) - (let ((command-code (case command - ('read-sectors-with-retry #x20) - ('write-sectors-with-retry #x30) - ('identify-drive #xCE)))) - (setf (command-register hdc) command-code))) + (setf (command-register hdc) (case command + ('identify-drive #xEC) + ('read-sectors #x20) + ('read-sectors-ext #x24) + ('write-sectors #x30) + ('write-sectors-ext #x34)))) ;;; ;;; misc @@ -139,11 +156,7 @@ (/= 0 (ldb (byte 1 number) place))) (defmacro set-bit (number value place) - (let ((gs-number (gensym "number-"))) - `(if ,value - (let ((,gs-number ,number)) - (setf ,place (dpb (ash 1 ,gs-number) (byte 1 ,gs-number) ,place))) - (setf ,place (dpb 0 (byte 1 ,number) ,place))))) + `(setf ,place (dpb (if ,value 1 0) (byte 1 ,number) ,place))) (defmacro while (test &body body) `(do () ((not ,test)) @@ -206,9 +219,57 @@ (loop for x from 1 to 2500) (loop while (reg-bsy hdc)))) +(defun hd-identify-device (hdnr) + "Get device information of hdnr. Returns a (vector 256 (unsigned-byte 16))." + (let ((data (make-array 256 :element-type :unsigned-byte16)) + (offset 0)) + (with-hd-info (hdc drive) hdnr + (tagbody + ;; drive must be ready + ;; drive number must be set + ;; intrq's must not be used + ;; LBA mode must be on + ;; LBA must be set + ;; sector-count must be set + ;; command must be entered + ;; 400 nsec must be waited before checking BSY + (loop until (reg-drdy hdc)) + (loop while (reg-alt-bsy hdc)) + (set-drive-number hdc drive) + (set-intrq-mode hdc nil) + (set-command hdc 'identify-drive) + (dotimes (x 500)) ;aught to be enough waiting + (go :check-status) + ;;;;;;;;;;;;;;;;;; + :check-status + ;; if BSY=0 and DRQ=0 then error + ;; if BSY=0 and DRQ=1 then go transfer-data + ;; if BSY=1 then go check-state + (let ((status (status-register hdc))) + (if (get-bit 7 status) ;if BSY = 1 + (go :check-status) + (if (get-bit 3 status) ;if DRQ = 1 + (go :transfer-data) + (progn + (hdc-error hdc "identify-device" hdnr))))) + ;;;;;;;;;;;;;;;;;; + :transfer-data + ;; read the data register + (setf (aref data offset) (data-register hdc)) + (incf offset) + ;; read the status register to determine if we're done + (if (reg-drq hdc) + (if (< offset 256) + (go :transfer-data) ;data block not completely transfered + (go :check-status)) + (return-from hd-identify-device data)))))) + (defun hd-read-sectors (hdnr start-sector count) + "Read count sectors from hdnr, starting at start-sector. Returns a (vector (* count 512) (unsigned-byte 8)). If start-sector doesn't fit into 28 bits or count doesn't fit into 8 bits an attempt is made to use 48 bits addressing." (let ((data (make-array (* count 512) :element-type :unsigned-byte8)) (offset 0) + (ext-mode (or (>= start-sector #xFFFFFFF) + (>= count #xFF))) input) (with-hd-info (hdc drive) hdnr (tagbody @@ -226,9 +287,20 @@ (set-drive-number hdc drive) (set-intrq-mode hdc nil) (set-lba-mode hdc t) + (if ext-mode + (progn + (puts "using 48 bits addressing") + (set-lba-address-ext hdc start-sector) + (set-sector-count-ext hdc count) + (set-command hdc 'read-sectors-ext)) + (progn + (puts "using 28 bits addressing") + (set-lba-address hdc start-sector) + (set-sector-count hdc count) + (set-command hdc 'read-sectors))) (set-lba-address hdc start-sector) (set-sector-count hdc count) - (set-command hdc 'read-sectors-with-retry) + (set-command hdc 'read-sectors) (dotimes (x 500)) ;aught to be enough waiting (go :check-status) ;;;;;;;;;;;;;;;;;; @@ -266,8 +338,10 @@ (check-type hdnr (integer 0 *)) (check-type start-sector (integer 0 *)) (check-type data vector) - (let ((count (truncate (length data) 512)) - (offset 0)) + (let* ((count (truncate (length data) 512)) + (ext-mode (or (>= start-sector #xFFFFFFF) + (>= count #xFF))) + (offset 0)) (with-hd-info (hdc drive) hdnr (tagbody ; (puts "in entry") @@ -284,9 +358,20 @@ (set-drive-number hdc drive) (set-intrq-mode hdc nil) (set-lba-mode hdc t) + (if ext-mode + (progn + (puts "using 48 bits addressing") + (set-lba-address-ext hdc start-sector) + (set-sector-count-ext hdc count) + (set-command hdc 'write-sectors-ext)) + (progn + (puts "using 28 bits addressing") + (set-lba-address hdc start-sector) + (set-sector-count hdc count) + (set-command hdc 'write-sectors))) (set-lba-address hdc start-sector) (set-sector-count hdc count) - (set-command hdc 'write-sectors-with-retry) + (set-command hdc 'write-sectors) (dotimes (x 500)) ;aught to be enough waiting (go :check-status) ;;;;;;;;;;;;;;;;;; @@ -315,4 +400,4 @@ (progn (alt-status-register hdc) ;read and ignore (go :check-status))) - (return-from hd-write-sectors nil)))))) + (return-from hd-write-sectors nil)))))) \ No newline at end of file

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